Bug fix: don't bind nil in expansion

ruricolist · Apr 28, 2023 · f45b8ea · f45b8ea
1 parent e3ad33c
commit f45b8ea
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 19 deletions.
diff --git a/tests/lists.lisp b/tests/lists.lisp
@@ -264,3 +264,10 @@
     (with-member-test (mem :key nil :test nil)
       (is-true (mem 1 '(1 2 3)))
       (is-false (mem 4 '(1 2 3))))))
+
+(test with-member-test/complex-expansion ()
+  "Test expansion of with-member-test when speed is the priority."
+  (locally (declare (optimize (speed 3) (space 0) (compilation-speed 0) (debug 0)))
+    (with-member-test (mem :key nil :test nil)
+      (is-true (mem 1 '(1 2 3)))
+      (is-false (mem 4 '(1 2 3))))))
diff --git a/types.lisp b/types.lisp
@@ -748,25 +748,34 @@ WITH-BOOLEAN."
                                     '(values :test-not ',utest-not)
                                     '(values)))))
              ,@body)))
-      `(let ((,test (canonicalize-test ,test ,test-not)))
-         (with-item-key-function (,key)
-           (with-two-arg-test (,test)
-             (macrolet ((,test-fn (x l)
-                          (let ((test ',test)
-                                (key ',key))
-                            (with-unique-names (ul ux mem)
-                              `(let ((,ul ,l)
-                                     (,ux ,x))
-                                 (declare (optimize (safety 0) (debug 0))
-                                          (list ,ul))
-                                 (block ,mem
-                                   (tagbody loop
-                                      (when ,ul
-                                        (unless (,test ,ux (,key (first ,ul)))
-                                          (setf ,ul (cdr ,ul))
-                                          (go loop)))
-                                      (return-from ,mem ,ul))))))))
-               ,@body))))))
+      (let ((test? test)
+            (test (or test (gensym (string 'test))))
+            (test-not? test-not)
+            (test-not (or test (gensym (string 'test-not))))
+            (key? key)
+            (key (or key (gensym (string 'key)))))
+        `(let ((,test (canonicalize-test
+                       ,(and test? test)
+                       ,(and test-not? test-not)))
+               (,key ,(and key? key)))
+           (with-item-key-function (,key)
+             (with-two-arg-test (,test)
+               (macrolet ((,test-fn (x l)
+                            (let ((test ',test)
+                                  (key ',key))
+                              (with-unique-names (ul ux mem)
+                                `(let ((,ul ,l)
+                                       (,ux ,x))
+                                   (declare (optimize (safety 0) (debug 0))
+                                            (list ,ul))
+                                   (block ,mem
+                                     (tagbody loop
+                                        (when ,ul
+                                          (unless (,test ,ux (,key (first ,ul)))
+                                            (setf ,ul (cdr ,ul))
+                                            (go loop)))
+                                        (return-from ,mem ,ul))))))))
+                 ,@body)))))))
 
 (defmacro with-item-key-function ((key &optional (key-form key))
                                   &body body &environment env)