urls: normalize paths when creating urls from strings.

diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor
index a1efa2c25d5e590fb6eeef49f5b6d01ca99121bc..50a43e639283cd8b5f45a18b8c617af09cd188b2 100644 (file)
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@@ -446,3 +446,19 @@ urls [
 } [
     1 cut* swap first2 '[ _ _ url-append-path ] unit-test
 ] each
+
+! RFC 3986 6.2.2.  Syntax Normalization
+{ URL" example://a/b/c/%7Bfoo%7D" } [
+    URL" eXAMPLE://a/./b/../b/%63/%7bfoo%7d"
+] unit-test
+
+! RFC 3986 6.2.3. Scheme-Based Normalization
+{ t } [
+    {
+      "http://example.com"
+      "http://example.com/"
+      "http://example.com:/"
+      "http://example.com:80/"
+    } [ >url present "http://example.com/" = ] all?
+] unit-test
+

diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 813fe7e9afb1af17710fb2b8471e90ce88a92d1b..6d1d23255423670651e62c23f8ad9a74661ad250 100644 (file)
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -44,8 +44,19 @@ M: url >url ;
 
 <PRIVATE
 
+: remove-dot-segments ( path -- path' )
+    [ "//" split1 ] [ "/" glue ] while*
+    [ "/./" split1 ] [ "/" glue ] while*
+    [ "/../" split1 ] [ [ "/" split1-last drop ] dip "/" glue ] while*
+    "/.." ?tail [ "/" split1-last drop "/" append ] when
+    "../" ?head [ "/" prepend ] when
+    "./" ?head [ "/" prepend ] when
+    "/." ?tail [ "/" append ] when
+    [ "/" ] when-empty ;
+
 : parse-path ( string -- path )
-    "/" split [ url-decode "/" "%2F" replace ] map "/" join ;
+    "/" split [ url-decode "/" "%2F" replace ] map "/" join
+    remove-dot-segments ;
 
 EBNF: parse-url [=[
 
@@ -146,16 +157,6 @@ M: url present
         } cleave
     ] "" make ;
 
-: remove-dot-segments ( path -- path' )
-    [ "//" split1 ] [ "/" glue ] while*
-    [ "/./" split1 ] [ "/" glue ] while*
-    [ "/../" 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>
 
 : url-append-path ( path1 path2 -- path )