From 797fb30ff17a3fe617cbd9a953c9b5f76871b510 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Mon, 13 Jan 2003 23:19:51 +0000
Subject: [PATCH] Added test files for APPLY, COMPILED-FUNCTION-P, FDEFINITION,
 FUNCTION-LAMBDA-EXPRESSION, GET-SETF-EXPANSION, and VALUES-LIST.  Added error
 tests for other forms, and moved some tests to more appropriate files.  Fixed
 bogus IGNORE in one function.

---
 ansi-tests/apply.lsp                      | 44 ++++++++++++++
 ansi-tests/cl-symbols-aux.lsp             |  1 -
 ansi-tests/compile.lsp                    | 16 -----
 ansi-tests/compiled-function-p.lsp        | 32 ++++++++++
 ansi-tests/complement.lsp                 |  7 +--
 ansi-tests/cons-test-06.lsp               | 47 ---------------
 ansi-tests/fdefinition.lsp                | 72 +++++++++++++++++++++++
 ansi-tests/fmakunbound.lsp                | 14 ++++-
 ansi-tests/funcall.lsp                    | 12 ++++
 ansi-tests/function-lambda-expression.lsp | 36 ++++++++++++
 ansi-tests/gclload2.lsp                   | 10 +++-
 ansi-tests/get-setf-expansion.lsp         | 16 +++++
 ansi-tests/not-and-null.lsp               | 27 +++++++++
 ansi-tests/types-and-class.lsp            | 65 ++++++++++++++++++++
 ansi-tests/values-list.lsp                | 40 +++++++++++++
 ansi-tests/values.lsp                     | 15 +++++
 16 files changed, 381 insertions(+), 73 deletions(-)
 create mode 100644 ansi-tests/apply.lsp
 create mode 100644 ansi-tests/compiled-function-p.lsp
 create mode 100644 ansi-tests/fdefinition.lsp
 create mode 100644 ansi-tests/function-lambda-expression.lsp
 create mode 100644 ansi-tests/get-setf-expansion.lsp
 create mode 100644 ansi-tests/values-list.lsp

