bug#74771: Native compilation bug with struct predicates when lexical binding enabled (HEAD)

[Pip Cet]

"Eric Marsden" <eric.marsden@risk-engineering.org> writes:

> Hi,
>
> With the attached source file, Emacs miscompiles the struct predicate such
> that a repeated call to the predicate on a non-struct object returns t.
> This occurs with current HEAD on Linux/AMD64, but not on the Emacs 30.0.92
> pretest. It does not occur when the lexical binding cookie is not present.
>
> % /opt/emacs/bin/emacs -Q --batch --eval "(load (native-compile 
> \"/tmp/bug.el\"))" -f run
> Loading 
> /home/emarsden/.emacs.d/eln-cache/31.0.50-c021c983/bug-59c4b27c-c70072f9.eln 
> (native compiled elisp)...
> Running in GNU Emacs 31.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 
> 3.24.43, cairo version 1.18.2)
>   of 2024-12-09
> is? nil
> is? t   ;; expecting nil
> bar: 111
>
> [2. text/x-emacs-lisp; bug.el]...

Can you try this patch?

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 0d40f05bef1..c3e9a8be66d 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2029,15 +2029,18 @@ comp--add-cond-cstrs
               (call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag)))
          (set ,(and (pred comp-mvar-p) mvar-3)
               (call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred 
comp-mvar-p) mvar-2)))
-         (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,bb1 
,bb2))
-       (comp--emit-assume 'and mvar-tested
-                         (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
-                         (comp--add-cond-cstrs-target-block b bb2)
-                         nil)
-       (comp--emit-assume 'and mvar-tested
-                         (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
-                         (comp--add-cond-cstrs-target-block b bb1)
-                         t))
+         (cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(and (pred comp-mvar-p) 
mvar-4) ,bb1 ,bb2))
+       (cond
+        ((and (comp-cstr-imm-vld-p mvar-4)
+              (eq (comp-cstr-imm mvar-4) t))
+         (comp--emit-assume 'and mvar-tested
+                            (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
+                            (comp--add-cond-cstrs-target-block b bb2)
+                            nil)
+         (comp--emit-assume 'and mvar-tested
+                            (make--comp-mvar :type (comp-cstr-cl-tag mvar-tag))
+                            (comp--add-cond-cstrs-target-block b bb1)
+                            t))))
       (`((set ,(and (pred comp-mvar-p) cmp-res)
               (,(pred comp--call-op-p)
                ,(and (or (pred comp--equality-fun-p)

IIUC, the code blindly assumes that cond-jump would use t as its second
argument.  In your code, the second argument was nil, so the assumptions
were put into the wrong basic blocks.

It looks like there are quite a few such assumptions in comp.el. I think
we should fix them all to ensure that they test for truth, not
falsehood.  After that, we'll have to decide whether it's worth it
to optimize the negated cases.

Pip