X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=6fcfb213dd3d29f3de037d2899218d9f6e43050d;hb=b20e8cac4dd15882d5e0fda1bcf04c487df1360f;hp=755547f57eca889b5295f97d0bc66a74e809d3ee;hpb=646a14a9099c3c6bbb60ff09f7fb6a781a030815;p=sbcl.git

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 755547f..6fcfb21 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2594,3 +2594,53 @@
                                '(lambda (s)
                                  (sb-c::compiler-derived-type (aref (the base-string s) 0))))
                       (coerce "foo" 'base-string)))))
+
+(with-test (:name :dolist-constant-type-derivation)
+  (assert (equal '(integer 1 3)
+                 (funcall (compile nil
+                                   '(lambda (x)
+                                     (dolist (y '(1 2 3))
+                                       (when x
+                                         (return (sb-c::compiler-derived-type y))))))
+                          t))))
+
+(with-test (:name :dolist-simple-list-type-derivation)
+  (assert (equal '(integer 1 3)
+                 (funcall (compile nil
+                                   '(lambda (x)
+                                     (dolist (y (list 1 2 3))
+                                       (when x
+                                         (return (sb-c::compiler-derived-type y))))))
+                          t))))
+
+(with-test (:name :dolist-dotted-constant-list-type-derivation)
+  (let* ((warned nil)
+         (fun (handler-bind ((style-warning (lambda (c) (push c warned))))
+                (compile nil
+                         '(lambda (x)
+                           (dolist (y '(1 2 3 . 4) :foo)
+                             (when x
+                               (return (sb-c::compiler-derived-type y)))))))))
+    (assert (equal '(integer 1 3) (funcall fun t)))
+    (assert (= 1 (length warned)))
+    (multiple-value-bind (res err) (ignore-errors (funcall fun nil))
+      (assert (not res))
+      (assert (typep err 'type-error)))))
+
+(with-test (:name :constant-list-destructuring)
+  (handler-bind ((sb-ext:compiler-note #'error))
+    (progn
+      (assert (= 10
+                 (funcall
+                  (compile nil
+                           '(lambda ()
+                             (destructuring-bind (a (b c) d) '(1 (2 3) 4)
+                               (+ a b c d)))))))
+      (assert (eq :feh
+                  (funcall
+                   (compile nil
+                            '(lambda (x)
+                              (or x
+                               (destructuring-bind (a (b c) d) '(1 "foo" 4)
+                                 (+ a b c d)))))
+                   :feh))))))