urls: improve remove-dot-segments and test lots of cases.

diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor
index f41a6e930df1eb4e9d010587d8cb54b3df4357d6..89fead985676de2533e95204a71e51af38ba1b0b 100644 (file)
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@@ -312,17 +312,20 @@ urls [
     T{ url
         { protocol "https" }
         { host "www.apple.com" }
+        { path "/" }
     }
 } [
     T{ url
         { protocol "http" }
         { host "www.apple.com" }
         { port 80 }
+        { path "/" }
     }
 
     T{ url
         { protocol "https" }
         { host "www.apple.com" }
+        { path "/" }
     }
 
     derive-url
@@ -406,3 +409,38 @@ urls [
 { URL" https://host:1234/path" } [ URL" https://host:1234/path" redacted-url ] unit-test
 { URL" https://user@host:1234/path" } [ URL" https://user@host:1234/path" redacted-url ] unit-test
 { URL" https://user:xxxxx@host:1234/path" } [ URL" https://user:password@host:1234/path" redacted-url ] unit-test
+
+{
+    { "/a/b/c"    "/d"          "/d"        }
+    { "/a/b/c"    "/./d"        "/d"        }
+    { "/a/b/c"    "/../d"       "/d"        }
+    { "/a/b/c"    "/d"          "/d"        }
+    { "/a/b/c"    "d"           "/a/b/d"    }
+    { "/a/b/c"    "./d"         "/a/b/d"    }
+    { "/a/b/c"    "d/"          "/a/b/d/"   }
+    { "/a/b/c"    "."           "/a/b/"     }
+    { "/a/b/c"    "./"          "/a/b/"     }
+    { "/a/b/c"    ".."          "/a/"       }
+    { "/a/b/c"    "../"         "/a/"       }
+    { "/a/b/c"    "../d"        "/a/d"      }
+    { "/a/b/c"    "../.."       "/"         }
+    { "/a/b/c"    "../../"      "/"         }
+    { "/a/b/c"    "../../d"     "/d"        }
+    { "/a/b/c"    "../../../d"  "/d"        }
+    { "/a/b/c"    "d."          "/a/b/d."   }
+    { "/a/b/c"    ".d"          "/a/b/.d"   }
+    { "/a/b/c"    "d.."         "/a/b/d.."  }
+    { "/a/b/c"    "..d"         "/a/b/..d"  }
+    { "/a/b/c"    "./../d"      "/a/d"      }
+    { "/a/b/c"    "./d/."       "/a/b/d/"   }
+    { "/a/b/c"    "d/./e"       "/a/b/d/e"  }
+    { "/a/b/c"    "d/../e"      "/a/b/e"    }
+    { "/a/b/c/d/" "../../e/f"   "/a/b/e/f"  }
+    { "/a/b/c/d"  "../../e/f"   "/a/e/f"    }
+    { "/a/b/c/d/" "../../e/f/"  "/a/b/e/f/" }
+    { "/a/b/c/d"  "../../e/f/"  "/a/e/f/"   }
+    { "/a/b/c/d/" "/../../e/f/" "/e/f/"     }
+    { "/a/b/c/d"  "/../../e/f/" "/e/f/"     }
+} [
+    1 cut* swap first2 '[ _ _ url-append-path ] unit-test
+] each

diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 64cc9d1e9067f231fbd81535656e92e5ed97a7ee..0347cd729295d9ef8dfc395df44a852453e3cac7 100644 (file)
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -147,11 +147,13 @@ M: url present
     ] "" make ;
 
 : remove-dot-segments ( path -- path' )
-    "/" split "." swap remove [
-        { ".." } split1 [
-            [ [ { } ] [ but-last ] if-empty ] dip append t
-        ] [ f ] if*
-    ] loop "/" join [ f ] when-empty ;
+    "/./" "/" replace
+    [ "/../" split1 ] [ [ "/" split1-last drop ] dip "/" glue ] while*
+    "/.." ?tail [ "/" split1-last drop "/" append ] when
+    "../" ?head [ "/" prepend ] when
+    "./" ?head [ "/" prepend ] when
+    "/." ?tail [ "/" append ] when
+    [ "/" ] when-empty ;
 
 PRIVATE>