defun.lsp 2.27 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))))

46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
;;; 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)