Fix test failures with evaluator-mode interpret

Which incidentally exposed a bug that could occur in compiled code.

src/code/symbol.lisp

@@ -643,9 +643,11 @@ distinct from the global value. Can also be SETF."
                    (when (eq (info :variable :always-bound symbol) :always-bound)
                      (values "Can't ~@?" nil)))))
         (cond ((not complaint)
-               (let ((package (symbol-package symbol)))
-                 (if (or (not package) (not (package-locked-p package)))
-                     (logior-header-bits symbol sb-vm::+symbol-fast-bindable+))))
+               ;; the optimize bit says whether PROGV can be optimized, and not other actions
+               (when (eq action 'progv)
+                 (let ((package (symbol-package symbol)))
+                   (if (or (not package) (not (package-locked-p package)))
+                       (logior-header-bits symbol sb-vm::+symbol-fast-bindable+)))))
               (continuable
                (cerror "Modify the constant." complaint (describe-action) symbol))
               (t

src/interpreter/macros.lisp

@@ -72,6 +72,12 @@
              (gen-code :immediate immediate-code))
           ,(gen-code :deferred deferred-code))))))
 
+(defmacro checking-progv (vars vals &body body)
+  `(locally
+       (declare (optimize (sb-c::type-check 3)))
+       (progv ,vars ,vals
+         (locally (declare (optimize (sb-c::type-check 1))) ,@body))))
+
 ;;; Create parallel bindings for LET or a LAMBDA's required args.
 ;;; Use of this macro is highly confined, so no bothering with ONCE-ONLY.
 ;;; FRAME-INDEX is purposely exposed and SPECIAL-B is freely referenced.
@@ -93,7 +99,7 @@
            ;; which would destroy the list for the LET*-like bindings.
            (dotimes (frame-index ,count
                      (if ,special-vals
-                         (progv ,specials ,special-vals ,@finally)
+                         (checking-progv ,specials ,special-vals ,@finally)
                          (progn ,@finally)))
              (let ((value ,value))
                (if ,specialp
@@ -124,7 +130,7 @@
                 ;; note by "manually" eliding half the logic :-(
                 ,@(if specialp
                       `((if ,specialp
-                            (progv ,specials (list value)
+                            (checking-progv ,specials (list value)
                               (let*-bind (setf ,count-place (1+ frame-index))
                                          end))
                             (progn

src/interpreter/special-forms.lisp

@@ -382,12 +382,12 @@
 
 (defspecial progv (symbols values &body forms)
   :immediate (env)
-  (progv (%eval symbols env) (%eval values env) (eval-progn forms env))
+  (checking-progv (%eval symbols env) (%eval values env) (eval-progn forms env))
   :deferred ()
   (let ((symbols (%sexpr symbols)) (values (%sexpr values))
         (forms (%progn forms)))
     (hlambda PROGV (symbols values forms) (env)
-      (progv (dispatch symbols env) (dispatch values env)
+      (checking-progv (dispatch symbols env) (dispatch values env)
         (dispatch forms env)))))
 
 (defspecial load-time-value (form &optional read-only-p)

tests/progv.pure.lisp

@@ -33,3 +33,8 @@
                    sb-vm::+symbol-fast-bindable+))
   ;; and still gets a type-error
   (assert-error (f-safe '(*mysym*) '("hi"))))
+
+(with-test (:name :full-call-to-set-symbol-value-does-not-imply-fast-bindable)
+  (let ((s (opaque-identity 'flerb)))
+    (set s 3)
+    (assert (not (logtest (sb-kernel:get-header-data s) sb-vm::+symbol-fast-bindable+)))))