Commit 797fb30f authored by pfdietz's avatar pfdietz

Added test files for APPLY, COMPILED-FUNCTION-P, FDEFINITION,...

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.
parent 60b12ff5
;-*- 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))
......@@ -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)
......
......@@ -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)
......
;-*- 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)
......@@ -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)
......
......@@ -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)
;-*- 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)
......@@ -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)
......@@ -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
......
;-*- 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)
......@@ -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")
......
;-*- 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
......@@ -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)
......@@ -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)
;-*- 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)
......@@ -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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment