Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3715/tests

Modified Files:
	clos.impure.lisp 
Log Message:
0.8.15.5:
	Fix for DEFGENERIC/FUNCTION/:METHOD interaction (Zach Beane
	2004-09-29 sbcl-devel)


Index: clos.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -d -r1.56 -r1.57
--- clos.impure.lisp	1 Oct 2004 12:35:27 -0000	1.56
+++ clos.impure.lisp	1 Oct 2004 13:24:22 -0000	1.57
@@ -840,6 +840,14 @@
                                         (defgeneric nonsense ())))))
         'generic-function))
 
+(assert
+ (typep (funcall (compile nil
+                          '(lambda () (flet ((nonsense-2 () nil))
+                                        (defgeneric nonsense-2 ()
+                                          (:method () t))))))
+        'generic-function))
+
+
 
 ;;;; success
 (sb-ext:quit :unix-status 104)

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3715

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.15.5:
	Fix for DEFGENERIC/FUNCTION/:METHOD interaction (Zach Beane
	2004-09-29 sbcl-devel)


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.629
retrieving revision 1.630
diff -u -d -r1.629 -r1.630
--- NEWS	1 Oct 2004 12:35:26 -0000	1.629
+++ NEWS	1 Oct 2004 13:24:21 -0000	1.630
@@ -6,6 +6,9 @@
     redefinition of generic functions with no DEFGENERIC to an
     incompatible lambda list now signals an error.  (thanks to Zach
     Beane)
+  * bug fix: DEFGENERIC now works even when there's a function of the
+    same name in an enclosing lexical environment.  (thanks to Zach
+    Beane)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** POSITION on displaced vectors with non-zero displacement
        returns the right answer.

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1845
retrieving revision 1.1846
diff -u -d -r1.1845 -r1.1846
--- version.lisp-expr	1 Oct 2004 12:35:26 -0000	1.1845
+++ version.lisp-expr	1 Oct 2004 13:24:22 -0000	1.1846
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.15.4"
+"0.8.15.5"

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3715/src/pcl

Modified Files:
	boot.lisp 
Log Message:
0.8.15.5:
	Fix for DEFGENERIC/FUNCTION/:METHOD interaction (Zach Beane
	2004-09-29 sbcl-devel)


