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