defun.lsp 2.83 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 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
(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))
      (defun defun-test-fun-5 (&optional (y x))
	(declare (special x))
	(values y x))
      (defun-test-fun-5)))
  2 1)

(deftest defun.7
  (let ((x 1))
    (declare (special x))
    (let ((x 2))
      (defun defun-test-fun-5 (&key (y x))
	(declare (special x))
	(values y x))
      (defun-test-fun-5)))
  2 1)

76 77 78 79 80 81 82 83 84 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
;;; 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)