/[gcl]/gcl/ansi-tests/random-types.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/random-types.lsp

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

revision 1.5 by pfdietz, Fri May 6 13:34:42 2005 UTC revision 1.6 by pfdietz, Fri Jul 1 12:34:36 2005 UTC
# Line 19  Line 19 
19         (1 (random-from-seq #(integer unsigned-byte ratio rational real float         (1 (random-from-seq #(integer unsigned-byte ratio rational real float
20                               short-float single-float double-float                               short-float single-float double-float
21                               long-float complex symbol cons function)))                               long-float complex symbol cons function)))
22           #|
23         (1         (1
24          (let* ((len (random *maximum-random-int-bits*))          (let* ((len (random *maximum-random-int-bits*))
25                 (r1 (ash 1 len))                 (r1 (ash 1 len))
# Line 28  Line 29 
29                 (lo (min x y))                 (lo (min x y))
30                 (hi (max x y)))                 (hi (max x y)))
31            `(integer ,lo ,hi)))            `(integer ,lo ,hi)))
32           |#
33           (1 (make-random-real-type))
34           (1 (make-random-complex-type))
35         )         )
36      (rcase      (rcase
37       (2 (let* ((op (random-from-seq #(cons cons and or)))       (2 (let* ((op (random-from-seq #(cons cons and or)))
# Line 36  Line 40 
40                 (sizes (random-partition (1- size) nargs)))                 (sizes (random-partition (1- size) nargs)))
41            `(,op ,@(mapcar #'make-random-type sizes))))            `(,op ,@(mapcar #'make-random-type sizes))))
42       (1 `(not ,(make-random-type (1- size))))       (1 `(not ,(make-random-type (1- size))))
43       (1 (make-random-function-type size))       ; (1 (make-random-function-type size))
44       )))       )))
45    
46    (defun make-random-real-type ()
47      (rcase
48       (1 (random-from-seq '(integer unsigned-byte short-float single-float
49                                     double-float long-float rational real)))
50       (1 (destructuring-bind (lo hi)
51              (make-random-integer-range)
52            (rcase
53             (4 `(integer ,lo ,hi))
54             (1 `(integer ,lo))
55             (1 `(integer ,lo *))
56             (2 `(integer * ,hi)))))
57       (1 (let ((r1 (random-real))
58                (r2 (random-real)))
59            `(real ,(min r1 r2) ,(max r2 r2))))
60       ;;; Add more cases here
61       ))
62    
63    (defun make-random-complex-type ()
64      `(complex ,(make-random-real-type)))
65    
66  (defun make-random-function-type (size)  (defun make-random-function-type (size)
67    (let* ((sizes (random-partition (1- size) 2))    (let* ((sizes (random-partition (1- size) 2))
68           (types (mapcar #'make-random-type sizes)))           (types (mapcar #'make-random-type sizes)))

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

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