repairs for srcloc-marshaling change

Handle "." and ".." as one of the last two elements of a path.

pkgs/racket-test-core/tests/racket/fasl.rktl

@@ -96,7 +96,9 @@
         (test (srcloc "there" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc windows-path 1 2 3 4))))
     (let ([root (car (filesystem-root-list))])
       (test (srcloc (path->string root) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc root 1 2 3 4)))
-      (test (srcloc (path->string (build-path root "x")) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root "x") 1 2 3 4))))
+      (test (srcloc (path->string (build-path root "x")) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root "x") 1 2 3 4)))
+      (test (srcloc (path->string (build-path root 'up)) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root 'up) 1 2 3 4)))
+      (test (srcloc (path->string (build-path root 'same)) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root 'same) 1 2 3 4))))
     (test (srcloc ".../a/b" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path (current-directory) "a" "b") 1 2 3 4)))))
 
 (let* ([rel-p (build-path "nested" "data.rktd")]
@@ -113,4 +115,9 @@
     (test p fasl->s-exp bstr)
     (test (srcloc p 10 20 30 40) fasl->s-exp srcloc-bstr)))
 
+(test (srcloc ".../a" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path 'up "a") 1 2 3 4)))
+(test (srcloc ".../a" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path 'same "a") 1 2 3 4)))
+(test (srcloc ".../a/.." 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path "a" 'up) 1 2 3 4)))
+(test (srcloc ".../a/." 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path "a" 'same) 1 2 3 4)))
+
 (report-errs)

pkgs/racket-test-core/tests/racket/print.rktl

@@ -364,6 +364,16 @@
   (try "apple")
   (try #"apple")
   (try (string->path "apple") "apple")
+  (try (build-path 'up) "..")
+  (try (build-path 'same) ".")
+  (try (build-path 'up "apple") ".../apple")
+  (try (build-path "x" 'up "apple") ".../apple")
+  (try (build-path "apple" 'up) ".../apple/..")
+  (try (build-path "apple" 'same) ".../apple/.")
+  (try (build-path "x" "apple" 'up) ".../apple/..")
+  (try (build-path "x" "apple" 'same) ".../apple/.")
+  (let ([d (car (filesystem-root-list))])
+    (try (build-path d 'up) (path->string (build-path d 'up))))
 
   (try 7 #:ok? #f)
   (try (box 7) #:ok? #f))

racket/collects/racket/private/truncate-path.rkt

@@ -12,10 +12,19 @@
        [(not base2)
         ;; Path at a root
         (path->string p)]
+       [(symbol? name2)
+        ;; "." or ".." before a name
+        (string-append ".../" (path-elem->string name1))]
        [else
-        (string-append ".../" (path->string name2) "/" (path->string name1))])]
+        (string-append ".../" (path->string name2) "/" (path-elem->string name1))])]
     [(eq? base1 'relative)
-     (path->string name1)]
+     (path-elem->string name1)]
     [else
-      ;; Path is a root
+     ;; Path is a root, ".", or ".."
      (path->string p)]))
+
+(define (path-elem->string p)
+  (cond
+    [(eq? p 'same) "."]
+    [(eq? p 'up) ".."]
+    [else (path->string p)]))

racket/src/racket/src/print.c

@@ -4311,23 +4311,30 @@ static Scheme_Object *srcloc_path_to_string(Scheme_Object *p)
   int isdir;
   
   name = scheme_split_path(SCHEME_PATH_VAL(p), SCHEME_PATH_LEN(p), &base, &isdir, SCHEME_PLATFORM_PATH_KIND);
-  if (SCHEME_PATHP(name) && SCHEME_PATHP(base)) {
+  if ((SCHEME_PATHP(name) || SCHEME_SYMBOLP(name)) && SCHEME_PATHP(base)) {
     dir_name = scheme_split_path(SCHEME_PATH_VAL(base), SCHEME_PATH_LEN(base), &base, &isdir, SCHEME_PLATFORM_PATH_KIND);
     if (SCHEME_FALSEP(base)) {
       /* Path is file at root, so just keep the whole path */
       return scheme_path_to_char_string(p);
     }
+    if (SCHEME_PATHP(name))
+      name = scheme_path_to_char_string(name);
+    else {
+      /* convert "." or ".." */
+      if (!strcmp(SCHEME_SYM_VAL(name), "up"))
+        name = scheme_make_utf8_string("..");
+      else
+        name = scheme_make_utf8_string(".");
+    }
     if (SCHEME_PATHP(dir_name))
       name = scheme_append_strings(scheme_path_to_char_string(dir_name),
                                    scheme_append_strings(scheme_make_utf8_string("/"),
-                                                         scheme_path_to_char_string(name)));
+                                                         name));
-    else
-      name = scheme_path_to_char_string(name);
     return scheme_append_strings(scheme_make_utf8_string(".../"), name);
   } else if (SCHEME_PATHP(name))
     return scheme_path_to_char_string(name);
   else {
-    /* original path is a root */
+    /* original path is a root, ".", or ".." */
     return scheme_path_to_char_string(p);
   }
 }