Speed up a test.

1 files changed, 59 insertions, 65 deletions

diff --git a/tests/cmp-combinations.pure.lisp b/tests/cmp-combinations.pure.lisp
index 05317aaed..454b18ca6 100644
--- a/tests/cmp-combinations.pure.lisp
+++ b/tests/cmp-combinations.pure.lisp
@@ -9,11 +9,11 @@
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
 
-#+slow(push :slow *features*) ;; takes more than 30 minutes
+#+slow(push :slow *features*) ;; takes around 5 minutes
 
 (with-test (:name :ranges)
   (let* ((ops '(< > <= >=))
-         (ranges (list 0 1 -1 -2 2 most-positive-fixnum most-negative-fixnum 100 -100))
+         (ranges (list 0 1 -1 -2 2 most-positive-fixnum most-negative-fixnum))
          (ns (append ranges
                      (list most-positive-double-float most-negative-double-float
                            least-positive-double-float least-negative-double-float
@@ -29,92 +29,86 @@
                            (/ (expt 2 300))
                            (/ (- (expt 2 300)))
                            (/ 3 (expt 2 300))
-                           (/ 3 (- (expt 2 300))))))
-         (cache (make-hash-table :test #'equal)))
-    (flet ((cached-compile (form)
-             (or (gethash form cache)
-                 (setf (gethash form cache)
-                       (checked-compile form)))))
+                           (/ 3 (- (expt 2 300)))))))
+    (loop
+      for logical in '(and #+slow or)
+      do
       (loop
-        for not in '(progn #+slow not)
+        for op1 in ops
         do
         (loop
-          for logical in '(and or)
+          for op1-not in '(progn #+slow not)
           do
           (loop
-            for op1 in ops
+            for op2 in ops
             do
             (loop
-              for op1-not in '(progn #+slow not)
+              for op2-not in '(progn #+slow not)
               do
               (loop
-                for op2 in ops
+                for l in (list* 'l ranges)
                 do
                 (loop
-                  for op2-not in '(progn #+slow not)
+                  for h in (list* 'h ranges)
                   do
                   (loop
-                    for l in (list* 'l ranges)
+                    for args1 in (list (list l 'n)
+                                       #+slow (list 'n l))
                     do
                     (loop
-                      for h in (list* 'h ranges)
+                      for args2 in (list (list h 'n)
+                                         #+slow (list 'n h))
                       do
                       (loop
-                        for args1 in (list (list l 'n)
-                                           #+slow (list 'n l))
+                        for type in `(t #+slow ,@'(integer fixnum unsigned-byte (and fixnum unsigned-byte)
+                                                   sb-vm:signed-word
+                                                   sb-vm:word))
                         do
                         (loop
-                          for args2 in (list (list h 'n)
-                                             #+slow (list 'n h))
-                          do
-                          (loop
-                            for type in `(t #+slow ,@'(integer fixnum unsigned-byte (and fixnum unsigned-byte)
-                                                       sb-vm:signed-word
-                                                       sb-vm:word))
-                            do
-                            (loop
-                              for l-type in `(fixnum #+slow ,@'((and unsigned-byte fixnum)
+                          for l-type in (if (integerp l)
+                                            '(t)
+                                            `(fixnum #+slow ,@'((and unsigned-byte fixnum)
                                                                 (and (integer * -1) fixnum)
                                                                 sb-vm:signed-word
-                                                                sb-vm:word))
-                              do
-                              (loop
-                                for h-type in `(fixnum #+slow ,@'((and unsigned-byte fixnum)
+                                                                sb-vm:word)))
+                          do
+                          (loop
+                            for h-type in (if (integerp h)
+                                              '(t)
+                                              `(fixnum #+slow ,@'((and unsigned-byte fixnum)
                                                                   (and (integer * -1) fixnum)
                                                                   sb-vm:signed-word
-                                                                  sb-vm:word))
+                                                                  sb-vm:word)))
+                            do
+                            (let* ((form `(lambda (l n h)
+                                            (declare (,l-type l)
+                                                     (,h-type h)
+                                                     (,type n)
+                                                     (ignorable l h))
+                                            (,logical
+                                             (,op1-not (,op1 ,@args1))
+                                             (,op2-not (,op2 ,@args2)))))
+                                   (fun1 (checked-compile form))
+                                   (fun2 (checked-compile
+                                          `(lambda (l n h)
+                                             (declare (ignorable l h)
+                                                      (notinline ,@ops))
+                                             (,logical
+                                              (,op1-not (,op1 ,@args1))
+                                              (,op2-not (,op2 ,@args2)))))))
+                              (loop
+                                for l in ranges
+                                when (typep l l-type)
                                 do
-                                (let* ((form `(lambda (l n h)
-                                                (declare (,l-type l)
-                                                         (,h-type h)
-                                                         (,type n)
-                                                         (ignorable l h))
-                                                (,not
-                                                 (,logical
-                                                  (,op1-not (,op1 ,@args1))
-                                                  (,op1-not (,op2 ,@args2))))))
-                                       (fun1 (cached-compile form))
-                                       (fun2 (cached-compile
-                                              `(lambda (l n h)
-                                                 (declare (ignorable l h)
-                                                          (notinline ,@ops))
-                                                 (,not
-                                                  (,logical
-                                                   (,op1-not (,op1 ,@args1))
-                                                   (,op1-not (,op2 ,@args2))))))))
+                                (loop
+                                  for h in ranges
+                                  when (typep h h-type)
+                                  do
                                   (loop
-                                    for l in ranges
-                                    when (typep l l-type)
+                                    for n in ns
+                                    when (typep n type)
                                     do
-                                    (loop
-                                      for h in ranges
-                                      when (typep h h-type)
-                                      do
-                                      (loop
-                                        for n in ns
-                                        when (typep n type)
-                                        do
-                                        (unless (eql (funcall fun1 l n h)
-                                                     (funcall fun2 l n h))
-                                          (error "~a" (list form
-                                                            l n h)))))))))))))))))))))))
+                                    (unless (eql (funcall fun1 l n h)
+                                                 (funcall fun2 l n h))
+                                      (error "~a" (list form
+                                                        l n h)))))))))))))))))))))