diff --git a/ansi-tests/apply.lsp b/ansi-tests/apply.lsp new file mode 100644 index 0000000000000000000000000000000000000000..8e8fc45e0d15fdc06462d67ca69ac4fe1d0f1007 --- /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 a27e8b5f30e4c444e8172c9b9998f06ba20ead68..2d4a859641b481c714be2931d17e328963f775ed 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 e18149d3cca51717005d0b0675d9ad8fa583ea58..88319a59a1dc8e599b40b90c5c58274a58efc0e0 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 0000000000000000000000000000000000000000..e2caffa8dfd5b8404f55e3884d67bb92ad082227 --- /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 da3fc7b6478effe580001a28371c0ad1092abf7e..87459c2cb7c077dc74c379f0290a5b784d32d974 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 db418941dacc5694f5981f440066fcd8817a72c3..3f3b365e1f252f0e477b2ff271aae607b4122ebe 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 0000000000000000000000000000000000000000..bdbf86adf1338fd26a0f16edddfdbc96d30f015f --- /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 f144ff2c2e51b10a7fa5e07f6bbde6692c85bbfa..a958541700c820a84ebea5f0dae80ca289037bab 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 a15c9064730cee647fe0fe86cda9f49970ac2c00..6fc7b33a4311a31854a71be9ce1dea2f41e27417 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 0000000000000000000000000000000000000000..e70fcb4daabd2f621bf06a72fd17dad0ae449548 --- /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 b50c2e20c6a0f18eac29c22a48f6ba9f77977322..138dbc31a810a4366461e22728b8c4d2357fdb73 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 0000000000000000000000000000000000000000..77c603aeae5fb80683fa502f63a3a66ebafd3904 --- /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 35393302f09758de6a9b1b0d28130f7b46084258..e4fdf563b7bf6f086a0e8b0ccbb8ed2a116bb8f9 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 79e3eb8c7743954b7af33c3620f29e81540b99e7..cfbb1176a35992fb4fa1723906db08fe29f9aab7 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 0000000000000000000000000000000000000000..f48e9245fdd76a4a39989053fade332e6e99449f --- /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 b3f36db3e1cd3ffeb8f2e67b2cdc7e28302381fd..d381baec1cc309a02a69315daae5c88f990502c0 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) + +