Fix three CLOS guards whose read-time class literals never match (eql-gf memoization, static slot-value, validate-superclass)

src/lisp/kernel/clos/class.lisp

@@ -168,13 +168,14 @@ argument was supplied for metaclass ~S." (class-of class))))))))
   supplied-superclasses)
 
 (defmethod validate-superclass ((class class) (superclass class))
+  ;; NOTE: runtime lookups (a #. literal never matches), deferred and errorp nil for bootstrap safety.
   (or (let ((c1 (class-of class))
 	    (c2 (class-of superclass)))
 	(or (eq c1 c2)
-	  (and (eq c1 #.(find-class 'standard-class))
-            (eq c2 #.(find-class 'funcallable-standard-class)))
-	  (and (eq c2 #.(find-class 'standard-class))
-            (eq c1 #.(find-class 'funcallable-standard-class)))))
+	    (let ((std (find-class 'standard-class nil))
+		  (fstd (find-class 'funcallable-standard-class nil)))
+	      (or (and (eq c1 std) (eq c2 fstd))
+		  (and (eq c2 std) (eq c1 fstd))))))
       (or (typep class 'forward-referenced-class)
           (typep superclass 'forward-referenced-class))))
 

src/lisp/kernel/clos/miss.lisp

@@ -262,8 +262,9 @@
                       ;; another thread has already added this entry
                       nil
                       (list (cons key outcome)))))
+               ;; NOTE: must be a runtime lookup; a #. literal here never matches.
                ((eq (class-of generic-function)
-                    #.(find-class 'standard-generic-function))
+                    (find-class 'standard-generic-function))
                 (memoize-eql-specialized generic-function method-combination
                                          call-history argument-classes))
                (t

src/lisp/kernel/clos/static-gfs/svuc.lisp

@@ -16,11 +16,12 @@ TODO 2: Build a cell system like we do for make-instance.
 ;;;; NOTE: The static-foo macros may evaluate the instance form more than once.
 ;;;; (Because we know here that it's always just a variable.)
 
+;;; NOTE: must be runtime lookups; #. literals here never match.
 (defun uncustomizable-slot-p (class slotd)
   (let ((metaclass (class-of class)))
-    (and (or (eq metaclass #.(find-class 'standard-class))
-             (eq metaclass #.(find-class 'clos:funcallable-standard-class)))
-         (eq (class-of slotd) #.(find-class 'clos:standard-effective-slot-definition)))))
+    (and (or (eq metaclass (find-class 'standard-class))
+             (eq metaclass (find-class 'clos:funcallable-standard-class)))
+         (eq (class-of slotd) (find-class 'clos:standard-effective-slot-definition)))))
 
 ;;; I said "constant slotd", but slotds aren't dumpable, so to satisfy
 ;;; COMPILE-FILE what we'll actually get is (ltv-slotd class slotd),

src/lisp/regression-tests/fastgf.lisp

@@ -5,3 +5,12 @@
 (defmethod fgf-foo ((x symbol)) :symbol)
 (test dispatch-symbol (fgf-foo :yadda) (:symbol))
 (test-expect-error dispatch-no-applicable-method (fgf-foo 1.2) :description "This should not dispatch")
+
+(defmethod fgf-eql ((x (eql :alpha))) :alpha)
+(defmethod fgf-eql ((x (eql :beta))) :beta)
+(test dispatch-eql-alpha (fgf-eql :alpha) (:alpha))
+(test dispatch-eql-beta (fgf-eql :beta) (:beta))
+;;; Without memoization every eql-specialized call is a full dispatch miss.
+(test-true dispatch-eql-memoized
+           (progn (fgf-eql :alpha)
+                  (plusp (length (clos::generic-function-call-history #'fgf-eql)))))

src/lisp/regression-tests/mop.lisp

@@ -110,3 +110,20 @@
         (loop for n in nonwriters
               when (fboundp `(setf ,n))
                 collect n)))
+
+;;; AMOP allows a standard-class and a funcallable-standard-class in each
+;;; other's superclass chain; validate-superclass must accept both directions.
+(defclass vsc-plain () ((a :initform 1)))
+
+(test-true validate-superclass-mixed-metaclasses
+           (and (clos:validate-superclass (find-class 'standard-generic-function)
+                                          (find-class 'vsc-plain))
+                (clos:validate-superclass (find-class 'vsc-plain)
+                                          (find-class 'standard-generic-function))
+                t))
+
+(test-true validate-superclass-funcallable-from-standard
+           (progn (eval '(defclass vsc-funcallable (vsc-plain) ()
+                           (:metaclass clos:funcallable-standard-class)))
+                  (eq (class-of (find-class 'vsc-funcallable))
+                      (find-class 'clos:funcallable-standard-class))))