Make the method-combination-generic-function cache consistent

The fixup phase of the PCL bootstrap was failing to add the generic
functions to the method combination hashsets.
This commit is contained in:
Christophe Rhodes 2024-05-02 14:01:44 +01:00
parent efa8fc4282
commit 9e3190e738
2 changed files with 30 additions and 8 deletions

View file

@ -2812,8 +2812,9 @@ bootstrapping.
(apply #'real-make-a-method args)))
(early-gf-methods gf))))
(setf (generic-function-method-class gf) *the-class-standard-method*)
(setf (generic-function-method-combination gf)
*standard-method-combination*)
(let ((mc *standard-method-combination*))
(setf (generic-function-method-combination gf) mc)
(add-to-weak-hashset gf (method-combination-%generic-functions mc)))
(set-methods gf methods)))
(dolist (fn *!early-functions*)
@ -2852,12 +2853,12 @@ bootstrapping.
'standard-method
qualifiers lambda-list specializers initargs nil
'source (translate-source-location fun))))))
(setf (generic-function-method-class gf)
*the-class-standard-method*
(generic-function-method-combination gf)
(ecase method-combination
(standard *standard-method-combination*)
(or *or-method-combination*)))
(let ((mc (ecase method-combination
(standard *standard-method-combination*)
(or *or-method-combination*))))
(setf (generic-function-method-class gf) *the-class-standard-method*
(generic-function-method-combination gf) mc)
(add-to-weak-hashset gf (method-combination-%generic-functions mc)))
(set-methods gf (mapcar #'make-method methods)))))
(/show "leaving !FIX-EARLY-GENERIC-FUNCTIONS"))

View file

@ -0,0 +1,21 @@
;;;; testing the consistency of method combination sets
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
;;;;
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
(let (problems)
(flet ((check (gf)
(let* ((mc (sb-mop:generic-function-method-combination gf))
(gfs (sb-pcl::method-combination-%generic-functions mc)))
(unless (sb-pcl::weak-hashset-memberp gf gfs)
(push gf problems)))))
(sb-pcl::map-all-generic-functions #'check))
(assert (null problems)))