1.0.43.53: less CPU-speed sensitive test for bug 654289

 Instead of hardcoding a time limit, compile bits of code with
 different sized constants, and compare the times in relation
 to each other.

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index b2c287c..074ef9a 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3575,21 +3575,24 @@
                        (load-time-value (the (values fixnum) 42)))))))
 
 (with-test (:name :bug-654289)
-  (let* ((big (labels ((make-tree (n acc)
-                         (cond ((zerop n) acc)
-                               (t (make-tree (1- n) (cons acc acc))))))
-                (make-tree 10000 nil)))
-         (small '((1) (2) (3)))
-         (t0 (get-internal-run-time))
-         (f1 (compile nil `(lambda (x) (eq x (quote ,big)))))
-         (t1 (get-internal-run-time))
-         (f2 (compile nil `(lambda (x) (eq x (quote ,small)))))
-         (t2 (get-internal-run-time)))
-    (assert (funcall f1 big))
-    (assert (funcall f2 small))
-    ;; Compile time should not explode just because there's a big constant
-    ;; object in the source.
-    (assert (> 10 (abs (- (- t1 t0) (- t2 t1)))))))
+  ;; Test that compile-times don't explode when quoted constants
+  ;; get big.
+  (labels ((time-n (n)
+             (let* ((tree (make-tree (expt 10 n) nil))
+                    (t0 (get-internal-run-time))
+                    (f (compile nil `(lambda (x) (eq x (quote ,tree)))))
+                    (t1 (get-internal-run-time)))
+               (assert (funcall f tree))
+               (- t1 t0)))
+           (make-tree (n acc)
+             (cond ((zerop n) acc)
+                   (t (make-tree (1- n) (cons acc acc))))))
+    (let* ((times (loop for i from 0 upto 4
+                        collect (time-n i)))
+           (max-small (reduce #'max times :end 3))
+           (max-big (reduce #'max times :start 3)))
+      ;; This way is hopefully fairly CPU-performance insensitive.
+      (assert (> (* (+ 2 max-small) 2) max-big)))))
 
 (with-test (:name :bug-309063)
   (let ((fun (compile nil `(lambda (x)

diff --git a/version.lisp-expr b/version.lisp-expr
index c269a61..06bf55e 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.43.52"
+"1.0.43.53"