diff --git a/run-random-type-tests.lisp b/run-random-type-tests.lisp index df6c4b7e3e076ca06b6ee27e2f746bf88c0c07df..1afea11b4a741e56074877e477f516fc1507144a 100644 --- a/run-random-type-tests.lisp +++ b/run-random-type-tests.lisp @@ -51,18 +51,41 @@ test-types shows the error for every pair |# (in-package :cl-test) -(let ((*random-state* (make-random-state t))) - (handler-bind ((style-warning #'muffle-warning)) - (test-random-integer-forms 4 4 10000))) - -#+no -(let ((failures (test-random-mutated-types 30000 10 :reps 2))) - (when failures - (mapcar #'prune-type-pair failures))) +#+asdf +(defun get-env-parameter (parameter) + (uiop:getenv parameter)) + +#-asdf +(defun get-env-parameter (parameter) + #+(or abcl clasp clisp ecl xcl) (ext:getenv parameter) + #+sbcl (sb-ext:posix-getenv parameter) + #+clozure (ccl:getenv parameter) + ) + +(defun get-env-parameter-as-number (parameter) + (let ((value (get-env-parameter parameter))) + (if value + (parse-integer value) + nil))) + +(let* ((default-size 20) + (default-variables 4) + (default-iterations 10000) + (actual-size (or (get-env-parameter-as-number "random_int_size") default-size)) + (actual-variables (or (get-env-parameter-as-number "random_int_variables") default-variables)) + (actual-iterations (or (get-env-parameter-as-number "random_int_iterations") default-iterations)) + (*random-state* (make-random-state t))) + (handler-bind ((style-warning #'muffle-warning)) + (format t "Running test-random-integer-forms with size: ~a variables: ~a iterations: ~a on implementation ~a ~%" + actual-size actual-variables actual-iterations (lisp-implementation-type)) + (test-random-integer-forms actual-size actual-variables actual-iterations))) #| 4) Additional testing can be done with test-types and test-type-triples. The latter has its own pruner, prune-type-triple. +(let ((failures (test-random-mutated-types 30000 10 :reps 2))) + (when failures + (mapcar #'prune-type-pair failures))) (let ((failures (test-random-types 30000 10))) (when failures @@ -71,15 +94,4 @@ test-types shows the error for every pair (let ((failures (test-random-types3 30000 10))) (when failures (mapcar #'prune-type-triple failures))) - -Bonus: The well known random tester - -(let ((*random-state* (make-random-state t))) - (handler-bind ((style-warning #'muffle-warning)) - (test-random-integer-forms 10 4 10000))) - -(time - (let ((*random-state* (make-random-state t))) - (handler-bind ((style-warning #'muffle-warning)) - (cl-test::test-random-integer-forms 30 4 10000)))) |#