Index: boot.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -d -r1.84 -r1.85
--- boot.lisp	1 Oct 2004 12:35:27 -0000	1.84
+++ boot.lisp	1 Oct 2004 13:24:22 -0000	1.85
@@ -165,7 +165,7 @@
 		    (qualifiers (subseq qab 0 arglist-pos))
 		    (body (nthcdr (1+ arglist-pos) qab)))
 	       `(push (defmethod ,fun-name ,@qualifiers ,arglist ,@body)
-                      (generic-function-initial-methods #',fun-name)))))
+                      (generic-function-initial-methods (fdefinition ',fun-name))))))
       (macrolet ((initarg (key) `(getf initargs ,key)))
 	(dolist (option options)
 	  (let ((car-option (car option)))

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26838

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.15.4:
	Fix for method redefinition WARNING (Zach Beane sbcl-devel
	2004-09-24)
	... slight tweak to get &optional (stream *standard-output*)
		right.


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.628
retrieving revision 1.629
diff -u -d -r1.628 -r1.629
--- NEWS	30 Sep 2004 20:20:26 -0000	1.628
+++ NEWS	1 Oct 2004 12:35:26 -0000	1.629
@@ -1,6 +1,11 @@
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
   * bug fix: read-write consistency on streams of element-type
     (SIGNED-BYTE N) for N > 32.  (reported by Bruno Haible for CMUCL)
+  * bug fix: redefiniton of the only method of a generic function with
+    no DEFGENERIC no longer emits a full WARNING.  In addition,
+    redefinition of generic functions with no DEFGENERIC to an
+    incompatible lambda list now signals an error.  (thanks to Zach
+    Beane)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** POSITION on displaced vectors with non-zero displacement
        returns the right answer.

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1844
retrieving revision 1.1845
diff -u -d -r1.1844 -r1.1845
--- version.lisp-expr	30 Sep 2004 20:20:27 -0000	1.1844
+++ version.lisp-expr	1 Oct 2004 12:35:26 -0000	1.1845
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.15.3"
+"0.8.15.4"

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26838/tests

Modified Files:
	clos.impure.lisp 
Log Message:
0.8.15.4:
	Fix for method redefinition WARNING (Zach Beane sbcl-devel
	2004-09-24)
	... slight tweak to get &optional (stream *standard-output*)
		right.


Index: clos.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/clos.impure.lisp,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -d -r1.55 -r1.56
--- clos.impure.lisp	1 Sep 2004 19:59:11 -0000	1.55
+++ clos.impure.lisp	1 Oct 2004 12:35:27 -0000	1.56
@@ -450,8 +450,19 @@
 (defmethod incompatible-ll-test-2 ((x integer) &key bar) bar)
 (assert (= (length
 	    (sb-pcl:generic-function-methods #'incompatible-ll-test-2)) 2))
-(assert (equal (incompatible-ll-test-2 t 1 2) '(1 2)))
+
+;;; Per Christophe, this is an illegal method call because of 7.6.5
+(assert (raises-error? (incompatible-ll-test-2 t 1 2)))
+
 (assert (eq (incompatible-ll-test-2 1 :bar 'yes) 'yes))
+
+(defmethod incompatible-ll-test-3 ((x integer)) x)
+(remove-method #'incompatible-ll-test-3
+               (find-method #'incompatible-ll-test-3
+                            nil
+                            (list (find-class 'integer))))
+(assert (raises-error? (defmethod incompatible-ll-test-3 (x y) (list x y))))
+
 
 ;;; Attempting to instantiate classes with forward references in their
 ;;; CPL should signal errors (FIXME: of what type?)

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26838/src/pcl

Modified Files:
	boot.lisp 
Log Message:
0.8.15.4:
	Fix for method redefinition WARNING (Zach Beane sbcl-devel
	2004-09-24)
	... slight tweak to get &optional (stream *standard-output*)
		right.


Index: boot.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -d -r1.83 -r1.84
--- boot.lisp	1 Sep 2004 19:59:11 -0000	1.83
+++ boot.lisp	1 Oct 2004 12:35:27 -0000	1.84
@@ -1644,6 +1644,12 @@
        (unless (equal ,pos ,valsym)
 	 (setf ,pos ,valsym)))))
 
+(defun create-gf-lambda-list (lambda-list)
+  ;;; Create a gf lambda list from a method lambda list
+  (loop for x in lambda-list
+        collect (if (consp x) (list (car x)) x)
+        if (eq x '&key) do (loop-finish)))
+
 (defun set-arg-info (gf &key new-method (lambda-list nil lambda-list-p)
 			argument-precedence-order)
   (let* ((arg-info (if (eq *boot-state* 'complete)
@@ -1671,8 +1677,10 @@
 	      (error "The lambda-list ~S is incompatible with ~
 		     existing methods of ~S."
 		     lambda-list gf))))
-	(when lambda-list-p
-	  (esetf (arg-info-lambda-list arg-info) lambda-list))
+        (esetf (arg-info-lambda-list arg-info)
+               (if lambda-list-p
+                   lambda-list
+                   (create-gf-lambda-list lambda-list)))
 	(when (or lambda-list-p argument-precedence-order
 		  (null (arg-info-precedence arg-info)))
 	  (esetf (arg-info-precedence arg-info)
@@ -1920,11 +1928,8 @@
 	      (let* ((method (car (last methods)))
 		     (ll (if (consp method)
 			     (early-method-lambda-list method)
-			     (method-lambda-list method)))
-		     (k (member '&key ll)))
-		(if k
-		    (ldiff ll (cdr k))
-		    ll))))
+			     (method-lambda-list method))))
+                (create-gf-lambda-list ll))))
 	(arg-info-lambda-list arg-info))))
 
 (defmacro real-ensure-gf-internal (gf-class all-keys env)