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

..

Browse Source 
original commit: ec3a138a83e9b5ab112f74c7024ce9488545dab7
This commit is contained in:
Robby Findler 2003-05-13 01:01:33 +00:00
parent b2ac2e69c5
commit ecdd92c040
2 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/mzlib/contract.ss
View File

@ -1401,7 +1401,7 @@
...
(check-contract dom-rest-x arg-rest-x neg-blame pos-blame src-info))))))
(lambda (body stx) (syntax (lambda x (error 'impl-contract "unimplemented for ->* (any case)"))))
(syntax (x (error 'impl-contract "unimplemented for ->* (any case)")))
(syntax ((dom-x ... . dom-rest-x) (error 'impl-contract "unimplemented for ->* (any case)")))
(syntax (lambda x (error 'impl-contract "unimplemented for ->* (any case)")))))]))
;; ->d/h : stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
@ -1454,9 +1454,9 @@
pos-blame
neg-blame
src-info))))))
(lambda (body stx) (syntax (lambda x (error 'impl-contract "unimplemented for ->d"))))
(syntax (x (error 'impl-contract "unimplemented for ->d")))
(syntax (lambda x (error 'impl-contract "unimplemented for ->d"))))))]))
(lambda (body stx) (syntax (lambda x (error 'impl-contract "unimplemented for ->d.1"))))
(syntax ((dom-x ...) (error 'impl-contract "unimplemented for ->d.2")))
(syntax (lambda x (error 'impl-contract "unimplemented for ->d.3"))))))]))
;; ->d*/h : stx -> (values (syntax -> syntax) (syntax -> syntax) (syntax -> syntax))
(define (->d*/h stx)
@ -1592,7 +1592,7 @@
rng-contracts
results))))))))))
(lambda (body stx) (syntax (lambda x (error 'impl-contract "unimplemented for ->d*"))))
(syntax (x (error 'impl-contract "unimplemented for ->d*")))
(syntax ((dom-x ...) (error 'impl-contract "unimplemented for ->d*")))
(syntax (lambda x (error 'impl-contract "unimplemented for ->d*")))))]))
;; select/h : syntax -> /h-function

15
collects/tests/mzscheme/contract-test.ss
View File

@ -39,6 +39,9 @@
ensure-contract-failed
expression))
(define (test/well-formed stx)
(expand stx))
(test/spec-passed
'contract-flat1
'(contract not #f 'pos 'neg))
@ -1105,6 +1108,18 @@
'pos
'neg)
'not-integer)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; case-> arity tests ;;
;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(test/well-formed #'(case-> (-> integer? integer?)))
(test/well-formed #'(case-> (-> integer? integer?) (-> integer? integer? integer?)))
(test/well-formed #'(case-> (-> integer? integer?) (-> integer? integer? any)))
(test/well-formed #'(case-> (-> integer? any) (-> integer? integer? any)))
(test/well-formed #'(case-> (integer? integer? . ->d . (lambda x integer?)) ((any?) any? . ->* . (any?))))
))