defined incompatibly. (lp#657499)
* bug fix: existing ASDF source registries are ignored when building
contribs (lp#659105)
+ * bug fix: short-form DEFSETF checks that the second argument is a symbol
+ (lp#655824, thanks to Roman Marynchak)
+ * bug fix: (SETF MACRO-FUNCTION) clobbered macro-definitions before
+ package-lock violation was detected. (lp#660752)
changes in sbcl-1.0.43 relative to sbcl-1.0.42:
* incompatible change: FD-STREAMS no longer participate in the serve-event
;; should deal with clearing old compiler information for
;; the functional value."
,@(unless set-p
- '((declare (ignore lambda-list debug-name))))
- (with-single-package-locked-error ()
- (case (info :function :kind name)
- (:function
- (let ((where-from (info :function :where-from name)))
- (when (eq :defined where-from)
- (assert-symbol-home-package-unlocked name "defining ~S as a macro"))
- (style-warn
- "~S is being redefined as a macro when it was ~
+ '((declare (ignore lambda-list debug-name doc))))
+ (let ((kind (info :function :kind name)))
+ ;; Check for special form before package locks.
+ (when (eq :special-form kind)
+ (error "The special operator ~S can't be redefined as a macro."
+ name))
+ (with-single-package-locked-error (:symbol name "defining ~S as a macro")
+ (when (eq :function kind)
+ (style-warn
+ "~S is being redefined as a macro when it was ~
previously ~(~A~) to be a function."
- name where-from))
- (undefine-fun-name name))
- (:special-form
- (error "The special form ~S can't be redefined as a macro."
- name)))
- (clear-info :function :where-from name)
+ name (info :function :where-from name))
+ (undefine-fun-name name))
+ (clear-info :function :where-from name)
- ;; FIXME: It would be nice to warn about DEFMACRO of an
- ;; already-defined macro, but that's slightly hard to do
- ;; because in common usage DEFMACRO is defined at compile
- ;; time and then redefined at load time. We'd need to make a
- ;; distinction between the defined-at-compile-time state and
- ;; the defined-at-load-time state to make this work. (Trying
- ;; to warn about duplicate DEFTYPEs runs into the same
- ;; problem.)
- #+nil
- (when (sb!xc:macro-function name)
- ;; Someday we could check for macro arguments
- ;; being incompatibly redefined. Doing this right
- ;; will involve finding the old macro lambda-list
- ;; and comparing it with the new one.
- (style-warn "redefining ~/sb-impl::print-symbol-with-prefix/ ~
+ ;; FIXME: It would be nice to warn about DEFMACRO of an
+ ;; already-defined macro, but that's slightly hard to do
+ ;; because in common usage DEFMACRO is defined at compile
+ ;; time and then redefined at load time. We'd need to make a
+ ;; distinction between the defined-at-compile-time state and
+ ;; the defined-at-load-time state to make this work. (Trying
+ ;; to warn about duplicate DEFTYPEs runs into the same
+ ;; problem.)
+ #+nil
+ (when (sb!xc:macro-function name)
+ ;; Someday we could check for macro arguments
+ ;; being incompatibly redefined. Doing this right
+ ;; will involve finding the old macro lambda-list
+ ;; and comparing it with the new one.
+ (style-warn "redefining ~/sb-impl::print-symbol-with-prefix/ ~
in DEFMACRO" name))
- (setf (sb!xc:macro-function name) definition)
- ,(when set-p
- `(setf (%fun-doc definition) doc
- (%fun-lambda-list definition) lambda-list
- (%fun-name definition) debug-name)))
+ (setf (sb!xc:macro-function name) definition)
+ ,(when set-p
+ `(setf (%fun-doc definition) doc
+ (%fun-lambda-list definition) lambda-list
+ (%fun-name definition) debug-name))))
name))))
(progn
(def (:load-toplevel :execute) #-sb-xc-host t #+sb-xc-host nil)
symbol environment))
(when (eq (info :function :kind symbol) :special-form)
(error "~S names a special form." symbol))
- (setf (info :function :kind symbol) :macro)
- (setf (info :function :macro-function symbol) function)
- ;; This is a nice thing to have in the target SBCL, but in the
- ;; cross-compilation host it's not nice to mess with
- ;; (SYMBOL-FUNCTION FOO) where FOO might be a symbol in the
- ;; cross-compilation host's COMMON-LISP package.
- #-sb-xc-host
- (setf (symbol-function symbol)
- (lambda (&rest args)
- (declare (ignore args))
- ;; (ANSI specification of FUNCALL says that this should be
- ;; an error of type UNDEFINED-FUNCTION, not just SIMPLE-ERROR.)
- (error 'undefined-function :name symbol)))
+ (with-single-package-locked-error (:symbol symbol "setting the macro-function of ~S")
+ (setf (info :function :kind symbol) :macro)
+ (setf (info :function :macro-function symbol) function)
+ ;; This is a nice thing to have in the target SBCL, but in the
+ ;; cross-compilation host it's not nice to mess with
+ ;; (SYMBOL-FUNCTION FOO) where FOO might be a symbol in the
+ ;; cross-compilation host's COMMON-LISP package.
+ #-sb-xc-host
+ (setf (symbol-function symbol)
+ (lambda (&rest args)
+ (declare (ignore args))
+ ;; (ANSI specification of FUNCALL says that this should be
+ ;; an error of type UNDEFINED-FUNCTION, not just SIMPLE-ERROR.)
+ (error 'undefined-function :name symbol))))
function)
(defun fun-locally-defined-p (name env)
`(check-consing t ',form (lambda () ,form) ,times))
(defun file-compile (toplevel-forms &key load)
- (let* ((lisp "compile-impure-tmp.lisp")
+ (let* ((lisp (merge-pathnames "file-compile-tmp.lisp"))
(fasl (compile-file-pathname lisp)))
(unwind-protect
(progn
(in-package :cl-user)
(load "assertoid.lisp")
+(load "compiler-test-util.lisp")
(use-package "ASSERTOID")
;;;; Our little labrats and a few utilities
sb-ext:package-lock-violation))
(assert (eq 'test:function (eval `(test:function)))))
+(defpackage :macro-killing-macro-1
+ (:use :cl)
+ (:lock t)
+ (:export #:to-die-for))
+
+(defpackage :macro-killing-macro-2
+ (:use :cl :macro-killing-macro-1))
+
+(ctu:file-compile
+ `((in-package :macro-killing-macro-1)
+ (defmacro to-die-for ()
+ :original))
+ :load t)
+
+(ctu:file-compile
+ `((in-package :macro-killing-macro-2)
+ (defmacro to-die-for ()
+ :replacement)))
+
+(with-test (:name :defmacro-killing-macro)
+ (assert (eq :original (macroexpand '(macro-killing-macro-1:to-die-for)))))
+
+(ctu:file-compile
+ `((in-package :macro-killing-macro-2)
+ (eval-when (:compile-toplevel)
+ (setf (macro-function 'to-die-for) (constantly :replacement2)))))
+
+(with-test (:name :setf-macro-function-killing-macro)
+ (assert (eq :original (macroexpand '(macro-killing-macro-1:to-die-for)))))
+
;;; WOOT! Done.
;;; 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".)
-"1.0.43.59"
+"1.0.43.60"
projects / sbcl.git / commitdiff