Permalink
Browse files

FOR-ALL: Deleting unreachable code

  • Loading branch information...
1 parent 68ebf88 commit f11b6a8ed8a7a54b40fda63a645fd73342433420 @adlai committed Dec 25, 2009
Showing with 0 additions and 211 deletions.
  1. +0 −211 src/random.lisp
View
@@ -1,211 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
-
-(in-package :Eos)
-
-(defparameter *num-trials* 100
- "Number of times we attempt to run the body of the FOR-ALL test.")
-
-(defparameter *max-trials* 10000
- "Number of total times we attempt to run the body of the
- FOR-ALL test including when the body is skipped due to failed
- guard conditions.
-
-Since we have guard conditions we may get into infinite loops
-where the test code is never run due to the guards never
-returning true. This second run limit prevents that.")
-
-(defmacro for-all (bindings &body body)
- "Bind BINDINGS to random variables and test BODY *num-trials* times.
-
-BINDINGS is a list of binding forms, each element is a list
-of (BINDING VALUE &optional GUARD). Value, which is evaluated
-once when the for-all is evaluated, must return a generator which
-be called each time BODY is evaluated. BINDING is either a symbol
-or a list which will be passed to destructuring-bind. GUARD is a
-form which, if present, stops BODY from executing when IT returns
-NIL. The GUARDS are evaluated after all the random data has been
-generated and they can refer to the current value of any
-binding. NB: Generator forms, unlike guard forms, can not contain
-references to the boud variables.
-
-Examples:
-
- (for-all ((a (gen-integer)))
- (is (integerp a)))
-
- (for-all ((a (gen-integer) (plusp a)))
- (is (integerp a))
- (is (plusp a)))
-
- (for-all ((less (gen-integer))
- (more (gen-integer) (< less more)))
- (is (<= less more)))
-
- (for-all (((a b) (gen-two-integers)))
- (is (integerp a))
- (is (integerp b)))"
- (with-gensyms (test-lambda-args)
- `(perform-random-testing
- (list ,@(mapcar #'second bindings))
- (lambda (,test-lambda-args)
- (destructuring-bind ,(mapcar #'first bindings) ,test-lambda-args
- (if (and ,@(delete-if #'null (mapcar #'third bindings)))
- (progn ,@body)
- (throw 'run-once (list :guard-conditions-failed))))))))
-
-(defun perform-random-testing (generators body)
- (loop
- :with random-state := *random-state*
- :with total-counter := *max-trials*
- :with counter := *num-trials*
- :with run-at-least-once := nil
- :until (or (zerop total-counter) (zerop counter))
- :do (let ((result (perform-random-testing/run-once generators body)))
- (ecase (first result)
- (:pass
- (decf counter)
- (decf total-counter)
- (setf run-at-least-once t))
- (:no-tests
- (add-result 'for-all-test-no-tests
- :reason "No tests"
- :random-state random-state)
- (return-from perform-random-testing nil))
- (:guard-conditions-failed
- (decf total-counter))
- (:fail
- (add-result 'for-all-test-failed
- :reason "Found failing test data"
- :random-state random-state
- :failure-values (second result)
- :result-list (third result))
- (return-from perform-random-testing nil))))
- :finally (if run-at-least-once
- (add-result 'for-all-test-passed)
- (add-result 'for-all-test-never-run
- :reason "Guard conditions never passed"))))
-
-(defun perform-random-testing/run-once (generators body)
- (catch 'run-once
- (bind-run-state ((result-list '()))
- (let ((values (mapcar #'funcall generators)))
- (funcall body values)
- (cond
- ((null result-list)
- (throw 'run-once (list :no-tests)))
- ((every #'test-passed-p result-list)
- (throw 'run-once (list :pass)))
- ((notevery #'test-passed-p result-list)
- (throw 'run-once (list :fail values result-list))))))))
-
-(defclass for-all-test-result ()
- ((random-state :initarg :random-state)))
-
-(defclass for-all-test-passed (test-passed for-all-test-result) ())
-
-(defclass for-all-test-failed (test-failure for-all-test-result)
- ((failure-values :initarg :failure-values)
- (result-list :initarg :result-list)))
-
-(defgeneric for-all-test-failed-p (object)
- (:method ((object for-all-test-failed)) t)
- (:method ((object t)) nil))
-
-(defmethod reason ((result for-all-test-failed))
- (format nil "Falsafiable with ~S" (slot-value result 'failure-values)))
-
-(defclass for-all-test-no-tests (test-failure for-all-test-result) ())
-
-(defclass for-all-test-never-run (test-failure for-all-test-result) ())
-
-(defun gen-integer (&key (max (1+ most-positive-fixnum))
- (min (1- most-negative-fixnum)))
- "Returns a generator which produces random integers greater
-than or equal to MIN and less than or equal to MIN."
- (lambda () (+ min (random (1+ (- max min))))))
-
-(defun gen-float (&key bound (type 'short-float))
- "Returns a generator which producs floats of type TYPE. BOUND,
-if specified, constrains the ruselts to be in the range (-BOUND,
-BOUND)."
- (lambda ()
- (let* ((most-negative (ecase type
- (short-float most-negative-short-float)
- (single-float most-negative-single-float)
- (double-float most-negative-double-float)
- (long-float most-negative-long-float)))
- (most-positive (ecase type
- (short-float most-positive-short-float)
- (single-float most-positive-single-float)
- (double-float most-positive-double-float)
- (long-float most-positive-long-float)))
- (bound (or bound (max most-positive (- most-negative)))))
- (coerce
- (ecase (random 2)
- (0 (random (min most-positive bound)))
- (1 (- (random (min (- most-negative) bound)))))
- type))))
-
-(defun gen-character (&key (code-limit char-code-limit)
- (code (gen-integer :min 0 :max (1- code-limit)))
- (alphanumericp nil))
- "Returns a generator of characters.
-
-CODE must be a generator of random integers. ALPHANUMERICP, if
-non-NIL, limits the returned chars to those which pass
-alphanumericp."
- (lambda ()
- (loop
- :for count :upfrom 0
- :for char := (code-char (funcall code))
- :until (and char
- (or (not alphanumericp)
- (alphanumericp char)))
- :when (= 1000 count)
- :do (error "After 1000 iterations ~S has still not generated ~:[a valid~;an alphanumeric~] character :(."
- code alphanumericp)
- :finally (return char))))
-
-(defun gen-string (&key (length (gen-integer :min 0 :max 80))
- (elements (gen-character))
- (element-type 'character))
- "Returns a generator which producs random strings. LENGTH must
-be a generator which producs integers, ELEMENTS must be a
-generator which produces characters of type ELEMENT-TYPE."
- (lambda ()
- (loop
- :with length := (funcall length)
- :with string := (make-string length :element-type element-type)
- :for index :below length
- :do (setf (aref string index) (funcall elements))
- :finally (return string))))
-
-(defun gen-list (&key (length (gen-integer :min 0 :max 10))
- (elements (gen-integer :min -10 :max 10)))
- "Returns a generator which producs random lists. LENGTH must be
-an integer generator and ELEMENTS must be a generator which
-producs objects."
- (lambda () (loop :repeat (funcall length) :collect (funcall elements))))
-
-(defun gen-tree (&key (size 20) (elements (gen-integer :min -10 :max 10)))
- "Returns a generator which producs random trees. SIZE control
-the approximate size of the tree, but don't try anything above
- 30, you have been warned. ELEMENTS must be a generator which
-will produce the elements."
- (labels ((rec (&optional (current-depth 0))
- (let ((key (random (+ 3 (- size current-depth)))))
- (cond ((> key 2)
- (list (rec (+ current-depth 1))
- (rec (+ current-depth 1))))
- (t (funcall elements))))))
- (lambda () (rec))))
-
-(defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
- (element-type '(unsigned-byte 8))
- (elements (gen-integer :min 0 :max (1- (expt 2 8)))))
- (lambda ()
- (let ((buffer (make-array (funcall length) :element-type element-type)))
- (map-into buffer elements))))
-
-(defun gen-one-element (&rest elements)
- (lambda () (nth (random (length elements)) elements)))

0 comments on commit f11b6a8

Please sign in to comment.