Fix two classes of wrong answer in Path.relative

README.md

@@ -14,7 +14,11 @@ The `Path` module mostly operates on `String` arguments. It allows you to
 split, join, merge, and normalize paths and extensions in a lot of different
 ways. `normalize` resolves `.`/`..` segments and collapses repeated separators
 lexically (without touching the filesystem), and `relative` expresses one path
-relative to a base the same way. It also has some functions to work with the
+relative to a base the same way. `relative` answers `Nothing` when there is no
+lexical answer: one path absolute and the other relative, different Windows
+drives, or a base that still starts with `..` once the shared prefix is gone, as
+in `(Path.relative "a" "../b")`, where naming `a` would take the name of a
+directory neither path mentions. It also has some functions to work with the
 `PATH` environment variable.
 
 It assumes either Windows or POSIX-style separators.

docs/Path.html

@@ -453,9 +453,18 @@ <h3 id="relative">
                         <p>computes the path to <code>target</code> relative to <code>base</code>, purely
 lexically. It is the companion to <a href="#absolute">absolute</a>.</p>
 <p>Both paths are normalized first, so <code>.</code>, <code>..</code>, and redundant separators are
-resolved before comparing. Returns <code>Nothing</code> when the paths cannot be related
-lexically: one absolute and one relative, or, on Windows, rooted at different
-drives. Equal paths yield <code>Just &quot;.&quot;</code>.</p>
+resolved before comparing. Equal paths yield <code>Just &quot;.&quot;</code>.</p>
+<p>Returns <code>Nothing</code> when the paths cannot be related lexically: one absolute and
+one relative; on Windows, rooted at different drives; or a <code>base</code> that still
+starts with <code>..</code> once the shared prefix is gone, because naming <code>target</code> from
+there would take the name of a directory neither path mentions.</p>
+<p>Examples on POSIX:</p>
+<pre><code>(relative &quot;a/b/c&quot; &quot;a/b&quot;) ; =&gt; (Maybe.Just &quot;c&quot;)
+(relative &quot;a&quot; &quot;.&quot;)       ; =&gt; (Maybe.Just &quot;a&quot;)
+(relative &quot;.&quot; &quot;a&quot;)       ; =&gt; (Maybe.Just &quot;..&quot;)
+(relative &quot;../a&quot; &quot;b&quot;)    ; =&gt; (Maybe.Just &quot;../../a&quot;)
+(relative &quot;a&quot; &quot;../b&quot;)    ; =&gt; (Maybe.Nothing)
+</code></pre>
 
                     </p>
                 </div>

docs/index.html

@@ -453,9 +453,18 @@ <h3 id="relative">
                         <p>computes the path to <code>target</code> relative to <code>base</code>, purely
 lexically. It is the companion to <a href="#absolute">absolute</a>.</p>
 <p>Both paths are normalized first, so <code>.</code>, <code>..</code>, and redundant separators are
-resolved before comparing. Returns <code>Nothing</code> when the paths cannot be related
-lexically: one absolute and one relative, or, on Windows, rooted at different
-drives. Equal paths yield <code>Just &quot;.&quot;</code>.</p>
+resolved before comparing. Equal paths yield <code>Just &quot;.&quot;</code>.</p>
+<p>Returns <code>Nothing</code> when the paths cannot be related lexically: one absolute and
+one relative; on Windows, rooted at different drives; or a <code>base</code> that still
+starts with <code>..</code> once the shared prefix is gone, because naming <code>target</code> from
+there would take the name of a directory neither path mentions.</p>
+<p>Examples on POSIX:</p>
+<pre><code>(relative &quot;a/b/c&quot; &quot;a/b&quot;) ; =&gt; (Maybe.Just &quot;c&quot;)
+(relative &quot;a&quot; &quot;.&quot;)       ; =&gt; (Maybe.Just &quot;a&quot;)
+(relative &quot;.&quot; &quot;a&quot;)       ; =&gt; (Maybe.Just &quot;..&quot;)
+(relative &quot;../a&quot; &quot;b&quot;)    ; =&gt; (Maybe.Just &quot;../../a&quot;)
+(relative &quot;a&quot; &quot;../b&quot;)    ; =&gt; (Maybe.Nothing)
+</code></pre>
 
                     </p>
                 </div>

path.carp

