1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber
; The barest skeleton of a test suite for some stuff in the compiler
(user '(open test-suites))
(config '(run
(define-structure bar (export bench-tests)
(open scheme test-suites))))
(in 'bar '(run (define-test-suite bench-tests)))
(in 'bar '(bench off))
(in 'bar '(run (define (foo) (cadr '(a b)))))
(in 'bar '(run (define cadr list)))
(in 'bar '(run (define-test-case non-bench bench-tests (check (foo) => '((a b))))))
(in 'bar '(bench on))
(in 'bar '(run (define (baz) (car '(a b)))))
(in 'bar '(run (define car list)))
(in 'bar '(run (define-test-case bench bench-tests (check (baz) => 'a))))
(user '(open bar))
(config '(run
(define-structure test1 (export test1-tests x)
(open scheme test-suites)
(begin (define-test-suite test1-tests)
(define x 10)
(define (z) x)))))
(config '(run
(define-structure test2 (export test2-tests)
(open scheme test1 test-suites)
(begin (define-test-suite test2-tests)
(define (z) x)))))
(config '(run
(define-structure test3 (export test3-tests)
(open scheme test1 test-suites)
(begin (define-test-suite test3-tests)
(define (z) x)))))
(load-package 'test2)
(load-package 'test3)
(in 'test3 '(run (define x 20)))
(in 'test3 '(open test2))
(in 'test2 '(run (define-test-case shadowing2 test2-tests (check (z) => 10))))
(in 'test3 '(run (define-test-case shadowing3 test3-tests (check (z) => 20))))
(in 'test1 '(run (define-test-case shadowing1 test1-tests (check (z) => 10))))
(user '(open test1 test2 test3))
(user '(run (define-test-suite compiler-tests (bench-tests
test1-tests test2-tests test3-tests))))
|
