defun.lsp 3.44 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
(deftest defun.5
  (let ((x 1))
    (declare (special x))
    (let ((x 2))
      (defun defun-test-fun-5 (&aux (y x))
sds's avatar
sds committed
51 52
        (declare (special x))
        (values y x))
pfdietz's avatar
pfdietz committed
53 54 55 56 57 58 59
      (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))
sds's avatar
sds 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))
sds's avatar
sds 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
;; Documentation

(deftest defun.8
  (let* ((sym (gensym))
sds's avatar
sds committed
80 81
         (doc "DEFUN.8")
         (form `(defun ,sym () ,doc nil)))
pfdietz's avatar
pfdietz committed
82 83 84
    (or (documentation sym 'function) doc))
  "DEFUN.8")

85 86 87 88
;;; Error tests

(deftest defun.error.1
  (signals-error (funcall (macro-function 'defun))
sds's avatar
sds committed
89
                 program-error)
90 91 92 93
  t)

(deftest defun.error.2
  (signals-error (funcall (macro-function 'defun)
sds's avatar
sds committed
94 95
                           '(defun nonexistent-function ()))
                 program-error)
96 97 98 99
  t)

(deftest defun.error.3
  (signals-error (funcall (macro-function 'defun)
sds's avatar
sds committed
100 101 102
                           '(defun nonexistent-function ())
                           nil nil)
                 program-error)
103 104 105 106 107 108 109 110
  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)
sds's avatar
sds committed
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
          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))
136 137
  nil)