basis/urls/urls-tests.factor

   1 IN: urls.tests
   2 USING: urls urls.private tools.test
   3 arrays kernel assocs present accessors ;
   4
   5 : urls
   6     {
   7         {
   8             T{ url
   9                 { protocol "http" }
  10                 { host "www.apple.com" }
  11                 { port 1234 }
  12                 { path "/a/path" }
  13                 { query H{ { "a" "b" } } }
  14                 { anchor "foo" }
  15             }
  16             "http://www.apple.com:1234/a/path?a=b#foo"
  17         }
  18         {
  19             T{ url
  20                 { protocol "http" }
  21                 { host "www.apple.com" }
  22                 { path "/a/path" }
  23                 { query H{ { "a" "b" } } }
  24                 { anchor "foo" }
  25             }
  26             "http://www.apple.com/a/path?a=b#foo"
  27         }
  28         {
  29             T{ url
  30                 { protocol "http" }
  31                 { host "www.apple.com" }
  32                 { port 1234 }
  33                 { path "/another/fine/path" }
  34                 { anchor "foo" }
  35             }
  36             "http://www.apple.com:1234/another/fine/path#foo"
  37         }
  38         {
  39             T{ url
  40                 { path "/a/relative/path" }
  41                 { anchor "foo" }
  42             }
  43             "/a/relative/path#foo"
  44         }
  45         {
  46             T{ url
  47                 { path "/a/relative/path" }
  48             }
  49             "/a/relative/path"
  50         }
  51         {
  52             T{ url
  53                 { path "a/relative/path" }
  54             }
  55             "a/relative/path"
  56         }
  57         {
  58             T{ url
  59                 { path "bar" }
  60                 { query H{ { "a" "b" } } }
  61             }
  62             "bar?a=b"
  63         }
  64         {
  65             T{ url
  66                 { protocol "ftp" }
  67                 { host "ftp.kernel.org" }
  68                 { username "slava" }
  69                 { path "/" }
  70             }
  71             "ftp://slava@ftp.kernel.org/"
  72         }
  73         {
  74             T{ url
  75                 { protocol "ftp" }
  76                 { host "ftp.kernel.org" }
  77                 { username "slava" }
  78                 { password "secret" }
  79                 { path "/" }
  80             }
  81             "ftp://slava:secret@ftp.kernel.org/"
  82         }
  83     } ;
  84
  85 urls [
  86     [ 1array ] [ [ >url ] curry ] bi* unit-test
  87 ] assoc-each
  88
  89 urls [
  90     swap [ 1array ] [ [ present ] curry ] bi* unit-test
  91 ] assoc-each
  92
  93 [ "b" ] [ "a" "b" url-append-path ] unit-test
  94
  95 [ "a/b" ] [ "a/c" "b" url-append-path ] unit-test
  96
  97 [ "a/b" ] [ "a/" "b" url-append-path ] unit-test
  98
  99 [ "/b" ] [ "a" "/b" url-append-path ] unit-test
 100
 101 [ "/b" ] [ "a/b/" "/b" url-append-path ] unit-test
 102
 103 [ "/xxx/bar" ] [ "/xxx/baz" "bar" url-append-path ] unit-test
 104
 105 [
 106     T{ url
 107         { protocol "http" }
 108         { host "www.apple.com" }
 109         { port 1234 }
 110         { path "/a/path" }
 111     }
 112 ] [
 113     T{ url
 114         { protocol "http" }
 115         { host "www.apple.com" }
 116         { port 1234 }
 117         { path "/foo" }
 118     }
 119
 120     T{ url
 121         { path "/a/path" }
 122     }
 123
 124     derive-url
 125 ] unit-test
 126
 127 [
 128     T{ url
 129         { protocol "http" }
 130         { host "www.apple.com" }
 131         { port 1234 }
 132         { path "/a/path/relative/path" }
 133         { query H{ { "a" "b" } } }
 134         { anchor "foo" }
 135     }
 136 ] [
 137     T{ url
 138         { protocol "http" }
 139         { host "www.apple.com" }
 140         { port 1234 }
 141         { path "/a/path/" }
 142     }
 143
 144     T{ url
 145         { path "relative/path" }
 146         { query H{ { "a" "b" } } }
 147         { anchor "foo" }
 148     }
 149
 150     derive-url
 151 ] unit-test
 152
 153 [
 154     T{ url
 155         { protocol "http" }
 156         { host "www.apple.com" }
 157         { port 1234 }
 158         { path "/a/path/relative/path" }
 159         { query H{ { "a" "b" } } }
 160         { anchor "foo" }
 161     }
 162 ] [
 163     T{ url
 164         { protocol "http" }
 165         { host "www.apple.com" }
 166         { port 1234 }
 167         { path "/a/path/" }
 168     }
 169
 170     T{ url
 171         { path "relative/path" }
 172         { query H{ { "a" "b" } } }
 173         { anchor "foo" }
 174     }
 175
 176     derive-url
 177 ] unit-test
 178
 179 [
 180     T{ url
 181         { protocol "http" }
 182         { host "www.apple.com" }
 183         { path "/xxx/baz" }
 184     }
 185 ] [
 186     T{ url
 187         { protocol "http" }
 188         { host "www.apple.com" }
 189         { path "/xxx/bar" }
 190     }
 191
 192     T{ url
 193         { path "baz" }
 194     }
 195
 196     derive-url
 197 ] unit-test
 198
 199 [ "a" ] [
 200     <url> "a" "b" set-query-param "b" query-param
 201 ] unit-test
 202
 203 [ "foo#3" ] [ URL" foo" clone 3 >>anchor present ] unit-test
 204
 205 [ "http://www.foo.com/" ] [ "http://www.foo.com:80" >url present ] unit-test
 206
 207 [ f ] [ URL" /gp/redirect.html/002-7009742-0004012?location=http://advantage.amazon.com/gp/vendor/public/join%26token%3d77E3769AB3A5B6CF611699E150DC33010761CE12" protocol>> ] unit-test
 208
 209 [
 210     T{ url
 211         { protocol "http" }
 212         { host "localhost" }
 213         { query H{ { "foo" "bar" } } }
 214         { path "/" }
 215     }
 216 ]
 217 [ "http://localhost?foo=bar" >url ] unit-test
 218
 219 [
 220     T{ url
 221         { protocol "http" }
 222         { host "localhost" }
 223         { query H{ { "foo" "bar" } } }
 224         { path "/" }
 225     }
 226 ]
 227 [ "http://localhost/?foo=bar" >url ] unit-test
 228
 229 [ "/" ] [ "http://www.jedit.org" >url path>> ] unit-test