diff --git a/ansi-tests/apply.lsp b/ansi-tests/apply.lsp
new file mode 100644
index 00000000..8e8fc45e
--- /dev/null
+++ b/ansi-tests/apply.lsp
@@ -0,0 +1,44 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Mon Jan 13 15:13:07 2003
+;;;; Contains: Tests of APPLY
+
+(in-package :cl-test)
+
+;;; Error cases
+
+(deftest apply.error.1
+  (classify-error (apply))
+  program-error)
+
+(deftest apply.error.2
+  (classify-error (apply #'cons))
+  program-error)
+
+(deftest apply.error.3
+  (classify-error (apply #'cons nil))
+  program-error)
+
+;;; Non-error cases
+
+(deftest apply.1
+  (apply #'cons 'a 'b nil)
+  (a . b))
+
+(deftest apply.2
+  (apply #'cons 'a '(b))
+  (a . b))
+
+(deftest apply.3
+  (apply #'cons '(a b))
+  (a . b))
+
+(deftest apply.4
+  (let ((zeros (make-list (min 10000 (1- call-arguments-limit))
+			  :initial-element 1)))
+    (apply #'+ zeros))
+  #.(min 10000 (1- call-arguments-limit)))
+
+(deftest apply.5
+  (apply 'cons '(a b))
+  (a . b))
diff --git a/ansi-tests/cl-symbols-aux.lsp b/ansi-tests/cl-symbols-aux.lsp
index a27e8b5f..2d4a8596 100644
--- a/ansi-tests/cl-symbols-aux.lsp
+++ b/ansi-tests/cl-symbols-aux.lsp
@@ -16,7 +16,6 @@
 (defun test-if-not-in-cl-package (str)
   (multiple-value-bind (sym status)
       (find-symbol (string-upcase str) 'common-lisp)
-      (declare (ignore sym))
       (or
        ;; Symbol not present in the common lisp package
        (not status)
diff --git a/ansi-tests/compile.lsp b/ansi-tests/compile.lsp
index e18149d3..88319a59 100644
--- a/ansi-tests/compile.lsp
+++ b/ansi-tests/compile.lsp
@@ -5,22 +5,6 @@
 
 (in-package :cl-test)
 
-(deftest compiled-function-p.1
-  (some #'(lambda (obj)
-	     (if (compiled-function-p obj)
-		 (not (typep obj 'compiled-function))
-	       (typep obj 'compiled-function)))
-	 *universe*)
-  nil)
-
-(deftest compiled-function-p.2
-  (compiled-function-p '(lambda (x y) (cons y x)))
-  nil)
-
-(deftest compiled-function-p.3
-  (not (compiled-function-p (compile nil '(lambda (y x) (cons x y)))))
-  nil)
-
 (deftest compile.1
   (progn
     (fmakunbound 'compile.1-fn)
diff --git a/ansi-tests/compiled-function-p.lsp b/ansi-tests/compiled-function-p.lsp
new file mode 100644
index 00000000..e2caffa8
--- /dev/null
+++ b/ansi-tests/compiled-function-p.lsp
@@ -0,0 +1,32 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Mon Jan 13 16:32:44 2003
+;;;; Contains: Tests of COMPILED-FUNCTION-P
+
+(in-package :cl-test)
+
+(deftest compiled-function-p.1
+  (some #'(lambda (obj)
+	     (if (compiled-function-p obj)
+		 (not (typep obj 'compiled-function))
+	       (typep obj 'compiled-function)))
+	 *universe*)
+  nil)
+
+(deftest compiled-function-p.2
+  (compiled-function-p '(lambda (x y) (cons y x)))
+  nil)
+
+(deftest compiled-function-p.3
+  (not (compiled-function-p (compile nil '(lambda (y x) (cons x y)))))
+  nil)
+
+(deftest compiled-function-p.error.1
+  (classify-error (compiled-function-p))
+  program-error)
+
+(deftest compiled-function-p.error.2
+  (classify-error (compiled-function-p nil nil))
+  program-error)
+
+
diff --git a/ansi-tests/complement.lsp b/ansi-tests/complement.lsp
index da3fc7b6..87459c2c 100644
--- a/ansi-tests/complement.lsp
+++ b/ansi-tests/complement.lsp
@@ -6,11 +6,11 @@
 (in-package :cl-test)
 
 (deftest complement.1
-  (not (funcall (cl::complement #'identity) nil))
+  (not (funcall (complement #'identity) nil))
   nil)
 
 (deftest complement.2
-  (funcall (cl::complement #'identity) t)
+  (funcall (complement #'identity) t)
   nil)
 
 (deftest complement.3
@@ -24,14 +24,13 @@
     (loop for i from 2 to (min 256 (1- call-arguments-limit))
 	  always (progn
 		   (push #\a x)
-		   (apply (cl::complement #'char=) x))))
+		   (apply (complement #'char=) x))))
   t)
 
 (deftest complement.5
   (classify-error (complement))
   program-error)
 
-
 (deftest complement.6
   (classify-error (complement #'not t))
   program-error)
diff --git a/ansi-tests/cons-test-06.lsp b/ansi-tests/cons-test-06.lsp
index db418941..3f3b365e 100644
--- a/ansi-tests/cons-test-06.lsp
+++ b/ansi-tests/cons-test-06.lsp
@@ -42,50 +42,3 @@
 (deftest endp.error.5
   (classify-error (endp nil nil))
   program-error)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; null
-
-(deftest null-1
-    (null nil)
-  t)
-
-(deftest null-2
-    (not (some #'null
-	       `(1 a 1.2 "a" #\w (a) ,*terminal-io*
-		   #'car (make-array '(10)))))
-  t)
-
-(deftest null.error.1
-  (classify-error (null))
-  program-error)
-
-(deftest null.error.2
-  (classify-error (null nil nil))
-  program-error)
-
-(deftest not-1
-    (not nil)
-  t)
-
-(deftest not-2
-    (not (some #'not
-	       `(1 a 1.2 "a" #\w (a) ,*terminal-io*
-		   #'car (make-array '(10)))))
-  t)
-
-(deftest not.error.1
-  (classify-error (not))
-  program-error)
-
-(deftest not.error.2
-  (classify-error (not nil nil))
-  program-error)
-
-(deftest typep-nil-null
-    (not (not (typep nil 'null)))
-  t)
-
-(deftest typep-t-null
-    (typep t 'null)
-  nil)
diff --git a/ansi-tests/fdefinition.lsp b/ansi-tests/fdefinition.lsp
new file mode 100644
index 00000000..bdbf86ad
--- /dev/null
+++ b/ansi-tests/fdefinition.lsp
@@ -0,0 +1,72 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Mon Jan 13 15:27:51 2003
+;;;; Contains: Tests for FDEFINITION
+
+(in-package :cl-test)
+
+;;; Error cases
+
+(deftest fdefinition.error.1
+  (classify-error (fdefinition))
+  program-error)
+
+(deftest fdefinition.error.2
+  (classify-error (fdefinition 'cons nil))
+  program-error)
+
+(deftest fdefinition.error.3
+  (classify-error (fdefinition (gensym)))
+  undefined-function)
+
+(deftest fdefinition.error.4
+  (classify-error (fdefinition 10))
+  type-error)
+
+(deftest fdefinition.error.5
+  (classify-error (fdefinition (list 'setf (gensym))))
+  undefined-function)
+
+;;; Non-error cases
+
+(deftest fdefinition.1
+  (let ((fun (fdefinition 'cons)))
+    (funcall fun 'a 'b))
+  (a . b))
+
+(deftest fdefinition.2
+  (progn
+    (fdefinition 'cond)
+    :good)
+  :good)
+
+(deftest fdefinition.3
+  (progn
+    (fdefinition 'setq)
+    :good)
+  :good)
+
+(deftest fdefinition.4
+  (let ((sym (gensym)))
+    (values
+     (fboundp sym)
+     (progn
+       (setf (fdefinition sym) (fdefinition 'cons))
+       (funcall (symbol-function sym) 'a 'b))
+     (notnot (fboundp sym))))
+  nil
+  (a . b)
+  t)
+
+(deftest fdefinition.5
+  (let* ((sym (gensym))
+	 (fname (list 'setf sym)))
+    (values
+     (fboundp fname)
+     (progn
+       (setf (fdefinition fname) (fdefinition 'cons))
+       (eval `(setf (,sym 'a) 'b)))
+     (notnot (fboundp fname))))
+  nil
+  (b . a)
+  t)
diff --git a/ansi-tests/fmakunbound.lsp b/ansi-tests/fmakunbound.lsp
index f144ff2c..a9585417 100644
--- a/ansi-tests/fmakunbound.lsp
+++ b/ansi-tests/fmakunbound.lsp
@@ -42,15 +42,23 @@
 		 (fboundp n))))
   t nil)
 
-(deftest fmakunbound.5
+(deftest fmakunbound.error.1
   (catch-type-error (fmakunbound 1))
   type-error)
 
-(deftest fmakunbound.6
+(deftest fmakunbound.error.2
   (catch-type-error (fmakunbound #\a))
   type-error)
 
-(deftest fmakunbound.7
+(deftest fmakunbound.error.3
   (catch-type-error (fmakunbound '(x)))
   type-error)
 
+(deftest fmakunbound.error.4
+  (classify-error (fmakunbound))
+  program-error)
+
+(deftest fmakunbound.error.5
+  (classify-error (fmakunbound (gensym) nil))
+  program-error)
+
diff --git a/ansi-tests/funcall.lsp b/ansi-tests/funcall.lsp
index a15c9064..6fc7b33a 100644
--- a/ansi-tests/funcall.lsp
+++ b/ansi-tests/funcall.lsp
@@ -39,6 +39,18 @@
   (1 . 2)
   (2 1))
 
+(deftest funcall.8
+  (flet ((foo (x y z) (values x y z)))
+    (funcall #'foo 1 2 3))
+  1 2 3)
+
+(deftest funcall.9
+  (flet ((foo () (values)))
+    (funcall #'foo))
+  )
+
+
+
 ;;; FUNCALL should throw an UNDEFINED-FUNCTION condition when
 ;;; called on a symbol with a global definition as a special
 ;;; operator
diff --git a/ansi-tests/function-lambda-expression.lsp b/ansi-tests/function-lambda-expression.lsp
new file mode 100644
index 00000000..e70fcb4d
--- /dev/null
+++ b/ansi-tests/function-lambda-expression.lsp
@@ -0,0 +1,36 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Mon Jan 13 16:27:12 2003
+;;;; Contains: Tests for FUNCTION-LAMBDA-EXPRESSION
+
+(in-package :cl-test)
+
+(deftest function-lambda-expression.1
+  (length
+   (multiple-value-list
+    (function-lambda-expression #'cons)))
+  3)
+
+(deftest function-lambda-expression.2
+  (let ((x nil))
+    (flet ((%f () x))
+      (let ((ret-vals
+	     (multiple-value-list
+	      (function-lambda-expression #'%f))))
+	(values (length ret-vals)
+		(notnot (second ret-vals))))))
+  3 t)
+
+(deftest function-lambda-expression.error.1
+  (classify-error (function-lambda-expression))
+  program-error)
+
+(deftest function-lambda-expression.error.2
+  (classify-error (function-lambda-expression #'cons nil))
+  program-error)
+
+
+
+
+
+
diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp
index b50c2e20..138dbc31 100644
--- a/ansi-tests/gclload2.lsp
+++ b/ansi-tests/gclload2.lsp
@@ -17,14 +17,16 @@
 (load "places.lsp")
 
 (load "and.lsp")
+(load "apply.lsp")
 (load "block.lsp")
 (load "call-arguments-limit.lsp")
 (load "case.lsp")
 (load "catch.lsp")
 (load "ccase.lsp")
-(load "constantly.lsp")
+(load "compiled-function-p.lsp")
 (load "complement.lsp")
 (load "cond.lsp")
+(load "constantly.lsp")
 (load "ctypecase.lsp")
 (load "defconstant.lsp")
 (load "define-modify-macro.lsp")
@@ -32,17 +34,20 @@
 (load "defvar.lsp")
 (load "destructuring-bind.lsp")
 (load "ecase.lsp")
+(load "eql.lsp")
 (load "equal.lsp")
 (load "equalp.lsp")
-(load "eql.lsp")
 (load "etypecase.lsp")
 (load "every.lsp")
 (load "fboundp.lsp")
+(load "fdefinition.lsp")
 (load "flet.lsp")
 (load "fmakunbound.lsp")
 (load "funcall.lsp")
+(load "function-lambda-expression.lsp")
 (load "function.lsp")
 (load "functionp.lsp")
+(load "get-setf-expansion.lsp")
 (load "identity.lsp")
 (load "if.lsp")
 (load "labels.lsp")
@@ -71,6 +76,7 @@
 (load "typecase.lsp")
 (load "unless.lsp")
 (load "unwind-protect.lsp")
+(load "values-list.lsp")
 (load "values.lsp")
 (load "when.lsp")
 
diff --git a/ansi-tests/get-setf-expansion.lsp b/ansi-tests/get-setf-expansion.lsp
new file mode 100644
index 00000000..77c603ae
--- /dev/null
+++ b/ansi-tests/get-setf-expansion.lsp
@@ -0,0 +1,16 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Mon Jan 13 17:05:17 2003
+;;;; Contains: Tests for GET-SETF-EXPANSION
+
+(in-package :cl-test)
+
+(deftest get-setf-expansion.error.1
+  (classify-error (get-setf-expansion))
+  program-error)
+
+(deftest get-setf-expansion.error.2
+  (classify-error (get-setf-expansion 'x nil nil))
+  program-error)
+
+;;; Tests for proper behavior will go here
diff --git a/ansi-tests/not-and-null.lsp b/ansi-tests/not-and-null.lsp
index 35393302..e4fdf563 100644
--- a/ansi-tests/not-and-null.lsp
+++ b/ansi-tests/not-and-null.lsp
@@ -17,6 +17,20 @@
   (some #'(lambda (x) (and x (null x))) *universe*)
   nil)
 
+(deftest null.4
+    (not (some #'null
+	       `(1 a 1.2 "a" #\w (a) ,*terminal-io*
+		   #'car (make-array '(10)))))
+  t)
+
+(deftest null.error.1
+  (classify-error (null))
+  program-error)
+
+(deftest null.error.2
+  (classify-error (null nil nil))
+  program-error)
+
 (deftest not.1
   (not nil)
   t)
@@ -29,4 +43,17 @@
   (some #'(lambda (x) (and x (not x))) *universe*)
   nil)
 
+(deftest not.4
+    (not (some #'not
+	       `(1 a 1.2 "a" #\w (a) ,*terminal-io*
+		   #'car (make-array '(10)))))
+  t)
+
+
+(deftest not.error.1
+  (classify-error (not))
+  program-error)
 
+(deftest not.error.2
+  (classify-error (not nil nil))
+  program-error)
diff --git a/ansi-tests/types-and-class.lsp b/ansi-tests/types-and-class.lsp
index 79e3eb8c..cfbb1176 100644
--- a/ansi-tests/types-and-class.lsp
+++ b/ansi-tests/types-and-class.lsp
@@ -317,6 +317,14 @@
   (not (macro-function 'deftype))
   nil)
 
+(deftest typep-nil-null
+    (not (not (typep nil 'null)))
+  t)
+
+(deftest typep-t-null
+    (typep t 'null)
+  nil)
+
 ;;; Special cases of types-6 that are/were causing problems in CMU CL
 
 (deftest keyword-is-subtype-of-atom
@@ -330,3 +338,60 @@
 (deftest extended-char-is-subtype-of-atom
   (subtypep* 'extended-char 'atom)
   t t)
+
+;;; Error checking of type-related functions
+
+(deftest subtypep.error.1
+  (classify-error (subtypep))
+  program-error)
+
+(deftest subtypep.error.2
+  (classify-error (subtypep t))
+  program-error)
+
+(deftest subtypep.error.3
+  (classify-error (subtypep t t nil nil))
+  program-error)
+
+(deftest type-of.error.1
+  (classify-error (type-of))
+  program-error)
+
+(deftest type-of.error.2
+  (classify-error (type-of nil nil))
+  program-error)
+
+(deftest typep.error.1
+  (classify-error (typep))
+  program-error)
+
+(deftest typep.error.2
+  (classify-error (typep nil))
+  program-error)
+
+(deftest typep.error.3
+  (classify-error (typep nil t nil nil))
+  program-error)
+
+(deftest type-error-datum.error.1
+  (classify-error (type-error-datum))
+  program-error)
+
+(deftest type-error-datum.error.2
+  (classify-error
+   (let ((c (make-condition 'type-error :datum nil
+			    :expected-type t)))
+     (type-error-datum c nil)))
+  program-error)
+
+(deftest type-error-expected-type.error.1
+  (classify-error (type-error-expected-type))
+  program-error)
+
+(deftest type-error-expected-type.error.2
+  (classify-error
+   (let ((c (make-condition 'type-error :datum nil
+			    :expected-type t)))
+     (type-error-expected-type c nil)))
+  program-error)
+
diff --git a/ansi-tests/values-list.lsp b/ansi-tests/values-list.lsp
new file mode 100644
index 00000000..f48e9245
--- /dev/null
+++ b/ansi-tests/values-list.lsp
@@ -0,0 +1,40 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Mon Jan 13 16:53:39 2003
+;;;; Contains: Tests for VALUES-LIST
+
+(in-package :cl-test)
+
+(deftest values-list.error.1
+  (classify-error (values-list))
+  program-error)
+
+(deftest values-list.error.2
+  (classify-error (values-list nil nil))
+  program-error)
+
+(deftest values-list.1
+  (values-list nil))
+
+(deftest values-list.2
+  (values-list '(1))
+  1)
+
+(deftest values-list.3
+  (values-list '(1 2))
+  1 2)
+
+(deftest values-list.4
+  (values-list '(a b c d e f g h i j))
+  a b c d e f g h i j)
+
+(deftest values-list.5
+  (let ((x (loop for i from 1 to (min 1000
+				      (1- call-arguments-limit)
+				      (1- multiple-values-limit))
+		 collect i)))
+    (equalt x
+	    (multiple-value-list (values-list x))))
+  t)
+
+  
diff --git a/ansi-tests/values.lsp b/ansi-tests/values.lsp
index b3f36db3..d381baec 100644
--- a/ansi-tests/values.lsp
+++ b/ansi-tests/values.lsp
@@ -39,3 +39,18 @@
 (deftest values.A
   (values (values 1 2) (values 3 4 5) (values) (values 10))
   1 3 nil 10)
+
+(deftest values.B
+  (funcall #'values 1 2 3 4)
+  1 2 3 4)
+
+(deftest values.C
+  (let ((x (loop for i from 1 to (min 1000
+				      (1- call-arguments-limit)
+				      (1- multiple-values-limit))
+		 collect i)))
+    (equalt x
+	    (multiple-value-list (apply #'values x))))
+  t)
+
+  
-- 
GitLab