nendo 0.5.3 → 0.5.4

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
data/lib/nendo/test.nnd CHANGED
@@ -2,7 +2,7 @@
2
2
  ;;;
3
3
  ;;; nendo.test - test framework
4
4
  ;;;
5
- ;;; Copyright (c) 2000-2009 Shiro Kawai <shiro@acm.org>
5
+ ;;; Copyright (c) 2000-2010 Shiro Kawai <shiro@acm.org>
6
6
  ;;;
7
7
  ;;; Redistribution and use in source and binary forms, with or without
8
8
  ;;; modification, are permitted provided that the following conditions
@@ -31,10 +31,28 @@
31
31
  ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
32
32
  ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33
33
  ;;;
34
- ;;; $Id: test.scm,v 1.29 2008-05-10 13:35:56 shirok Exp $
35
- ;;
36
34
  ;; ported by Kiyoka Nishiyama for Nendo.
37
35
  ;;
36
+ (define (test-error? obj) (obj.is_a? Nendo::NendoTestError))
37
+
38
+ (define (test-error . maybe-class)
39
+ (let ([cl (get-optional maybe-class #f)]
40
+ [err (. Nendo::NendoTestError new)])
41
+ (when cl
42
+ (set! err.type cl))
43
+ err))
44
+
45
+
46
+ (define (test-check expected result)
47
+ (cond [(test-error? expected)
48
+ (and (test-error? result)
49
+ (let ([ex (expected.type)]
50
+ [ey (result.type)])
51
+ (and ex
52
+ (eq? ex ey))))]
53
+ [else (equal? expected result)]))
54
+
55
+
38
56
  ;; List of discrepancies
39
57
  (define *test-record-file* "test.record")
40
58
  (define *test-output-file* STDOUT)
@@ -44,6 +62,7 @@
44
62
  (define (test-output-file file) (set! *test-output-file* file)) ;;putlic API
45
63
 
46
64
  (define *test-counts* (vector 0 0 0 0))
65
+
47
66
  (define (test-count++)
48
67
  (vector-set! *test-counts* 0 (+ (vector-ref *test-counts* 0) 1)))
49
68
  (define (test-pass++)
@@ -85,14 +104,17 @@
85
104
  (f.printf "%s" (format-summary)))
86
105
  "w")))
87
106
 
88
- (define (test msg expect thunk . compare)
89
- (let ((cmp (get-optional compare equal?))
107
+ ;; Tests ------------------------------------------------------------
108
+
109
+ (define (prim-test msg expect thunk . compare)
110
+ (let ((cmp (if (pair? compare) (car compare) test-check))
90
111
  (f *test-output-file*))
91
112
  (f.printf "test %s, expects %s ==> " msg (write-to-string expect))
92
113
  (f.flush)
93
114
  (test-count++)
94
- (let ((r (thunk)))
95
- (cond ((cmp expect r)
115
+ (let* ([r (thunk)]
116
+ [ret (cmp expect r)])
117
+ (cond (ret
96
118
  (f.printf "ok\n")
97
119
  (test-pass++))
98
120
  (else
@@ -101,7 +123,17 @@
101
123
  (cons (list msg expect r) *discrepancy-list*))
102
124
  (test-fail++)))
103
125
  (f.flush)
104
- #t)))
126
+ ret)))
127
+
128
+
129
+ ;; Normal test.
130
+ (define (test msg expect thunk . compare)
131
+ (apply prim-test msg expect
132
+ (lambda ()
133
+ (guard (exc (else
134
+ (Nendo::NendoTestError.new (exc.class))))
135
+ (thunk)))
136
+ compare))
105
137
 
106
138
  ;; A convenient macro version
107
139
  (define test*