(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")
--- /dev/null
+;; 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))))
--- /dev/null
+;; 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))))
--- /dev/null
+
+;; 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))))))
Repositories / ecl.git / commitdiff