0.9.16.27:
[sbcl.git] / tests / compiler.pure.lisp
index 4b0af78..cfc11c1 100644 (file)
 
 (cl:in-package :cl-user)
 
+;; The tests in this file assume that EVAL will use the compiler
+(when (eq sb-ext:*evaluator-mode* :interpret)
+  (invoke-restart 'run-tests::skip-file))
+
 ;;; Exercise a compiler bug (by crashing the compiler).
 ;;;
 ;;; This test code is from Douglas Crosher's simplified TICKLE-BUG
        (f (compile nil l)))
   (assert (funcall f :good))
   (assert (nth-value 1 (ignore-errors (funcall f 42)))))
+
+;;; Check that the compiler doesn't munge *RANDOM-STATE*.
+(let* ((state (make-random-state))
+       (*random-state* (make-random-state state))
+       (a (random most-positive-fixnum)))
+  (setf *random-state* state)
+  (compile nil `(lambda (x a)
+                  (declare (single-float x)
+                           (type (simple-array double-float) a))
+                  (+ (loop for i across a
+                           summing i)
+                     x)))
+  (assert (= a (random most-positive-fixnum))))
+
+;;; MISC.641: LET-conversion after physical environment analysis lost NLX-INFOs
+(let ((form '(lambda ()
+              (declare (optimize (speed 1) (space 0) (debug 2)
+                           (compilation-speed 0) (safety 1)))
+              (flet ((%f3 (f3-1 &key (key1 (count (floor 0 (min -74 0)) #())))
+                          0))
+                   (apply #'%f3 0 nil)))))
+  (assert (zerop (funcall (compile nil form)))))
+
+;;;  size mismatch: #<SB-VM::EA :DWORD base=#<SB-C:TN t1[RDX]> disp=1> is a :DWORD and #<SB-C:TN t2[RAX]> is a :QWORD. on x86-64
+(compile nil '(lambda ()
+               (let ((x (make-array '(1) :element-type '(signed-byte 32))))
+                 (setf (aref x 0) 1))))
+
+;;; step instrumentation confusing the compiler, reported by Faré
+(handler-bind ((warning #'error))
+  (compile nil '(lambda ()
+                 (declare (optimize (debug 2))) ; not debug 3!
+                 (let ((val "foobar"))
+                   (map-into (make-array (list (length val))
+                                         :element-type '(unsigned-byte 8))
+                             #'char-code val)))))