Restore undefined variable warnings

The change in d788babebf to respect
scope of mufflings inadvertently removed warnings from a number of
cases, including type and extent declarations and setq forms.  Restore
them, fixing in the sources a few instances of undefined declarations
that have crept in, and an instance in our tests whose behaviour
inexplicably changed somehow.  This also changes the condition kind of
a free, unknown dynamic extent declaration on a variable to a full
warning (it was a style warning before).

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:

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))

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)

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*

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)
+       (maybe-note-undefined-variable-reference var name)
-                  (eq (global-var-kind var) :unknown)
-                  (not (deprecated-thing-p 'variable name)))
-         (note-undefined-reference name :variable))
        (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
+                  (cond
-                      (if (and (leaf-extent var) (neq extent (leaf-extent var)))
+                    ((and (typep var 'global-var) (eq (global-var-kind var) :unknown)))
-                          (warn "Multiple incompatible extent declarations for ~S?" name)
+                    (bound-var
-                          (setf (leaf-extent var) extent))
+                     (if (and (leaf-extent var) (neq extent (leaf-extent var)))
-                      (compiler-notify
+                         (warn "Multiple incompatible extent declarations for ~S?" name)
-                       "Ignoring free ~S declaration: ~S" kind 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))
+                  (compiler-error "~S on alien-variable: ~S" kind name)))))
-                 (null
-                  (compiler-style-warn
-                   "Unbound variable declared ~S: ~S" kind name)))))
             ((and (consp name)
                   (eq (car name) 'function)
                   (null (cddr name))

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))

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

tests/compiler.test.sh

@@ -600,5 +600,29 @@ cat > $tmpfilename <<EOF
 EOF
 expect_clean_cload $tmpfilename
 
+# Test compiler warning generation for unbound variables from type declaration...
+cat > $tmpfilename <<EOF
+(defun foo (bar)
+  (declare (type vector baz))
+  (length bar))
+EOF
+expect_failed_compile $tmpfilename
+
+# ... extent declaration ...
+cat > $tmpfilename <<EOF
+(defun foo (n)
+  (declare (type (mod 32) n))
+  (let ((vect (make-array n :element-type 'fixnum)))
+    (declare (dynamic-extent vec))
+    (1+ (length vect))))
+EOF
+expect_failed_compile $tmpfilename
+
+# ... and setq
+cat > $tmpfilename <<EOF
+(setq nonexistent t)
+EOF
+expect_failed_compile $tmpfilename
+
 # success
 exit $EXIT_TEST_WIN

tests/dynamic-extent.pure.lisp

@@ -1120,7 +1120,7 @@
     (test `(lambda () (declare (dynamic-extent #'bar)))
           :allow-style-warnings 'style-warning)
     (test `(lambda () (declare (dynamic-extent bar)))
-          :allow-style-warnings 'style-warning)
+          :allow-warnings 'warning)
     (test `(lambda (bar) (cons bar (lambda () (declare (dynamic-extent bar)))))
           :allow-notes 'sb-ext:compiler-note)
     (test `(lambda ()