From: Christophe Rhodes Date: Sat, 18 Oct 2003 10:14:52 +0000 (+0000) Subject: 0.8.4.30: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a53deb94a224bc903d00a5075acf562488cab06a;p=sbcl.git 0.8.4.30: Be more careful over automatically generated generic function lambda lists ... when generating PCL-internal GFs, pass :LAMBDA-LIST to ENSURE-GENERIC-FUNCTION ... when generating accessor GFs, pass :LAMBDA-LIST if the function is not already created (where you want to preserve the user's lambda list instead) ... tests for required behaviour Adjust INVALID-FASL patch slightly ... comment in package-data-list.lisp-expr ... remove unneccessary sb!ext:: prefixes --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 4c2bb04..273558e 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -553,6 +553,10 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." "DEFCONSTANT-UNEQL" "DEFCONSTANT-UNEQL-NAME" "DEFCONSTANT-UNEQL-NEW-VALUE" "DEFCONSTANT-UNEQL-OLD-VALUE" + ;; error signalled when attempt to load an invalid fasl + ;; is made, so that user code can try to recompile, etc. + "INVALID-FASL" + ;; conditions that can be handled to reduce compiler ;; verbosity "CODE-DELETION-NOTE" "COMPILER-NOTE" @@ -591,11 +595,6 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." ;; to hide it from them.. "INTERACTIVE-EVAL" - ;; Subtype of SIMPLE-ERROR signalled when attempt to - ;; load an invalid fasl is made, so that user-code can - ;; try to recompile, etc. - "INVALID-FASL" - ;; weak pointers and finalization "CANCEL-FINALIZATION" "FINALIZE" diff --git a/src/code/load.lisp b/src/code/load.lisp index f97af52..57aa9bf 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -211,7 +211,7 @@ ;;;; make only condition INVALID-FASL part of the public interface, ;;;; and keep the guts internal. -(define-condition sb!ext::invalid-fasl (error) +(define-condition invalid-fasl (error) ((stream :reader invalid-fasl-stream :initarg :stream) (expected :reader invalid-fasl-expected :initarg :expected)) (:report @@ -219,7 +219,7 @@ (format stream "~S is an invalid fasl file." (invalid-fasl-stream condition))))) -(define-condition invalid-fasl-header (sb!ext::invalid-fasl) +(define-condition invalid-fasl-header (invalid-fasl) ((byte :reader invalid-fasl-byte :initarg :byte) (byte-nr :reader invalid-fasl-byte-nr :initarg :byte-nr)) (:report @@ -231,7 +231,7 @@ (invalid-fasl-byte condition) (invalid-fasl-expected condition))))) -(define-condition invalid-fasl-version (sb!ext::invalid-fasl) +(define-condition invalid-fasl-version (invalid-fasl) ((variant :reader invalid-fasl-variant :initarg :variant) (version :reader invalid-fasl-version :initarg :version)) (:report @@ -243,7 +243,7 @@ (invalid-fasl-version condition) (invalid-fasl-expected condition))))) -(define-condition invalid-fasl-implementation (sb!ext::invalid-fasl) +(define-condition invalid-fasl-implementation (invalid-fasl) ((implementation :reader invalid-fasl-implementation :initarg :implementation)) (:report @@ -253,7 +253,7 @@ (invalid-fasl-implementation condition) (invalid-fasl-expected condition))))) -(define-condition invalid-fasl-features (sb!ext::invalid-fasl) +(define-condition invalid-fasl-features (invalid-fasl) ((potential-features :reader invalid-fasl-potential-features :initarg :potential-features) (features :reader invalid-fasl-features :initarg :features)) diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 79c2e89..56e0441 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -42,7 +42,7 @@ ;;;; LOAD itself -(define-condition fasl-header-missing (sb!ext::invalid-fasl) +(define-condition fasl-header-missing (invalid-fasl) ((fhsss :reader invalid-fasl-fhsss :initarg :fhsss)) (:report (lambda (condition stream) diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 1a8b077..9e65da9 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -436,7 +436,8 @@ (list class-name) (list class-name) "automatically generated boundp method"))) - (let ((gf (ensure-generic-function accessor-name))) + (let ((gf (ensure-generic-function accessor-name + :lambda-list arglist))) (if (find specls (early-gf-methods gf) :key #'early-method-specializers :test 'equal) @@ -601,7 +602,7 @@ (pushnew 'maybe-reinitialize-structure-class sb-kernel::*defstruct-hooks*) (defun make-class-predicate (class name) - (let* ((gf (ensure-generic-function name)) + (let* ((gf (ensure-generic-function name :lambda-list '(object))) (mlist (if (eq *boot-state* 'complete) (generic-function-methods gf) (early-gf-methods gf)))) diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp index 0d3b707..a283337 100644 --- a/src/pcl/slots-boot.lisp +++ b/src/pcl/slots-boot.lisp @@ -78,8 +78,12 @@ (slot-missing-fun slot-name type) "generated slot-missing method" slot-name))))) - (unless (fboundp fun-name) - (let ((gf (ensure-generic-function fun-name))) + (unless (fboundp fun-name) + (let ((gf (ensure-generic-function + fun-name + :lambda-list (ecase type + ((reader boundp) '(object)) + (writer '(new-value object)))))) (ecase type (reader (add-slot-missing-method gf slot-name 'slot-value)) (boundp (add-slot-missing-method gf slot-name 'slot-boundp)) diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 7b64b5a..5e0249a 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -797,7 +797,10 @@ (defun fix-slot-accessors (class dslotds add/remove) (flet ((fix (gfspec name r/w) - (let ((gf (ensure-generic-function gfspec))) + (let* ((ll (case r/w (r '(object)) (w '(new-value object)))) + (gf (if (fboundp gfspec) + (ensure-generic-function gfspec) + (ensure-generic-function gfspec :lambda-list ll)))) (case r/w (r (if (eq add/remove 'add) (add-reader-method class gf name) diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp index cc43bc9..b183624 100644 --- a/tests/clos.impure.lisp +++ b/tests/clos.impure.lisp @@ -720,5 +720,17 @@ :font 'baskerville :pixel-size 10) 'baskerville)) +;;; class redefinition shouldn't give any warnings, in the usual case +(defclass about-to-be-redefined () ((some-slot :accessor some-slot))) +(handler-bind ((warning #'error)) + (defclass about-to-be-redefined () ((some-slot :accessor some-slot)))) + +;;; attempts to add accessorish methods to generic functions with more +;;; complex lambda lists should fail +(defgeneric accessoroid (object &key &allow-other-keys)) +(assert (raises-error? + (defclass accessoroid-class () ((slot :accessor accessoroid))) + program-error)) + ;;;; success (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index df038c1..52f066e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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.4.29" +"0.8.4.30"