diff --git a/ansi-tests/beyond-ansi/errors-data-and-control-flow-2.lsp b/ansi-tests/beyond-ansi/errors-data-and-control-flow-2.lsp index 366858850d4b2c21783dfff68ce20cf571e30b41..0dc871000d580fb310ae6c72991b09636bd9ab5f 100644 --- a/ansi-tests/beyond-ansi/errors-data-and-control-flow-2.lsp +++ b/ansi-tests/beyond-ansi/errors-data-and-control-flow-2.lsp @@ -190,3 +190,145 @@ (def-error-test return-from.5 (block foo (return-from foo nil . 2))) (def-error-test return-from.6 (block foo (return-from foo nil 3))) +;;; RETURN + +(def-error-test return.1 (return . x)) +(def-error-test return.2 (return nil . x)) + +;;; TAGBODY + +(def-error-test tagbody.1 (tagbody . x)) +(def-all-error-test tagbody.2 (typef '(or symbol integer cons)) + #'(lambda (x) `(tagbody ,x))) + +;;; THROW + +(def-error-test throw.1 (throw)) +(def-error-test throw.2 (throw . x)) +(def-error-test throw.3 (catch 'a (throw 'a))) +(def-error-test throw.4 (catch 'a (throw 'a . x))) +(def-error-test throw.5 (catch 'a (throw 'a 1 . x))) +(def-error-test throw.6 (catch 'a (throw 'a 1 'x))) + +;;; UNWIND-PROTECT + +(def-error-test unwind-protect.1 (unwind-protect)) +(def-error-test unwind-protect.2 (unwind-protect . x)) +(def-error-test unwind-protect.3 (unwind-protect nil . x)) + +;;; NOT + +(def-error-test not.1 (not . x)) +(def-error-test not.2 (not nil . x)) + + +;;; EQ + +(def-error-test eq.1 (eq . 1)) +(def-error-test eq.2 (eq 'x . 2)) +(def-error-test eq.3 (eq :foo 2 . 17)) + +;;; EQL + +(def-error-test eql.1 (eql . 1)) +(def-error-test eql.2 (eql 'x . 2)) +(def-error-test eql.3 (eql :foo 2 . 17)) + +;;; EQUAL + +(def-error-test equal.1 (equal . 1)) +(def-error-test equal.2 (equal 'x . 2)) +(def-error-test equal.3 (equal :foo 2 . 17)) + +;;; EQUALP + +(def-error-test equalp.1 (equalp . 1)) +(def-error-test equalp.2 (equalp 'x . 2)) +(def-error-test equalp.3 (equalp :foo 2 . 17)) + +;;; IDENTITY + +(def-error-test identity.1 (identity . 0)) +(def-error-test identity.2 (identity 0 . "foo")) + +;;; COMPLEMENT + +(def-error-test complement.1 (complement . 1.2)) +(def-error-test complement.2 (complement #'plusp . #(1 2))) +(def-error-test complement.3 (complement #'zerop #*110101 . #c(1 2))) +(def-all-error-test complement.4 'functionp '(complement x)) + +;;; CONSTANTLY + +(def-error-test constantly.1 (constantly . 1/2)) +(def-error-test constantly.2 (constantly :foo . 1/2)) + +;;; EVERY + +(def-error-test every.1 (every . :foo)) +(def-error-test every.2 (every 'null . (list))) +(def-error-test every.3 (every (gensym) '(a b c d))) + +;;; SOME + +(def-error-test some.1 (some . :foo)) +(def-error-test some.2 (some 'null . (list))) +(def-error-test some.3 (some (gensym) '(a b c d))) + +;;; NOTEVERY + +(def-error-test notevery.1 (notevery . :foo)) +(def-error-test notevery.2 (notevery 'null . (list))) +(def-error-test notevery.3 (notevery (gensym) '(a b c d))) + +;;; NOTANY + +(def-error-test notany.1 (notany . :foo)) +(def-error-test notany.2 (notany 'null . (list))) +(def-error-test notany.3 (notany (gensym) '(a b c d))) + +;;; AND + +(def-error-test and.1 (and . #.(make-hash-table))) +(def-error-test and.2 (and t . :foo)) + +;;; COND + +(def-error-test cond.1 (cond . 1)) +(def-error-test cond.2 (cond (t . 2))) +(def-error-test cond.3 (cond nil)) +(def-error-test cond.4 (cond (nil) . "foo")) + +;;; IF + +(def-error-test if.1 (if)) +(def-error-test if.2 (if . t)) +(def-error-test if.3 (if t)) +(def-error-test if.4 (if nil)) +(def-error-test if.5 (if t . 1)) +(def-error-test if.6 (if nil . 2)) +(def-error-test if.7 (if t 1 . 2)) +(def-error-test if.8 (if nil #\x . #\y)) +(def-error-test if.9 (if t 1 2 . 3)) +(def-error-test if.10 (if nil #\x #\y . 1.23d4)) +(def-error-test if.11 (if t 1 2 3)) +(def-error-test if.12 (if nil #\x #\y nil nil nil)) + +;;; OR + +(def-error-test or.1 (or . :foo)) +(def-error-test or.2 (or nil . :bar)) + +;;; WHEN + +(def-error-test when.1 (when)) +(def-error-test when.2 (when . #\$)) +(def-error-test when.3 (when t . x)) +(def-error-test when.4 (when t nil . "A")) + +;;; UNLESS + +(def-error-test unless.1 (unless)) +(def-error-test unless.2 (unless . #*1011)) +(def-error-test unless.3 (unless nil . t)) +(def-error-test unless.4 (unless nil nil . #())) diff --git a/ansi-tests/beyond-ansi/errors-data-and-control-flow-3.lsp b/ansi-tests/beyond-ansi/errors-data-and-control-flow-3.lsp new file mode 100644 index 0000000000000000000000000000000000000000..da9c91f3be190aa5d7e13ff59d52ca67effe953c --- /dev/null +++ b/ansi-tests/beyond-ansi/errors-data-and-control-flow-3.lsp @@ -0,0 +1,118 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Jun 14 07:00:58 2005 +;;;; Contains: Tests of non-ANSI exceptions sutation from CLHS section 5, part 3 +(in-package :ba-test) + +(compile-and-load "ba-aux.lsp") + +;;; CASE + +(def-error-test case.1 (case . 1)) +(def-error-test case.2 (case nil . 1)) +(def-error-test case.3 (case nil (nil . 1))) +(def-error-test case.4 (case 'x nil)) +(def-error-test case.5 (case 'x ((nil . x) 1))) +(def-error-test case.6 (case)) + +;;; CCASE + +(def-error-test ccase.1 (ccase . 1)) +(def-error-test ccase.2 (let ((x nil)) (ccase x . 1))) +(def-error-test ccase.3 (let ((x nil)) (ccase x (nil . 1)))) +(def-error-test ccase.4 (let ((x 'x)) (ccase x nil))) +(def-error-test ccase.5 (let ((x 'x)) (ccase x ((nil . x) 1)))) +(def-error-test ccase.6 (ccase 1 (1 nil))) ;; 1 is not a place! +(def-error-test ccase.7 (ccase)) + +;;; ECASE + +(def-error-test ecase.1 (ecase . 1)) +(def-error-test ecase.2 (ecase nil . 1)) +(def-error-test ecase.3 (ecase nil (nil . 1))) +(def-error-test ecase.4 (ecase 'x nil)) +(def-error-test ecase.5 (ecase 'x ((nil . x) 1))) +(def-error-test ecase.6 (ecase)) + +;;; TYPECASE + +(def-error-test typecase.1 (typecase)) +(def-error-test typecase.2 (typecase . :foo)) +(def-error-test typecase.3 (typecase 'x . #\X)) +(def-error-test typecase.4 (typecase 'x (#.(gensym) t))) +(def-error-test typecase.5 (typecase 'x (symbol . :foo))) +(def-error-test typecase.6 (typecase 'x . :foo)) +(def-error-test typecase.7 (typepcase 'x (t . :foo))) +(def-error-test typecase.8 (typepcase 'x (otherwise . :foo))) + +;;; CTYPECASE + +(def-error-test ctypecase.1 (ctypecase)) +(def-error-test ctypecase.2 (ctypecase . :foo)) +(def-error-test ctypecase.3 (let ((x 'x)) (ctypecase x . #\X))) +(def-error-test ctypecase.4 (let ((x 'x)) (ctypecase x (#.(gensym) t)))) +(def-error-test ctypecase.5 (let ((x 'x)) (ctypecase x (symbol . :foo)))) +(def-error-test ctypecase.6 (let ((x 'x)) (ctypecase x . :foo))) +(def-error-test ctypecase.7 (let ((x 'x)) (ctypecase x (t . :foo)))) +(def-error-test ctypecase.8 (let ((x 'x)) (ctypecase x (otherwise . :foo)))) +(def-error-test ctypecase.9 (ctypecase 1 (integer :bad))) + +;;; ETYPECASE + +(def-error-test etypecase.1 (etypecase)) +(def-error-test etypecase.2 (etypecase . :foo)) +(def-error-test etypecase.3 (etypecase 'x . #\X)) +(def-error-test etypecase.4 (etypecase 'x (#.(gensym) t))) +(def-error-test etypecase.5 (etypecase 'x (symbol . :foo))) +(def-error-test etypecase.6 (etypecase 'x . :foo)) + +;;; MULTIPLE-VALUE-BIND + +(def-error-test multiple-value-bind.1 (multiple-value-bind)) +(def-error-test multiple-value-bind.2 (multiple-value-bind . + #.(1+ most-positive-fixnum))) +(def-error-test multiple-value-bind.3 (multiple-value-bind (x))) +(def-error-test multiple-value-bind.4 (multiple-value-bind (x . y) 1 x)) +(def-error-test multiple-value-bind.5 (multiple-value-bind (x) . :foo)) +(def-error-test multiple-value-bind.6 (multiple-value-bind (x) nil . :bar)) +(def-error-test multiple-value-bind.7 + (multiple-value-bind (x) nil "doc string" . 1)) +(def-error-test multiple-value-bind.8 + (multiple-value-bind (x) nil (declare) . 1)) +(def-error-test multiple-value-bind.9 + (multiple-value-bind (x) 1 (declare (type symbol x)) x)) + +;;; MULTIPLE-VALUE-CALL + +(def-error-test multiple-value-call.1 (multiple-value-call)) +(def-error-test multiple-value-call.2 (multiple-value-call . :x)) +(def-error-test multiple-value-call.3 (multiple-value-call 'list . :x)) +(def-error-test multiple-value-call.4 (multiple-value-call 'list 1 . :x)) +(def-all-error-test multiple-value-call.5 'function-designator-p + '(multiple-value-call x nil)) +(def-error-test multiple-value-call.6 (multiple-value-call (gensym))) + +;;; MULTIPLE-VALUE-LIST + +(def-error-test multiple-value-list.1 (multiple-value-list)) +(def-error-test multiple-value-list.2 (multiple-value-list . 1)) +(def-error-test multiple-value-list.3 (multiple-value-list 1 . 2)) +(def-error-test multiple-value-list.4 (multiple-value-list 1 2)) + +;;; MULTIPLE-VALUE-PROG1 + +(def-error-test multiple-value-prog1.1 (multiple-value-prog1)) +(def-error-test multiple-value-prog1.2 (multiple-value-prog1 . 1)) +(def-error-test multiple-value-prog1.3 (multiple-value-prog1 :x . :y)) + +;;; MULTIPLE-VALUE-SETQ + +(def-error-test multiple-value-setq.1 (multiple-value-setq)) +(def-error-test multiple-value-setq.2 (let (x) (multiple-value-setq (x)) x)) +(def-error-test multiple-value-setq.3 + (let (x y) (multiple-value-setq (x . y) nil (list x y)))) +(def-all-error-test multiple-value-setq.4 'symbolp + #'(lambda (x) `(multiple-value-setq (,x) nil))) +(def-all-error-test multiple-value-setq.5 (constantly nil) + #'(lambda (x) `(multiple-value-setq (,x) nil)) + :vals cl-test::*cl-constant-symbols*) diff --git a/ansi-tests/beyond-ansi/load-ba.lsp b/ansi-tests/beyond-ansi/load-ba.lsp index 96a4e6fa3698842adfac72c8285f0dc55ba7aa0c..4109acc97d05239d4da875a74590ac8835843d58 100644 --- a/ansi-tests/beyond-ansi/load-ba.lsp +++ b/ansi-tests/beyond-ansi/load-ba.lsp @@ -8,11 +8,12 @@ (merge-pathnames (make-pathname :directory '(:relative :up))))) (load "gclload1.lsp")) (load "ba-test-package.lsp") - (compile-and-load "ba-aux.lsp") + (eval '(compile-and-load "ba-aux.lsp")) (load "errors-eval-compile.lsp") (load "errors-types-and-class.lsp") (load "errors-data-and-control-flow-1.lsp") (load "errors-data-and-control-flow-2.lsp") + (load "errors-data-and-control-flow-3.lsp") (in-package :ba-test) )