X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure.lisp;h=9b509c2e0246900e1e0eaf7e2d566515678594df;hb=aa8cdb795d6bb551aaecb6db38d5ef6571c698ed;hp=06f52a51603237c96f5e634285a47e24aaa4a617;hpb=b402bbba90ce3b8b90683a09f36568d9dc8d7ba9;p=sbcl.git

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 06f52a5..9b509c2 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -618,7 +618,7 @@
 (assert (equal (check-embedded-thes 3 0  2 :a) '(2 :a)))
 (assert (typep (check-embedded-thes 3 0  4 2.5f0) 'type-error))
 
-(assert (equal (check-embedded-thes 1 0  4 :b) '(4 :b)))
+(assert (equal (check-embedded-thes 1 0  3 :b) '(3 :b)))
 (assert (typep (check-embedded-thes 1 0  1.0 2.5f0) 'type-error))
 
 
@@ -1084,6 +1084,21 @@
   (assert (equal "GOOD!"
                  (progv '(*hairy-progv-var*) (list (eval "GOOD!"))
                     *hairy-progv-var*))))
+
+(with-test (:name :fill-complex-single-float)
+  (assert (every (lambda (x) (eql x #c(-1.0 -2.0)))
+                 (funcall
+                  (lambda ()
+                    (make-array 2
+                                :element-type '(complex single-float)
+                                :initial-element #c(-1.0 -2.0)))))))
+
+(with-test (:name :make-array-symbol-as-initial-element)
+  (assert (every (lambda (x) (eq x 'a))
+                 (funcall
+                  (compile nil
+                           `(lambda ()
+                              (make-array 12 :initial-element 'a)))))))
 
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself
@@ -1835,4 +1850,37 @@
 (setf *mystery* :mystery)
 (assert (eq :ok (test-mystery (make-thing :slot :mystery))))
 
+;;; optimizing make-array
+(defun count-code-callees (f)
+  (let ((code (sb-kernel:fun-code-header f))
+        (n 0))
+    (loop for i from sb-vm::code-constants-offset below (sb-kernel:get-header-data code)
+          for c = (sb-kernel:code-header-ref code i)
+          do (when (typep c 'fdefn)
+               (print c)
+               (incf n)))
+    n))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '(3) :initial-contents (list x y z)))))))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '3 :initial-contents (vector x y z)))))))
+(assert (zerop (count-code-callees
+                (compile nil
+                         `(lambda (x y z)
+                            (make-array '3 :initial-contents `(,x ,y ,z)))))))
+
+;;; optimizing (EXPT -1 INTEGER)
+(test-util:with-test (:name (expt minus-one integer))
+  (dolist (x '(-1 -1.0 -1.0d0))
+    (let ((fun (compile nil `(lambda (x) (expt ,x (the fixnum x))))))
+      (assert (zerop (count-code-callees fun)))
+      (dotimes (i 12)
+        (if (oddp i)
+            (assert (eql x (funcall fun i)))
+            (assert (eql (- x) (funcall fun i))))))))
+
 ;;; success