Added tests for Stas' latest bugfixes.

src/tests/bugs/doit.lsp

@@ -29,8 +29,12 @@
 (load "../ansi-tests/universe.lsp")
 (load "../ansi-tests/ansi-aux.lsp")
 
+(load "sf262--declaim-type-foo-setf-foo.lsp")
+(load "sf272--style-warning-argument-order.lsp")
 (load "sf276--write-hash-readably.lsp")
+(load "sf282--mvb-not-evaled.lsp")
 (load "sf286.lsp")
+
 (load "cl-001.lsp")
 
 (load "int-001.lsp")

src/tests/bugs/sf262--declaim-type-foo-setf-foo.lsp

@@ -0,0 +1,21 @@
+;; http://sourceforge.net/p/ecls/bugs/262
+
+(declaim (ftype (function (cons)   t)       foo))
+(declaim (ftype (function (t cons) t) (setf foo)))
+
+(defun foo (cons)
+  (first cons))
+
+(defun (setf foo) (value cons)
+  (setf (first cons) value))
+
+(defvar *c* (cons 'x 'y))
+
+(foo *c*) ;; correctly returns 'x
+
+;; signals an error:
+;; Z is not of type CONS.
+;;   [Condition of type TYPE-ERROR]
+(deftest sf262--declaim-type-foo-setf-foo.lsp
+         (assert (eq 'z
+                     (setf (foo *c*) 'z))))

src/tests/bugs/sf272--style-warning-argument-order.lsp

@@ -0,0 +1,20 @@
+;; https://sourceforge.net/p/ecls/bugs/272
+
+(compile nil
+         `(lambda (x) (1+ (the (values integer string) (funcall x)))))
+
+(deftest sf272--style-warning-argument-order
+         (let ((warning nil))
+           (assert
+             (eq :ok
+                 (handler-bind
+                   ((style-warning 
+                      (lambda (c) 
+                        (format t "got style-warning: ~s~%" c)
+                        (setf warning c))))
+                   (block nil
+                          (tagbody
+                            (return (multiple-value-bind () (go :fail) :bad))
+                            :fail
+                            (return :ok))))))
+           (assert (not warning))))

src/tests/bugs/sf282--mvb-not-evaled.lsp

@@ -0,0 +1,11 @@
+
+;; https://sourceforge.net/p/ecls/bugs/282
+
+(deftest sf282--mvb-not-evaled
+         (assert
+           (eq :ok
+               (block nil
+                      (tagbody
+                        (return (multiple-value-bind () (go :fail) :bad))
+                        :fail
+                        (return :ok))))))