;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                  ;;;
;;; Free Software published under an MIT-like license. See LICENSE   ;;;
;;;                                                                  ;;;
;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
;;;                                                                  ;;;
;;; Original author: Scott McKay                                     ;;;
;;;                                                                  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "PROTO-TEST")


;;; Ultra light-weight test framework

(defmacro define-test (test-name () &body body)
  `(defun ,test-name ()
     (handler-case
         (progn ,@body)
       (error (e)
         (warn "An error was signalled executing ~S: ~A"
               ',test-name e)))))

(defmacro define-test-suite (suite-name () &body body)
  (if (listp (car body))
    ;; QRes-style body
    `(defun ,suite-name ()
       ,@(loop for test in (car body)
               collect (list test)))
    ;; The more sensible style
    `(defun ,suite-name ()
       ,@(loop for test in body
               collect (list test)))))

(defvar *all-registered-tests* ())
(defmacro register-test (test-name)

  `(pushnew ,test-name *all-registered-tests*))

(defmacro run-test (test-name)
  `(progn
     (format t "~&Running test ~A" ',test-name)
     (funcall ',test-name)))

(defun run-all-tests ()
  (dolist (test *all-registered-tests*)
    (format t "~&Running test ~A" test)

    (funcall test))
  (fresh-line))

(defmacro assert-equal (actual expected &key (test '#'equal))
  `(unless (funcall ,test ,actual ,expected)

     (warn "The value of ~S (~S) is not equal to the expected value ~S"
           ',actual ,actual ,expected)))

(defmacro assert-true (form)
  `(unless ,form

     (warn "The value of ~S (~S) does not evaluate to 'true'"
           ',form ,form)))

(defmacro assert-false (form)
  `(when ,form

     (warn "The value ~S (~S) does not evaluate to 'false'"
           ',form ,form)))