the problem is probably with the new FP implementation.
412: deletion of global variable references in safe code
- The following returns 1 instead of signalling an error.
- (funcall (compile nil
- '(lambda ()
- (declare (optimize (safety 3)))
- #:unbound
- 42)))
- Reported by Marco Monteiro on sbcl-devel.
+ fixed in 1.0.4.45.
in multithreaded application code.
* optimization: GET-INTERNAL-REAL-TIME has been optimized on POSIX
platforms. (thanks to James Anderson for the optimization hint)
+ * enhancement: XREF information is now collected to references made
+ to global variables using SYMBOL-VALUE with a constant argument.
+ * bug fix: dead unbound variable references now signal an error.
+ (reported by Marco Monteiro)
* bug fix: / with an unused value was being deleted in safe code.
(thanks to Marco Monteiro and Kevin Reid)
* bug fix: number of characters that can be written onto a single
(cl:defpackage :sb-aclrepl
(:use "COMMON-LISP" "SB-EXT")
(:shadowing-import-from "SB-IMPL" "SCRUB-CONTROL-STACK")
- (:shadowing-import-from "SB-INT" "*REPL-PROMPT-FUN*" "*REPL-READ-FORM-FUN*" "*STEP*" "*STEPPING*")
+ (:shadowing-import-from "SB-INT" "*REPL-PROMPT-FUN*" "*REPL-READ-FORM-FUN*")
(:export
;; user-level customization of UI
"*PROMPT*" "*EXIT-ON-EOF*" "*MAX-HISTORY*"
(loop
(unwind-protect
(rep-one)
- ;; reset toplevel step-condition handler
- (setf *step* nil
- *stepping* nil))))
+ ;; if we started stepping in the debugger, now is the
+ ;; time to stop
+ (sb-impl::disable-stepping))))
(declare (ignore reason-param))
(cond
((and (eq reason :inspect)
;;; Return a LAMBDA form which can be used to set a slot.
(defun slot-setter-lambda-form (dd dsd)
- `(lambda (new-value instance)
- ,(funcall (nth-value 1 (slot-accessor-transforms dd dsd))
- '(dummy new-value instance))))
+ ;; KLUDGE: Evaluating the results of SLOT-ACCESSOR-TRANSFORMS needs
+ ;; a lexenv.
+ (let ((sb!c:*lexenv* (if (boundp 'sb!c:*lexenv*)
+ sb!c:*lexenv*
+ (sb!c::make-null-lexenv))))
+ `(lambda (new-value instance)
+ ,(funcall (nth-value 1 (slot-accessor-transforms dd dsd))
+ '(dummy new-value instance)))))
;;; core compile-time setup of any class with a LAYOUT, used even by
;;; !DEFSTRUCT-WITH-ALTERNATE-METACLASS weirdosities
(defun ir1-convert-var (start next result name)
(declare (type ctran start next) (type (or lvar null) result) (symbol name))
(let ((var (or (lexenv-find name vars) (find-free-var name))))
- (etypecase var
- (leaf
- (when (lambda-var-p var)
- (let ((home (ctran-home-lambda-or-null start)))
- (when home
- (sset-adjoin var (lambda-calls-or-closes home))))
- (when (lambda-var-ignorep var)
- ;; (ANSI's specification for the IGNORE declaration requires
- ;; that this be a STYLE-WARNING, not a full WARNING.)
- #-sb-xc-host
- (compiler-style-warn "reading an ignored variable: ~S" name)
- ;; there's no need for us to accept ANSI's lameness when
- ;; processing our own code, though.
- #+sb-xc-host
- (warn "reading an ignored variable: ~S" name)))
- (reference-leaf start next result var))
- (cons
- (aver (eq (car var) 'macro))
- ;; FIXME: [Free] type declarations. -- APD, 2002-01-26
- (ir1-convert start next result (cdr var)))
- (heap-alien-info
- (ir1-convert start next result `(%heap-alien ',var)))))
+ (if (and (global-var-p var) (not result))
+ ;; KLUDGE: If the reference is dead, convert using SYMBOL-VALUE
+ ;; which is not flushable, so that unbound dead variables signal
+ ;; an error (bug 412).
+ (ir1-convert start next result `(symbol-value ',name))
+ (etypecase var
+ (leaf
+ (when (lambda-var-p var)
+ (let ((home (ctran-home-lambda-or-null start)))
+ (when home
+ (sset-adjoin var (lambda-calls-or-closes home))))
+ (when (lambda-var-ignorep var)
+ ;; (ANSI's specification for the IGNORE declaration requires
+ ;; that this be a STYLE-WARNING, not a full WARNING.)
+ #-sb-xc-host
+ (compiler-style-warn "reading an ignored variable: ~S" name)
+ ;; there's no need for us to accept ANSI's lameness when
+ ;; processing our own code, though.
+ #+sb-xc-host
+ (warn "reading an ignored variable: ~S" name)))
+ (reference-leaf start next result var))
+ (cons
+ (aver (eq (car var) 'macro))
+ ;; FIXME: [Free] type declarations. -- APD, 2002-01-26
+ (ir1-convert start next result (cdr var)))
+ (heap-alien-info
+ (ir1-convert start next result `(%heap-alien ',var))))))
(values))
;;; Find a compiler-macro for a form, taking FUNCALL into account.
;; Note that this code can get executed several times
;; for the same block, if the functional is referenced
;; from multiple XEPs.
- (loop for node = (ctran-next this-cont) then (ctran-next (node-next node))
+ (loop for node = (ctran-next this-cont)
+ then (ctran-next (node-next node))
until (eq node last)
do (record-node-xrefs node functional))
;; Properly record the deferred macroexpansion information
(defun record-node-xrefs (node context)
(declare (type node node))
(etypecase node
- ((or creturn cif entry combination mv-combination cast))
+ ((or creturn cif entry mv-combination cast))
+ (combination
+ ;; Record references to globals made using SYMBOL-VALUE.
+ (let ((fun (principal-lvar-use (combination-fun node)))
+ (arg (car (combination-args node))))
+ (when (and (ref-p fun) (eq 'symbol-value (leaf-%source-name (ref-leaf fun)))
+ (constant-lvar-p arg) (symbolp (lvar-value arg)))
+ (record-xref :references (lvar-value arg) context node nil))))
(ref
(let ((leaf (ref-leaf node)))
(typecase leaf
0)
(division-by-zero ()
:error)))))
+
+;;; Dead unbound variable (bug 412)
+(with-test (:name :dead-unbound)
+ (assert (eq :error
+ (handler-case
+ (funcall (compile nil
+ '(lambda ()
+ #:unbound
+ 42)))
+ (unbound-variable ()
+ :error)))))
;;; 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.4.44"
+"1.0.4.45"
projects / sbcl.git / commitdiff