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

...

Browse Source 
original commit: 933015c8dc6d6ef7fc7407fe2c6af2d241cbfd8c
This commit is contained in:
Robby Findler 2003-01-22 00:01:19 +00:00
parent f7e5826d76
commit e818e2e345
1 changed files with 68 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
collects/tests/mzscheme/contracts.ss
View File

@ -32,7 +32,7 @@
(cond
[(regexp-match ": ([^ ]*) broke" result) => cadr]
[(regexp-match "([^ ]+): .* does not imply" result) => cadr]
[else "no blame in error message"])
[else (format "no blame in error message: \"~a\"" result)])
result)))
(printf "testing: ~s\n" name)
(test blame
@ -747,6 +747,73 @@
300)
"badguy")
(test/spec-passed/result
'contract-=>-case->1
'((contract-=> (case-> (integer? . -> . integer?)) (case-> (integer? . -> . integer?)) (case-lambda [(x) x]) 'badguy) 1)
1)
(test/spec-passed/result
'contract-=>-case->2
'((contract-=> (case->
(-> (>=/c 10) (>=/c 3))
(-> (>=/c 10) (>=/c 10) (>=/c 3)))
(case->
(-> (>=/c 3) (>=/c 10))
(-> (>=/c 3) (>=/c 3) (>=/c 10)))
(case-lambda
[(x) x]
[(x y) x])
'badguy)
100)
100)
(test/spec-passed/result
'contract-=>-case->3
'((contract-=> (case->
(-> (>=/c 10) (>=/c 3))
(-> (>=/c 10) (>=/c 10) (>=/c 3)))
(case->
(-> (>=/c 3) (>=/c 10))
(-> (>=/c 3) (>=/c 3) (>=/c 10)))
(case-lambda
[(x) x]
[(x y) x])
'badguy)
100
200)
100)
(test/spec-failed
'contract-=>-case->4
'((contract-=> (case->
(-> (>=/c 10) (>=/c 3))
(-> (>=/c 100) (>=/c 100) (>=/c 30)))
(case->
(-> (>=/c 3) (>=/c 10))
(-> (>=/c 30) (>=/c 30) (>=/c 100)))
(case-lambda
[(x) x]
[(x y) x])
'badguy)
8)
"badguy")
(test/spec-failed
'contract-=>-case->5
'((contract-=> (case->
(-> (>=/c 10) (>=/c 3))
(-> (>=/c 100) (>=/c 100) (>=/c 30)))
(case->
(-> (>=/c 3) (>=/c 10))
(-> (>=/c 30) (>=/c 30) (>=/c 100)))
(case-lambda
[(x) x]
[(x y) x])
'badguy)
80
80)
"badguy")
))
(report-errs)