]> gitweb.factorcode.org Git - factor.git/commitdiff
urls: fix for the test failure in the yahoo vocab
authorBjörn Lindqvist <bjourne@gmail.com>
Mon, 16 Nov 2015 10:41:21 +0000 (11:41 +0100)
committerBjörn Lindqvist <bjourne@gmail.com>
Mon, 16 Nov 2015 10:41:21 +0000 (11:41 +0100)
?set-at can't be used in set-query-param because it creates a normal
hashtable and we need a linked-assoc

basis/urls/urls-tests.factor
basis/urls/urls.factor
extra/yahoo/yahoo-tests.factor

index 0a934469ef83fb2355c8c191dae4489bd0fdd3a3..95cf109e66b64cb27942a7020846a239943e664b 100644 (file)
@@ -139,7 +139,7 @@ urls [
         { host "www.apple.com" }
         { port 1234 }
         { path "/a/path/relative/path" }
-        { query H{ { "a" "b" } } }
+        { query LH{ { "a" "b" } } }
         { anchor "foo" }
     }
 } [
@@ -152,7 +152,7 @@ urls [
 
     T{ url
         { path "relative/path" }
-        { query H{ { "a" "b" } } }
+        { query LH{ { "a" "b" } } }
         { anchor "foo" }
     }
 
@@ -165,7 +165,7 @@ urls [
         { host "www.apple.com" }
         { port 1234 }
         { path "/a/path/relative/path" }
-        { query H{ { "a" "b" } } }
+        { query LH{ { "a" "b" } } }
         { anchor "foo" }
     }
 } [
@@ -178,7 +178,7 @@ urls [
 
     T{ url
         { path "relative/path" }
-        { query H{ { "a" "b" } } }
+        { query LH{ { "a" "b" } } }
         { anchor "foo" }
     }
 
@@ -236,6 +236,11 @@ urls [
     <url> "a" "b" set-query-param "b" query-param
 ] unit-test
 
+{ t } [
+    URL" http://www.google.com" "foo" "bar" set-query-param
+    query>> linked-assoc?
+] unit-test
+
 { "foo#3" } [ URL" foo" clone 3 >>anchor present ] unit-test
 
 { "http://www.foo.com/" } [ "http://www.foo.com:80" >url present ] unit-test
@@ -278,3 +283,12 @@ urls [
 
 { "git+https" }
 [ URL" git+https://google.com/git/factor.git" >url protocol>> ] unit-test
+
+! Params should be rendered in the order in which they are added.
+{ "/?foo=foo&bar=bar&baz=baz" } [
+    URL" /"
+    "foo" "foo" set-query-param
+    "bar" "bar" set-query-param
+    "baz" "baz" set-query-param
+    present
+] unit-test
index bc99601f761c85cf690e7deb05c020b01017e955..2f1c3e1fa38ca5a36b249a2afda881591e6137f8 100644 (file)
@@ -1,10 +1,10 @@
 ! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: accessors arrays assocs combinators fry hashtables
-io.pathnames io.sockets kernel lexer make math.parser
-namespaces peg.ebnf present sequences splitting strings
-strings.parser urls.encoding vocabs.loader ;
+USING: accessors arrays assocs combinators fry hashtables io.pathnames
+io.sockets kernel lexer linked-assocs make math.parser namespaces
+peg.ebnf present sequences splitting strings strings.parser
+urls.encoding vocabs.loader ;
 
 IN: urls
 
@@ -15,15 +15,11 @@ TUPLE: url protocol username password host port path query anchor ;
 : query-param ( url key -- value )
     swap query>> at ;
 
-: delete-query-param ( url key -- url )
-    over query>> delete-at ;
+: set-or-delete ( val key query -- )
+    pick [ set-at ] [ delete-at drop ] if ;
 
 : set-query-param ( url value key -- url )
-    over [
-        '[ [ _ _ ] dip ?set-at ] change-query
-    ] [
-        nip delete-query-param
-    ] if ;
+    pick query>> <linked-hash> or [ set-or-delete ] keep >>query ;
 
 ERROR: malformed-port ;
 
index fb1536829ac4276c87bf5957f84564fcc921c423..9a429519462585f205c3145fbee34ca45774b2ac 100644 (file)
@@ -8,5 +8,8 @@ USING: tools.test yahoo kernel io.files xml sequences accessors urls ;
     "Official site with news, tour dates, discography, store, community, and more."
 } } [ "resource:extra/yahoo/test-results.xml" file>xml parse-yahoo first ] unit-test
 
-{ URL" http://search.yahooapis.com/WebSearchService/V1/webSearch?similar_ok=1&appid=Factor-search&results=2&query=hi" }
-[ "hi" <search> "Factor-search" >>appid 2 >>results t >>similar-ok query ] unit-test
+{
+    URL" http://search.yahooapis.com/WebSearchService/V1/webSearch?appid=Factor-search&query=hi&results=2&similar_ok=1"
+} [
+    "hi" <search> "Factor-search" >>appid 2 >>results t >>similar-ok query
+] unit-test