common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Make the method-combination-generic-function cache consistent

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

17
src/pcl/boot.lisp
View file

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

21
tests/clos-method-combination-caches.pure.lisp Normal file
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)))