diff --git a/src/tests/bugs/doit.lsp b/src/tests/bugs/doit.lsp index a9f071c54..797870750 100644 --- a/src/tests/bugs/doit.lsp +++ b/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") diff --git a/src/tests/bugs/sf262--declaim-type-foo-setf-foo.lsp b/src/tests/bugs/sf262--declaim-type-foo-setf-foo.lsp new file mode 100644 index 000000000..ae64a2962 --- /dev/null +++ b/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)))) diff --git a/src/tests/bugs/sf272--style-warning-argument-order.lsp b/src/tests/bugs/sf272--style-warning-argument-order.lsp new file mode 100644 index 000000000..d4497259e --- /dev/null +++ b/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)))) diff --git a/src/tests/bugs/sf282--mvb-not-evaled.lsp b/src/tests/bugs/sf282--mvb-not-evaled.lsp new file mode 100644 index 000000000..ac69b3eb1 --- /dev/null +++ b/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))))))