suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

..

Browse Source 
original commit: ec3762197e3b61193537c93239c3fc131e74d9f7
This commit is contained in:
Robby Findler 2002-02-25 15:51:51 +00:00
parent f9487db937
commit dc9419b3c5
1 changed files with 57 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
collects/tests/framework/spec-test.ss
View File

@ -19,7 +19,7 @@
(test name
(lambda (x)
(and (string? x)
(let ([m (regexp-match "blame ([^:]*):" x)])
(let ([m (regexp-match "blame: ([^;]*);" x)])
(equal? (cadr m) blame))))
(lambda ()
(send-sexp-to-mred `(with-handlers ([(lambda (x) (and (not-break-exn? x) (exn? x)))
@ -145,7 +145,7 @@
(test/spec-failed
'contract-d-protect-shared-state
'(let ([x 1])
((contract (((lambda () #t) . ->d . (lambda () (let ([pre-x 1]) (lambda (res) (= x pre-x)))))
((contract ((->d (lambda () (let ([pre-x x]) (lambda (res) (= x pre-x)))))
. -> .
(lambda (x) #t))
(lambda (thnk) (thnk))
@ -154,6 +154,61 @@
(lambda () (set! x 2))))
"neg")
(test/spec-passed
'contract-arrow-star1
'(let-values ([(a b) ((contract (->* (integer?) (integer? integer?))
(lambda (x) (values x x))
'pos
'neg)
2)])
1))
(test/spec-failed
'contract-arrow-star2
'((contract (->* (integer?) (integer? integer?))
(lambda (x) (values x x))
'pos
'neg)
#f)
"neg")
(test/spec-failed
'contract-arrow-star3
'((contract (->* (integer?) (integer? integer?))
(lambda (x) (values 1 #t))
'pos
'neg)
1)
"pos")
(test/spec-failed
'contract-arrow-star4
'((contract (->* (integer?) (integer? integer?))
(lambda (x) (values #t 1))
'pos
'neg)
1)
"pos")
(test/spec-failed
'combo1
'(let ([cf (contract (case->
((class? . ->d . (lambda (%) (lambda (x) #f))) . -> . void?)
((class? . ->d . (lambda (%) (lambda (x) #f))) boolean? . -> . void?))
(letrec ([c% (class object% (super-instantiate ()))]
[f
(case-lambda
[(class-maker) (f class-maker #t)]
[(class-maker b)
(class-maker c%)
(void)])])
f)
'pos
'neg)])
(cf (lambda (x%) 'going-to-be-bad)))
"neg")
)