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

raco {pkg,planet} <subcommand>: improve error for ambiguous <subcommand>

Browse Source 
Report a user error instead of an internal error.

Closes PR 14969
This commit is contained in:
Matthew Flatt 2015-02-08 06:06:06 -07:00
parent be8f70fffb
commit 8e8c9842fa
2 changed files with 22 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
racket/collects/planet/private/command.rkt
View File

@ -68,6 +68,17 @@
(values "help" '())
(values (car argslist) (cdr argslist)))])
(prefix-case the-command
#:ambiguous (lambda (opts)
(raise-user-error
(string->symbol (format "~a ~a" p the-command))
(string-append "does not identify a unique subcommand;\n"
" please use a longer name for the intended subcommand\n"
" given: " the-command "\n"
" subcommands with a matching prefix:"
(apply
string-append
(for/list ([opt (in-list opts)])
(format "\n ~a" opt))))))
[n
(parameterize ([current-svn-style-command n])
(command-line

15
racket/collects/planet/private/prefix-dispatcher.rkt
View File

@ -104,15 +104,15 @@
(syntax-case stx ()
[(_ elt
clause ...)
#:ambiguous amb-handler
clause ...)
(let* ([clauses (syntax-e #'(clause ...))]
[else-clauses (filter else? clauses)]
[amb-clauses (filter amb? clauses)]
[rest (filter (λ (x) (not (or (else? x) (amb? x)))) clauses)]
[else (extract-clause "else" else-clauses else-clause->body
#'(error 'prefix-case "element ~e was not a prefix" e))]
[amb (extract-clause "ambiguous" amb-clauses amb-clause->body
#'(λ (opts) (error 'prefix-case "element matches more than one option: ~s" opts)))])
[amb (extract-clause "ambiguous" amb-clauses amb-clause->body #'amb-handler)])
(with-syntax ([else-clause else]
[amb-clause amb]
[((option result) ...) rest])
@ -121,4 +121,11 @@
[exn:unknown-command?
(λ (e) else-clause)])
(((get-prefix-dispatcher (list (list option (λ () result)) ...))
elt)))))]))
elt)))))]
[(_ elt clause ...) (syntax/loc stx
(prefix-case elt
#:ambiguous (λ (opts)
(error 'prefix-case
"element matches more than one option: ~s"
opts))
clause ...))]))