;; -*- lisp -*-

(in-package :it.bese.FiveAM)

;;;; * Random (QuickCheck-ish) testing

;;;; FiveAM provides the ability to automatically generate a
;;;; collection of random input data for a specific test and run a
;;;; test multiple times.

;;;; Specification testing is done through the FOR-ALL macro. This
;;;; macro will bind variables to random data and run a test body a
;;;; certain number of times. Should the test body ever signal a
;;;; failure we stop running and report what values of the variables
;;;; caused the code to fail.

(defmacro for-all (bindings &body body)
  `(perform-random-testing
    (list ,@(mapcar #'second bindings))
    (lambda ,(mapcar #'first bindings)
      (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 = 1000
     with counter = 100
     until (zerop counter)
     do (let ((result (perform-random-testing/run-once generators body)))
          (ecase (first result)
            (:pass
             (decf counter)
             (decf total-counter))
            (: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 (add-result 'for-all-test-passed)))

(defun perform-random-testing/run-once (generators body)
  (catch 'run-once
    (bind-run-state ((result-list '()))
      (let ((values (mapcar #'funcall generators)))
        (apply 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))

(defclass for-all-test-no-tests (test-failure for-all-test-result)
  ())

(defmethod reason ((result for-all-test-failed))
  (format nil "Falsafiable with ~S" (slot-value result 'failure-values)))

;;;; ** Generators.

;;;; Since this is random testing we need some way of creating random
;;;; data to feed to our code. Generators are regular functions whcih
;;;; create this random data.

;;;; We provide a set of built-in generators.

(defmacro defgenerator (name arguments &body body)
  `(defun ,name ,arguments
     (lambda () ,@body)))

(defgenerator gen-integer (&key (max (1+ most-positive-fixnum))
                                (min (1+ most-negative-fixnum)))
  (+ min (random (1+ (- max min)))))

(defgenerator gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit))))
  (code-char (funcall code)))

(defun gen-string (&key
                   (length (gen-integer :min 0 :max 80))
                   (elements (gen-character))
                   (element-type 'character))
  (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)))
  (lambda ()
    (loop
       repeat (funcall length)
       collect (funcall elements))))

;;;; The trivial always-produce-the-same-thing generator is done using
;;;; cl:constantly.