From f371032a34e562ca3a543fe3ed6d06f62f27356b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 20 Aug 2013 15:46:04 -0600
Subject: [PATCH] protect package-source parsing against non-path strings

---
 pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt |  8 ++++++++
 racket/collects/pkg/name.rkt                          | 10 +++++++---
 2 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt
index daef5840bf..597a2a2c6f 100644
--- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt
@@ -79,6 +79,14 @@
 
   (check-equal-values? (package-source->name+type "random://racket-lang.org/fish.plt" #f) (values #f #f))
 
+  (check-equal-values? (package-source->name+type "" #f) (values #f #f))
+  (check-equal-values? (package-source->name+type "" 'file) (values #f 'file))
+  (check-equal-values? (package-source->name+type "" 'link) (values #f 'link))
+  (check-equal-values? (package-source->name+type "" 'static-link) (values #f 'static-link))
+  (check-equal-values? (package-source->name+type "" 'file-url) (values #f 'file-url))
+  (check-equal-values? (package-source->name+type "" 'dir-url) (values #f 'dir-url))
+  (check-equal-values? (package-source->name+type "" 'github) (values #f 'github))
+
   (void))
 
 (provide run-pkg-tests)
diff --git a/racket/collects/pkg/name.rkt b/racket/collects/pkg/name.rkt
index fc85199b04..f1b1505e4b 100644
--- a/racket/collects/pkg/name.rkt
+++ b/racket/collects/pkg/name.rkt
@@ -46,15 +46,19 @@
           (eq? type 'file)
           (and (path-string? s)
                (regexp-match rx:archive s)))
-      (define-values (base name+ext dir?) (split-path s))
-      (define name (extract-archive-name name+ext))
+      (define-values (base name+ext dir?) (if (path-string? s)
+                                              (split-path s)
+                                              (values #f #f #f)))
+      (define name (and name+ext (extract-archive-name name+ext)))
       (values name 'file)]
      [(if type
           (or (eq? type 'dir) 
               (eq? type 'link)
               (eq? type 'static-link))
           (path-string? s))
-      (define-values (base name dir?) (split-path s))
+      (define-values (base name dir?) (if (path-string? s)
+                                          (split-path s)
+                                          (values #f #f #f)))
       (define dir-name (and (path? name) (path->string name)))
       (values (validate-name dir-name) (or type (and dir-name (if link-dirs? 'link 'dir))))]
      [else