From f6cdeb3433c168c586740df8cce00c253494d3c4 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 17 Sep 2009 22:25:36 +0000
Subject: [PATCH] fix parsing of planet paths in executables (merge to 4.2.2)

svn: r16057
---
 collects/compiler/embed-unit.ss | 28 +++++++++++++++++-----------
 1 file changed, 17 insertions(+), 11 deletions(-)

diff --git a/collects/compiler/embed-unit.ss b/collects/compiler/embed-unit.ss
index 9d93cee0f7..42e954021b 100644
--- a/collects/compiler/embed-unit.ss
+++ b/collects/compiler/embed-unit.ss
@@ -660,16 +660,17 @@
                                                                                                         (symbol->string (cadr name))
                                                                                                         (cadr name))])
                                                                                     (letrec-values ([(split)
-                                                                                                     (lambda (s rx suffix?)
+                                                                                                     (lambda (s rx suffix-after)
                                                                                                        (let-values ([(m) (regexp-match-positions 
                                                                                                                           rx
                                                                                                                           s)])
                                                                                                          (if m
                                                                                                              (cons (substring s 0 (caar m))
                                                                                                                    (split (substring s (cdar m))
-                                                                                                                          rx suffix?))
+                                                                                                                          rx 
+                                                                                                                          (- suffix-after 1)))
                                                                                                              (list
-                                                                                                              (if suffix?
+                                                                                                              (if (suffix-after . <= . 0)
                                                                                                                   (if (regexp-match? #rx"[.]" s)
                                                                                                                       s
                                                                                                                       (string-append s ".ss"))
@@ -684,19 +685,24 @@
                                                                                                        (if (null? (cdr l))
                                                                                                            null
                                                                                                            (cons (car l) (not-last (cdr l)))))])
-                                                                                      (let-values ([(parts) (split s #rx"/" #t)])
-                                                                                        (let-values ([(vparts) (split (cadr parts) #rx":" #f)])
+                                                                                      (let-values ([(parts) (split s #rx"/" 2)])
+                                                                                        (let-values ([(vparts) (split (cadr parts) #rx":" +inf.0)])
                                                                                           (cons 'planet
                                                                                                 (cons (if (null? (cddr parts))
                                                                                                           "main.ss"
                                                                                                           (last-of parts))
                                                                                                       (cons
-                                                                                                       (cons (car parts) 
-                                                                                                             (cons (string-append (car vparts) 
-                                                                                                                                  ".plt")
-                                                                                                                   ;; FIXME: finish version parse:
-                                                                                                                   (cdddr parts)))
-                                                                                                       (not-last (cddr parts)))))))))
+                                                                                                       (cons 
+                                                                                                        (car parts) 
+                                                                                                        (cons (string-append (car vparts) 
+                                                                                                                             ".plt")
+                                                                                                              (if (null? (cddr parts))
+                                                                                                                  null
+                                                                                                                  ;; FIXME: finish version parse:
+                                                                                                                  (cdddr parts))))
+                                                                                                       (if (null? (cddr parts))
+                                                                                                           null
+                                                                                                           (not-last (cddr parts))))))))))
                                                                                   ;; already in long form:
                                                                                   name)
                                                                               #f))