[Guile-commits] 02/05: Baseline compiler no longer crashes on (not (list 1 2)).

[Ludovic Courtès]

civodul pushed a commit to branch main
in repository guile.

commit e2797f529b8934b0a11b9f6aebbf937b183ece77
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Oct 1 15:36:21 2022 +0200

    Baseline compiler no longer crashes on (not (list 1 2)).
    
    Fixes <https://bugs.gnu.org/58217>.
    
    * module/language/tree-il/compile-bytecode.scm (canonicalize)
    [finish-conditional](predicate?): Do not assume 'lookup-primitive'
    returns true.
    * test-suite/tests/compiler.test ("regression tests")
    ["(not (list 1 2))"]: New test.
---
 NEWS                                         | 2 ++
 module/language/tree-il/compile-bytecode.scm | 4 +++-
 test-suite/tests/compiler.test               | 8 +++++++-
 3 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/NEWS b/NEWS
index 19d314f4a..682b796e3 100644
--- a/NEWS
+++ b/NEWS
@@ -61,6 +61,8 @@ for use with `setsockopt'.
    (<https://bugs.gnu.org/49223>)
 ** 'primitive-load' opens files as O_CLOEXEC
    (<https://bugs.gnu.org/57567>)
+** Baseline compiler no longer crashes on (not (list 1 2))
+   (<https://bugs.gnu.org/58217>)
 
 
 Changes in 3.0.8 (since 3.0.7)
diff --git a/module/language/tree-il/compile-bytecode.scm 
b/module/language/tree-il/compile-bytecode.scm
index 87d903c10..909a311b4 100644
--- a/module/language/tree-il/compile-bytecode.scm
+++ b/module/language/tree-il/compile-bytecode.scm
@@ -409,7 +409,9 @@
   (define (finish-conditional exp)
     (define (true? x) (match x (($ <const> _ val) val) (_ #f)))
     (define (false? x) (match x (($ <const> _ val) (not val)) (_ #f)))
-    (define (predicate? name) (primitive-predicate? (lookup-primitive name)))
+    (define (predicate? name)
+      (and=> (lookup-primitive name) primitive-predicate?))
+
     (match exp
       (($ <conditional> src ($ <conditional> _ test (? true?) (? false?))
           consequent alternate)
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index d60151c6f..67d8d9ed9 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -235,7 +235,13 @@
 
   (pass-if "Chained comparisons"
     (not (compile
-          '(false-if-exception (< 'not-a-number))))))
+          '(false-if-exception (< 'not-a-number)))))
+
+  (pass-if-equal "(not (list 1 2))"          ;https://bugs.gnu.org/58217
+      '(#f #f)
+    ;; The baseline compiler (-O0 and -O1) in 3.0.8 would crash.
+    (list (compile '(not (list 1 2)) #:optimization-level 2)
+          (compile '(not (list 1 2)) #:optimization-level 0))))
 
 (with-test-prefix "prompt body slot allocation"
   (define test-code