5 |
|
|
6 |
(in-package :cl-test) |
(in-package :cl-test) |
7 |
|
|
|
(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) |
|
8 |
|
|
9 |
;;; Tests for implicit blocks |
;;; Tests for implicit blocks |
10 |
|
|
43 |
(defun (setf defun-test-fun-4) (newval x) |
(defun (setf defun-test-fun-4) (newval x) |
44 |
(return-from defun-test-fun-4 (setf (car x) newval)))) |
(return-from defun-test-fun-4 (setf (car x) newval)))) |
45 |
|
|
46 |
|
;;; Error tests |
47 |
|
|
48 |
|
(deftest defun.error.1 |
49 |
|
(signals-error (funcall (macro-function 'defun)) |
50 |
|
program-error) |
51 |
|
t) |
52 |
|
|
53 |
|
(deftest defun.error.2 |
54 |
|
(signals-error (funcall (macro-function 'defun) |
55 |
|
'(defun nonexistent-function ())) |
56 |
|
program-error) |
57 |
|
t) |
58 |
|
|
59 |
|
(deftest defun.error.3 |
60 |
|
(signals-error (funcall (macro-function 'defun) |
61 |
|
'(defun nonexistent-function ()) |
62 |
|
nil nil) |
63 |
|
program-error) |
64 |
|
t) |
65 |
|
|
66 |
|
;;; More comprehensive error handling tests of calls to |
67 |
|
;;; user-defined functions |
68 |
|
|
69 |
|
(deftest defun.error.4 |
70 |
|
(let* ((name (gensym))) |
71 |
|
(loop for i below (min 100 lambda-parameters-limit) |
72 |
|
for params = nil then (cons (gensym) params) |
73 |
|
for args = nil then (cons nil args) |
74 |
|
for expected = '(1 2 3) |
75 |
|
for fn = (eval `(prog2 (proclaim '(optimize (safety 0))) |
76 |
|
(defun ,name ,params (values ,@expected)) |
77 |
|
(proclaim '(optimize safety)))) |
78 |
|
when |
79 |
|
(cond |
80 |
|
((not (equal (multiple-value-list (apply fn args)) expected)) |
81 |
|
(list i :fail1)) |
82 |
|
((not (equal (multiple-value-list |
83 |
|
(apply (symbol-function fn) args)) |
84 |
|
expected)) |
85 |
|
(list i :fail2)) |
86 |
|
((not (equal (multiple-value-list (eval `(,name ,@args))) |
87 |
|
expected)) |
88 |
|
(list i :fail3)) |
89 |
|
;; Error cases |
90 |
|
((and (> i 0) |
91 |
|
(let ((val (eval `(signals-error (,name ,@(cdr args)) program-error)))) |
92 |
|
(and (not (eq val t)) :fail4)))) |
93 |
|
((and (< i (1- call-arguments-limit)) |
94 |
|
(let ((val (eval `(signals-error (,name nil ,@args) program-error)))) |
95 |
|
(and (not (eq val t)) :fail5))))) |
96 |
|
collect it)) |
97 |
|
nil) |
98 |
|
|