GNU bug report logs - #78989
31.0.50; classes and methods inheritance (defclass) seq-contains-p

Previous Next

Full log

View this message in rfc822 format

From: Pip Cet <pipcet <at> protonmail.com>
To: Eli Zaretskii <eliz <at> gnu.org>
Cc: 78989 <at> debbugs.gnu.org, Stefan Monnier <monnier <at> iro.umontreal.ca>, "Pierre L. Nageoire" <devel <at> pollock-nageoire.net>
Subject: bug#78989: 31.0.50; classes and methods inheritance (defclass) seq-contains-p
Date: Fri, 11 Jul 2025 13:43:30 +0000

"Eli Zaretskii" <eliz <at> gnu.org> writes:

>> From: "Pierre L. Nageoire" <devel <at> pollock-nageoire.net>
>> Date: Thu, 10 Jul 2025 10:31:50 +0200
>>
>> Code below has a different behavior in the current emacs version
>> (referenced in this mail) and in the last git pull one (one day ago)
>> that I will name new!
>>
>>
>> In current version it produces the expected message
>> "Son does not contain dummy"
>>
>> but in new one it trigger the error also included below.
>>
>> Please excuse me for the complicated code but it was very tricky to find
>> a minimal class tree structure that triggers the error.
>>
>> I suspect that problem comes from the method lookup through the
>> inheritance class tree. This schedule has maybe been modified recently ;
>> and it is perhaps not a bug but simply changes in inheritance scope.
>>
>> I know that that whole stuff is work in progress and that things may
>> change from time to time.
>>
>> Anywa it looks me strange that the reimplemented method `seq-contains-p'
>> cannot be reached from son while it can be from father. From son it
>> fallback on the method for sequence as shown in the error report.
>>
>> Sory that mother seems to be responsbile for that !
>
> Thanks, I added the usual suspects to this discussion.

I think the bug is in cl--class-allparents, which incorrectly assumes
topological sorting can be done recursively, but it's hidden by another
problem:

1. cl--class-allparents doesn't handle inconsistent class hierarchies;
it doesn't pass an extra argument to merge-ordered-lists, so
merge-ordered-lists will just return something that doesn't guarantee
topological order.  This isn't usually a problem because our class
hierarchies shouldn't contain cycles.

2. cl--class-allparents is buggy: it assumes that topological sorting
can be performed recursively.  That's not correct.

Consider '((a b) (a c) (c b)): the correct topological sort result is
'(a c b). But if we sort the first two lists separately, we'll usually
get '(a b c), and sorting '((a b c) (c b)) fails.  However, because of
(1), we don't handle this failure in cl--class-allparents and simply
return '(a b c), which is incorrect.

In our case, the incorrect partially-sorted return value of
cl--class-allparents has t appear in the list before 'baselist does, so
we end up trying to use the wrong method: we incorrectly assume that t
is a more specific type than 'baselist.

I have no idea why this bug only appears now, or how to fix it properly.
This patch does "fix" the bug, but it does so by replacing an efficient
(buggy) algorithm by a massively-inefficient "obviously correct" one:

diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 263a9b85225..108a5fc2b91 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -284,9 +284,40 @@ cl--copy-slot-descriptor
 (cl-assert (cl--class-p (cl--find-class 'cl-structure-object)))
 
 (defun cl--class-allparents (class)
+  (let ((ht (make-hash-table :test 'eq))
+        (cont t))
+    (puthash class (cl--class-parents class) ht)
+    (while cont
+      (setq cont nil)
+      (maphash (lambda (_class parents)
+                 (dolist (parent parents)
+                   (unless (hash-table-contains-p parent ht)
+                     (puthash parent (cl--class-parents parent) ht)
+                     (setq cont t))))
+               ht))
+    ;; (message "%S keys" (hash-table-count ht))
+    (let ((lists nil))
+      (maphash (lambda (class parents)
+                 (dolist (parent parents)
+                   (push (list class parent)
+                         lists)))
+               ht)
+      (let ((res
+             (merge-ordered-lists lists
+                                  (lambda (_lists)
+                                    (error "cycle in class hierarchy!")))))
+        (setq res (mapcar #'cl--class-name res))
+        (setq res (remq (cl--class-name class) res))
+        (setq res (cons (cl--class-name class) res))
+        ;; (message "res %S" res)
+        res))))
+
+(defun cl--class-allparents-old (class)
   (cons (cl--class-name class)
         (merge-ordered-lists (mapcar #'cl--class-allparents
-                                     (cl--class-parents class)))))
+                                     (cl--class-parents class))
+                             (lambda (_lists)
+                               (error "cycle in class hierarchy!")))))
 
 (cl-defstruct (built-in-class
                (:include cl--class)

Pip

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.