25 |
(rest-type 'integer) |
(rest-type 'integer) |
26 |
(reps 1000) |
(reps 1000) |
27 |
(enclosing-the nil) |
(enclosing-the nil) |
28 |
|
(cell t) |
29 |
(test #'regression-test::equalp-with-case)) |
(test #'regression-test::equalp-with-case)) |
30 |
(assert (<= 1 minargs maxargs 20)) |
(assert (<= 1 minargs maxargs 20)) |
31 |
(dotimes (i reps) |
(dotimes (i reps) |
77 |
(member v '(nil t)))))) |
(member v '(nil t)))))) |
78 |
`(quote ,v) |
`(quote ,v) |
79 |
v))))) |
v))))) |
80 |
|
(speed (random 4)) |
81 |
|
(space (random 4)) |
82 |
|
(safety #-allegro (random 4) |
83 |
|
#+allegro (1+ (random 3))) |
84 |
|
(debug (random 4)) |
85 |
|
(store-into-cell? (and cell (coin))) |
86 |
(form |
(form |
87 |
`(lambda (r ,@params) |
`(lambda (,@(when store-into-cell? '(r)) ,@params) |
88 |
(declare (optimize speed (safety 1)) |
(declare (optimize (speed ,speed) (safety ,safety) (debug ,debug) (space ,space)) |
89 |
(type (simple-array ,upgraded-result-type nil) r) |
,@(when store-into-cell? `((type (simple-array ,upgraded-result-type nil) r))) |
90 |
,@ type-decls) |
,@ type-decls) |
91 |
(setf (aref r) |
,(let ((result-form |
92 |
,(if enclosing-the `(the ,result-type ,expr) expr)) |
(if enclosing-the `(the ,result-type ,expr) expr))) |
93 |
(values))) |
(if store-into-cell? |
94 |
|
`(setf (aref r) ,result-form) |
95 |
|
result-form)))) |
96 |
(*form* form)) |
(*form* form)) |
97 |
(when *print-random-type-prop-input* |
(when *print-random-type-prop-input* |
98 |
(let ((*print-pretty* t) |
(let ((*print-pretty* t) |
106 |
(#+sbcl (sb-ext::compiler-note #'muffle-warning) |
(#+sbcl (sb-ext::compiler-note #'muffle-warning) |
107 |
(warning #'muffle-warning)) |
(warning #'muffle-warning)) |
108 |
(compile nil form))) |
(compile nil form))) |
109 |
(r (make-array nil :element-type upgraded-result-type)) |
(result (if store-into-cell? |
110 |
(result (progn |
(let ((r (make-array nil :element-type upgraded-result-type))) |
111 |
;; (dotimes (i 100) (apply fn r param-vals)) |
(apply fn r param-vals) |
112 |
(apply fn r param-vals) |
(aref r)) |
113 |
(aref r)))) |
(apply fn param-vals)))) |
114 |
(setq *random-type-prop-result* |
(setq *random-type-prop-result* |
115 |
(list :upgraded-result-type upgraded-result-type |
(list :upgraded-result-type upgraded-result-type |
116 |
:form form |
:form form |