Skip to content
Snippets Groups Projects
Commit f558517a authored by pfdietz's avatar pfdietz
Browse files

Randomize optimization settings. Make storing into a zero-d array optional...

Randomize optimization settings.  Make storing into a zero-d array optional (and controlled by a keyword param)
parent 01041341
No related branches found
No related tags found
No related merge requests found
...@@ -25,6 +25,7 @@ ...@@ -25,6 +25,7 @@
(rest-type 'integer) (rest-type 'integer)
(reps 1000) (reps 1000)
(enclosing-the nil) (enclosing-the nil)
(cell t)
(test #'regression-test::equalp-with-case)) (test #'regression-test::equalp-with-case))
(assert (<= 1 minargs maxargs 20)) (assert (<= 1 minargs maxargs 20))
(dotimes (i reps) (dotimes (i reps)
...@@ -76,14 +77,22 @@ ...@@ -76,14 +77,22 @@
(member v '(nil t)))))) (member v '(nil t))))))
`(quote ,v) `(quote ,v)
v))))) v)))))
(speed (random 4))
(space (random 4))
(safety #-allegro (random 4)
#+allegro (1+ (random 3)))
(debug (random 4))
(store-into-cell? (and cell (coin)))
(form (form
`(lambda (r ,@params) `(lambda (,@(when store-into-cell? '(r)) ,@params)
(declare (optimize speed (safety 1)) (declare (optimize (speed ,speed) (safety ,safety) (debug ,debug) (space ,space))
(type (simple-array ,upgraded-result-type nil) r) ,@(when store-into-cell? `((type (simple-array ,upgraded-result-type nil) r)))
,@ type-decls) ,@ type-decls)
(setf (aref r) ,(let ((result-form
,(if enclosing-the `(the ,result-type ,expr) expr)) (if enclosing-the `(the ,result-type ,expr) expr)))
(values))) (if store-into-cell?
`(setf (aref r) ,result-form)
result-form))))
(*form* form)) (*form* form))
(when *print-random-type-prop-input* (when *print-random-type-prop-input*
(let ((*print-pretty* t) (let ((*print-pretty* t)
...@@ -97,11 +106,11 @@ ...@@ -97,11 +106,11 @@
(#+sbcl (sb-ext::compiler-note #'muffle-warning) (#+sbcl (sb-ext::compiler-note #'muffle-warning)
(warning #'muffle-warning)) (warning #'muffle-warning))
(compile nil form))) (compile nil form)))
(r (make-array nil :element-type upgraded-result-type)) (result (if store-into-cell?
(result (progn (let ((r (make-array nil :element-type upgraded-result-type)))
;; (dotimes (i 100) (apply fn r param-vals)) (apply fn r param-vals)
(apply fn r param-vals) (aref r))
(aref r)))) (apply fn param-vals))))
(setq *random-type-prop-result* (setq *random-type-prop-result*
(list :upgraded-result-type upgraded-result-type (list :upgraded-result-type upgraded-result-type
:form form :form form
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment