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

fixed first half of PR 11185

Browse Source
This commit is contained in:
Robby Findler 2010-09-11 07:11:21 -05:00
parent 078c9e26f4
commit d8a495de94
3 changed files with 30 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/racket/contract/private/arr-i-parse.rkt
View File

@ -344,8 +344,8 @@ code does the parsing and validation of the syntax.
(for-each (λ (x) (check-id stx x))
(syntax->list #'(id2 ...)))
(values (arg/res #'id
(syntax->list #'(id2 ...))
#'rest-expr)
(syntax->list #'(id2 ...))
#'rest-expr)
#'leftover))]
[(#:rest other . leftover)
(raise-syntax-error #f "expected an id+ctc"
@ -398,12 +398,6 @@ code does the parsing and validation of the syntax.
[_
(raise-syntax-error #f "bad syntax" stx)])))
;(define (ensure-no-cycles istx)
; (let (;; cm : id -o> {'pending, 'no-cycle}
; [cm (make-free-identifier-map)])
; (for ([dom (in-list (istx-args istx))])
; (let loop ([id (
(provide
parse-->i
(struct-out istx)

2
collects/racket/contract/private/arr-i.rkt
View File

@ -745,7 +745,7 @@
#,(if (istx-rst an-istx)
(if (arg/res-vars (istx-rst an-istx))
`(dep ,(syntax-e (arg/res-var (istx-rst an-istx)))
,(syntax-e (arg/res-vars (istx-rst an-istx))))
,(map syntax-e (arg/res-vars (istx-rst an-istx))))
`(nodep ,(syntax-e (arg/res-var (istx-rst an-istx)))))
#f)
#,(and (istx-pre an-istx) (map syntax-e (pre/post-vars (istx-pre an-istx))))

27
collects/tests/racket/contract-test.rktl
View File

@ -2162,6 +2162,33 @@
m 1)
1)
(test/spec-passed/result
'->i28
'((contract (->i ([x real?])
#:rest [rest (x) (listof (>=/c x))]
any)
(λ (x . rest)
(cons x rest))
'pos
'neg)
1
2
3)
'(1 2 3))
(test/neg-blame
'->i29
'((contract (->i ([x real?])
#:rest [rest (x) (listof (>=/c x))]
any)
(λ (x . rest)
(cons x rest))
'pos
'neg)
1
-2
-3))
(test/spec-passed
'->i-any1
'((contract (->i () () any) (lambda () 1) 'pos 'neg)))