X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Farith.pure.lisp;h=5a6ca2f60a8870d9c9cd4ddad70f64b98f1fa28c;hb=930a0e019b4c823da04d52e907d322a296fb9ae3;hp=746b88b11008845f2e1df97f3b55baccd5de2721;hpb=b5696612c774dac57abff3b5abe3f04ebe0ce2c7;p=sbcl.git

diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index 746b88b..5a6ca2f 100644
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -372,3 +372,35 @@
   (assert (raises-error? (expt 0.0 0.0) sb-int:arguments-out-of-domain-error))
   (assert (raises-error? (expt 0 0.0) sb-int:arguments-out-of-domain-error))
   (assert (eql (expt 0.0 0) 1.0)))
+
+(with-test (:name :multiple-constant-folding)
+  (let ((*random-state* (make-random-state t)))
+    (flet ((make-args ()
+             (let (args vars)
+               (loop repeat (1+ (random 12))
+                     do (if (zerop (random 2))
+                            (let ((var (gensym)))
+                              (push var args)
+                              (push var vars))
+                            (push (- (random 21) 10) args)))
+               (values args vars))))
+      (dolist (op '(+ * logior logxor logand logeqv gcd lcm - /))
+        (loop repeat 10
+              do (multiple-value-bind (args vars) (make-args)
+                   (let ((fast (compile nil `(lambda ,vars
+                                               (,op ,@args))))
+                         (slow (compile nil `(lambda ,vars
+                                               (declare (notinline ,op))
+                                               (,op ,@args)))))
+                     (loop repeat 3
+                           do (let* ((call-args (loop repeat (length vars)
+                                                      collect (- (random 21) 10)))
+                                     (fast-result (handler-case
+                                                      (apply fast call-args)
+                                                    (division-by-zero () :div0)))
+                                     (slow-result (handler-case
+                                                      (apply fast call-args)
+                                                    (division-by-zero () :div0))))
+                                (if (eql fast-result slow-result)
+                                    (print (list :ok `(,op ,@args) :=> fast-result))
+                                    (error "oops: ~S, ~S" args call-args)))))))))))