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