From 34975263e947a681be92662409fa8af8f3074751 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 17 Feb 2003 11:54:02 +0000 Subject: [PATCH] Added more argument order/reevaluation tests. Added error cases for some builtin macros, and for DESTRUCTURING-BIND. --- ansi-tests/case.lsp | 3 +++ ansi-tests/ccase.lsp | 21 ++++++++++++++++++--- ansi-tests/cerror.lsp | 9 +++++++++ ansi-tests/ctypecase.lsp | 20 +++++++++++++------- ansi-tests/defconstant.lsp | 17 +++++++++++++---- ansi-tests/define-modify-macro.lsp | 18 ++++++++++++++++++ ansi-tests/defparameter.lsp | 15 +++++++++++++++ ansi-tests/defun.lsp | 17 +++++++++++++++++ ansi-tests/defvar.lsp | 11 ++++++++++- ansi-tests/destructuring-bind.lsp | 18 +++++++++++++----- ansi-tests/function-lambda-expression.lsp | 6 ++++++ ansi-tests/functionp.lsp | 7 +++++++ ansi-tests/gclload2.lsp | 1 + ansi-tests/hash-table.lsp | 14 ++++++++++++++ ansi-tests/identity.lsp | 5 +++++ ansi-tests/if.lsp | 16 ++++++++++++++++ ansi-tests/nreverse.lsp | 7 +++++++ ansi-tests/reverse.lsp | 7 +++++++ 18 files changed, 192 insertions(+), 20 deletions(-) create mode 100644 ansi-tests/defun.lsp diff --git a/ansi-tests/case.lsp b/ansi-tests/case.lsp index 55bf0820..0f170d66 100644 --- a/ansi-tests/case.lsp +++ b/ansi-tests/case.lsp @@ -166,3 +166,6 @@ (case 'a (b 'b) (otherwise)) nil) +(deftest case.error.1 + (classify-error (case)) + program-error) diff --git a/ansi-tests/ccase.lsp b/ansi-tests/ccase.lsp index 3afc1fcf..58cef3cf 100644 --- a/ansi-tests/ccase.lsp +++ b/ansi-tests/ccase.lsp @@ -167,8 +167,23 @@ y b) (deftest ccase.30 - (ccase 'a (a)) + (let ((x 'a)) + (ccase x (a))) nil) -;;; Need to add tests for continuability of the error, -;;; and resetting of the place. +(deftest ccase.31 + (handler-bind + ((type-error #'(lambda (c) (store-value 7 c)))) + (let ((x 0)) + (ccase x + (1 :bad) + (7 :good) + (2 nil)))) + :good) + +(deftest ccase.error.1 + (classify-error (ccase)) + program-error) + + + diff --git a/ansi-tests/cerror.lsp b/ansi-tests/cerror.lsp index c5df50bc..2f1b489d 100644 --- a/ansi-tests/cerror.lsp +++ b/ansi-tests/cerror.lsp @@ -64,3 +64,12 @@ (cerror "Wooo" 'simple-error) 10)) 10) + + +(deftest cerror.error.1 + (classify-error (cerror)) + program-error) + +(deftest cerror.error.2 + (classify-error (cerror "foo")) + program-error) diff --git a/ansi-tests/ctypecase.lsp b/ansi-tests/ctypecase.lsp index a23aaed3..00416b3d 100644 --- a/ansi-tests/ctypecase.lsp +++ b/ansi-tests/ctypecase.lsp @@ -64,11 +64,17 @@ (ctypecase x (integer) (t 'a))) nil) +(deftest ctypecase.12 + (let ((x 1)) + (values + (handler-bind + ((type-error #'(lambda (c) (store-value 'a c)))) + (ctypecase x + (symbol :good) + (float :bad))) + x)) + :good a) - - - - - - - +(deftest ctypecase.error.1 + (classify-error (ctypecase)) + program-error) diff --git a/ansi-tests/defconstant.lsp b/ansi-tests/defconstant.lsp index 02a69e95..2c40ffd8 100644 --- a/ansi-tests/defconstant.lsp +++ b/ansi-tests/defconstant.lsp @@ -30,7 +30,16 @@ (defconstant test-constant-3 0) test-constant-3) - - - - +(deftest defconstant.error.1 + (classify-error (defconstant)) + program-error) + +(deftest defconstant.error.2 + (classify-error (defconstant +ignorable-constant-name+)) + program-error) + +(deftest defconstant.error.3 + (classify-error (defconstant +ignorable-constant-name2+ nil + "This is a docstring" + "This is an unnecessary extra argument.")) + program-error) \ No newline at end of file diff --git a/ansi-tests/define-modify-macro.lsp b/ansi-tests/define-modify-macro.lsp index b06caf01..a3818299 100644 --- a/ansi-tests/define-modify-macro.lsp +++ b/ansi-tests/define-modify-macro.lsp @@ -63,3 +63,21 @@ i)))) new-incf2 (3 #(0 0 3 0 0) 3)) + +(deftest define-modify-macro.error.1 + (classify-error (define-modify-macro)) + program-error) + +(deftest define-modify-macro.error.2 + (classify-error (define-modify-macro dfm-error-1)) + program-error) + +(deftest define-modify-macro.error.2 + (classify-error (define-modify-macro dfm-error-2 ())) + program-error) + +(deftest define-modify-macro.error.3 + (classify-error (define-modify-macro dfm-error-2 () nil "Documentation" + "extra illegal argument")) + program-error) + diff --git a/ansi-tests/defparameter.lsp b/ansi-tests/defparameter.lsp index 6b0caac7..473550c1 100644 --- a/ansi-tests/defparameter.lsp +++ b/ansi-tests/defparameter.lsp @@ -51,4 +51,19 @@ "And ever." 300) +(deftest defparameter.error.1 + (classify-error (defparameter)) + program-error) + +(deftest defparameter.error.2 + (classify-error (defparameter *ignored-defparameter-name*)) + program-error) + +(deftest defparameter.error.3 + (classify-error (defparameter *ignored-defparameter-name* nil + "documentation" + "illegal extra argument")) + program-error) + + diff --git a/ansi-tests/defun.lsp b/ansi-tests/defun.lsp new file mode 100644 index 00000000..ab68ad98 --- /dev/null +++ b/ansi-tests/defun.lsp @@ -0,0 +1,17 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sun Feb 16 23:40:32 2003 +;;;; Contains: Tests of DEFUN + +(in-package :cl-test) + +;;; DEFUN is used extensively elsewhere, so I'm just putting error +;;; case tests here + +(deftest defun.error.1 + (classify-error (defun)) + program-error) + +(deftest defun.error.2 + (classify-error (defun ignored-defun-name)) + program-error) diff --git a/ansi-tests/defvar.lsp b/ansi-tests/defvar.lsp index 696bdfe3..d14dff7c 100644 --- a/ansi-tests/defvar.lsp +++ b/ansi-tests/defvar.lsp @@ -1,4 +1,4 @@ -;-*- Mode: Lisp -*- +`;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Thu Oct 10 23:21:50 2002 ;;;; Contains: Tests for DEFVAR @@ -53,3 +53,12 @@ "And ever." 200 0) + +(deftest defvar.error.1 + (classify-error (defvar)) + program-error) + +(deftest defvar.error.2 + (classify-error (defvar *ignored-defvar-name* nil "documentation" + "illegal extra argument")) + program-error) diff --git a/ansi-tests/destructuring-bind.lsp b/ansi-tests/destructuring-bind.lsp index 25fe37a5..f42426fd 100644 --- a/ansi-tests/destructuring-bind.lsp +++ b/ansi-tests/destructuring-bind.lsp @@ -80,12 +80,20 @@ (destructuring-bind ((&key a b c)) '((:c 1 :b 2)) (values a b c)) nil 2 1) +;;; Error cases - - - - - +(deftest destructuring-bind.error.1 + (classify-error (destructuring-bind (a b c) nil (list a b c))) + program-error) +(deftest destructuring-bind.error.2 + (classify-error (destructuring-bind ((a b c)) nil (list a b c))) + program-error) +(deftest destructuring-bind.error.3 + (classify-error (destructuring-bind (a b) 'x (list a b))) + program-error) +(deftest destructuring-bind.error.4 + (classify-error (destructuring-bind (a . b) 'x (list a b))) + program-error) diff --git a/ansi-tests/function-lambda-expression.lsp b/ansi-tests/function-lambda-expression.lsp index e70fcb4d..1ac0a070 100644 --- a/ansi-tests/function-lambda-expression.lsp +++ b/ansi-tests/function-lambda-expression.lsp @@ -21,6 +21,12 @@ (notnot (second ret-vals)))))) 3 t) +(deftest function-lambda-expression.order.1 + (let ((i 0)) + (function-lambda-expression (progn (incf i) #'cons)) + i) + 1) + (deftest function-lambda-expression.error.1 (classify-error (function-lambda-expression)) program-error) diff --git a/ansi-tests/functionp.lsp b/ansi-tests/functionp.lsp index 4910d025..23edd093 100644 --- a/ansi-tests/functionp.lsp +++ b/ansi-tests/functionp.lsp @@ -80,6 +80,13 @@ (flet ((%f () nil)) (not-mv (functionp #'%f))) nil) +(deftest functionp.order.1 + (let ((i 0)) + (values + (notnot (functionp (progn (incf i) #'cons))) + i)) + t 1) + (deftest functionp.error.1 (classify-error (functionp)) program-error) diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index 2dfe42ee..10e0f85e 100644 --- a/ansi-tests/gclload2.lsp +++ b/ansi-tests/gclload2.lsp @@ -34,6 +34,7 @@ (load "defconstant.lsp") (load "define-modify-macro.lsp") (load "defparameter.lsp") +(load "defun.lsp") (load "defvar.lsp") (load "destructuring-bind.lsp") (load "ecase.lsp") diff --git a/ansi-tests/hash-table.lsp b/ansi-tests/hash-table.lsp index 9bb01b00..fb6c5fd2 100644 --- a/ansi-tests/hash-table.lsp +++ b/ansi-tests/hash-table.lsp @@ -51,6 +51,20 @@ always (if p q (not q))) t) +(deftest hash-table-p.3 + (let ((i 0)) + (values (hash-table-p (incf i)) i)) + nil 1) + +(deftest hash-table-p.error.1 + (classify-error (hash-table-p)) + program-error) + +(deftest hash-table-p.error.2 + (classify-error (let ((h (make-hash-table))) (hash-table-p h nil))) + program-error) + + diff --git a/ansi-tests/identity.lsp b/ansi-tests/identity.lsp index 03f0ca28..0ea8f708 100644 --- a/ansi-tests/identity.lsp +++ b/ansi-tests/identity.lsp @@ -20,6 +20,11 @@ (eqlt x (check-values (identity x)))) t) +(deftest identity.order.1 + (let ((i 0)) + (values (identity (incf i)) i)) + 1 1) + (deftest identity.error.1 (classify-error (identity)) program-error) diff --git a/ansi-tests/if.lsp b/ansi-tests/if.lsp index d2acdc28..26af82e3 100644 --- a/ansi-tests/if.lsp +++ b/ansi-tests/if.lsp @@ -29,4 +29,20 @@ (deftest if.7 (if nil 'a (values))) +(deftest if.order.1 + (let ((i 0)) + (values (if (= (incf i) 1) 't nil) i)) + t 1) + +(deftest if.error.1 + (classify-error (if)) + program-error) + +(deftest if.error.2 + (classify-error (if t 1 2 3)) + program-error) + + + + diff --git a/ansi-tests/nreverse.lsp b/ansi-tests/nreverse.lsp index 1ab09440..d752aa04 100644 --- a/ansi-tests/nreverse.lsp +++ b/ansi-tests/nreverse.lsp @@ -86,6 +86,13 @@ y) "edcba") +(deftest nreverse.order.1 + (let ((i 0)) + (values + (nreverse (progn (incf i) (list 'a 'b 'c 'd))) + i)) + (d c b a) 1) + (deftest nreverse.error.1 (classify-error (nreverse 'a)) type-error) diff --git a/ansi-tests/reverse.lsp b/ansi-tests/reverse.lsp index 10362273..cf1ab93a 100644 --- a/ansi-tests/reverse.lsp +++ b/ansi-tests/reverse.lsp @@ -89,6 +89,13 @@ y) "edcba") +(deftest reverse.order.1 + (let ((i 0)) + (values + (reverse (progn (incf i) (list 'a 'b 'c 'd))) + i)) + (d c b a) 1) + ;;; Error cases (deftest reverse.error.1 -- GitLab