Commit f4ee69e9 authored by pfdietz's avatar pfdietz

Added tests to confirm that MACRO-FUNCTIONs have the correct error behavior...

Added tests to confirm that MACRO-FUNCTIONs have the correct error behavior when called with the wrong number of arguments.
parent 98a78667
......@@ -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
......@@ -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
......@@ -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
......@@ -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
......@@ -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)
......@@ -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
......@@ -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
;-*- 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)
......@@ -81,3 +81,5 @@
;;; "extra illegal argument"))
;;; program-error)
(def-macro-test define-modify-macro.error.1
(define-modify-macro nonexistent-modify-macro () foo))
;-*- 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)))
;-*- 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)
;-*- 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)
......@@ -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)
;-*- 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))
;-*- 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)
......@@ -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
......
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)
......@@ -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)))
......@@ -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)
......@@ -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")
......
......@@ -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")
......@@ -13,3 +13,5 @@
(load "subtypep-eql.lsp")
(load "subtypep-array.lsp")
(load "deftype.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
......@@ -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
......
......@@ -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)
......@@ -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
......@@ -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
......@@ -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)
......@@ -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)
......@@ -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))
......@@ -50,3 +50,6 @@
(package-error () 'package-error)
(error (c) c)))
package-error)
(def-macro-test in-package.error.1
(in-package :cl-test))
......@@ -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
......@@ -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
......@@ -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))))