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

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

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

revision 1.12 by pfdietz, Fri Oct 15 02:47:53 2004 UTC revision 1.13 by pfdietz, Fri Oct 15 03:13:04 2004 UTC
# Line 100  Line 100 
100                    (otherwise :bad)))                    (otherwise :bad)))
101    (:good :good :good :good))    (:good :good :good :good))
102    
103    ;;; A randomized test
104    
105    (deftest typecase.19
106      (let* ((u (coerce *universe* 'vector))
107             (len1 (length u))
108             (types (coerce *cl-all-type-symbols* 'vector))
109             (len2 (length types)))
110        (loop
111         for n = (random 10)
112         for my-types = (loop repeat n collect (elt types (random len2)))
113         for val = (elt u (random len1))
114         for i = (position val my-types :test #'typep)
115         for form = `(typecase ',val
116                       ,@(loop for i from 0 for type in my-types collect `(,type ,i))
117                       (otherwise nil))
118         for j = (eval form)
119         repeat 1000
120         unless (eql i j)
121         collect (list n my-types val i form j)))
122      nil)
123    
124  ;;; Error cases  ;;; Error cases
125    
126  (deftest typecase.error.1  (deftest typecase.error.1

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

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