From 8e8c9842fa964ececd52640c4c45e46afeb5f3f9 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 8 Feb 2015 06:06:06 -0700
Subject: [PATCH] raco {pkg,planet} <subcommand>: improve error for ambiguous
 <subcommand>

Report a user error instead of an internal error.

Closes PR 14969
---
 racket/collects/planet/private/command.rkt        | 11 +++++++++++
 .../collects/planet/private/prefix-dispatcher.rkt | 15 +++++++++++----
 2 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/racket/collects/planet/private/command.rkt b/racket/collects/planet/private/command.rkt
index c36d5c9a96..8c262b4099 100644
--- a/racket/collects/planet/private/command.rkt
+++ b/racket/collects/planet/private/command.rkt
@@ -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 
diff --git a/racket/collects/planet/private/prefix-dispatcher.rkt b/racket/collects/planet/private/prefix-dispatcher.rkt
index 4aa48d88ab..a53bdb677e 100644
--- a/racket/collects/planet/private/prefix-dispatcher.rkt
+++ b/racket/collects/planet/private/prefix-dispatcher.rkt
@@ -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 ...))]))