original commit: 9938d751d72e7a6acec582e8500a4cc53ba50619
This commit is contained in:
Matthew Flatt 2001-01-06 15:21:29 +00:00
parent ca617eea1e
commit f68a6d0b7c

View File

@ -3,6 +3,7 @@
(load-relative "testing.ss")) (load-relative "testing.ss"))
(SECTION 'unit) (SECTION 'unit)
(import (lib "unit.ss"))
(syntax-test '(unit)) (syntax-test '(unit))
(syntax-test '(unit (import))) (syntax-test '(unit (import)))
@ -34,10 +35,6 @@
(syntax-test '(unit (import i) (export b a) (begin (define a 5) (define b 6) . x))) (syntax-test '(unit (import i) (export b a) (begin (define a 5) (define b 6) . x)))
(syntax-test '(unit (import i) (export b a) (begin (define a 5) (define b 6)) (define b 6))) (syntax-test '(unit (import i) (export b a) (begin (define a 5) (define b 6)) (define b 6)))
(syntax-test '(unit (import #%car) (export) (define a 5)))
(syntax-test '(unit (import) (export #%car) (define a 5)))
(syntax-test '(unit (import) (export #%car) (define #%car 5)))
(syntax-test '(unit (import) (export) (define #%car 5)))
(syntax-test '(unit (import) (export) (define-values (3) 5))) (syntax-test '(unit (import) (export) (define-values (3) 5)))
(syntax-test '(unit (import a) (export (a x) b) (define a 5) (define b 6))) (syntax-test '(unit (import a) (export (a x) b) (define a 5) (define b 6)))
@ -57,7 +54,6 @@
(syntax-test '(unit (import i) (export (a x) b) (define x 5) (define b 6))) (syntax-test '(unit (import i) (export (a x) b) (define x 5) (define b 6)))
(syntax-test '(unit (import i) (export (a x) b) (set! a 5) (define b 6))) (syntax-test '(unit (import i) (export (a x) b) (set! a 5) (define b 6)))
(syntax-test '(unit (import i) (export) (set! g 5)))
(syntax-test '(unit (import i) (export) (set! i 5))) (syntax-test '(unit (import i) (export) (set! i 5)))
; Empty exports are syntactically ok:: ; Empty exports are syntactically ok::
@ -77,12 +73,7 @@
(U b))]) (U b))])
(export)))) (export))))
(error-test '(invoke-unit (unit (import not-defined) (export) 10) not-defined) exn:unit?) (error-test '(invoke-unit (unit (import not-defined) (export) 10) not-defined) exn:variable?)
(unless (defined? 'test-global-var)
(let ()
(define test-global-var 5)
(syntax-test '(unit (import) (export) test-global-var))))
(test #t unit? (unit (import) (export))) (test #t unit? (unit (import) (export)))
(test #t unit? (unit (import) (export) 5)) (test #t unit? (unit (import) (export) 5))
@ -232,10 +223,10 @@
(M x v struct:a y x? make-x x-z both))]) (M x v struct:a y x? make-x x-z both))])
(export))) (export)))
(test (string-append "(5 #(struct:a 5 6) #<struct-type> (proc: y)" (test (string-append "(5 #<struct:a> #<struct-type> (proc: y)"
" (proc: make-x) (proc: x?)" " (proc: make-x) (proc: x?)"
" (proc: x-z) (proc: both))" " (proc: x-z) (proc: both))"
"(5 #t #(struct:a 5 6) #t #f #(struct:x 1 2 3 4) #t #t #f #t)") "(5 #t #<struct:a> #t #f #<struct:x> #t #t #f #t)")
get-output-string p)) get-output-string p))
; Compound with circularity ; Compound with circularity
@ -286,7 +277,7 @@
; Import linking via invoke-unit ; Import linking via invoke-unit
(test '(5 7 (7 2)) 'invoke-unit-linking (test '(5 7 (7 7)) 'invoke-unit-linking
(let ([u (unit (import x) (export) x)] (let ([u (unit (import x) (export) x)]
[v (unit (import x) (export) (lambda () x))] [v (unit (import x) (export) (lambda () x))]
[x 5]) [x 5])
@ -325,18 +316,10 @@
(test 5 'invoke-unit-in-unit (invoke-unit u2)) (test 5 'invoke-unit-in-unit (invoke-unit u2))
(syntax-test '(define u
(invoke-unit
(unit
(import) (export)
(define x 10)
x
(unit (import) (export)
apple
x)))))
; Units and objects combined: ; Units and objects combined:
(import (lib "class.ss"))
(define u@ (define u@
(unit (import x) (export) (unit (import x) (export)
(class* object% () () (class* object% () ()
@ -445,14 +428,13 @@
(import) (import)
(export b) (export b)
(define a 'a) (define a 'a)
(define b 'tmp-b) (define b 'b)
(begin (begin
(define c 'c) (define c 'c)
(define-struct d (w))) (define-struct d (w)))
(define x '...) (define x '...)
(define-struct (e struct:d) ()) (define-struct (e struct:d) ())
(set! b 'b)
(set! x (cons c c)) (set! x (cons c c))
(define i (interface ())) (define i (interface ()))