source: project/release/4/testeez/testeez.scm @ 11917

Last change on this file since 11917 was 11917, checked in by felix winkelmann, 13 years ago

testeez and numbers fixes; still have to be tested

File size: 5.0 KB
Line 
1;;; @legal
2;;; Copyright @copyright{} 2005 Neil W. Van Dyke.  This program is Free
3;;; Software; you can redistribute it and/or modify it under the terms of the
4;;; GNU Lesser General Public License as published by the Free Software
5;;; Foundation; either version 2.1 of the License, or (at your option) any
6;;; later version.  This program is distributed in the hope that it will be
7;;; useful, but without any warranty; without even the implied warranty of
8;;; merchantability or fitness for a particular purpose.  See
9;;; @indicateurl{http://www.gnu.org/copyleft/lesser.html} for details.  For
10;;; other license options and consulting, contact the author.
11;;; @end legal
12
13;;; @defsyntax testeez [ title ] form ...
14;;;
15;;; The @code{testeez} syntax contains a short string @var{title} and one or
16;;; more @var{forms}, of the following syntaxes, which are evaluated in order.
17;;;
18;;; @table @code
19;;;
20;;; @item (test/equal @var{desc} @var{expr} @var{expected})
21;;; Execute a test case.  @var{desc} is a short title or description of the
22;;; test case, @var{expr} is a Scheme expression, and @var{expected} is an
23;;; expression for the expected value (or multiple values).  The test case
24;;; passes iff each value of @var{expr} is @code{equal?} to the corresponding
25;;; value of @var{expected}.
26;;;
27;;; @item (test/eq @var{desc} @var{expr} @var{expected})
28;;; Like @code{test/equal}, except the equivalence predicate is @code{eq?}
29;;; rather than @code{equal?}.
30;;;
31;;; @item (test/eqv @var{desc} @var{expr} @var{expected})
32;;; Like @code{test/equal}, except the equivalence predicate is @code{eqv?}
33;;; rather than @code{equal?}.
34;;;
35;;; @item (test-define @var{desc} @var{name} @var{val})
36;;; Bind a variable.  @var{desc} is a short description string, @var{name} is
37;;; the identifier, and @var{val} is the value expression.  The binding is
38;;; visible to the remainder of the enclosing @code{testeez} syntax.
39;;;
40;;; @item (test-eval @var{desc} @var{expr})
41;;; Evaluate an expression.
42;;;
43;;; @item (@var{expr} @var{expected})
44;;; Shorthand for @code{(test/equal "" @var{expr} @var{expected})}.  This
45;;; shorthand is intended for interactive and rapid-prototyping use, not for
46;;; released code.
47;;;
48;;; @end table
49
50;; TODO: Lose the "begin"s.
51
52;; TODO: Expose the custom equivalence predicates, once we're sure we like
53;; the syntax.  Should add generic predicates first.
54
55(module testeez (testeez
56                 %testeez:start-test
57                 %testeez:start-tests
58                 %testeez:start-define
59                 %testeez:start-eval
60                 %testeez:body
61                 %testeez:print-result
62                 %testeez:finish-test
63                 %testeez:finish-tests))
64  (import scheme chicken)
65
66  (include "testeez-support.scm")
67
68(define-syntax %testeez:body
69  (syntax-rules (test/eq test/equal test/eqv test-eval test-define)
70
71    ((_ DATA-VAR
72        (test/equiv DESC EXPR EXPECTED (PRED0 PRED1 ...))
73        REST ...)
74     ;; TODO: Maybe turn "(PRED0 PRED1 ...)" into a string so that
75     ;; "%testeez:finish-test" can report the equivalence predicate(s) used.
76     (begin (%testeez:start-test  DATA-VAR DESC (quote EXPR))
77            (let ((result-list   (call-with-values (lambda () EXPR)     list))
78                  (expected-list (call-with-values (lambda () EXPECTED) list)))
79            (%testeez:finish-test DATA-VAR
80                                  PRED0
81                                  (quasiquote ((unquote PRED1) ...))
82                                  result-list
83                                  expected-list))
84            (%testeez:body        DATA-VAR REST ...)))
85
86    ((_ DATA-VAR (test/eq DESC EXPR EXPECTED) REST ...)
87     (%testeez:body DATA-VAR
88                    (test/equiv DESC EXPR EXPECTED (eq?))
89                    REST ...))
90
91    ((_ DATA-VAR (test/equal DESC EXPR EXPECTED) REST ...)
92     (%testeez:body DATA-VAR
93                    (test/equiv DESC EXPR EXPECTED (equal?))
94                    REST ...))
95
96    ((_ DATA-VAR (test/eqv DESC EXPR EXPECTED) REST ...)
97     (%testeez:body DATA-VAR
98                    (test/equiv DESC EXPR EXPECTED (eqv?))
99                    REST ...))
100     
101    ((_ DATA-VAR (test-define DESC NAME VAL) REST ...)
102     (begin (%testeez:start-define DESC
103                                   (list 'define
104                                         (quote NAME)
105                                         (quote VAL)))
106            (let ()
107              (define NAME VAL)
108              (%testeez:body DATA-VAR REST ...))))
109    ((_ DATA-VAR (test-eval DESC EXPR) REST ...)
110     (begin (%testeez:start-eval   DESC (quote EXPR))
111            (let ((result (call-with-values (lambda () EXPR) list)))
112              (%testeez:print-result result))
113            (%testeez:body         DATA-VAR REST ...)))
114
115    ((_             DATA-VAR (              EXPR EXPECTED) REST ...)
116     (%testeez:body DATA-VAR (test/equal "" EXPR EXPECTED) REST ...))
117
118    ((_ DATA-VAR) (if #f #f))))
119
120(define-syntax testeez
121  (syntax-rules (test/equal test-eval test-define)
122    ((_ (X ...) BODY ...)
123     (testeez #f (X ...) BODY ...))
124    ((_ TITLE BODY ...)
125     (let ((data (%testeez:start-tests TITLE)))
126       (%testeez:body         data BODY ...)
127       (%testeez:finish-tests data)))))
128
129)
Note: See TracBrowser for help on using the repository browser.