1.0.29.53: some LOAD-TIME-VALUE smartness
[sbcl.git] / tests / compiler.impure.lisp
index 9b509c2..6795171 100644 (file)
 (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