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