@@ -199,9 +199,21 @@ an extension if there previously was none.")
 lexically. It is the companion to [absolute](#absolute).
 
 Both paths are normalized first, so `.`, `..`, and redundant separators are
-resolved before comparing. Returns `Nothing` when the paths cannot be related
-lexically: one absolute and one relative, or, on Windows, rooted at different
-drives. Equal paths yield `Just \".\"`.")
+resolved before comparing. Equal paths yield `Just \".\"`.
+
+Returns `Nothing` when the paths cannot be related lexically: one absolute and
+one relative; on Windows, rooted at different drives; or a `base` that still
+starts with `..` once the shared prefix is gone, because naming `target` from
+there would take the name of a directory neither path mentions.
+
+Examples on POSIX:
+```
+(relative \"a/b/c\" \"a/b\") ; => (Maybe.Just \"c\")
+(relative \"a\" \".\")       ; => (Maybe.Just \"a\")
+(relative \".\" \"a\")       ; => (Maybe.Just \"..\")
+(relative \"../a\" \"b\")    ; => (Maybe.Just \"../../a\")
+(relative \"a\" \"../b\")    ; => (Maybe.Nothing)
+```")
   (defn relative [target base]
     (let [nt (normalize target)
           nb (normalize base)
@@ -212,9 +224,9 @@ drives. Equal paths yield `Just \".\"`.")
               bc (split &nb)]
           (if (and abs (/= (Array.unsafe-nth &tc 0) (Array.unsafe-nth &bc 0)))
             (Maybe.Nothing)
-            (let [non-empty? (fn [s] (not (String.empty? s)))
-                  tf (Array.copy-filter &non-empty? &tc)
-                  bf (Array.copy-filter &non-empty? &bc)
+            (let [component? (fn [s] (and (not (String.empty? s)) (/= s ".")))
+                  tf (Array.copy-filter &component? &tc)
+                  bf (Array.copy-filter &component? &bc)
                   tn (Array.length &tf)
                   bn (Array.length &bf)
                   common (let-do [k 0]
@@ -223,11 +235,13 @@ drives. Equal paths yield `Just \".\"`.")
                                 (= (Array.unsafe-nth &tf k)
                                    (Array.unsafe-nth &bf k)))
                       (set! k (inc k)))
-                    k)
-                  ups (Array.replicate (- bn common) "..")
-                  comps (Array.concat &[ups (Array.suffix &tf common)])
-                  joined (join &comps)]
-              (Maybe.Just (if (String.empty? &joined) @"." joined))))))))
+                    k)]
+              (if (and (< common bn) (= (Array.unsafe-nth &bf common) ".."))
+                (Maybe.Nothing)
+                (let [ups (Array.replicate (- bn common) "..")
+                      comps (Array.concat &[ups (Array.suffix &tf common)])
+                      joined (join &comps)]
+                  (Maybe.Just (if (String.empty? &joined) @"." joined))))))))))
 
   (defn- class-end [pcs i]
     (let-do [n (Array.length pcs)

test/path.carp

@@ -127,6 +127,34 @@
       &(Maybe.Nothing)
       &(relative "a/b" "/a/b")
       "relative returns Nothing for a relative target and absolute base")
+    (assert-equal test
+      &(Maybe.Just @"a")
+      &(relative "a" ".")
+      "relative descends from a . base")
+    (assert-equal test
+      &(Maybe.Just @"..")
+      &(relative "." "a")
+      "relative walks up to a . target")
+    (assert-equal test
+      &(Maybe.Just @"..")
+      &(relative ".." ".")
+      "relative walks up from a . base")
+    (assert-equal test
+      &(Maybe.Just @"../../a")
+      &(relative "../a" "b")
+      "relative resolves a target above the base")
+    (assert-equal test
+      &(Maybe.Just @"../a")
+      &(relative "../a" "../b")
+      "relative cancels leading .. shared by both paths")
+    (assert-equal test
+      &(Maybe.Nothing)
+      &(relative "a" "..")
+      "relative returns Nothing for a base above the current directory")
+    (assert-equal test
+      &(Maybe.Nothing)
+      &(relative "a" "../b")
+      "relative returns Nothing for a base whose residual starts with ..")
     (assert-equal test
       &(Maybe.Just @"file.txt")
       &(filename "path/to/file.txt")