;;; @legal
;;; Copyright @copyright{} 2005 Neil W. Van Dyke.  This program is Free
;;; Software; you can redistribute it and/or modify it under the terms of the
;;; GNU Lesser General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at your option) any
;;; later version.  This program is distributed in the hope that it will be
;;; useful, but without any warranty; without even the implied warranty of
;;; merchantability or fitness for a particular purpose.  See
;;; @indicateurl{http://www.gnu.org/copyleft/lesser.html} for details.  For
;;; other license options and consulting, contact the author.
;;; @end legal

;;; @defsyntax testeez [ title ] form ...
;;;
;;; The @code{testeez} syntax contains a short string @var{title} and one or
;;; more @var{forms}, of the following syntaxes, which are evaluated in order.
;;;
;;; @table @code
;;;
;;; @item (test/equal @var{desc} @var{expr} @var{expected})
;;; Execute a test case.  @var{desc} is a short title or description of the
;;; test case, @var{expr} is a Scheme expression, and @var{expected} is an
;;; expression for the expected value (or multiple values).  The test case
;;; passes iff each value of @var{expr} is @code{equal?} to the corresponding
;;; value of @var{expected}.
;;;
;;; @item (test/eq @var{desc} @var{expr} @var{expected})
;;; Like @code{test/equal}, except the equivalence predicate is @code{eq?}
;;; rather than @code{equal?}.
;;;
;;; @item (test/eqv @var{desc} @var{expr} @var{expected})
;;; Like @code{test/equal}, except the equivalence predicate is @code{eqv?}
;;; rather than @code{equal?}.
;;;
;;; @item (test-define @var{desc} @var{name} @var{val})
;;; Bind a variable.  @var{desc} is a short description string, @var{name} is
;;; the identifier, and @var{val} is the value expression.  The binding is
;;; visible to the remainder of the enclosing @code{testeez} syntax.
;;;
;;; @item (test-eval @var{desc} @var{expr})
;;; Evaluate an expression.
;;;
;;; @item (@var{expr} @var{expected})
;;; Shorthand for @code{(test/equal "" @var{expr} @var{expected})}.  This
;;; shorthand is intended for interactive and rapid-prototyping use, not for
;;; released code.
;;;
;;; @end table

;; TODO: Lose the "begin"s.

;; TODO: Expose the custom equivalence predicates, once we're sure we like
;; the syntax.  Should add generic predicates first.

(module testeez (testeez
		 %testeez:start-test
		 %testeez:start-tests
		 %testeez:start-define
		 %testeez:start-eval
		 %testeez:body
		 %testeez:print-result
		 %testeez:finish-test
		 %testeez:finish-tests)
  (import scheme chicken)

  (include "testeez-support.scm")

(define-syntax %testeez:body
  (syntax-rules (test/eq test/equal test/eqv test-eval test-define)

    ((_ DATA-VAR
        (test/equiv DESC EXPR EXPECTED (PRED0 PRED1 ...))
        REST ...)
     ;; TODO: Maybe turn "(PRED0 PRED1 ...)" into a string so that
     ;; "%testeez:finish-test" can report the equivalence predicate(s) used.
     (begin (%testeez:start-test  DATA-VAR DESC (quote EXPR))
            (let ((result-list   (call-with-values (lambda () EXPR)     list))
                  (expected-list (call-with-values (lambda () EXPECTED) list)))
            (%testeez:finish-test DATA-VAR
                                  PRED0
                                  (quasiquote ((unquote PRED1) ...))
                                  result-list
                                  expected-list))
            (%testeez:body        DATA-VAR REST ...)))

    ((_ DATA-VAR (test/eq DESC EXPR EXPECTED) REST ...)
     (%testeez:body DATA-VAR
                    (test/equiv DESC EXPR EXPECTED (eq?))
                    REST ...))

    ((_ DATA-VAR (test/equal DESC EXPR EXPECTED) REST ...)
     (%testeez:body DATA-VAR
                    (test/equiv DESC EXPR EXPECTED (equal?))
                    REST ...))

    ((_ DATA-VAR (test/eqv DESC EXPR EXPECTED) REST ...)
     (%testeez:body DATA-VAR
                    (test/equiv DESC EXPR EXPECTED (eqv?))
                    REST ...))
     
    ((_ DATA-VAR (test-define DESC NAME VAL) REST ...)
     (begin (%testeez:start-define DESC
                                   (list 'define
                                         (quote NAME)
                                         (quote VAL)))
            (let ()
              (define NAME VAL)
              (%testeez:body DATA-VAR REST ...))))
    ((_ DATA-VAR (test-eval DESC EXPR) REST ...)
     (begin (%testeez:start-eval   DESC (quote EXPR))
            (let ((result (call-with-values (lambda () EXPR) list)))
              (%testeez:print-result result))
            (%testeez:body         DATA-VAR REST ...)))

    ((_             DATA-VAR (              EXPR EXPECTED) REST ...)
     (%testeez:body DATA-VAR (test/equal "" EXPR EXPECTED) REST ...))

    ((_ DATA-VAR) (if #f #f))))

(define-syntax testeez
  (syntax-rules (test/equal test-eval test-define)
    ((_ (X ...) BODY ...)
     (testeez #f (X ...) BODY ...))
    ((_ TITLE BODY ...)
     (let ((data (%testeez:start-tests TITLE)))
       (%testeez:body         data BODY ...)
       (%testeez:finish-tests data)))))

)