/[gcl]/gcl/ansi-tests/defun.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/defun.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by pfdietz, Sat Jan 17 12:44:01 2004 UTC revision 1.10 by pfdietz, Sun Dec 26 15:58:08 2004 UTC
# Line 5  Line 5 
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    
# Line 60  Line 43 
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    

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26