From f4ee69e9e92b9ef6a5d885b7db2ac61bbfbd7129 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 20 Apr 2003 22:59:26 +0000 Subject: [PATCH] Added tests to confirm that MACRO-FUNCTIONs have the correct error behavior when called with the wrong number of arguments. --- ansi-tests/and.lsp | 13 ++ ansi-tests/ansi-aux.lsp | 15 ++ ansi-tests/case.lsp | 14 ++ ansi-tests/ccase.lsp | 14 ++ ansi-tests/cond.lsp | 14 ++ ansi-tests/ctypecase.lsp | 21 +- ansi-tests/defconstant.lsp | 16 ++ ansi-tests/define-compiler-macro.lsp | 23 +++ ansi-tests/define-modify-macro.lsp | 2 + ansi-tests/define-setf-expander.lsp | 11 + ansi-tests/define-symbol-macro.lsp | 23 +++ ansi-tests/defmacro.lsp | 23 +++ ansi-tests/defparameter.lsp | 16 ++ ansi-tests/defsetf.lsp | 11 + ansi-tests/deftype.lsp | 21 ++ ansi-tests/defun.lsp | 13 +- ansi-tests/defvar.lsp | 16 ++ ansi-tests/destructuring-bind.lsp | 15 ++ ansi-tests/ecase.lsp | 15 ++ ansi-tests/etypecase.lsp | 15 +- ansi-tests/iteration.lsp | 11 + ansi-tests/lambda.lsp | 18 +- ansi-tests/load-data-and-control-flow.lsp | 7 + ansi-tests/load-eval-and-compile.lsp | 3 + ansi-tests/load-types-and-class.lsp | 2 + ansi-tests/loop.lsp | 33 +++ ansi-tests/macrolet.lsp | 10 +- ansi-tests/multiple-value-bind.lsp | 16 +- ansi-tests/multiple-value-list.lsp | 15 ++ ansi-tests/multiple-value-setq.lsp | 15 ++ ansi-tests/nth-value.lsp | 16 ++ ansi-tests/or.lsp | 15 +- ansi-tests/packages-10.lsp | 3 + ansi-tests/packages-13.lsp | 3 + ansi-tests/packages-16.lsp | 3 + ansi-tests/packages-17.lsp | 10 +- ansi-tests/places.lsp | 233 +--------------------- ansi-tests/pop.lsp | 2 + ansi-tests/prog.lsp | 7 +- ansi-tests/prog1.lsp | 2 + ansi-tests/prog2.lsp | 2 +- ansi-tests/psetf.lsp | 95 +++++++++ ansi-tests/psetq.lsp | 74 +++++++ ansi-tests/push.lsp | 12 ++ ansi-tests/pushnew.lsp | 25 ++- ansi-tests/remf.lsp | 10 + ansi-tests/return.lsp | 22 ++ ansi-tests/rotatef.lsp | 28 +++ ansi-tests/shiftf.lsp | 20 ++ ansi-tests/structures-03.lsp | 4 + ansi-tests/typecase.lsp | 14 ++ ansi-tests/unless.lsp | 14 ++ ansi-tests/when.lsp | 14 ++ 53 files changed, 817 insertions(+), 252 deletions(-) create mode 100644 ansi-tests/define-compiler-macro.lsp create mode 100644 ansi-tests/define-setf-expander.lsp create mode 100644 ansi-tests/define-symbol-macro.lsp create mode 100644 ansi-tests/defmacro.lsp create mode 100644 ansi-tests/defsetf.lsp create mode 100644 ansi-tests/deftype.lsp create mode 100644 ansi-tests/psetf.lsp create mode 100644 ansi-tests/psetq.lsp create mode 100644 ansi-tests/return.lsp create mode 100644 ansi-tests/rotatef.lsp create mode 100644 ansi-tests/shiftf.lsp diff --git a/ansi-tests/and.lsp b/ansi-tests/and.lsp index 1a1ffdaa..30319b23 100644 --- a/ansi-tests/and.lsp +++ b/ansi-tests/and.lsp @@ -55,3 +55,16 @@ i a b c d)) 4 4 1 2 3 4) +(deftest and.error.1 + (classify-error (funcall (macro-function 'and))) + program-error) + +(deftest and.error.2 + (classify-error (funcall (macro-function 'and) + '(and))) + program-error) + +(deftest and.error.3 + (classify-error (funcall (macro-function 'and) + '(and) nil nil)) + program-error) \ No newline at end of file diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index 3357d12b..5fac9ada 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -1438,3 +1438,18 @@ the condition to go uncaught if it cannot be classified." (loop for e on plist by #'cddr when (eql (car e) prop) collect (cadr e))) + +(defmacro def-macro-test (test-name macro-form) + (let ((macro-name (car macro-form))) + (assert (symbolp macro-name)) + `(deftest ,test-name + (values + (eqlt (classify-error (funcall (macro-function ',macro-name))) + 'program-error) + (eqlt (classify-error (funcall (macro-function ',macro-name) + ',macro-form)) + 'program-error) + (eqlt (classify-error (funcall (macro-function ',macro-name) + ',macro-form nil nil)) + 'program-error)) + t t t))) \ No newline at end of file diff --git a/ansi-tests/case.lsp b/ansi-tests/case.lsp index 0ec8b1bd..584e11e5 100644 --- a/ansi-tests/case.lsp +++ b/ansi-tests/case.lsp @@ -194,3 +194,17 @@ ;;; (deftest case.error.1 ;;; (classify-error (case)) ;;; program-error) + +(deftest case.error.1 + (classify-error (funcall (macro-function 'case))) + program-error) + +(deftest case.error.2 + (classify-error (funcall (macro-function 'case) + '(case t))) + program-error) + +(deftest case.error.3 + (classify-error (funcall (macro-function 'case) + '(case t) nil nil)) + program-error) \ No newline at end of file diff --git a/ansi-tests/ccase.lsp b/ansi-tests/ccase.lsp index 76642a35..befd49b5 100644 --- a/ansi-tests/ccase.lsp +++ b/ansi-tests/ccase.lsp @@ -197,3 +197,17 @@ ;;; (deftest ccase.error.1 ;;; (classify-error (ccase)) ;;; program-error) + +(deftest ccase.error.1 + (classify-error (funcall (macro-function 'ccase))) + program-error) + +(deftest ccase.error.2 + (classify-error (funcall (macro-function 'ccase) + '(ccase t))) + program-error) + +(deftest ccase.error.3 + (classify-error (funcall (macro-function 'ccase) + '(ccase t) nil nil)) + program-error) \ No newline at end of file diff --git a/ansi-tests/cond.lsp b/ansi-tests/cond.lsp index 1150887c..3394da41 100644 --- a/ansi-tests/cond.lsp +++ b/ansi-tests/cond.lsp @@ -80,3 +80,17 @@ 10 (return-from done 'good))) good) + +(deftest cond.error.1 + (classify-error (funcall (macro-function 'cond))) + program-error) + +(deftest cond.error.2 + (classify-error (funcall (macro-function 'cond) + '(cond))) + program-error) + +(deftest cond.error.3 + (classify-error (funcall (macro-function 'cond) + '(cond) nil nil)) + program-error) diff --git a/ansi-tests/ctypecase.lsp b/ansi-tests/ctypecase.lsp index c786a7c1..87348d6c 100644 --- a/ansi-tests/ctypecase.lsp +++ b/ansi-tests/ctypecase.lsp @@ -81,9 +81,10 @@ (deftest ctypecase.13 - (ctypecase 'a - (number 'bad) - (#.(find-class 'symbol nil) 'good)) + (let ((x 'a)) + (ctypecase x + (number 'bad) + (#.(find-class 'symbol nil) 'good))) good) (deftest ctypecase.14 @@ -97,3 +98,17 @@ (return-from done 'good))) good) +(deftest ctypecase.error.1 + (classify-error (funcall (macro-function 'ctypecase))) + program-error) + +(deftest ctypecase.error.2 + (classify-error (funcall (macro-function 'ctypecase) + '(ctypecase t))) + program-error) + +(deftest ctypecase.error.3 + (classify-error (funcall (macro-function 'ctypecase) + '(ctypecase t) + nil nil)) + program-error) \ No newline at end of file diff --git a/ansi-tests/defconstant.lsp b/ansi-tests/defconstant.lsp index f0b132c2..af229580 100644 --- a/ansi-tests/defconstant.lsp +++ b/ansi-tests/defconstant.lsp @@ -43,3 +43,19 @@ ;;; "This is a docstring" ;;; "This is an unnecessary extra argument.")) ;;; program-error) + +(deftest defconstant.error.1 + (classify-error (funcall (macro-function 'defconstant))) + program-error) + +(deftest defconstant.error.2 + (classify-error (funcall (macro-function 'defconstant) + '(defconstant +nonexistent-constant+ 0))) + program-error) + +(deftest defconstant.error.3 + (classify-error (funcall (macro-function 'defconstant) + '(defconstant +nonexistent-constant+ 0) + nil nil)) + program-error) + \ No newline at end of file diff --git a/ansi-tests/define-compiler-macro.lsp b/ansi-tests/define-compiler-macro.lsp new file mode 100644 index 00000000..4fbd03d0 --- /dev/null +++ b/ansi-tests/define-compiler-macro.lsp @@ -0,0 +1,23 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 12:33:02 2003 +;;;; Contains: Tests of DEFINE-COMPILER-MACRO + +(in-package :cl-test) + +;;; Need to add non-error tests + +(deftest define-compiler-macro.error.1 + (classify-error (funcall (macro-function 'define-compiler-macro))) + program-error) + +(deftest define-compiler-macro.error.2 + (classify-error (funcall (macro-function 'define-compiler-macro) + '(definee-compiler-macro nonexistent-function ()))) + program-error) + +(deftest define-compiler-macro.error.3 + (classify-error (funcall (macro-function 'define-compiler-macro) + '(definee-compiler-macro nonexistent-function ()) + nil nil)) + program-error) diff --git a/ansi-tests/define-modify-macro.lsp b/ansi-tests/define-modify-macro.lsp index e1d43814..b3a5fb4b 100644 --- a/ansi-tests/define-modify-macro.lsp +++ b/ansi-tests/define-modify-macro.lsp @@ -81,3 +81,5 @@ ;;; "extra illegal argument")) ;;; program-error) +(def-macro-test define-modify-macro.error.1 + (define-modify-macro nonexistent-modify-macro () foo)) diff --git a/ansi-tests/define-setf-expander.lsp b/ansi-tests/define-setf-expander.lsp new file mode 100644 index 00000000..482713b5 --- /dev/null +++ b/ansi-tests/define-setf-expander.lsp @@ -0,0 +1,11 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 17:19:35 2003 +;;;; Contains: Tests of DEFINE-SETF-EXPANDER + +(in-package :cl-test) + +;;; Need to add non-error tests + +(def-macro-test define-setf-expander.error.1 + (define-setf-expander nonexistent-access-fn (x))) diff --git a/ansi-tests/define-symbol-macro.lsp b/ansi-tests/define-symbol-macro.lsp new file mode 100644 index 00000000..9a02631c --- /dev/null +++ b/ansi-tests/define-symbol-macro.lsp @@ -0,0 +1,23 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 12:55:05 2003 +;;;; Contains: Tests of DEFINE-SYMBOL-MACRO + +(in-package :cl-test) + +(deftest define-symbol-macro.error.1 + (classify-error (funcall (macro-function 'define-symbol-macro))) + program-error) + +(deftest define-symbol-macro.error.2 + (classify-error (funcall (macro-function 'define-symbol-macro) + '(define-symbol-macro + nonexistent-symbol-macro nil))) + program-error) + +(deftest define-symbol-macro.error.3 + (classify-error (funcall (macro-function 'define-symbol-macro) + '(define-symbol-macro + nonexistent-symbol-macro nil) + nil nil)) + program-error) diff --git a/ansi-tests/defmacro.lsp b/ansi-tests/defmacro.lsp new file mode 100644 index 00000000..91f799a6 --- /dev/null +++ b/ansi-tests/defmacro.lsp @@ -0,0 +1,23 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 12:35:24 2003 +;;;; Contains: Tests of DEFMACRO + +(in-package :cl-test) + +;;; Need to add non-error tests + +(deftest defmacro.error.1 + (classify-error (funcall (macro-function 'defmacro))) + program-error) + +(deftest defmacro.error.2 + (classify-error (funcall (macro-function 'defmacro) + '(defmacro nonexistent-macro ()))) + program-error) + +(deftest defmacro.error.3 + (classify-error (funcall (macro-function 'defmacro) + '(defmacro nonexistent-macro ()) + nil nil)) + program-error) diff --git a/ansi-tests/defparameter.lsp b/ansi-tests/defparameter.lsp index 4cc3c908..a285c3a6 100644 --- a/ansi-tests/defparameter.lsp +++ b/ansi-tests/defparameter.lsp @@ -64,3 +64,19 @@ ;;; "documentation" ;;; "illegal extra argument")) ;;; program-error) + +(deftest defparameter.error.1 + (classify-error (funcall (macro-function 'defparameter))) + program-error) + +(deftest defparameter.error.2 + (classify-error (funcall (macro-function 'defparameter) + '(defparameter *nonexistent-variable* nil))) + program-error) + +(deftest defparameter.error.3 + (classify-error (funcall (macro-function 'defparameter) + '(defparameter *nonexistent-variable* nil) + nil nil)) + program-error) + diff --git a/ansi-tests/defsetf.lsp b/ansi-tests/defsetf.lsp new file mode 100644 index 00000000..0375c73b --- /dev/null +++ b/ansi-tests/defsetf.lsp @@ -0,0 +1,11 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 17:18:01 2003 +;;;; Contains: Tests of DEFSETF + +(in-package :cl-test) + +;;; Need to add non-error tests + +(def-macro-test defsetf.error.1 (defsetf nonexistent-access-fn + nonexistent-update-fn)) diff --git a/ansi-tests/deftype.lsp b/ansi-tests/deftype.lsp new file mode 100644 index 00000000..003d3beb --- /dev/null +++ b/ansi-tests/deftype.lsp @@ -0,0 +1,21 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 12:56:56 2003 +;;;; Contains: Tests of DEFTYPE + +(in-package :cl-test) + +(deftest deftype.error.1 + (classify-error (funcall (macro-function 'deftype))) + program-error) + +(deftest deftype.error.2 + (classify-error (funcall (macro-function 'deftype) + '(deftype nonexistent-type () nil))) + program-error) + +(deftest deftype.error.3 + (classify-error (funcall (macro-function 'deftype) + '(deftype nonexistent-type () nil) + nil nil)) + program-error) diff --git a/ansi-tests/defun.lsp b/ansi-tests/defun.lsp index 35fb6d0f..2b9d9082 100644 --- a/ansi-tests/defun.lsp +++ b/ansi-tests/defun.lsp @@ -5,15 +5,20 @@ (in-package :cl-test) -#| (deftest defun.error.1 - (classify-error (defun)) + (classify-error (funcall (macro-function 'defun))) program-error) (deftest defun.error.2 - (classify-error (defun ignored-defun-name)) + (classify-error (funcall (macro-function 'defun) + '(defun nonexistent-function ()))) + program-error) + +(deftest defun.error.3 + (classify-error (funcall (macro-function 'defun) + '(defun nonexistent-function ()) + nil nil)) program-error) -|# ;;; Tests for implicit blocks diff --git a/ansi-tests/defvar.lsp b/ansi-tests/defvar.lsp index 02aadc83..1e1d3c9c 100644 --- a/ansi-tests/defvar.lsp +++ b/ansi-tests/defvar.lsp @@ -62,3 +62,19 @@ ;;; (classify-error (defvar *ignored-defvar-name* nil "documentation" ;;; "illegal extra argument")) ;;; program-error) + +(deftest defvar.error.1 + (classify-error (funcall (macro-function 'defvar))) + program-error) + +(deftest defvar.error.2 + (classify-error (funcall (macro-function 'defvar) + '(defvar *nonexistent-variable* nil))) + program-error) + +(deftest defvar.error.3 + (classify-error (funcall (macro-function 'defvar) + '(defvar *nonexistent-variable* nil) + nil nil)) + program-error) + diff --git a/ansi-tests/destructuring-bind.lsp b/ansi-tests/destructuring-bind.lsp index cf353d2b..4f198056 100644 --- a/ansi-tests/destructuring-bind.lsp +++ b/ansi-tests/destructuring-bind.lsp @@ -129,3 +129,18 @@ ;;; (classify-error (destructuring-bind x)) ;;; program-error) +(deftest destructuring-bind.error.7 + (classify-error (funcall (macro-function 'destructuring-bind))) + program-error) + +(deftest destructuring-bind.error.8 + (classify-error (funcall (macro-function 'destructuring-bind) + '(destructuring-bind (a . b) '(1 2) nil))) + program-error) + +(deftest destructuring-bind.error.9 + (classify-error (funcall (macro-function 'destructuring-bind) + '(destructuring-bind (a . b) '(1 2) nil) + nil nil)) + program-error) + diff --git a/ansi-tests/ecase.lsp b/ansi-tests/ecase.lsp index 72c37715..bc41a5ba 100644 --- a/ansi-tests/ecase.lsp +++ b/ansi-tests/ecase.lsp @@ -158,3 +158,18 @@ 10 (return-from done 'good))) good) + +(deftest ecase.error.1 + (classify-error (funcall (macro-function 'ecase))) + program-error) + +(deftest ecase.error.2 + (classify-error (funcall (macro-function 'ecase) + '(ecase t))) + program-error) + +(deftest ecase.error.3 + (classify-error (funcall (macro-function 'ecase) + '(ecase t) + nil nil)) + program-error) diff --git a/ansi-tests/etypecase.lsp b/ansi-tests/etypecase.lsp index 189cbde7..67bf6d1e 100644 --- a/ansi-tests/etypecase.lsp +++ b/ansi-tests/etypecase.lsp @@ -70,4 +70,17 @@ (return 'good))) good) - +(deftest etypecase.error.1 + (classify-error (funcall (macro-function 'etypecase))) + program-error) + +(deftest etypecase.error.2 + (classify-error (funcall (macro-function 'etypecase) + '(etypecase t))) + program-error) + +(deftest etypecase.error.3 + (classify-error (funcall (macro-function 'etypecase) + '(etypecase t) + nil nil)) + program-error) diff --git a/ansi-tests/iteration.lsp b/ansi-tests/iteration.lsp index 5de230e7..eb17e088 100644 --- a/ansi-tests/iteration.lsp +++ b/ansi-tests/iteration.lsp @@ -131,6 +131,9 @@ (push #'(lambda () i) x)))) (5 5 5 5 5)) +(def-macro-test do.error.1 + (do ((i 0 (1+ i))) ((= i 5) 'a))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Tests of DO* @@ -250,6 +253,9 @@ (push #'(lambda () i) x)))) (5 5 5 5 5)) +(def-macro-test do*.error.1 + (do* ((i 0 (1+ i))) ((= i 5) 'a))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Tests for DOLIST @@ -361,6 +367,9 @@ (when (eq e 'c) (return x)))) (c b a)) +(def-macro-test dolist.error.1 + (dolist (x nil))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Tests for DOTIMES @@ -491,6 +500,8 @@ y) (3 2 1 0)) +(def-macro-test dotimes.error.1 + (dotimes (i 10))) diff --git a/ansi-tests/lambda.lsp b/ansi-tests/lambda.lsp index 07d830ea..20966292 100644 --- a/ansi-tests/lambda.lsp +++ b/ansi-tests/lambda.lsp @@ -234,19 +234,19 @@ :d 40 :allow-other-keys nil :a 1 :b 2 :c 20) (nil 1 2)) -(deftest lambda.48 +(deftest lambda.49 ((lambda (&key a b allow-other-keys &allow-other-keys) (list allow-other-keys a b)) :d 40 :a 1 :b 2 :c 20) (nil 1 2)) -(deftest lambda.49 +(deftest lambda.50 ((lambda (&key a b ((:allow-other-keys aok))) (list aok a b)) :d 40 :a 1 :allow-other-keys t :b 2 :c 20) (t 1 2)) -(deftest lambda.50 +(deftest lambda.51 ((lambda (&key &allow-other-keys)) :a 1 :b 2 :c 3) nil) @@ -261,4 +261,14 @@ (funcall (eval (macroexpand '(lambda () 10)))) 10) - \ No newline at end of file +(deftest lambda.error.1 + (classify-error (funcall (macro-function 'lambda))) + program-error) + +(deftest lambda.error.2 + (classify-error (funcall (macro-function 'lambda) '(lambda ()))) + program-error) + +(deftest lambda.error.3 + (classify-error (funcall (macro-function 'lambda) '(lambda ()) nil nil)) + program-error) diff --git a/ansi-tests/load-data-and-control-flow.lsp b/ansi-tests/load-data-and-control-flow.lsp index d4ea1dab..e5bd1b60 100644 --- a/ansi-tests/load-data-and-control-flow.lsp +++ b/ansi-tests/load-data-and-control-flow.lsp @@ -2,6 +2,13 @@ (load "data-and-control-flow.lsp") (load "places.lsp") +(load "psetq.lsp") +(load "psetf.lsp") +(load "shiftf.lsp") +(load "rotatef.lsp") +(load "return.lsp") +(load "defsetf.lsp") +(load "define-setf-expander.lsp") (load "and.lsp") (load "apply.lsp") diff --git a/ansi-tests/load-eval-and-compile.lsp b/ansi-tests/load-eval-and-compile.lsp index 4229d557..64b64aa3 100644 --- a/ansi-tests/load-eval-and-compile.lsp +++ b/ansi-tests/load-eval-and-compile.lsp @@ -6,3 +6,6 @@ (load "constantp.lsp") (load "lambda.lsp") (load "eval-when.lsp") +(load "define-compiler-macro.lsp") +(load "define-symbol-macro.lsp") +(load "defmacro.lsp") diff --git a/ansi-tests/load-types-and-class.lsp b/ansi-tests/load-types-and-class.lsp index 3ad82e4f..fc6cd38d 100644 --- a/ansi-tests/load-types-and-class.lsp +++ b/ansi-tests/load-types-and-class.lsp @@ -13,3 +13,5 @@ (load "subtypep-eql.lsp") (load "subtypep-array.lsp") +(load "deftype.lsp") + diff --git a/ansi-tests/loop.lsp b/ansi-tests/loop.lsp index 2a362faa..026a541a 100644 --- a/ansi-tests/loop.lsp +++ b/ansi-tests/loop.lsp @@ -51,3 +51,36 @@ (incf i) (push 'a x)))) (a a a a)) + +;;; Loop errors + +(def-macro-test loop.error.1 (loop)) + +(deftest loop-finish.error.1 + (block done + (loop + for i from 1 to 10 + do (macrolet + ((%m (&environment env) + (let ((mfn (macro-function 'loop-finish env))) + (cond + ((not mfn) '(return-from done :fail1)) + ((not (eqt (eval `(classify-error (funcall ,mfn))) + 'program-error)) + '(return-from done :fail2)) + ((not (eqt (eval `(classify-error (funcall ,mfn + '(loop-finish)))) + 'program-error)) + '(return-from done :fail3)) + + ((not (eqt (eval `(classify-error (funcall ,mfn + '(loop-finish) + nil nil))) + 'program-error)) + '(return-from done :fail4)) + (t '(return-from done :good)))))) + (%m)))) + :good) + + + \ No newline at end of file diff --git a/ansi-tests/macrolet.lsp b/ansi-tests/macrolet.lsp index d4702108..8c2b804c 100644 --- a/ansi-tests/macrolet.lsp +++ b/ansi-tests/macrolet.lsp @@ -189,7 +189,7 @@ (a 2 3) (a b c)) -(deftest macrolet.22 +(deftest macrolet.22a (macrolet ((%m (x &optional ((y z) '(2 3) y-z-p)) `(quote (,x ,y ,z ,y-z-p)))) (values @@ -339,6 +339,14 @@ (%m 1 2)) (%m 1 2 1 2)) +;;; Macro names are shadowed by local functions + +(deftest macrolet.37 + (macrolet ((%f () :bad)) + (flet ((%f () :good)) + (%f))) + :good) + ;;; Symbol-macrolet tests (deftest symbol-macrolet.1 diff --git a/ansi-tests/multiple-value-bind.lsp b/ansi-tests/multiple-value-bind.lsp index 6ffc1b8f..a6547568 100644 --- a/ansi-tests/multiple-value-bind.lsp +++ b/ansi-tests/multiple-value-bind.lsp @@ -71,4 +71,18 @@ ;;; (classify-error (multiple-value-bind (a b c))) ;;; program-error) - \ No newline at end of file +(deftest multiple-value-bind.error.1 + (classify-error (funcall (macro-function 'multiple-value-bind))) + program-error) + +(deftest multiple-value-bind.error.2 + (classify-error (funcall (macro-function 'multiple-value-bind) + '(multiple-value-bind nil nil))) + program-error) + +(deftest multiple-value-bind.error.3 + (classify-error (funcall (macro-function 'multiple-value-bind) + '(multiple-value-bind nil nil) + nil nil)) + program-error) + diff --git a/ansi-tests/multiple-value-list.lsp b/ansi-tests/multiple-value-list.lsp index cdb32778..25e42c58 100644 --- a/ansi-tests/multiple-value-list.lsp +++ b/ansi-tests/multiple-value-list.lsp @@ -35,3 +35,18 @@ (classify-error (multiple-value-list 'a 'b)) program-error) |# + +(deftest multiple-value-list.error.1 + (classify-error (funcall (macro-function 'multiple-value-list))) + program-error) + +(deftest multiple-value-list.error.2 + (classify-error (funcall (macro-function 'multiple-value-list) + '(multiple-value-list nil))) + program-error) + +(deftest multiple-value-list.error.3 + (classify-error (funcall (macro-function 'multiple-value-list) + '(multiple-value-list nil) + nil nil)) + program-error) \ No newline at end of file diff --git a/ansi-tests/multiple-value-setq.lsp b/ansi-tests/multiple-value-setq.lsp index 088ff88c..fede5eea 100644 --- a/ansi-tests/multiple-value-setq.lsp +++ b/ansi-tests/multiple-value-setq.lsp @@ -107,3 +107,18 @@ collect (list i form))) nil) +(deftest multiple-value-setq.error.1 + (classify-error (funcall (macro-function 'multiple-value-setq))) + program-error) + +(deftest multiple-value-setq.error.2 + (classify-error (funcall (macro-function 'multiple-value-setq) + '(multiple-value-setq nil nil))) + program-error) + +(deftest multiple-value-setq.error.3 + (classify-error (funcall (macro-function 'multiple-value-setq) + '(multiple-value-setq nil nil) + nil nil)) + program-error) + \ No newline at end of file diff --git a/ansi-tests/nth-value.lsp b/ansi-tests/nth-value.lsp index 1d825ad7..8c49e75f 100644 --- a/ansi-tests/nth-value.lsp +++ b/ansi-tests/nth-value.lsp @@ -34,3 +34,19 @@ (progn (setf y (incf i)) (values 'a 'b 'c 'd 'e 'f 'g))) i x y)) d 2 1 2) + +(deftest nth-value.error.1 + (classify-error (funcall (macro-function 'nth-value))) + program-error) + +(deftest nth-value.error.2 + (classify-error (funcall (macro-function 'nth-value) + '(nth-value 1 '(a b c)))) + program-error) + +(deftest nth-value.error.3 + (classify-error (funcall (macro-function 'nth-value) + '(nth-value 1 '(a b c)) + nil nil)) + program-error) + diff --git a/ansi-tests/or.lsp b/ansi-tests/or.lsp index 4b7d7462..d9d965b8 100644 --- a/ansi-tests/or.lsp +++ b/ansi-tests/or.lsp @@ -41,8 +41,19 @@ (or (values nil 1 2) (values 1 nil 2)) 1 nil 2) - - +(deftest or.error.1 + (classify-error (funcall (macro-function 'or))) + program-error) + +(deftest or.error.2 + (classify-error (funcall (macro-function 'or) + '(or))) + program-error) + +(deftest or.error.3 + (classify-error (funcall (macro-function 'or) + '(or) nil nil)) + program-error) diff --git a/ansi-tests/packages-10.lsp b/ansi-tests/packages-10.lsp index d8ff8979..306b5333 100644 --- a/ansi-tests/packages-10.lsp +++ b/ansi-tests/packages-10.lsp @@ -119,3 +119,6 @@ (format t "Error ~S on package ~S~%" c p) t))) 0) + +(def-macro-test with-package-iterator.error.1 + (with-package-iterator (x "CL" :external) nil)) diff --git a/ansi-tests/packages-13.lsp b/ansi-tests/packages-13.lsp index 4add73c7..4cba3327 100644 --- a/ansi-tests/packages-13.lsp +++ b/ansi-tests/packages-13.lsp @@ -50,3 +50,6 @@ (package-error () 'package-error) (error (c) c))) package-error) + +(def-macro-test in-package.error.1 + (in-package :cl-test)) diff --git a/ansi-tests/packages-16.lsp b/ansi-tests/packages-16.lsp index 44a052a6..56a409c4 100644 --- a/ansi-tests/packages-16.lsp +++ b/ansi-tests/packages-16.lsp @@ -612,3 +612,6 @@ (list (%do-it% args) (%do-it% (reverse args)))))) (success success)) + +(def-macro-test defpackage.error.1 + (defpackage :nonexistent-package (:use))) \ No newline at end of file diff --git a/ansi-tests/packages-17.lsp b/ansi-tests/packages-17.lsp index 2555f7b8..52a99943 100644 --- a/ansi-tests/packages-17.lsp +++ b/ansi-tests/packages-17.lsp @@ -140,6 +140,14 @@ (error (c) c)) (NIL (DS1:B T))) +(def-macro-test do-symbols.error.1 + (do-symbols (x "CL"))) +(def-macro-test do-external-symbols.error.1 + (do-external-symbols (x "CL"))) + +(def-macro-est do-all-symbols.error.1 + (do-all-symbols (x))) + +;;; Need to add DO-ALL-SYMBOLS tests - diff --git a/ansi-tests/places.lsp b/ansi-tests/places.lsp index caf7815f..497cee5c 100644 --- a/ansi-tests/places.lsp +++ b/ansi-tests/places.lsp @@ -6,14 +6,15 @@ (in-package :cl-test) ;;; Section 5.1.1.1 -(deftest setf-order + +(deftest setf.order.1 (let ((x (vector nil nil nil nil)) (i 0)) (setf (aref x (incf i)) (incf i)) (values x i)) #(nil 2 nil nil) 2) -(deftest setf-order.2 +(deftest setf.order.2 (let ((x (vector nil nil nil nil)) (i 0)) (setf (aref x (incf i)) (incf i) @@ -21,47 +22,7 @@ (values x i)) #(nil 2 nil 13) 13) -(deftest push-order - (let ((x (vector nil nil nil nil)) - (y (vector 'a 'b 'c 'd)) - (i 1)) - (push (aref y (incf i)) (aref x (incf i))) - (values x y i)) - #(nil nil nil (c)) - #(a b c d) - 3) - -(deftest pushnew-order - (let ((x (vector nil nil nil nil)) - (y (vector 'a 'b 'c 'd)) - (i 1)) - (pushnew (aref y (incf i)) (aref x (incf i))) - (values x y i)) - #(nil nil nil (c)) - #(a b c d) - 3) - -(deftest pushnew-order.2 - (let ((x (vector nil nil nil nil nil)) - (y (vector 'a 'b 'c 'd 'e)) - (i 1)) - (pushnew (aref y (incf i)) (aref x (incf i)) - :test (progn (incf i) #'eql)) - (values x y i)) - #(nil nil nil (c) nil) - #(a b c d e) - 4) - -(deftest remf-order - (let ((x (copy-seq #(nil :a :b))) - (pa (vector (list :a 1) (list :b 2) (list :c 3) (list :d 4))) - (i 0)) - (values - (not (remf (aref pa (incf i)) (aref x (incf i)))) - pa)) - nil #((:a 1) nil (:c 3) (:d 4))) - -(deftest incf-order +(deftest incf.order.1 (let ((x (copy-seq #(0 0 0 0 0))) (i 1)) (values @@ -69,7 +30,7 @@ x i)) 3 #(0 0 3 0 0) 3) -(deftest decf-order +(deftest decf.order.1 (let ((x (copy-seq #(0 0 0 0 0))) (i 1)) (values @@ -77,60 +38,7 @@ x i)) -3 #(0 0 -3 0 0) 3) -(deftest shiftf-order.1 - (let ((x (vector 'a 'b 'c 'd 'e)) - (i 2)) - (values (shiftf (aref x (incf i)) (incf i)) x i)) - d #(a b c 4 e) 4) - -(deftest shiftf-order.2 - (let ((x (vector 'a 'b 'c 'd 'e 'f 'g 'h)) - (i 2)) - (values (shiftf (aref x (incf i)) (aref x (incf i)) (incf i)) x i)) - d #(a b c e 5 f g h) 5) - -(deftest rotatef-order.1 - (let ((x (vector 'a 'b 'c 'd 'e 'f)) - (i 2)) - (values - (rotatef (aref x (incf i)) (aref x (incf i))) - x i)) - nil - #(a b c e d f) - 4) - -(deftest rotatef-order.2 - (let ((x (vector 'a 'b 'c 'd 'e 'f)) - (i 2)) - (values - (rotatef (aref x (incf i)) (aref x (incf i)) (aref x (incf i))) - x i)) - nil - #(a b c e f d) - 5) - -(deftest psetf-order - (let ((x (vector nil nil nil nil)) - (i 0)) - (psetf (aref x (incf i)) (incf i)) - (values x i)) - #(nil 2 nil nil) 2) - -(deftest psetf-order.2 - (let ((x (vector nil nil nil nil)) - (i 0)) - (psetf (aref x (incf i)) (incf i) - (aref x (incf i)) (incf i 10)) - (values x i)) - #(nil 2 nil 13) 13) - -(deftest pop-order - (let ((x (vector '(a b) '(c d) '(e f))) - (i 0)) - (values (pop (aref x (incf i))) x i)) - c #((a b) (d) (e f)) 1) - - + ;;; Section 5.1.2.1 (deftest setf-var (let ((x nil)) @@ -336,132 +244,3 @@ (deftest setf.4 (let (x) (setf x (values 1 2))) 1) - -;;; Tests of PSETQ - -(deftest psetq.1 - (psetq) - nil) - -(deftest psetq.2 - (let ((x 0)) - (values (psetq x 1) x)) - nil 1) - -(deftest psetq.3 - (let ((x 0) (y 1)) - (values (psetq x y y x) x y)) - nil 1 0) - -(deftest psetq.4 - (let ((x 0)) - (values - (symbol-macrolet ((x y)) - (let ((y 1)) - (psetq x 2) - y)) - x)) - 2 0) - -(deftest psetq.5 - (let ((w (list nil))) - (values - (symbol-macrolet ((x (car w))) - (psetq x 2)) - w)) - nil (2)) - -(deftest psetq.6 - (let ((c 0) x y) - (psetq x (incf c) - y (incf c)) - (values c x y)) - 2 1 2) - -;;; The next test is a PSETQ that is equivalent to a PSETF -;;; See PSETF.7 for comments related to this test. - -(deftest psetq.7 - (symbol-macrolet ((x (aref a (incf i))) - (y (aref a (incf i)))) - (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) - (i 0)) - (psetq x (aref a (incf i)) - y (aref a (incf i))) - (values a i))) - #(0 2 2 4 4 5 6 7 8 9) - 4) - -;;; Tests of PSETF - -(deftest psetf.1 - (psetf) - nil) - -(deftest psetf.2 - (let ((x 0)) - (values (psetf x 1) x)) - nil 1) - -(deftest psetf.3 - (let ((x 0) (y 1)) - (values (psetf x y y x) x y)) - nil 1 0) - -(deftest psetf.4 - (let ((x 0)) - (values - (symbol-macrolet ((x y)) - (let ((y 1)) - (psetf x 2) - y)) - x)) - 2 0) - -(deftest psetf.5 - (let ((w (list nil))) - (values - (symbol-macrolet ((x (car w))) - (psetf x 2)) - w)) - nil (2)) - -(deftest psetf.6 - (let ((c 0) x y) - (psetf x (incf c) - y (incf c)) - (values c x y)) - 2 1 2) - -;;; According to the standard, the forms to be assigned and -;;; the subforms in the places to be assigned to are evaluated -;;; from left to right. Therefore, PSETF.7 and PSETF.8 should -;;; do the same thing to A as PSETF.9 does. -;;; (See the page for PSETF) - -(deftest psetf.7 - (symbol-macrolet ((x (aref a (incf i))) - (y (aref a (incf i)))) - (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) - (i 0)) - (psetf x (aref a (incf i)) - y (aref a (incf i))) - (values a i))) - #(0 2 2 4 4 5 6 7 8 9) - 4) - -(deftest psetf.8 - (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) - (i 0)) - (psetf (aref a (incf i)) (aref a (incf i)) - (aref a (incf i)) (aref a (incf i))) - (values a i)) - #(0 2 2 4 4 5 6 7 8 9) - 4) - -(deftest psetf.9 - (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9)))) - (psetf (aref a 1) (aref a 2) - (aref a 3) (aref a 4)) - a) - #(0 2 2 4 4 5 6 7 8 9)) diff --git a/ansi-tests/pop.lsp b/ansi-tests/pop.lsp index f6b7cc26..f58d8f06 100644 --- a/ansi-tests/pop.lsp +++ b/ansi-tests/pop.lsp @@ -35,4 +35,6 @@ (pop x))) c) +(def-macro-test pop.error.1 (pop x)) + ;;; Need to add tests of POP vs. various accessors diff --git a/ansi-tests/prog.lsp b/ansi-tests/prog.lsp index 8b508f28..737fb893 100644 --- a/ansi-tests/prog.lsp +++ b/ansi-tests/prog.lsp @@ -71,6 +71,7 @@ (return 'bad)) 2) +(def-macro-test prog.error.1 (prog nil)) ;;; Tests of PROG* @@ -140,8 +141,4 @@ (return 'bad)) 2) - - - - - +(def-macro-test prog*.error.1 (prog* nil)) diff --git a/ansi-tests/prog1.lsp b/ansi-tests/prog1.lsp index 979b2c6c..57fe4415 100644 --- a/ansi-tests/prog1.lsp +++ b/ansi-tests/prog1.lsp @@ -35,3 +35,5 @@ 10 (return 'good))) good) + +(def-macro-test prog1.error.1 (prog1 nil)) diff --git a/ansi-tests/prog2.lsp b/ansi-tests/prog2.lsp index c3659fca..5da6e28a 100644 --- a/ansi-tests/prog2.lsp +++ b/ansi-tests/prog2.lsp @@ -45,4 +45,4 @@ (return 'good))) good) - +(def-macro-test prog2.error.1 (prog2 nil nil)) diff --git a/ansi-tests/psetf.lsp b/ansi-tests/psetf.lsp new file mode 100644 index 00000000..b34d5be1 --- /dev/null +++ b/ansi-tests/psetf.lsp @@ -0,0 +1,95 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 15:38:30 2003 +;;;; Contains: Tests of PSETF + +(in-package :cl-test) + +(deftest psetf.order.1 + (let ((x (vector nil nil nil nil)) + (i 0)) + (psetf (aref x (incf i)) (incf i)) + (values x i)) + #(nil 2 nil nil) 2) + +(deftest psetf.order.2 + (let ((x (vector nil nil nil nil)) + (i 0)) + (psetf (aref x (incf i)) (incf i) + (aref x (incf i)) (incf i 10)) + (values x i)) + #(nil 2 nil 13) 13) + +(deftest psetf.1 + (psetf) + nil) + +(deftest psetf.2 + (let ((x 0)) + (values (psetf x 1) x)) + nil 1) + +(deftest psetf.3 + (let ((x 0) (y 1)) + (values (psetf x y y x) x y)) + nil 1 0) + +(deftest psetf.4 + (let ((x 0)) + (values + (symbol-macrolet ((x y)) + (let ((y 1)) + (psetf x 2) + y)) + x)) + 2 0) + +(deftest psetf.5 + (let ((w (list nil))) + (values + (symbol-macrolet ((x (car w))) + (psetf x 2)) + w)) + nil (2)) + +(deftest psetf.6 + (let ((c 0) x y) + (psetf x (incf c) + y (incf c)) + (values c x y)) + 2 1 2) + +;;; According to the standard, the forms to be assigned and +;;; the subforms in the places to be assigned to are evaluated +;;; from left to right. Therefore, PSETF.7 and PSETF.8 should +;;; do the same thing to A as PSETF.9 does. +;;; (See the page for PSETF) + +(deftest psetf.7 + (symbol-macrolet ((x (aref a (incf i))) + (y (aref a (incf i)))) + (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) + (i 0)) + (psetf x (aref a (incf i)) + y (aref a (incf i))) + (values a i))) + #(0 2 2 4 4 5 6 7 8 9) + 4) + +(deftest psetf.8 + (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) + (i 0)) + (psetf (aref a (incf i)) (aref a (incf i)) + (aref a (incf i)) (aref a (incf i))) + (values a i)) + #(0 2 2 4 4 5 6 7 8 9) + 4) + +(deftest psetf.9 + (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9)))) + (psetf (aref a 1) (aref a 2) + (aref a 3) (aref a 4)) + a) + #(0 2 2 4 4 5 6 7 8 9)) + +(def-macro-test psetf.error.1 (psetf)) diff --git a/ansi-tests/psetq.lsp b/ansi-tests/psetq.lsp new file mode 100644 index 00000000..c5f52db4 --- /dev/null +++ b/ansi-tests/psetq.lsp @@ -0,0 +1,74 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 15:37:20 2003 +;;;; Contains: Tests of PSETQ + +(in-package :cl-test) + +(deftest psetq.1 + (psetq) + nil) + +(deftest psetq.2 + (let ((x 0)) + (values (psetq x 1) x)) + nil 1) + +(deftest psetq.3 + (let ((x 0) (y 1)) + (values (psetq x y y x) x y)) + nil 1 0) + +(deftest psetq.4 + (let ((x 0)) + (values + (symbol-macrolet ((x y)) + (let ((y 1)) + (psetq x 2) + y)) + x)) + 2 0) + +(deftest psetq.5 + (let ((w (list nil))) + (values + (symbol-macrolet ((x (car w))) + (psetq x 2)) + w)) + nil (2)) + +(deftest psetq.6 + (let ((c 0) x y) + (psetq x (incf c) + y (incf c)) + (values c x y)) + 2 1 2) + +;;; The next test is a PSETQ that is equivalent to a PSETF +;;; See PSETF.7 for comments related to this test. + +(deftest psetq.7 + (symbol-macrolet ((x (aref a (incf i))) + (y (aref a (incf i)))) + (let ((a (copy-seq #(0 1 2 3 4 5 6 7 8 9))) + (i 0)) + (psetq x (aref a (incf i)) + y (aref a (incf i))) + (values a i))) + #(0 2 2 4 4 5 6 7 8 9) + 4) + +(deftest psetq.error.1 + (classify-error (funcall (macro-function 'psetq))) + program-error) + +(deftest psetq.error.2 + (classify-error (funcall (macro-function 'psetq) + '(psetq))) + program-error) + +(deftest psetq.error.3 + (classify-error (funcall (macro-function 'psetq) + '(psetq) + nil nil)) + program-error) diff --git a/ansi-tests/push.lsp b/ansi-tests/push.lsp index ee99f99d..41e8f907 100644 --- a/ansi-tests/push.lsp +++ b/ansi-tests/push.lsp @@ -35,4 +35,16 @@ i a b)) (z) ((z)) 2 1 2) +(deftest push.order.2 + (let ((x (vector nil nil nil nil)) + (y (vector 'a 'b 'c 'd)) + (i 1)) + (push (aref y (incf i)) (aref x (incf i))) + (values x y i)) + #(nil nil nil (c)) + #(a b c d) + 3) + +(def-macro-test push.error.1 (push x y)) + ;;; Need to add push vs. various accessors diff --git a/ansi-tests/pushnew.lsp b/ansi-tests/pushnew.lsp index 74548751..b35ae8be 100644 --- a/ansi-tests/pushnew.lsp +++ b/ansi-tests/pushnew.lsp @@ -5,8 +5,6 @@ (in-package :cl-test) -;;; See also places.lsp - (deftest pushnew.1 (let ((x nil)) (let ((y (pushnew 'a x))) @@ -156,6 +154,27 @@ (a b c) (a b c) 3 1 3 2) +(deftest pushnew.order.1 + (let ((x (vector nil nil nil nil)) + (y (vector 'a 'b 'c 'd)) + (i 1)) + (pushnew (aref y (incf i)) (aref x (incf i))) + (values x y i)) + #(nil nil nil (c)) + #(a b c d) + 3) + +(deftest pushnew.order.2 + (let ((x (vector nil nil nil nil nil)) + (y (vector 'a 'b 'c 'd 'e)) + (i 1)) + (pushnew (aref y (incf i)) (aref x (incf i)) + :test (progn (incf i) #'eql)) + (values x y i)) + #(nil nil nil (c) nil) + #(a b c d e) + 4) + (deftest pushnew.error.1 (classify-error (let ((x '(a b))) @@ -173,3 +192,5 @@ (let ((x '(a b))) (pushnew 'c x :key #'cons))) program-error) + +(def-macro-test pushnew.error.4 (pushnew x y)) diff --git a/ansi-tests/remf.lsp b/ansi-tests/remf.lsp index c3ef3aa1..6a1af541 100644 --- a/ansi-tests/remf.lsp +++ b/ansi-tests/remf.lsp @@ -41,3 +41,13 @@ i x y)) t (a b e f) 2 1 2) +(deftest remf.order.2 + (let ((x (copy-seq #(nil :a :b))) + (pa (vector (list :a 1) (list :b 2) (list :c 3) (list :d 4))) + (i 0)) + (values + (not (remf (aref pa (incf i)) (aref x (incf i)))) + pa)) + nil #((:a 1) nil (:c 3) (:d 4))) + +(def-macro-test remf.error.1 (remf x 'a)) diff --git a/ansi-tests/return.lsp b/ansi-tests/return.lsp new file mode 100644 index 00000000..6cff4030 --- /dev/null +++ b/ansi-tests/return.lsp @@ -0,0 +1,22 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 16:00:32 2003 +;;;; Contains: Tests of RETURN + +(in-package :cl-test) + +(deftest return.error.1 + (classify-error (funcall (macro-function 'return))) + program-error) + +(deftest return.error.2 + (classify-error (funcall (macro-function 'return) + '(return nil))) + program-error) + +(deftest return.error.3 + (classify-error (funcall (macro-function 'return) + '(return nil) + nil nil)) + program-error) + diff --git a/ansi-tests/rotatef.lsp b/ansi-tests/rotatef.lsp new file mode 100644 index 00000000..0743f96b --- /dev/null +++ b/ansi-tests/rotatef.lsp @@ -0,0 +1,28 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 15:44:38 2003 +;;;; Contains: Tests for ROTATEF + +(in-package :cl-test) + +(deftest rotatef-order.1 + (let ((x (vector 'a 'b 'c 'd 'e 'f)) + (i 2)) + (values + (rotatef (aref x (incf i)) (aref x (incf i))) + x i)) + nil + #(a b c e d f) + 4) + +(deftest rotatef-order.2 + (let ((x (vector 'a 'b 'c 'd 'e 'f)) + (i 2)) + (values + (rotatef (aref x (incf i)) (aref x (incf i)) (aref x (incf i))) + x i)) + nil + #(a b c e f d) + 5) + +;;; Need to add more tests for ROTATEF here diff --git a/ansi-tests/shiftf.lsp b/ansi-tests/shiftf.lsp new file mode 100644 index 00000000..397db35f --- /dev/null +++ b/ansi-tests/shiftf.lsp @@ -0,0 +1,20 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Apr 20 15:43:44 2003 +;;;; Contains: Tests of SHIFTF + +(in-package :cl-test) + +(deftest shiftf-order.1 + (let ((x (vector 'a 'b 'c 'd 'e)) + (i 2)) + (values (shiftf (aref x (incf i)) (incf i)) x i)) + d #(a b c 4 e) 4) + +(deftest shiftf-order.2 + (let ((x (vector 'a 'b 'c 'd 'e 'f 'g 'h)) + (i 2)) + (values (shiftf (aref x (incf i)) (aref x (incf i)) (incf i)) x i)) + d #(a b c e 5 f g h) 5) + +;;; Need to add more shiftf tests here diff --git a/ansi-tests/structures-03.lsp b/ansi-tests/structures-03.lsp index 11b9a4e3..59fe3c25 100644 --- a/ansi-tests/structures-03.lsp +++ b/ansi-tests/structures-03.lsp @@ -415,3 +415,7 @@ ;;; :a :b :c) ;;; (3 6 9)) + +;;; Error test + +(def-macro-test struct.error.1 (defstruct nonexistent-structure-type a b c)) diff --git a/ansi-tests/typecase.lsp b/ansi-tests/typecase.lsp index 48f609cb..c9dcab86 100644 --- a/ansi-tests/typecase.lsp +++ b/ansi-tests/typecase.lsp @@ -93,6 +93,20 @@ (return-from done 'good))) good) +(deftest typecase.error.1 + (classify-error (funcall (macro-function 'typecase))) + program-error) + +(deftest typecase.error.2 + (classify-error (funcall (macro-function 'typecase) + '(typecase t))) + program-error) + +(deftest typecase.error.3 + (classify-error (funcall (macro-function 'typecase) + '(typecase t) + nil nil)) + program-error) diff --git a/ansi-tests/unless.lsp b/ansi-tests/unless.lsp index 948c2c8b..e3b96915 100644 --- a/ansi-tests/unless.lsp +++ b/ansi-tests/unless.lsp @@ -59,3 +59,17 @@ ;;; (deftest unless.error.1 ;;; (classify-error (unless)) ;;; program-error) + +(deftest unless.error.1 + (classify-error (funcall (macro-function 'unless))) + program-error) + +(deftest unless.error.2 + (classify-error (funcall (macro-function 'unless) + '(unless t))) + program-error) + +(deftest unless.error.3 + (classify-error (funcall (macro-function 'unless) + '(unless t) nil nil)) + program-error) \ No newline at end of file diff --git a/ansi-tests/when.lsp b/ansi-tests/when.lsp index 3dc179d7..8b29c55d 100644 --- a/ansi-tests/when.lsp +++ b/ansi-tests/when.lsp @@ -50,3 +50,17 @@ ;;; (deftest when.error.1 ;;; (classify-error (when)) ;;; program-error) + +(deftest when.error.1 + (classify-error (funcall (macro-function 'when))) + program-error) + +(deftest when.error.2 + (classify-error (funcall (macro-function 'when) + '(when t))) + program-error) + +(deftest when.error.3 + (classify-error (funcall (macro-function 'when) + '(when t) nil nil)) + program-error) \ No newline at end of file -- GitLab