diff --git a/NEWS b/NEWS index c9cca6a72..6c621bd2d 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,12 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- + changes relative to sbcl-2.2.6: + * minor incompatible change: the compiler emits full WARNINGs for undefined + references to variables in TYPE and DYNAMIC-EXTENT declarations, and for + SETQ of an undefined variable. (This was the historic behaviour for + everything except the DYNAMIC-EXTENT case, which used to emit a + STYLE-WARNING, but these diagnostics got lost in a refactoring since + sbcl-2.2.2) * optimization: faster TRUNCATE with float arguments. changes in sbcl-2.2.6 relative to sbcl-2.2.5: diff --git a/src/code/x86-64-simd.lisp b/src/code/x86-64-simd.lisp index a0697eaef..203e0f5d6 100644 --- a/src/code/x86-64-simd.lisp +++ b/src/code/x86-64-simd.lisp @@ -386,7 +386,7 @@ result) (defun simd-reverse8 (source start length target) - (declare ((simple-array * (*)) vector target) + (declare ((simple-array * (*)) source target) (fixnum start length) (optimize speed (safety 0))) (let ((source (vector-sap source)) @@ -433,7 +433,7 @@ target) (def-variant simd-reverse8 :avx2 (source start length target) - (declare ((simple-array * (*)) vector target) + (declare ((simple-array * (*)) source target) (fixnum start length) (optimize speed (safety 0))) (let ((source (vector-sap source)) @@ -509,7 +509,7 @@ target) (defun simd-reverse32 (source start length target) - (declare ((simple-array * (*)) vector target) + (declare ((simple-array * (*)) source target) (fixnum start length) (optimize speed (safety 0))) (let ((source (vector-sap source)) @@ -552,7 +552,7 @@ (def-variant simd-reverse32 :avx2 (source start length target) - (declare ((simple-array * (*)) vector target) + (declare ((simple-array * (*)) source target) (fixnum start length) (optimize speed (safety 0))) (let ((source (vector-sap source)) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 5903baf11..426e6e47d 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -1226,6 +1226,7 @@ care." (let* ((name (first things)) (value-form (second things)) (leaf (or (lexenv-find name vars) (find-free-var name)))) + (maybe-note-undefined-variable-reference leaf name) (etypecase leaf (leaf (when (constant-p leaf) diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp index fb597178d..432cbd6aa 100644 --- a/src/compiler/ir1report.lisp +++ b/src/compiler/ir1report.lisp @@ -652,6 +652,12 @@ has written, having proved that it is unreachable.")) (incf (undefined-warning-count res)))))) (values)) +(defun maybe-note-undefined-variable-reference (var name) + (when (and (global-var-p var) + (eq (global-var-kind var) :unknown) + (not (deprecated-thing-p 'variable name))) + (note-undefined-reference name :variable))) + (defun note-key-arg-mismatch (name keys) (let* ((found (find name *argument-mismatch-warnings* diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index e36af9dc9..92548079e 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -274,16 +274,11 @@ (declaim (end-block)) -(defun maybe-find-free-var (name) - (let ((found (gethash name (free-vars *ir1-namespace*)))) - (unless (eq found :deprecated) - found))) - ;;; Return the LEAF node for a global variable reference to NAME. If ;;; NAME is already entered in (FREE-VARS *IR1-NAMESPACE*), then we just return the ;;; corresponding value. Otherwise, we make a new leaf using ;;; information from the global environment and enter it in -;;; FREE-VARS. If the variable is unknown, then we emit a warning. +;;; FREE-VARS. (declaim (ftype (sfunction (t) (or leaf cons heap-alien-info)) find-free-var)) (defun find-free-var (name &aux (free-vars (free-vars *ir1-namespace*)) (existing (gethash name free-vars))) @@ -708,12 +703,9 @@ ;; processing our own code, though. #+sb-xc-host (warn "reading an ignored variable: ~S" name))) - (when (and (global-var-p var) - (eq (global-var-kind var) :unknown) - (not (deprecated-thing-p 'variable name))) - (note-undefined-reference name :variable)) + (maybe-note-undefined-variable-reference var name) (reference-leaf start next result var name)) - ((cons (eql macro)) ; symbol-macro + ((cons (eql macro)) ; symbol-macro ;; FIXME: the following comment is probably wrong now. ;; If we warn here on :early and :late deprecation ;; then we get an extra warning somehow. @@ -1160,6 +1152,7 @@ (var (or bound-var (lexenv-find var-name vars) (find-free-var var-name)))) + (maybe-note-undefined-variable-reference var var-name) (etypecase var (leaf (flet @@ -1475,22 +1468,21 @@ the stack without triggering overflow protection.") (let* ((bound-var (find-in-bindings vars name)) (var (or bound-var (lexenv-find name vars) - (maybe-find-free-var name)))) + (find-free-var name)))) + (maybe-note-undefined-variable-reference var name) (etypecase var (leaf - (if bound-var - (if (and (leaf-extent var) (neq extent (leaf-extent var))) - (warn "Multiple incompatible extent declarations for ~S?" name) - (setf (leaf-extent var) extent)) - (compiler-notify - "Ignoring free ~S declaration: ~S" kind name))) + (cond + ((and (typep var 'global-var) (eq (global-var-kind var) :unknown))) + (bound-var + (if (and (leaf-extent var) (neq extent (leaf-extent var))) + (warn "Multiple incompatible extent declarations for ~S?" name) + (setf (leaf-extent var) extent))) + (t (compiler-notify "Ignoring free ~S declaration: ~S" kind name)))) (cons (compiler-error "~S on symbol-macro: ~S" kind name)) (heap-alien-info - (compiler-error "~S on alien-variable: ~S" kind name)) - (null - (compiler-style-warn - "Unbound variable declared ~S: ~S" kind name))))) + (compiler-error "~S on alien-variable: ~S" kind name))))) ((and (consp name) (eq (car name) 'function) (null (cddr name)) diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index 3a946df9e..43abbe6ed 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -279,6 +279,11 @@ ;;;; generic type inference methods +(defun maybe-find-free-var (name) + (let ((found (gethash name (free-vars *ir1-namespace*)))) + (unless (eq found :deprecated) + found))) + (defun symbol-value-derive-type (node &aux (args (basic-combination-args node)) (lvar (pop args))) (unless (and lvar (endp args)) diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp index 122ccb37e..f9016082c 100644 --- a/tests/compiler.pure-cload.lisp +++ b/tests/compiler.pure-cload.lisp @@ -27,7 +27,8 @@ ;;; isn't declared as a variable, but to set its SYMBOL-VALUE anyway. ;;; ;;; This bug was in sbcl-0.6.11.13. -(print (setq improperly-declared-var '(1 2))) +(locally (declare (sb-ext:muffle-conditions warning)) + (print (setq improperly-declared-var '(1 2)))) (assert (equal (symbol-value 'improperly-declared-var) '(1 2))) (makunbound 'improperly-declared-var) ;;; This is a slightly different way of getting the same symptoms out diff --git a/tests/compiler.test.sh b/tests/compiler.test.sh index ac78ae1a8..4d22c0ded 100644 --- a/tests/compiler.test.sh +++ b/tests/compiler.test.sh @@ -600,5 +600,29 @@ cat > $tmpfilename < $tmpfilename < $tmpfilename < $tmpfilename <