Skip to content
Snippets Groups Projects
Commit c1f64e96 authored by pfdietz's avatar pfdietz
Browse files

More section 5 boundary cases

parent 48b6b8d4
No related branches found
No related tags found
No related merge requests found
......@@ -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 . #()))
;-*- 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*)
......@@ -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)
)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment