X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.impure.lisp;h=9a8458c203d1867f9fa25356b6312db331005300;hb=09d7974601df2aaaa820ca576026b9b4f03e6ab1;hp=1d5ce41171ca37b11a51d7910bb027507f49cf5d;hpb=7e6a733d8decb72a778323d6dba4dcc5699a91fc;p=sbcl.git

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 1d5ce41..9a8458c 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -578,6 +578,63 @@ BUG 48c, not yet fixed:
 ;;; (fix provided by Matthew Danish) on sbcl-devel
 (assert (null (ignore-errors
 		(defmacro bug172 (&rest rest foo) `(list ,rest ,foo)))))
+
+;;; embedded THEs
+(defun check-embedded-thes (policy1 policy2 x y)
+  (handler-case
+      (funcall (compile nil
+                        `(lambda (f)
+                           (declare (optimize (speed 2) (safety ,policy1)))
+                           (multiple-value-list
+                            (the (values (integer 2 3) t)
+                              (locally (declare (optimize (safety ,policy2)))
+                                (the (values t (single-float 2f0 3f0))
+                                  (funcall f)))))))
+               (lambda () (values x y)))
+    (type-error (error)
+      error)))
+
+(assert (equal (check-embedded-thes 0 0  :a :b) '(:a :b)))
+
+(assert (equal (check-embedded-thes 0 3  :a 2.5f0) '(:a 2.5f0)))
+(assert (typep (check-embedded-thes 0 3  2 3.5f0) 'type-error))
+
+(assert (equal (check-embedded-thes 0 1  :a 3.5f0) '(:a 3.5f0)))
+(assert (typep (check-embedded-thes 0 1  2 2.5d0) 'type-error))
+
+#+nil
+(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 (typep (check-embedded-thes 1 0  1.0 2.5f0) 'type-error))
+
+
+(assert (equal (check-embedded-thes 3 3  2 2.5f0) '(2 2.5f0)))
+(assert (typep (check-embedded-thes 3 3  0 2.5f0) 'type-error))
+(assert (typep (check-embedded-thes 3 3  2 3.5f0) 'type-error))
+
+
+;;; INLINE inside MACROLET
+(declaim (inline to-be-inlined))
+(macrolet ((def (x) `(defun ,x (y) (+ y 1))))
+  (def to-be-inlined))
+(defun call-inlined (z)
+  (to-be-inlined z))
+(assert (= (call-inlined 3) 4))
+(macrolet ((frob (x) `(+ ,x 3)))
+  (defun to-be-inlined (y)
+    (frob y)))
+(assert (= (call-inlined 3)
+	   ;; we should have inlined the previous definition, so the
+	   ;; new one won't show up yet.
+	   4))
+(defun call-inlined (z)
+  (to-be-inlined z))
+(assert (= (call-inlined 3) 6))
+(defun to-be-inlined (y)
+  (+ y 5))
+(assert (= (call-inlined 3) 6))
 
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself