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

fix bugs with error checking for ->* and ->

Browse Source 
closes 1997
This commit is contained in:
Robby Findler 2018-03-20 07:47:38 -05:00
parent 93e3b44fd2
commit c442e9707f
3 changed files with 35 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/racket-test/tests/racket/contract/arrow.rkt
View File

@ -683,4 +683,15 @@
(regexp-match? "a procedure that accepts the #:x keyword argument"
(exn-message e))))
(contract-syntax-error-test
'->-duplicate-keywords.1
#'(->* [] [#:a any/c #:a any/c] void?))
(contract-syntax-error-test
'->-duplicate-keywords.2
#'(->* [#:a any/c #:a any/c] [] void?))
(contract-error-test
'->-duplicate-keywords.3
#'(eval '(->* [#:a any/c] [#:a any/c] void?))
(λ (x) (and (exn:fail:syntax? x) (regexp-match #rx"->[*]: duplicate keyword" (exn-message x)))))
)

27
racket/collects/racket/contract/private/arr-util.rkt
View File

@ -94,17 +94,20 @@
(cond
[(null? lst) (list x)]
[else
(let ([fst-kwd (syntax-e (car (syntax-e (car lst))))]
[x-kwd (syntax-e (car (syntax-e x)))])
(cond
[(equal? x-kwd fst-kwd)
(raise-syntax-error #f
"duplicate keyword"
stx
(car x))]
[(keyword<? x-kwd fst-kwd)
(cons x lst)]
[else (cons (car lst) (insert x (cdr lst)))]))]))
(define fst-kwd-stx (car (syntax-e (car lst))))
(define fst-kwd (syntax-e fst-kwd-stx))
(define x-kwd-stx (car (syntax-e x)))
(define x-kwd (syntax-e x-kwd-stx))
(cond
[(equal? x-kwd fst-kwd)
(raise-syntax-error #f
"duplicate keyword"
stx
x-kwd-stx
(list fst-kwd-stx))]
[(keyword<? x-kwd fst-kwd)
(cons x lst)]
[else (cons (car lst) (insert x (cdr lst)))])]))
(let loop ([pairs kwd/ctc-pairs])
(cond
@ -120,4 +123,4 @@
(+ min-arg-length num-of-opts 1))
opt+man-dom-lengths)
man-kwds
opt-kwds))
opt-kwds))

9
racket/collects/racket/contract/private/arrow-val-first.rkt
View File

@ -588,6 +588,13 @@
(sort (map cons kwds kwd-args)
keyword<?
#:key (compose syntax-e car)))
(when (pair? sorted)
(for ([pr1 (in-list sorted)]
[pr2 (in-list (cdr sorted))])
(when (equal? (syntax-e (car pr1)) (syntax-e (car pr2)))
(raise-syntax-error #f "duplicate keyword" stx
(car pr1)
(list (car pr2))))))
(values (reverse regular-args)
(map car sorted)
(map cdr sorted)
@ -811,6 +818,8 @@
opt-dom-kwds
opt-lets)
(:split-doms stx '->* raw-optional-doms this->*)])
;; call sort-keywords for the duplicate variable check
(sort-keywords stx (append (syntax->list #'man-dom-kwds) (syntax->list #'opt-dom-kwds)))
(values
#'man-dom
#'man-dom-kwds