defun.lsp 3 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Feb 16 23:40:32 2003
;;;; Contains: Tests of DEFUN

(in-package :cl-test)

8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41

;;; Tests for implicit blocks

(defun defun-test-fun-1 ()
  (return-from defun-test-fun-1 'good))

(deftest defun.1
  (defun-test-fun-1)
  good)

(defun defun-test-fun-2 ()
  (return-from defun-test-fun-2 (values)))

(deftest defun.2
  (defun-test-fun-2))

(defun defun-test-fun-3 ()
  (return-from defun-test-fun-3 (values 'a 'b 'c 'd 'e 'f)))

(deftest defun.3
  (defun-test-fun-3)
  a b c d e f)

(defun defun-test-fun-4 (x)
  (car x))

(deftest defun.4
  (let ((x (list 'a 'b)))
    (values
     (setf (defun-test-fun-4 x) 'c)
     x))
  c
  (c b))

42 43 44 45
(report-and-ignore-errors
 (defun (setf defun-test-fun-4) (newval x)
   (return-from defun-test-fun-4 (setf (car x) newval))))

pfdietz's avatar
pfdietz committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59
(deftest defun.5
  (let ((x 1))
    (declare (special x))
    (let ((x 2))
      (defun defun-test-fun-5 (&aux (y x))
	(declare (special x))
	(values y x))
      (defun-test-fun-5)))
  2 1)

(deftest defun.6
  (let ((x 1))
    (declare (special x))
    (let ((x 2))
60
      (defun defun-test-fun-6 (&optional (y x))
pfdietz's avatar
pfdietz committed
61 62
	(declare (special x))
	(values y x))
63
      (defun-test-fun-6)))
pfdietz's avatar
pfdietz committed
64 65 66 67 68 69
  2 1)

(deftest defun.7
  (let ((x 1))
    (declare (special x))
    (let ((x 2))
70
      (defun defun-test-fun-7 (&key (y x))
pfdietz's avatar
pfdietz committed
71 72
	(declare (special x))
	(values y x))
73
      (defun-test-fun-7)))
pfdietz's avatar
pfdietz committed
74 75
  2 1)

pfdietz's avatar
pfdietz committed
76 77 78 79 80 81 82 83 84
;; Documentation

(deftest defun.8
  (let* ((sym (gensym))
	 (doc "DEFUN.8")
	 (form `(defun ,sym () ,doc nil)))
    (or (documentation sym 'function) doc))
  "DEFUN.8")

85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
;;; Error tests

(deftest defun.error.1
  (signals-error (funcall (macro-function 'defun))
		 program-error)
  t)

(deftest defun.error.2
  (signals-error (funcall (macro-function 'defun)
			   '(defun nonexistent-function ()))
		 program-error)
  t)

(deftest defun.error.3
  (signals-error (funcall (macro-function 'defun)
			   '(defun nonexistent-function ())
			   nil nil)
		 program-error)
  t)

;;; More comprehensive error handling tests of calls to
;;; user-defined functions

(deftest defun.error.4
  (let* ((name (gensym)))
    (loop for i below (min 100 lambda-parameters-limit)
	  for params = nil then (cons (gensym) params)
	  for args = nil then (cons nil args)
	  for expected = '(1 2 3)
	  for fn = (eval `(prog2 (proclaim '(optimize (safety 0)))
				 (defun ,name ,params (values ,@expected))
				 (proclaim '(optimize safety))))
	  when
	  (cond
	   ((not (equal (multiple-value-list (apply fn args)) expected))
	    (list i :fail1))
	   ((not (equal (multiple-value-list
			 (apply (symbol-function fn) args))
			expected))
	    (list i :fail2))
	   ((not (equal (multiple-value-list (eval `(,name ,@args)))
			expected))
	    (list i :fail3))
	   ;; Error cases
	   ((and (> i 0)
		 (let ((val (eval `(signals-error (,name ,@(cdr args)) program-error))))
		   (and (not (eq val t)) :fail4))))
	   ((and (< i (1- call-arguments-limit))
		 (let ((val (eval `(signals-error (,name nil ,@args) program-error))))
		   (and (not (eq val t)) :fail5)))))
	  collect it))
  nil)