1{-# OPTIONS_GHC -fno-warn-missing-signatures #-} 2-------------------------------------------------------------------------------- 3-- $Id: URITest.hs,v 1.8 2005/07/19 22:01:27 gklyne Exp $ 4-- 5-- Copyright (c) 2004, G. KLYNE. All rights reserved. 6-- See end of this file for licence information. 7-------------------------------------------------------------------------------- 8-- | 9-- Module : URITest 10-- Copyright : (c) 2004, Graham Klyne 11-- License : BSD-style (see end of this file) 12-- 13-- Maintainer : Graham Klyne 14-- Stability : provisional 15-- Portability : H98 16-- 17-- This Module contains test cases for module URI. 18-- 19-- To run this test without using Cabal to build the package 20-- (2013-01-05, instructions tested on MacOS): 21-- 1. Install Haskell platform 22-- 2. cabal install test-framework 23-- 3. cabal install test-framework-hunit 24-- 4. ghc -XDeriveDataTypeable -D"MIN_VERSION_base(x,y,z)=1" ../Network/URI.hs uri001.hs 25-- 5. ./uri001 26-- 27-- Previous build instructions: 28-- Using GHC, I compile with this command line: 29-- ghc --make -fglasgow-exts 30-- -i..\;C:\Dev\Haskell\Lib\HUnit;C:\Dev\Haskell\Lib\Parsec 31-- -o URITest.exe URITest -main-is URITest.main 32-- The -i line may need changing for alternative installations. 33-- 34-------------------------------------------------------------------------------- 35 36module Main where 37 38import Network.URI 39 ( URI(..), URIAuth(..) 40 , nullURI 41 , rectify, rectifyAuth 42 , parseURI, parseURIReference, parseRelativeReference, parseAbsoluteURI 43 , parseAbsoluteURI 44 , isURI, isURIReference, isRelativeReference, isAbsoluteURI 45 , uriIsAbsolute, uriIsRelative 46 , relativeTo, nonStrictRelativeTo 47 , relativeFrom 48 , uriToString, uriAuthToString 49 , isUnescapedInURIComponent 50 , isUnescapedInURI, escapeURIString, unEscapeString 51 , normalizeCase, normalizeEscape, normalizePathSegments 52 , pathSegments 53 ) 54 55import Test.HUnit 56 57import Data.Maybe (fromJust) 58import Data.List (intercalate) 59import System.IO (openFile, IOMode(WriteMode), hClose) 60import qualified Test.Framework as TF 61import qualified Test.Framework.Providers.HUnit as TF 62import qualified Test.Framework.Providers.QuickCheck2 as TF 63 64-- Test supplied string for valid URI reference syntax 65-- isValidURIRef :: String -> Bool 66-- Test supplied string for valid absolute URI reference syntax 67-- isAbsoluteURIRef :: String -> Bool 68-- Test supplied string for valid absolute URI syntax 69-- isAbsoluteURI :: String -> Bool 70 71data URIType = AbsId -- URI form (absolute, no fragment) 72 | AbsRf -- Absolute URI reference 73 | RelRf -- Relative URI reference 74 | InvRf -- Invalid URI reference 75isValidT :: URIType -> Bool 76isValidT InvRf = False 77isValidT _ = True 78 79isAbsRfT :: URIType -> Bool 80isAbsRfT AbsId = True 81isAbsRfT AbsRf = True 82isAbsRfT _ = False 83 84isRelRfT :: URIType -> Bool 85isRelRfT RelRf = True 86isRelRfT _ = False 87 88isAbsIdT :: URIType -> Bool 89isAbsIdT AbsId = True 90isAbsIdT _ = False 91 92testEq :: (Eq a, Show a) => String -> a -> a -> Assertion 93testEq lab a1 a2 = assertEqual lab a1 a2 94 95testURIRef :: URIType -> String -> Assertion 96testURIRef t u = sequence_ 97 [ testEq ("test_isURIReference:"++u) (isValidT t) (isURIReference u) 98 , testEq ("test_isRelativeReference:"++u) (isRelRfT t) (isRelativeReference u) 99 , testEq ("test_isAbsoluteURI:"++u) (isAbsIdT t) (isAbsoluteURI u) 100 ] 101 102testURIRefComponents :: String -> (Maybe URI) -> String -> Assertion 103testURIRefComponents _lab uv us = 104 testEq ("testURIRefComponents:"++us) uv (parseURIReference us) 105 106 107testURIRef001 = testURIRef AbsRf "http://example.org/aaa/bbb#ccc" 108testURIRef002 = testURIRef AbsId "mailto:local@domain.org" 109testURIRef003 = testURIRef AbsRf "mailto:local@domain.org#frag" 110testURIRef004 = testURIRef AbsRf "HTTP://EXAMPLE.ORG/AAA/BBB#CCC" 111testURIRef005 = testURIRef RelRf "//example.org/aaa/bbb#ccc" 112testURIRef006 = testURIRef RelRf "/aaa/bbb#ccc" 113testURIRef007 = testURIRef RelRf "bbb#ccc" 114testURIRef008 = testURIRef RelRf "#ccc" 115testURIRef009 = testURIRef RelRf "#" 116testURIRef010 = testURIRef RelRf "/" 117-- escapes 118testURIRef011 = testURIRef AbsRf "http://example.org/aaa%2fbbb#ccc" 119testURIRef012 = testURIRef AbsRf "http://example.org/aaa%2Fbbb#ccc" 120testURIRef013 = testURIRef RelRf "%2F" 121testURIRef014 = testURIRef RelRf "aaa%2Fbbb" 122-- ports 123testURIRef015 = testURIRef AbsRf "http://example.org:80/aaa/bbb#ccc" 124testURIRef016 = testURIRef AbsRf "http://example.org:/aaa/bbb#ccc" 125testURIRef017 = testURIRef AbsRf "http://example.org./aaa/bbb#ccc" 126testURIRef018 = testURIRef AbsRf "http://example.123./aaa/bbb#ccc" 127-- bare authority 128testURIRef019 = testURIRef AbsId "http://example.org" 129-- IPv6 literals (from RFC2732): 130testURIRef021 = testURIRef AbsId "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html" 131testURIRef022 = testURIRef AbsId "http://[1080:0:0:0:8:800:200C:417A]/index.html" 132testURIRef023 = testURIRef AbsId "http://[3ffe:2a00:100:7031::1]" 133testURIRef024 = testURIRef AbsId "http://[1080::8:800:200C:417A]/foo" 134testURIRef025 = testURIRef AbsId "http://[::192.9.5.5]/ipng" 135testURIRef026 = testURIRef AbsId "http://[::FFFF:129.144.52.38]:80/index.html" 136testURIRef027 = testURIRef AbsId "http://[2010:836B:4179::836B:4179]" 137testURIRef028 = testURIRef RelRf "//[2010:836B:4179::836B:4179]" 138testURIRef029 = testURIRef InvRf "[2010:836B:4179::836B:4179]" 139testURIRef030 = testURIRef AbsId "http://[fe80::ff:fe00:1%25eth0]" 140-- RFC2396 test cases 141testURIRef031 = testURIRef RelRf "./aaa" 142testURIRef032 = testURIRef RelRf "../aaa" 143testURIRef033 = testURIRef AbsId "g:h" 144testURIRef034 = testURIRef RelRf "g" 145testURIRef035 = testURIRef RelRf "./g" 146testURIRef036 = testURIRef RelRf "g/" 147testURIRef037 = testURIRef RelRf "/g" 148testURIRef038 = testURIRef RelRf "//g" 149testURIRef039 = testURIRef RelRf "?y" 150testURIRef040 = testURIRef RelRf "g?y" 151testURIRef041 = testURIRef RelRf "#s" 152testURIRef042 = testURIRef RelRf "g#s" 153testURIRef043 = testURIRef RelRf "g?y#s" 154testURIRef044 = testURIRef RelRf ";x" 155testURIRef045 = testURIRef RelRf "g;x" 156testURIRef046 = testURIRef RelRf "g;x?y#s" 157testURIRef047 = testURIRef RelRf "." 158testURIRef048 = testURIRef RelRf "./" 159testURIRef049 = testURIRef RelRf ".." 160testURIRef050 = testURIRef RelRf "../" 161testURIRef051 = testURIRef RelRf "../g" 162testURIRef052 = testURIRef RelRf "../.." 163testURIRef053 = testURIRef RelRf "../../" 164testURIRef054 = testURIRef RelRf "../../g" 165testURIRef055 = testURIRef RelRf "../../../g" 166testURIRef056 = testURIRef RelRf "../../../../g" 167testURIRef057 = testURIRef RelRf "/./g" 168testURIRef058 = testURIRef RelRf "/../g" 169testURIRef059 = testURIRef RelRf "g." 170testURIRef060 = testURIRef RelRf ".g" 171testURIRef061 = testURIRef RelRf "g.." 172testURIRef062 = testURIRef RelRf "..g" 173testURIRef063 = testURIRef RelRf "./../g" 174testURIRef064 = testURIRef RelRf "./g/." 175testURIRef065 = testURIRef RelRf "g/./h" 176testURIRef066 = testURIRef RelRf "g/../h" 177testURIRef067 = testURIRef RelRf "g;x=1/./y" 178testURIRef068 = testURIRef RelRf "g;x=1/../y" 179testURIRef069 = testURIRef RelRf "g?y/./x" 180testURIRef070 = testURIRef RelRf "g?y/../x" 181testURIRef071 = testURIRef RelRf "g#s/./x" 182testURIRef072 = testURIRef RelRf "g#s/../x" 183testURIRef073 = testURIRef RelRf "" 184testURIRef074 = testURIRef RelRf "A'C" 185testURIRef075 = testURIRef RelRf "A$C" 186testURIRef076 = testURIRef RelRf "A@C" 187testURIRef077 = testURIRef RelRf "A,C" 188-- Invalid 189testURIRef080 = testURIRef InvRf "http://foo.org:80Path/More" 190testURIRef081 = testURIRef InvRf "::" 191testURIRef082 = testURIRef InvRf " " 192testURIRef083 = testURIRef InvRf "%" 193testURIRef084 = testURIRef InvRf "A%Z" 194testURIRef085 = testURIRef InvRf "%ZZ" 195testURIRef086 = testURIRef InvRf "%AZ" 196testURIRef087 = testURIRef InvRf "A C" 197-- testURIRef088 = -- (case removed) 198-- testURIRef089 = -- (case removed) 199testURIRef090 = testURIRef InvRf "A\"C" 200testURIRef091 = testURIRef InvRf "A`C" 201testURIRef092 = testURIRef InvRf "A<C" 202testURIRef093 = testURIRef InvRf "A>C" 203testURIRef094 = testURIRef InvRf "A^C" 204testURIRef095 = testURIRef InvRf "A\\C" 205testURIRef096 = testURIRef InvRf "A{C" 206testURIRef097 = testURIRef InvRf "A|C" 207testURIRef098 = testURIRef InvRf "A}C" 208-- From RFC2396: 209-- rel_segment = 1*( unreserved | escaped | 210-- ";" | "@" | "&" | "=" | "+" | "$" | "," ) 211-- unreserved = alphanum | mark 212-- mark = "-" | "_" | "." | "!" | "~" | "*" | "'" | 213-- "(" | ")" 214-- Note RFC 2732 allows '[', ']' ONLY for reserved purpose of IPv6 literals, 215-- or does it? 216testURIRef101 = testURIRef InvRf "A[C" 217testURIRef102 = testURIRef InvRf "A]C" 218testURIRef103 = testURIRef InvRf "A[**]C" 219testURIRef104 = testURIRef InvRf "http://[xyz]/" 220testURIRef105 = testURIRef InvRf "http://]/" 221testURIRef106 = testURIRef InvRf "http://example.org/[2010:836B:4179::836B:4179]" 222testURIRef107 = testURIRef InvRf "http://example.org/abc#[2010:836B:4179::836B:4179]" 223testURIRef108 = testURIRef InvRf "http://example.org/xxx/[qwerty]#a[b]" 224-- Random other things that crop up 225testURIRef111 = testURIRef AbsRf "http://example/Andrȷ" 226testURIRef112 = testURIRef AbsId "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" 227testURIRef113 = testURIRef AbsId "http://46229EFFE16A9BD60B9F1BE88B2DB047ADDED785/demo.mp3" 228testURIRef114 = testURIRef InvRf "http://example.org/xxx/qwerty#a#b" 229testURIRef115 = testURIRef InvRf "dcp.tcp.pft://192.168.0.1:1002:3002?fec=1&crc=0" 230testURIRef116 = testURIRef AbsId "dcp.tcp.pft://192.168.0.1:1002?fec=1&crc=0" 231testURIRef117 = testURIRef AbsId "foo://" 232-- URIs prefixed with IPv4 addresses 233testURIRef118 = testURIRef AbsId "http://192.168.0.1.example.com/" 234testURIRef119 = testURIRef AbsId "http://192.168.0.1.example.com./" 235-- URI prefixed with 3 octets of an IPv4 address and a subdomain part with a leading digit. 236testURIRef120 = testURIRef AbsId "http://192.168.0.1test.example.com/" 237-- URI with IPv(future) address 238testURIRef121 = testURIRef AbsId "http://[v9.123.abc;456.def]/" 239testURIRef122 = testEq "v.future authority" 240 (Just (URIAuth "" "[v9.123.abc;456.def]" ":42")) 241 ((maybe Nothing uriAuthority) . parseURI $ "http://[v9.123.abc;456.def]:42/") 242-- URI with non-ASCII characters, fail with Network.HTTP escaping code (see below) 243-- Currently not supported by Network.URI, but captured here for possible future reference 244-- when IRI support may be added. 245testURIRef123 = testURIRef AbsId "http://example.com/test123/䡥汬漬⁗潲汤/index.html" 246testURIRef124 = testURIRef AbsId "http://example.com/test124/Москва/index.html" 247 248-- From report by Alexander Ivanov: 249-- should return " 䡥汬漬⁗潲汤", but returns "Hello, World" instead 250-- print $ urlDecode $ urlEncode " 䡥汬漬⁗潲汤" 251-- should return "Москва" 252-- print $ urlDecode $ urlEncode "Москва" 253 254testURIRefSuite = TF.testGroup "Test URIrefs" testURIRefList 255testURIRefList = 256 [ TF.testCase "testURIRef001" testURIRef001 257 , TF.testCase "testURIRef002" testURIRef002 258 , TF.testCase "testURIRef003" testURIRef003 259 , TF.testCase "testURIRef004" testURIRef004 260 , TF.testCase "testURIRef005" testURIRef005 261 , TF.testCase "testURIRef006" testURIRef006 262 , TF.testCase "testURIRef007" testURIRef007 263 , TF.testCase "testURIRef008" testURIRef008 264 , TF.testCase "testURIRef009" testURIRef009 265 , TF.testCase "testURIRef010" testURIRef010 266 -- 267 , TF.testCase "testURIRef011" testURIRef011 268 , TF.testCase "testURIRef012" testURIRef012 269 , TF.testCase "testURIRef013" testURIRef013 270 , TF.testCase "testURIRef014" testURIRef014 271 , TF.testCase "testURIRef015" testURIRef015 272 , TF.testCase "testURIRef016" testURIRef016 273 , TF.testCase "testURIRef017" testURIRef017 274 , TF.testCase "testURIRef018" testURIRef018 275 -- 276 , TF.testCase "testURIRef019" testURIRef019 277 -- 278 , TF.testCase "testURIRef021" testURIRef021 279 , TF.testCase "testURIRef022" testURIRef022 280 , TF.testCase "testURIRef023" testURIRef023 281 , TF.testCase "testURIRef024" testURIRef024 282 , TF.testCase "testURIRef025" testURIRef025 283 , TF.testCase "testURIRef026" testURIRef026 284 , TF.testCase "testURIRef027" testURIRef027 285 , TF.testCase "testURIRef028" testURIRef028 286 , TF.testCase "testURIRef029" testURIRef029 287 -- 288 , TF.testCase "testURIRef031" testURIRef031 289 , TF.testCase "testURIRef032" testURIRef032 290 , TF.testCase "testURIRef033" testURIRef033 291 , TF.testCase "testURIRef034" testURIRef034 292 , TF.testCase "testURIRef035" testURIRef035 293 , TF.testCase "testURIRef036" testURIRef036 294 , TF.testCase "testURIRef037" testURIRef037 295 , TF.testCase "testURIRef038" testURIRef038 296 , TF.testCase "testURIRef039" testURIRef039 297 , TF.testCase "testURIRef040" testURIRef040 298 , TF.testCase "testURIRef041" testURIRef041 299 , TF.testCase "testURIRef042" testURIRef042 300 , TF.testCase "testURIRef043" testURIRef043 301 , TF.testCase "testURIRef044" testURIRef044 302 , TF.testCase "testURIRef045" testURIRef045 303 , TF.testCase "testURIRef046" testURIRef046 304 , TF.testCase "testURIRef047" testURIRef047 305 , TF.testCase "testURIRef048" testURIRef048 306 , TF.testCase "testURIRef049" testURIRef049 307 , TF.testCase "testURIRef050" testURIRef050 308 , TF.testCase "testURIRef051" testURIRef051 309 , TF.testCase "testURIRef052" testURIRef052 310 , TF.testCase "testURIRef053" testURIRef053 311 , TF.testCase "testURIRef054" testURIRef054 312 , TF.testCase "testURIRef055" testURIRef055 313 , TF.testCase "testURIRef056" testURIRef056 314 , TF.testCase "testURIRef057" testURIRef057 315 , TF.testCase "testURIRef058" testURIRef058 316 , TF.testCase "testURIRef059" testURIRef059 317 , TF.testCase "testURIRef060" testURIRef060 318 , TF.testCase "testURIRef061" testURIRef061 319 , TF.testCase "testURIRef062" testURIRef062 320 , TF.testCase "testURIRef063" testURIRef063 321 , TF.testCase "testURIRef064" testURIRef064 322 , TF.testCase "testURIRef065" testURIRef065 323 , TF.testCase "testURIRef066" testURIRef066 324 , TF.testCase "testURIRef067" testURIRef067 325 , TF.testCase "testURIRef068" testURIRef068 326 , TF.testCase "testURIRef069" testURIRef069 327 , TF.testCase "testURIRef070" testURIRef070 328 , TF.testCase "testURIRef071" testURIRef071 329 , TF.testCase "testURIRef072" testURIRef072 330 , TF.testCase "testURIRef073" testURIRef073 331 , TF.testCase "testURIRef074" testURIRef074 332 , TF.testCase "testURIRef075" testURIRef075 333 , TF.testCase "testURIRef076" testURIRef076 334 , TF.testCase "testURIRef077" testURIRef077 335 -- 336 , TF.testCase "testURIRef080" testURIRef080 337 , TF.testCase "testURIRef081" testURIRef081 338 , TF.testCase "testURIRef082" testURIRef082 339 , TF.testCase "testURIRef083" testURIRef083 340 , TF.testCase "testURIRef084" testURIRef084 341 , TF.testCase "testURIRef085" testURIRef085 342 , TF.testCase "testURIRef086" testURIRef086 343 , TF.testCase "testURIRef087" testURIRef087 344 -- testURIRef088, 345 -- testURIRef089, 346 , TF.testCase "testURIRef090" testURIRef090 347 , TF.testCase "testURIRef091" testURIRef091 348 , TF.testCase "testURIRef092" testURIRef092 349 , TF.testCase "testURIRef093" testURIRef093 350 , TF.testCase "testURIRef094" testURIRef094 351 , TF.testCase "testURIRef095" testURIRef095 352 , TF.testCase "testURIRef096" testURIRef096 353 , TF.testCase "testURIRef097" testURIRef097 354 , TF.testCase "testURIRef098" testURIRef098 355 -- testURIRef099, 356 -- 357 , TF.testCase "testURIRef101" testURIRef101 358 , TF.testCase "testURIRef102" testURIRef102 359 , TF.testCase "testURIRef103" testURIRef103 360 , TF.testCase "testURIRef104" testURIRef104 361 , TF.testCase "testURIRef105" testURIRef105 362 , TF.testCase "testURIRef106" testURIRef106 363 , TF.testCase "testURIRef107" testURIRef107 364 , TF.testCase "testURIRef108" testURIRef108 365 -- 366 , TF.testCase "testURIRef111" testURIRef111 367 , TF.testCase "testURIRef112" testURIRef112 368 , TF.testCase "testURIRef113" testURIRef113 369 , TF.testCase "testURIRef114" testURIRef114 370 , TF.testCase "testURIRef115" testURIRef115 371 , TF.testCase "testURIRef116" testURIRef116 372 , TF.testCase "testURIRef117" testURIRef117 373 -- 374 , TF.testCase "testURIRef118" testURIRef118 375 , TF.testCase "testURIRef119" testURIRef119 376 , TF.testCase "testURIRef120" testURIRef120 377 -- 378 , TF.testCase "testURIRef121" testURIRef121 379 , TF.testCase "testURIRef122" testURIRef122 380 -- IRI test cases not currently supported 381 -- , TF.testCase "testURIRef123" testURIRef123 382 -- , TF.testCase "testURIRef124" testURIRef124 383 ] 384 385-- test decomposition of URI into components 386testComponent01 = testURIRefComponents "testComponent01" 387 ( Just $ URI 388 { uriScheme = "http:" 389 , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") 390 , uriPath = "/aaa/bbb" 391 , uriQuery = "?qqq" 392 , uriFragment = "#fff" 393 } ) 394 "http://user:pass@example.org:99/aaa/bbb?qqq#fff" 395testComponent02 = testURIRefComponents "testComponent02" 396 ( const Nothing 397 ( Just $ URI 398 { uriScheme = "http:" 399 , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") 400 , uriPath = "aaa/bbb" 401 , uriQuery = "" 402 , uriFragment = "" 403 } ) 404 ) 405 "http://user:pass@example.org:99aaa/bbb" 406testComponent03 = testURIRefComponents "testComponent03" 407 ( Just $ URI 408 { uriScheme = "http:" 409 , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") 410 , uriPath = "" 411 , uriQuery = "?aaa/bbb" 412 , uriFragment = "" 413 } ) 414 "http://user:pass@example.org:99?aaa/bbb" 415testComponent04 = testURIRefComponents "testComponent03" 416 ( Just $ URI 417 { uriScheme = "http:" 418 , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") 419 , uriPath = "" 420 , uriQuery = "" 421 , uriFragment = "#aaa/bbb" 422 } ) 423 "http://user:pass@example.org:99#aaa/bbb" 424-- These test cases contributed by Robert Buck (mathworks.com) 425testComponent11 = testURIRefComponents "testComponent03" 426 ( Just $ URI 427 { uriScheme = "about:" 428 , uriAuthority = Nothing 429 , uriPath = "" 430 , uriQuery = "" 431 , uriFragment = "" 432 } ) 433 "about:" 434testComponent12 = testURIRefComponents "testComponent03" 435 ( Just $ URI 436 { uriScheme = "file:" 437 , uriAuthority = Just (URIAuth "" "windowsauth" "") 438 , uriPath = "/d$" 439 , uriQuery = "" 440 , uriFragment = "" 441 } ) 442 "file://windowsauth/d$" 443 444testComponentSuite = TF.testGroup "Test URIrefs" $ 445 [ TF.testCase "testComponent01" testComponent01 446 , TF.testCase "testComponent02" testComponent02 447 , TF.testCase "testComponent03" testComponent03 448 , TF.testCase "testComponent04" testComponent04 449 , TF.testCase "testComponent11" testComponent11 450 , TF.testCase "testComponent12" testComponent12 451 ] 452 453-- Get reference relative to given base 454-- relativeRef :: String -> String -> String 455-- 456-- Get absolute URI given base and relative reference 457-- absoluteURI :: String -> String -> String 458-- 459-- Test cases taken from: http://www.w3.org/2000/10/swap/uripath.py 460-- (Thanks, Dan Connolly) 461-- 462-- NOTE: absoluteURI base (relativeRef base u) is always equivalent to u. 463-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html 464 465testRelSplit :: String -> String -> String -> String -> Assertion 466testRelSplit label base uabs urel = 467 testEq label urel (mkrel puabs pubas) 468 where 469 mkrel (Just u1) (Just u2) = show (u1 `relativeFrom` u2) 470 mkrel Nothing _ = "Invalid URI: "++urel 471 mkrel _ Nothing = "Invalid URI: "++uabs 472 puabs = parseURIReference uabs 473 pubas = parseURIReference base 474 475testRelJoin :: String -> String -> String -> String -> Assertion 476testRelJoin label base urel uabs = 477 testEq label uabs (mkabs purel pubas) 478 where 479 mkabs (Just u1) (Just u2) = show (u1 `relativeTo` u2) 480 mkabs Nothing _ = "Invalid URI: "++urel 481 mkabs _ Nothing = "Invalid URI: "++uabs 482 purel = parseURIReference urel 483 pubas = parseURIReference base 484 485testRelative :: String -> String -> String -> String -> Assertion 486testRelative label base uabs urel = sequence_ 487 [ 488 (testRelSplit (label++"(rel)") base uabs urel), 489 (testRelJoin (label++"(abs)") base urel uabs) 490 ] 491 492testRelative01 = testRelative "testRelative01" 493 "foo:xyz" "bar:abc" "bar:abc" 494testRelative02 = testRelative "testRelative02" 495 "http://example/x/y/z" "http://example/x/abc" "../abc" 496testRelative03 = testRelative "testRelative03" 497 "http://example2/x/y/z" "http://example/x/abc" "//example/x/abc" 498 -- "http://example2/x/y/z" "http://example/x/abc" "http://example/x/abc" 499testRelative04 = testRelative "testRelative04" 500 "http://ex/x/y/z" "http://ex/x/r" "../r" 501testRelative05 = testRelative "testRelative05" 502 "http://ex/x/y/z" "http://ex/r" "/r" 503 -- "http://ex/x/y/z" "http://ex/r" "../../r" 504testRelative06 = testRelative "testRelative06" 505 "http://ex/x/y/z" "http://ex/x/y/q/r" "q/r" 506testRelative07 = testRelative "testRelative07" 507 "http://ex/x/y" "http://ex/x/q/r#s" "q/r#s" 508testRelative08 = testRelative "testRelative08" 509 "http://ex/x/y" "http://ex/x/q/r#s/t" "q/r#s/t" 510testRelative09 = testRelative "testRelative09" 511 "http://ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r" 512testRelative10 = testRelative "testRelative10" 513 -- "http://ex/x/y" "http://ex/x/y" "y" 514 "http://ex/x/y" "http://ex/x/y" "" 515testRelative11 = testRelative "testRelative11" 516 -- "http://ex/x/y/" "http://ex/x/y/" "./" 517 "http://ex/x/y/" "http://ex/x/y/" "" 518testRelative12 = testRelative "testRelative12" 519 -- "http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq" 520 "http://ex/x/y/pdq" "http://ex/x/y/pdq" "" 521testRelative13 = testRelative "testRelative13" 522 "http://ex/x/y/" "http://ex/x/y/z/" "z/" 523testRelative14 = testRelative "testRelative14" 524 -- "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal" 525 "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "#Animal" 526testRelative15 = testRelative "testRelative15" 527 "file:/e/x/y/z" "file:/e/x/abc" "../abc" 528testRelative16 = testRelative "testRelative16" 529 "file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc" 530testRelative17 = testRelative "testRelative17" 531 "file:/ex/x/y/z" "file:/ex/x/r" "../r" 532testRelative18 = testRelative "testRelative18" 533 "file:/ex/x/y/z" "file:/r" "/r" 534testRelative19 = testRelative "testRelative19" 535 "file:/ex/x/y" "file:/ex/x/q/r" "q/r" 536testRelative20 = testRelative "testRelative20" 537 "file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s" 538testRelative21 = testRelative "testRelative21" 539 "file:/ex/x/y" "file:/ex/x/q/r#" "q/r#" 540testRelative22 = testRelative "testRelative22" 541 "file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t" 542testRelative23 = testRelative "testRelative23" 543 "file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r" 544testRelative24 = testRelative "testRelative24" 545 -- "file:/ex/x/y" "file:/ex/x/y" "y" 546 "file:/ex/x/y" "file:/ex/x/y" "" 547testRelative25 = testRelative "testRelative25" 548 -- "file:/ex/x/y/" "file:/ex/x/y/" "./" 549 "file:/ex/x/y/" "file:/ex/x/y/" "" 550testRelative26 = testRelative "testRelative26" 551 -- "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq" 552 "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "" 553testRelative27 = testRelative "testRelative27" 554 "file:/ex/x/y/" "file:/ex/x/y/z/" "z/" 555testRelative28 = testRelative "testRelative28" 556 "file:/devel/WWW/2000/10/swap/test/reluri-1.n3" 557 "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1" 558 -- "file:/devel/WWW/2000/10/swap/test/reluri-1.n3" 559 -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1" 560testRelative29 = testRelative "testRelative29" 561 "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3" 562 "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1" 563 -- "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3" 564 -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1" 565testRelative30 = testRelative "testRelative30" 566 "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort" 567testRelative31 = testRelative "testRelative31" 568 "file:/some/dir/foo" "file:/some/dir/#" "./#" 569testRelative32 = testRelative "testRelative32" 570 "http://ex/x/y" "http://ex/x/q:r" "./q:r" 571 -- see RFC2396bis, section 5 ^^ 572testRelative33 = testRelative "testRelative33" 573 "http://ex/x/y" "http://ex/x/p=q:r" "./p=q:r" 574 -- "http://ex/x/y" "http://ex/x/p=q:r" "p=q:r" 575testRelative34 = testRelative "testRelative34" 576 "http://ex/x/y?pp/qq" "http://ex/x/y?pp/rr" "?pp/rr" 577testRelative35 = testRelative "testRelative35" 578 "http://ex/x/y?pp/qq" "http://ex/x/y/z" "y/z" 579testRelative36 = testRelative "testRelative36" 580 "mailto:local" 581 "mailto:local/qual@domain.org#frag" 582 "local/qual@domain.org#frag" 583testRelative37 = testRelative "testRelative37" 584 "mailto:local/qual1@domain1.org" 585 "mailto:local/more/qual2@domain2.org#frag" 586 "more/qual2@domain2.org#frag" 587testRelative38 = testRelative "testRelative38" 588 "http://ex/x/z?q" "http://ex/x/y?q" "y?q" 589testRelative39 = testRelative "testRelative39" 590 "http://ex?p" "http://ex/x/y?q" "/x/y?q" 591testRelative40 = testRelative "testRelative40" 592 "foo:a/b" "foo:a/c/d" "c/d" 593testRelative41 = testRelative "testRelative41" 594 "foo:a/b" "foo:/c/d" "/c/d" 595testRelative42 = testRelative "testRelative42" 596 "foo:a/b?c#d" "foo:a/b?c" "" 597testRelative43 = testRelative "testRelative42" 598 "foo:a" "foo:b/c" "b/c" 599testRelative44 = testRelative "testRelative44" 600 "foo:/a/y/z" "foo:/a/b/c" "../b/c" 601testRelative45 = testRelJoin "testRelative45" 602 "foo:a" "./b/c" "foo:b/c" 603testRelative46 = testRelJoin "testRelative46" 604 "foo:a" "/./b/c" "foo:/b/c" 605testRelative47 = testRelJoin "testRelative47" 606 "foo://a//b/c" "../../d" "foo://a/d" 607testRelative48 = testRelJoin "testRelative48" 608 "foo:a" "." "foo:" 609testRelative49 = testRelJoin "testRelative49" 610 "foo:a" ".." "foo:" 611 612-- add escape tests 613testRelative50 = testRelative "testRelative50" 614 "http://example/x/y%2Fz" "http://example/x/abc" "abc" 615testRelative51 = testRelative "testRelative51" 616 "http://example/a/x/y/z" "http://example/a/x%2Fabc" "../../x%2Fabc" 617testRelative52 = testRelative "testRelative52" 618 "http://example/a/x/y%2Fz" "http://example/a/x%2Fabc" "../x%2Fabc" 619testRelative53 = testRelative "testRelative53" 620 "http://example/x%2Fy/z" "http://example/x%2Fy/abc" "abc" 621testRelative54 = testRelative "testRelative54" 622 "http://ex/x/y" "http://ex/x/q%3Ar" "q%3Ar" 623testRelative55 = testRelative "testRelative55" 624 "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc" 625-- Apparently, TimBL prefers the following way to 41, 42 above 626-- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html 627-- He also notes that there may be different relative fuctions 628-- that satisfy the basic equivalence axiom: 629-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html 630testRelative56 = testRelative "testRelative56" 631 "http://example/x/y/z" "http://example/x%2Fabc" "/x%2Fabc" 632testRelative57 = testRelative "testRelative57" 633 "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc" 634 635-- Other oddball tests 636 -- Check segment normalization code: 637testRelative60 = testRelJoin "testRelative60" 638 "ftp://example/x/y" "http://example/a/b/../../c" "http://example/c" 639testRelative61 = testRelJoin "testRelative61" 640 "ftp://example/x/y" "http://example/a/b/c/../../" "http://example/a/" 641testRelative62 = testRelJoin "testRelative62" 642 "ftp://example/x/y" "http://example/a/b/c/./" "http://example/a/b/c/" 643testRelative63 = testRelJoin "testRelative63" 644 "ftp://example/x/y" "http://example/a/b/c/.././" "http://example/a/b/" 645testRelative64 = testRelJoin "testRelative64" 646 "ftp://example/x/y" "http://example/a/b/c/d/../../../../e" "http://example/e" 647testRelative65 = testRelJoin "testRelative65" 648 "ftp://example/x/y" "http://example/a/b/c/d/../.././../../e" "http://example/e" 649 -- Check handling of queries and fragments with non-relative paths 650testRelative70 = testRelative "testRelative70" 651 "mailto:local1@domain1?query1" "mailto:local2@domain2" 652 "local2@domain2" 653testRelative71 = testRelative "testRelative71" 654 "mailto:local1@domain1" "mailto:local2@domain2?query2" 655 "local2@domain2?query2" 656testRelative72 = testRelative "testRelative72" 657 "mailto:local1@domain1?query1" "mailto:local2@domain2?query2" 658 "local2@domain2?query2" 659testRelative73 = testRelative "testRelative73" 660 "mailto:local@domain?query1" "mailto:local@domain?query2" 661 "?query2" 662testRelative74 = testRelative "testRelative74" 663 "mailto:?query1" "mailto:local@domain?query2" 664 "local@domain?query2" 665testRelative75 = testRelative "testRelative75" 666 "mailto:local@domain?query1" "mailto:local@domain?query2" 667 "?query2" 668testRelative76 = testRelative "testRelative76" 669 "foo:bar" "http://example/a/b?c/../d" "http://example/a/b?c/../d" 670testRelative77 = testRelative "testRelative77" 671 "foo:bar" "http://example/a/b#c/../d" "http://example/a/b#c/../d" 672{- These (78-81) are some awkward test cases thrown up by a question on the URI list: 673 http://lists.w3.org/Archives/Public/uri/2005Jul/0013 674 Mote that RFC 3986 discards path segents after the final '/' only when merging two 675 paths - otherwise the final segment in the base URI is mnaintained. This leads to 676 difficulty in constructinmg a reversible relativeTo/relativeFrom pair of functions. 677-} 678testRelative78 = testRelative "testRelative78" 679 "http://www.example.com/data/limit/.." "http://www.example.com/data/limit/test.xml" 680 "test.xml" 681testRelative79 = testRelative "testRelative79" 682 "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort" 683testRelative80 = testRelative "testRelative80" 684 "file:/some/dir/foo" "file:/some/dir/#" "./#" 685testRelative81 = testRelative "testRelative81" 686 "file:/some/dir/.." "file:/some/dir/#blort" "./#blort" 687 688-- testRelative base abs rel 689-- testRelSplit base abs rel 690-- testRelJoin base rel abs 691testRelative91 = testRelSplit "testRelative91" 692 "http://example.org/base/uri" "http:this" 693 "this" 694testRelative92 = testRelJoin "testRelative92" 695 "http://example.org/base/uri" "http:this" 696 "http:this" 697testRelative93 = testRelJoin "testRelative93" 698 "http:base" "http:this" 699 "http:this" 700testRelative94 = testRelJoin "testRelative94" 701 "f:/a" ".//g" 702 "f://g" 703testRelative95 = testRelJoin "testRelative95" 704 "f://example.org/base/a" "b/c//d/e" 705 "f://example.org/base/b/c//d/e" 706testRelative96 = testRelJoin "testRelative96" 707 "mid:m@example.ord/c@example.org" "m2@example.ord/c2@example.org" 708 "mid:m@example.ord/m2@example.ord/c2@example.org" 709testRelative97 = testRelJoin "testRelative97" 710 "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" "mini1.xml" 711 "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/mini1.xml" 712testRelative98 = testRelative "testRelative98" 713 "foo:a/y/z" "foo:a/b/c" "../b/c" 714testRelative99 = testRelJoin "testRelative99" 715 "f:/a/" "..//g" 716 "f://g" 717 718 719testRelativeSuite = TF.testGroup "Test Relative URIs" testRelativeList 720testRelativeList = 721 [ TF.testCase "testRelative01" testRelative01 722 , TF.testCase "testRelative02" testRelative02 723 , TF.testCase "testRelative03" testRelative03 724 , TF.testCase "testRelative04" testRelative04 725 , TF.testCase "testRelative05" testRelative05 726 , TF.testCase "testRelative06" testRelative06 727 , TF.testCase "testRelative07" testRelative07 728 , TF.testCase "testRelative08" testRelative08 729 , TF.testCase "testRelative09" testRelative09 730 , TF.testCase "testRelative10" testRelative10 731 , TF.testCase "testRelative11" testRelative11 732 , TF.testCase "testRelative12" testRelative12 733 , TF.testCase "testRelative13" testRelative13 734 , TF.testCase "testRelative14" testRelative14 735 , TF.testCase "testRelative15" testRelative15 736 , TF.testCase "testRelative16" testRelative16 737 , TF.testCase "testRelative17" testRelative17 738 , TF.testCase "testRelative18" testRelative18 739 , TF.testCase "testRelative19" testRelative19 740 , TF.testCase "testRelative20" testRelative20 741 , TF.testCase "testRelative21" testRelative21 742 , TF.testCase "testRelative22" testRelative22 743 , TF.testCase "testRelative23" testRelative23 744 , TF.testCase "testRelative24" testRelative24 745 , TF.testCase "testRelative25" testRelative25 746 , TF.testCase "testRelative26" testRelative26 747 , TF.testCase "testRelative27" testRelative27 748 , TF.testCase "testRelative28" testRelative28 749 , TF.testCase "testRelative29" testRelative29 750 , TF.testCase "testRelative30" testRelative30 751 , TF.testCase "testRelative31" testRelative31 752 , TF.testCase "testRelative32" testRelative32 753 , TF.testCase "testRelative33" testRelative33 754 , TF.testCase "testRelative34" testRelative34 755 , TF.testCase "testRelative35" testRelative35 756 , TF.testCase "testRelative36" testRelative36 757 , TF.testCase "testRelative37" testRelative37 758 , TF.testCase "testRelative38" testRelative38 759 , TF.testCase "testRelative39" testRelative39 760 , TF.testCase "testRelative40" testRelative40 761 , TF.testCase "testRelative41" testRelative41 762 , TF.testCase "testRelative42" testRelative42 763 , TF.testCase "testRelative43" testRelative43 764 , TF.testCase "testRelative44" testRelative44 765 , TF.testCase "testRelative45" testRelative45 766 , TF.testCase "testRelative46" testRelative46 767 , TF.testCase "testRelative47" testRelative47 768 , TF.testCase "testRelative48" testRelative48 769 , TF.testCase "testRelative49" testRelative49 770 -- 771 , TF.testCase "testRelative50" testRelative50 772 , TF.testCase "testRelative51" testRelative51 773 , TF.testCase "testRelative52" testRelative52 774 , TF.testCase "testRelative53" testRelative53 775 , TF.testCase "testRelative54" testRelative54 776 , TF.testCase "testRelative55" testRelative55 777 , TF.testCase "testRelative56" testRelative56 778 , TF.testCase "testRelative57" testRelative57 779 -- 780 , TF.testCase "testRelative60" testRelative60 781 , TF.testCase "testRelative61" testRelative61 782 , TF.testCase "testRelative62" testRelative62 783 , TF.testCase "testRelative63" testRelative63 784 , TF.testCase "testRelative64" testRelative64 785 , TF.testCase "testRelative65" testRelative65 786 -- 787 , TF.testCase "testRelative70" testRelative70 788 , TF.testCase "testRelative71" testRelative71 789 , TF.testCase "testRelative72" testRelative72 790 , TF.testCase "testRelative73" testRelative73 791 , TF.testCase "testRelative74" testRelative74 792 , TF.testCase "testRelative75" testRelative75 793 , TF.testCase "testRelative76" testRelative76 794 , TF.testCase "testRelative77" testRelative77 795 -- Awkward cases: 796 , TF.testCase "testRelative78" testRelative78 797 , TF.testCase "testRelative79" testRelative79 798 , TF.testCase "testRelative80" testRelative80 799 , TF.testCase "testRelative81" testRelative81 800 -- 801 -- , TF.testCase "testRelative90" testRelative90 802 , TF.testCase "testRelative91" testRelative91 803 , TF.testCase "testRelative92" testRelative92 804 , TF.testCase "testRelative93" testRelative93 805 , TF.testCase "testRelative94" testRelative94 806 , TF.testCase "testRelative95" testRelative95 807 , TF.testCase "testRelative96" testRelative96 808 , TF.testCase "testRelative97" testRelative97 809 , TF.testCase "testRelative98" testRelative98 810 , TF.testCase "testRelative99" testRelative99 811 ] 812 813-- RFC2396 relative-to-absolute URI tests 814 815rfcbase = "http://a/b/c/d;p?q" 816-- normal cases, RFC2396bis 5.4.1 817testRFC01 = testRelJoin "testRFC01" rfcbase "g:h" "g:h" 818testRFC02 = testRelJoin "testRFC02" rfcbase "g" "http://a/b/c/g" 819testRFC03 = testRelJoin "testRFC03" rfcbase "./g" "http://a/b/c/g" 820testRFC04 = testRelJoin "testRFC04" rfcbase "g/" "http://a/b/c/g/" 821testRFC05 = testRelJoin "testRFC05" rfcbase "/g" "http://a/g" 822testRFC06 = testRelJoin "testRFC06" rfcbase "//g" "http://g" 823testRFC07 = testRelJoin "testRFC07" rfcbase "?y" "http://a/b/c/d;p?y" 824testRFC08 = testRelJoin "testRFC08" rfcbase "g?y" "http://a/b/c/g?y" 825testRFC09 = testRelJoin "testRFC09" rfcbase "?q#s" "http://a/b/c/d;p?q#s" 826testRFC23 = testRelJoin "testRFC10" rfcbase "#s" "http://a/b/c/d;p?q#s" 827testRFC10 = testRelJoin "testRFC11" rfcbase "g#s" "http://a/b/c/g#s" 828testRFC11 = testRelJoin "testRFC12" rfcbase "g?y#s" "http://a/b/c/g?y#s" 829testRFC12 = testRelJoin "testRFC13" rfcbase ";x" "http://a/b/c/;x" 830testRFC13 = testRelJoin "testRFC14" rfcbase "g;x" "http://a/b/c/g;x" 831testRFC14 = testRelJoin "testRFC15" rfcbase "g;x?y#s" "http://a/b/c/g;x?y#s" 832testRFC24 = testRelJoin "testRFC16" rfcbase "" "http://a/b/c/d;p?q" 833testRFC15 = testRelJoin "testRFC17" rfcbase "." "http://a/b/c/" 834testRFC16 = testRelJoin "testRFC18" rfcbase "./" "http://a/b/c/" 835testRFC17 = testRelJoin "testRFC19" rfcbase ".." "http://a/b/" 836testRFC18 = testRelJoin "testRFC20" rfcbase "../" "http://a/b/" 837testRFC19 = testRelJoin "testRFC21" rfcbase "../g" "http://a/b/g" 838testRFC20 = testRelJoin "testRFC22" rfcbase "../.." "http://a/" 839testRFC21 = testRelJoin "testRFC23" rfcbase "../../" "http://a/" 840testRFC22 = testRelJoin "testRFC24" rfcbase "../../g" "http://a/g" 841-- abnormal cases, RFC2396bis 5.4.2 842testRFC31 = testRelJoin "testRFC31" rfcbase "?q" rfcbase 843testRFC32 = testRelJoin "testRFC32" rfcbase "../../../g" "http://a/g" 844testRFC33 = testRelJoin "testRFC33" rfcbase "../../../../g" "http://a/g" 845testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/g" 846testRFC35 = testRelJoin "testRFC35" rfcbase "/../g" "http://a/g" 847testRFC36 = testRelJoin "testRFC36" rfcbase "g." "http://a/b/c/g." 848testRFC37 = testRelJoin "testRFC37" rfcbase ".g" "http://a/b/c/.g" 849testRFC38 = testRelJoin "testRFC38" rfcbase "g.." "http://a/b/c/g.." 850testRFC39 = testRelJoin "testRFC39" rfcbase "..g" "http://a/b/c/..g" 851testRFC40 = testRelJoin "testRFC40" rfcbase "./../g" "http://a/b/g" 852testRFC41 = testRelJoin "testRFC41" rfcbase "./g/." "http://a/b/c/g/" 853testRFC42 = testRelJoin "testRFC42" rfcbase "g/./h" "http://a/b/c/g/h" 854testRFC43 = testRelJoin "testRFC43" rfcbase "g/../h" "http://a/b/c/h" 855testRFC44 = testRelJoin "testRFC44" rfcbase "g;x=1/./y" "http://a/b/c/g;x=1/y" 856testRFC45 = testRelJoin "testRFC45" rfcbase "g;x=1/../y" "http://a/b/c/y" 857testRFC46 = testRelJoin "testRFC46" rfcbase "g?y/./x" "http://a/b/c/g?y/./x" 858testRFC47 = testRelJoin "testRFC47" rfcbase "g?y/../x" "http://a/b/c/g?y/../x" 859testRFC48 = testRelJoin "testRFC48" rfcbase "g#s/./x" "http://a/b/c/g#s/./x" 860testRFC49 = testRelJoin "testRFC49" rfcbase "g#s/../x" "http://a/b/c/g#s/../x" 861testRFC50 = testRelJoin "testRFC50" rfcbase "http:x" "http:x" 862 863-- Null path tests 864-- See RFC2396bis, section 5.2, 865-- "If the base URI's path component is the empty string, then a single 866-- slash character is copied to the buffer" 867testRFC60 = testRelative "testRFC60" "http://ex" "http://ex/x/y?q" "/x/y?q" 868testRFC61 = testRelJoin "testRFC61" "http://ex" "x/y?q" "http://ex/x/y?q" 869testRFC62 = testRelative "testRFC62" "http://ex?p" "http://ex/x/y?q" "/x/y?q" 870testRFC63 = testRelJoin "testRFC63" "http://ex?p" "x/y?q" "http://ex/x/y?q" 871testRFC64 = testRelative "testRFC64" "http://ex#f" "http://ex/x/y?q" "/x/y?q" 872testRFC65 = testRelJoin "testRFC65" "http://ex#f" "x/y?q" "http://ex/x/y?q" 873testRFC66 = testRelative "testRFC66" "http://ex?p" "http://ex/x/y#g" "/x/y#g" 874testRFC67 = testRelJoin "testRFC67" "http://ex?p" "x/y#g" "http://ex/x/y#g" 875testRFC68 = testRelative "testRFC68" "http://ex" "http://ex/" "/" 876testRFC69 = testRelJoin "testRFC69" "http://ex" "./" "http://ex/" 877testRFC70 = testRelative "testRFC70" "http://ex" "http://ex/a/b" "/a/b" 878testRFC71 = testRelative "testRFC71" "http://ex/a/b" "http://ex" "./" 879 880testRFC2396Suite = TF.testGroup "Test RFC2396 examples" testRFC2396List 881testRFC2396List = 882 [ TF.testCase "testRFC01" testRFC01 883 , TF.testCase "testRFC02" testRFC02 884 , TF.testCase "testRFC03" testRFC03 885 , TF.testCase "testRFC04" testRFC04 886 , TF.testCase "testRFC05" testRFC05 887 , TF.testCase "testRFC06" testRFC06 888 , TF.testCase "testRFC07" testRFC07 889 , TF.testCase "testRFC08" testRFC08 890 , TF.testCase "testRFC09" testRFC09 891 , TF.testCase "testRFC10" testRFC10 892 , TF.testCase "testRFC11" testRFC11 893 , TF.testCase "testRFC12" testRFC12 894 , TF.testCase "testRFC13" testRFC13 895 , TF.testCase "testRFC14" testRFC14 896 , TF.testCase "testRFC15" testRFC15 897 , TF.testCase "testRFC16" testRFC16 898 , TF.testCase "testRFC17" testRFC17 899 , TF.testCase "testRFC18" testRFC18 900 , TF.testCase "testRFC19" testRFC19 901 , TF.testCase "testRFC20" testRFC20 902 , TF.testCase "testRFC21" testRFC21 903 , TF.testCase "testRFC22" testRFC22 904 , TF.testCase "testRFC23" testRFC23 905 , TF.testCase "testRFC24" testRFC24 906 -- testRFC30, 907 , TF.testCase "testRFC31" testRFC31 908 , TF.testCase "testRFC32" testRFC32 909 , TF.testCase "testRFC33" testRFC33 910 , TF.testCase "testRFC34" testRFC34 911 , TF.testCase "testRFC35" testRFC35 912 , TF.testCase "testRFC36" testRFC36 913 , TF.testCase "testRFC37" testRFC37 914 , TF.testCase "testRFC38" testRFC38 915 , TF.testCase "testRFC39" testRFC39 916 , TF.testCase "testRFC40" testRFC40 917 , TF.testCase "testRFC41" testRFC41 918 , TF.testCase "testRFC42" testRFC42 919 , TF.testCase "testRFC43" testRFC43 920 , TF.testCase "testRFC44" testRFC44 921 , TF.testCase "testRFC45" testRFC45 922 , TF.testCase "testRFC46" testRFC46 923 , TF.testCase "testRFC47" testRFC47 924 , TF.testCase "testRFC48" testRFC48 925 , TF.testCase "testRFC49" testRFC49 926 , TF.testCase "testRFC50" testRFC50 927 -- 928 , TF.testCase "testRFC60" testRFC60 929 , TF.testCase "testRFC61" testRFC61 930 , TF.testCase "testRFC62" testRFC62 931 , TF.testCase "testRFC63" testRFC63 932 , TF.testCase "testRFC64" testRFC64 933 , TF.testCase "testRFC65" testRFC65 934 , TF.testCase "testRFC66" testRFC66 935 , TF.testCase "testRFC67" testRFC67 936 , TF.testCase "testRFC68" testRFC68 937 , TF.testCase "testRFC69" testRFC69 938 , TF.testCase "testRFC70" testRFC70 939 ] 940 941-- And some other oddballs: 942mailbase = "mailto:local/option@domain.org?notaquery#frag" 943testMail01 = testRelJoin "testMail01" 944 mailbase "more@domain" 945 "mailto:local/more@domain" 946testMail02 = testRelJoin "testMail02" 947 mailbase "#newfrag" 948 "mailto:local/option@domain.org?notaquery#newfrag" 949testMail03 = testRelJoin "testMail03" 950 mailbase "l1/q1@domain" 951 "mailto:local/l1/q1@domain" 952 953testMail11 = testRelJoin "testMail11" 954 "mailto:local1@domain1?query1" "mailto:local2@domain2" 955 "mailto:local2@domain2" 956testMail12 = testRelJoin "testMail12" 957 "mailto:local1@domain1" "mailto:local2@domain2?query2" 958 "mailto:local2@domain2?query2" 959testMail13 = testRelJoin "testMail13" 960 "mailto:local1@domain1?query1" "mailto:local2@domain2?query2" 961 "mailto:local2@domain2?query2" 962testMail14 = testRelJoin "testMail14" 963 "mailto:local@domain?query1" "mailto:local@domain?query2" 964 "mailto:local@domain?query2" 965testMail15 = testRelJoin "testMail15" 966 "mailto:?query1" "mailto:local@domain?query2" 967 "mailto:local@domain?query2" 968testMail16 = testRelJoin "testMail16" 969 "mailto:local@domain?query1" "?query2" 970 "mailto:local@domain?query2" 971testInfo17 = testRelJoin "testInfo17" 972 "info:name/1234/../567" "name/9876/../543" 973 "info:name/name/543" 974testInfo18 = testRelJoin "testInfo18" 975 "info:/name/1234/../567" "name/9876/../543" 976 "info:/name/name/543" 977 978testOddballSuite = TF.testGroup "Test oddball examples" testOddballList 979testOddballList = 980 [ TF.testCase "testMail01" testMail01 981 , TF.testCase "testMail02" testMail02 982 , TF.testCase "testMail03" testMail03 983 , TF.testCase "testMail11" testMail11 984 , TF.testCase "testMail12" testMail12 985 , TF.testCase "testMail13" testMail13 986 , TF.testCase "testMail14" testMail14 987 , TF.testCase "testMail15" testMail15 988 , TF.testCase "testMail16" testMail16 989 , TF.testCase "testInfo17" testInfo17 990 ] 991 992-- Normalization tests 993 994-- Case normalization; cf. RFC2396bis section 6.2.2.1 995-- NOTE: authority case normalization is not performed 996testNormalize01 = testEq "testNormalize01" 997 "http://EXAMPLE.com/Root/%2A?%2B#%2C" 998 (normalizeCase "HTTP://EXAMPLE.com/Root/%2a?%2b#%2c") 999 1000-- Encoding normalization; cf. RFC2396bis section 6.2.2.2 1001testNormalize11 = testEq "testNormalize11" 1002 "HTTP://EXAMPLE.com/Root/~Me/" 1003 (normalizeEscape "HTTP://EXAMPLE.com/Root/%7eMe/") 1004testNormalize12 = testEq "testNormalize12" 1005 "foo:%40AZ%5b%60az%7b%2f09%3a-._~" 1006 (normalizeEscape "foo:%40%41%5a%5b%60%61%7a%7b%2f%30%39%3a%2d%2e%5f%7e") 1007testNormalize13 = testEq "testNormalize13" 1008 "foo:%3a%2f%3f%23%5b%5d%40" 1009 (normalizeEscape "foo:%3a%2f%3f%23%5b%5d%40") 1010 1011-- Path segment normalization; cf. RFC2396bis section 6.2.2.4 1012testNormalize21 = testEq "testNormalize21" 1013 "http://example/c" 1014 (normalizePathSegments "http://example/a/b/../../c") 1015testNormalize22 = testEq "testNormalize22" 1016 "http://example/a/" 1017 (normalizePathSegments "http://example/a/b/c/../../") 1018testNormalize23 = testEq "testNormalize23" 1019 "http://example/a/b/c/" 1020 (normalizePathSegments "http://example/a/b/c/./") 1021testNormalize24 = testEq "testNormalize24" 1022 "http://example/a/b/" 1023 (normalizePathSegments "http://example/a/b/c/.././") 1024testNormalize25 = testEq "testNormalize25" 1025 "http://example/e" 1026 (normalizePathSegments "http://example/a/b/c/d/../../../../e") 1027testNormalize26 = testEq "testNormalize26" 1028 "http://example/e" 1029 (normalizePathSegments "http://example/a/b/c/d/../.././../../e") 1030testNormalize27 = testEq "testNormalize27" 1031 "http://example/e" 1032 (normalizePathSegments "http://example/a/b/../.././../../e") 1033testNormalize28 = testEq "testNormalize28" 1034 "foo:e" 1035 (normalizePathSegments "foo:a/b/../.././../../e") 1036 1037testNormalizeSuite = TF.testGroup "testNormalizeSuite" 1038 [ TF.testCase "testNormalize01" testNormalize01 1039 , TF.testCase "testNormalize11" testNormalize11 1040 , TF.testCase "testNormalize12" testNormalize12 1041 , TF.testCase "testNormalize13" testNormalize13 1042 , TF.testCase "testNormalize21" testNormalize21 1043 , TF.testCase "testNormalize22" testNormalize22 1044 , TF.testCase "testNormalize23" testNormalize23 1045 , TF.testCase "testNormalize24" testNormalize24 1046 , TF.testCase "testNormalize25" testNormalize25 1047 , TF.testCase "testNormalize26" testNormalize26 1048 , TF.testCase "testNormalize27" testNormalize27 1049 , TF.testCase "testNormalize28" testNormalize28 1050 ] 1051 1052-- URI formatting (show) tests 1053 1054ts02URI = URI { uriScheme = "http:" 1055 , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99") 1056 , uriPath = "/aaa/bbb" 1057 , uriQuery = "?ccc" 1058 , uriFragment = "#ddd/eee" 1059 } 1060 1061ts04URI = URI { uriScheme = "http:" 1062 , uriAuthority = Just (URIAuth "user:anonymous@" "example.org" ":99") 1063 , uriPath = "/aaa/bbb" 1064 , uriQuery = "?ccc" 1065 , uriFragment = "#ddd/eee" 1066 } 1067 1068ts02str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee" 1069ts03str = "http://user:pass@example.org:99/aaa/bbb?ccc#ddd/eee" 1070ts04str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee" 1071 1072testShowURI01 = testEq "testShowURI01" "" (show nullURI) 1073testShowURI02 = testEq "testShowURI02" ts02str (show ts02URI) 1074testShowURI03 = testEq "testShowURI03" ts03str ((uriToString id ts02URI) "") 1075testShowURI04 = testEq "testShowURI04" ts04str (show ts04URI) 1076 1077testShowURI = TF.testGroup "testShowURI" 1078 [ TF.testCase "testShowURI01" testShowURI01 1079 , TF.testCase "testShowURI02" testShowURI02 1080 , TF.testCase "testShowURI03" testShowURI03 1081 , TF.testCase "testShowURI04" testShowURI04 1082 ] 1083 1084 1085-- URI escaping tests 1086 1087te01str = "http://example.org/az/09-_/.~:/?#[]@!$&'()*+,;=" 1088te02str = "http://example.org/a</b>/c%/d /e" 1089te02esc = "http://example.org/a%3C/b%3E/c%25/d%20/e" 1090 1091testEscapeURIString01 = testEq "testEscapeURIString01" 1092 te01str (escapeURIString isUnescapedInURI te01str) 1093 1094testEscapeURIString02 = testEq "testEscapeURIString02" 1095 te02esc (escapeURIString isUnescapedInURI te02str) 1096 1097testEscapeURIString03 = testEq "testEscapeURIString03" 1098 te01str (unEscapeString te01str) 1099 1100testEscapeURIString04 = testEq "testEscapeURIString04" 1101 te02str (unEscapeString te02esc) 1102 1103testEscapeURIString05 = testEq "testEscapeURIString05" 1104 "http%3A%2F%2Fexample.org%2Faz%2F09-_%2F.~%3A%2F%3F%23%5B%5D%40%21%24%26%27%28%29%2A%2B%2C%3B%3D" 1105 (escapeURIString isUnescapedInURIComponent te01str) 1106 1107testEscapeURIString06 = testEq "testEscapeURIString06" 1108 "hello%C3%B8%C2%A9%E6%97%A5%E6%9C%AC" 1109 (escapeURIString isUnescapedInURIComponent "helloø©日本") 1110 1111propEscapeUnEscapeLoop :: String -> Bool 1112propEscapeUnEscapeLoop s = s == (unEscapeString $! escaped) 1113 where 1114 escaped = escapeURIString (const False) s 1115 {-# NOINLINE escaped #-} 1116 1117testEscapeURIString = TF.testGroup "testEscapeURIString" 1118 [ TF.testCase "testEscapeURIString01" testEscapeURIString01 1119 , TF.testCase "testEscapeURIString02" testEscapeURIString02 1120 , TF.testCase "testEscapeURIString03" testEscapeURIString03 1121 , TF.testCase "testEscapeURIString04" testEscapeURIString04 1122 , TF.testCase "testEscapeURIString05" testEscapeURIString05 1123 , TF.testCase "testEscapeURIString06" testEscapeURIString06 1124 , TF.testProperty "propEscapeUnEscapeLoop" propEscapeUnEscapeLoop 1125 ] 1126 1127-- URI string normalization tests 1128 1129tn01str = "eXAMPLE://a/b/%7bfoo%7d" 1130tn01nrm = "example://a/b/%7Bfoo%7D" 1131 1132tn02str = "example://a/b/%63/" 1133tn02nrm = "example://a/b/c/" 1134 1135tn03str = "example://a/./b/../b/c/foo" 1136tn03nrm = "example://a/b/c/foo" 1137 1138tn04str = "eXAMPLE://a/b/%7bfoo%7d" -- From RFC2396bis, 6.2.2 1139tn04nrm = "example://a/b/%7Bfoo%7D" 1140 1141tn06str = "file:/x/..//y" 1142tn06nrm = "file://y" 1143 1144tn07str = "file:x/..//y/" 1145tn07nrm = "file:/y/" 1146 1147testNormalizeURIString01 = testEq "testNormalizeURIString01" 1148 tn01nrm (normalizeCase tn01str) 1149testNormalizeURIString02 = testEq "testNormalizeURIString02" 1150 tn02nrm (normalizeEscape tn02str) 1151testNormalizeURIString03 = testEq "testNormalizeURIString03" 1152 tn03nrm (normalizePathSegments tn03str) 1153testNormalizeURIString04 = testEq "testNormalizeURIString04" 1154 tn04nrm ((normalizeCase . normalizeEscape . normalizePathSegments) tn04str) 1155testNormalizeURIString05 = testEq "testNormalizeURIString05" 1156 tn04nrm ((normalizePathSegments . normalizeEscape . normalizeCase) tn04str) 1157testNormalizeURIString06 = testEq "testNormalizeURIString06" 1158 tn06nrm (normalizePathSegments tn06str) 1159testNormalizeURIString07 = testEq "testNormalizeURIString07" 1160 tn07nrm (normalizePathSegments tn07str) 1161 1162testNormalizeURIString = TF.testGroup "testNormalizeURIString" 1163 [ TF.testCase "testNormalizeURIString01" testNormalizeURIString01 1164 , TF.testCase "testNormalizeURIString02" testNormalizeURIString02 1165 , TF.testCase "testNormalizeURIString03" testNormalizeURIString03 1166 , TF.testCase "testNormalizeURIString04" testNormalizeURIString04 1167 , TF.testCase "testNormalizeURIString05" testNormalizeURIString05 1168 , TF.testCase "testNormalizeURIString06" testNormalizeURIString06 1169 , TF.testCase "testNormalizeURIString07" testNormalizeURIString07 1170 ] 1171 1172-- Test strict vs non-strict relativeTo logic 1173 1174trbase = fromJust $ parseURIReference "http://bar.org/" 1175 1176testRelativeTo01 = testEq "testRelativeTo01" 1177 "http://bar.org/foo" 1178 (show $ 1179 (fromJust $ parseURIReference "foo") `relativeTo` trbase) 1180 1181testRelativeTo02 = testEq "testRelativeTo02" 1182 "http:foo" 1183 (show $ 1184 (fromJust $ parseURIReference "http:foo") `relativeTo` trbase) 1185 1186testRelativeTo03 = testEq "testRelativeTo03" 1187 "http://bar.org/foo" 1188 (show $ 1189 (fromJust $ parseURIReference "http:foo") `nonStrictRelativeTo` trbase) 1190 1191testRelativeTo = TF.testGroup "testRelativeTo" 1192 [ TF.testCase "testRelativeTo01" testRelativeTo01 1193 , TF.testCase "testRelativeTo02" testRelativeTo02 1194 , TF.testCase "testRelativeTo03" testRelativeTo03 1195 ] 1196 1197-- Test alternative parsing functions 1198testAltFn01 = testEq "testAltFn01" "Just http://a.b/c#f" 1199 (show . parseURI $ "http://a.b/c#f") 1200testAltFn02 = testEq "testAltFn02" "Just http://a.b/c#f" 1201 (show . parseURIReference $ "http://a.b/c#f") 1202testAltFn03 = testEq "testAltFn03" "Just c/d#f" 1203 (show . parseRelativeReference $ "c/d#f") 1204testAltFn04 = testEq "testAltFn04" "Nothing" 1205 (show . parseRelativeReference $ "http://a.b/c#f") 1206testAltFn05 = testEq "testAltFn05" "Just http://a.b/c" 1207 (show . parseAbsoluteURI $ "http://a.b/c") 1208testAltFn06 = testEq "testAltFn06" "Nothing" 1209 (show . parseAbsoluteURI $ "http://a.b/c#f") 1210testAltFn07 = testEq "testAltFn07" "Nothing" 1211 (show . parseAbsoluteURI $ "c/d") 1212testAltFn08 = testEq "testAltFn08" "Just http://a.b/c" 1213 (show . parseAbsoluteURI $ "http://a.b/c") 1214 1215testAltFn11 = testEq "testAltFn11" True (isURI "http://a.b/c#f") 1216testAltFn12 = testEq "testAltFn12" True (isURIReference "http://a.b/c#f") 1217testAltFn13 = testEq "testAltFn13" True (isRelativeReference "c/d#f") 1218testAltFn14 = testEq "testAltFn14" False (isRelativeReference "http://a.b/c#f") 1219testAltFn15 = testEq "testAltFn15" True (isAbsoluteURI "http://a.b/c") 1220testAltFn16 = testEq "testAltFn16" False (isAbsoluteURI "http://a.b/c#f") 1221testAltFn17 = testEq "testAltFn17" False (isAbsoluteURI "c/d") 1222 1223testAltFn = TF.testGroup "testAltFn" 1224 [ TF.testCase "testAltFn01" testAltFn01 1225 , TF.testCase "testAltFn02" testAltFn02 1226 , TF.testCase "testAltFn03" testAltFn03 1227 , TF.testCase "testAltFn04" testAltFn04 1228 , TF.testCase "testAltFn05" testAltFn05 1229 , TF.testCase "testAltFn06" testAltFn06 1230 , TF.testCase "testAltFn07" testAltFn07 1231 , TF.testCase "testAltFn08" testAltFn08 1232 , TF.testCase "testAltFn11" testAltFn11 1233 , TF.testCase "testAltFn12" testAltFn12 1234 , TF.testCase "testAltFn13" testAltFn13 1235 , TF.testCase "testAltFn14" testAltFn14 1236 , TF.testCase "testAltFn15" testAltFn15 1237 , TF.testCase "testAltFn16" testAltFn16 1238 , TF.testCase "testAltFn17" testAltFn17 1239 ] 1240 1241testUriIsAbsolute :: String -> Assertion 1242testUriIsAbsolute str = 1243 assertBool str (uriIsAbsolute uri) 1244 where 1245 Just uri = parseURIReference str 1246 1247testUriIsRelative :: String -> Assertion 1248testUriIsRelative str = 1249 assertBool str (uriIsRelative uri) 1250 where 1251 Just uri = parseURIReference str 1252 1253testIsAbsolute = TF.testGroup "testIsAbsolute" 1254 [ TF.testCase "testIsAbsolute01" $ testUriIsAbsolute "http://google.com" 1255 , TF.testCase "testIsAbsolute02" $ testUriIsAbsolute "ftp://p.x.ca/woo?hai=a" 1256 , TF.testCase "testIsAbsolute03" $ testUriIsAbsolute "mailto:bob@example.com" 1257 ] 1258 1259testIsRelative = TF.testGroup "testIsRelative" 1260 [ TF.testCase "testIsRelative01" $ testUriIsRelative "//google.com" 1261 , TF.testCase "testIsRelative02" $ testUriIsRelative "/hello" 1262 , TF.testCase "testIsRelative03" $ testUriIsRelative "this/is/a/path" 1263 , TF.testCase "testIsRelative04" $ testUriIsRelative "?what=that" 1264 ] 1265 1266testPathSegmentsRoundTrip :: URI -> Assertion 1267testPathSegmentsRoundTrip u = 1268 let segs = pathSegments u 1269 1270 dropSuffix _suf [] = [] 1271 dropSuffix suf [x] | suf == x = [] 1272 | otherwise = [x] 1273 dropSuffix suf (x:xs) = x : dropSuffix suf xs 1274 1275 dropPrefix _pre [] = [] 1276 dropPrefix pre (x:xs) | pre == x = xs 1277 | otherwise = (x:xs) 1278 strippedUriPath = dropSuffix '/' $ dropPrefix '/' $ uriPath u 1279 in 1280 (Data.List.intercalate "/" segs @?= strippedUriPath) 1281 1282assertJust _f Nothing = assertFailure "URI failed to parse" 1283assertJust f (Just x) = f x 1284 1285testPathSegments = TF.testGroup "testPathSegments" 1286 [ TF.testCase "testPathSegments03" $ 1287 assertJust testPathSegmentsRoundTrip $ parseURIReference "" 1288 , TF.testCase "testPathSegments04" $ 1289 assertJust testPathSegmentsRoundTrip $ parseURIReference "/" 1290 , TF.testCase "testPathSegments05" $ 1291 assertJust testPathSegmentsRoundTrip $ parseURIReference "//" 1292 , TF.testCase "testPathSegments06" $ 1293 assertJust testPathSegmentsRoundTrip $ parseURIReference "foo//bar/" 1294 , TF.testCase "testPathSegments07" $ 1295 assertJust testPathSegmentsRoundTrip $ parseURIReference "/foo//bar/" 1296 , TF.testCase "testPathSegments03" $ 1297 assertJust testPathSegmentsRoundTrip $ parseURI "http://example.org" 1298 , TF.testCase "testPathSegments04" $ 1299 assertJust testPathSegmentsRoundTrip $ parseURI "http://example.org/" 1300 , TF.testCase "testPathSegments05" $ 1301 assertJust testPathSegmentsRoundTrip $ parseURI "http://example.org//" 1302 , TF.testCase "testPathSegments06" $ 1303 assertJust testPathSegmentsRoundTrip $ parseURI "http://ex.ca/foo//bar/" 1304 , TF.testCase "testPathSegments07" $ 1305 assertJust testPathSegmentsRoundTrip $ parseURI "http://ex.ca/foo//bar/" 1306 ] 1307 1308testRectify = TF.testGroup "testRectify" 1309 [ TF.testCase "" $ testEq "testRectify" 1310 (show $ rectify $ URI { uriScheme = "http" , 1311 uriAuthority = Just (URIAuth "ezra" "www.google.com" "80") , 1312 uriPath = "/foo/bar" , 1313 uriQuery = "foo=bar&baz=quz" , 1314 uriFragment = "chap10" }) 1315 "http://ezra@www.google.com:80/foo/bar?foo=bar&baz=quz#chap10" 1316 , -- According to RFC2986, any URL without a // does not have an authority component. 1317 -- Therefore tag: URIs have all their content in the path component. This is supported 1318 -- by the urn: example in section 3. Note that tag: URIs have no leading slash on their 1319 -- path component. 1320 TF.testCase "" $ testEq "testRectify" 1321 "tag:timothy@hpl.hp.com,2001:web/externalHome" 1322 (show $ rectify $ URI { uriScheme = "tag" , 1323 uriAuthority = Nothing, 1324 uriPath = "timothy@hpl.hp.com,2001:web/externalHome", 1325 uriQuery = "" , 1326 uriFragment = "" }) 1327 , TF.testCase "" $ testEq "testRectifyAuth" 1328 "//ezra@www.google.com:80" 1329 ((uriAuthToString id . Just . rectifyAuth $ URIAuth "ezra" "www.google.com" "80") "") 1330 ] 1331 1332-- Full test suite 1333allTests = 1334 [ testURIRefSuite 1335 , testComponentSuite 1336 , testRelativeSuite 1337 , testRFC2396Suite 1338 , testOddballSuite 1339 , testNormalizeSuite 1340 , testShowURI 1341 , testEscapeURIString 1342 , testNormalizeURIString 1343 , testRelativeTo 1344 , testAltFn 1345 , testIsAbsolute 1346 , testIsRelative 1347 , testPathSegments 1348 , testRectify 1349 ] 1350 1351main = TF.defaultMain allTests 1352 1353runTestFile t = do 1354 h <- openFile "a.tmp" WriteMode 1355 _ <- runTestText (putTextToHandle h False) t 1356 hClose h 1357tf = runTestFile 1358tt = runTestTT 1359 1360-- Miscellaneous values for hand-testing/debugging in Hugs: 1361 1362uref = testURIRefSuite 1363tr01 = testRelative01 1364tr02 = testRelative02 1365tr03 = testRelative03 1366tr04 = testRelative04 1367rel = testRelativeSuite 1368rfc = testRFC2396Suite 1369oddb = testOddballSuite 1370 1371(Just bu02) = parseURIReference "http://example/x/y/z" 1372(Just ou02) = parseURIReference "../abc" 1373(Just ru02) = parseURIReference "http://example/x/abc" 1374-- fileuri = testURIReference "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" 1375 1376cu02 = ou02 `relativeTo` bu02 1377 1378-------------------------------------------------------------------------------- 1379-- 1380-- Copyright (c) 2004, G. KLYNE. All rights reserved. 1381-- Distributed as free software under the following license. 1382-- 1383-- Redistribution and use in source and binary forms, with or without 1384-- modification, are permitted provided that the following conditions 1385-- are met: 1386-- 1387-- - Redistributions of source code must retain the above copyright notice, 1388-- this list of conditions and the following disclaimer. 1389-- 1390-- - Redistributions in binary form must reproduce the above copyright 1391-- notice, this list of conditions and the following disclaimer in the 1392-- documentation and/or other materials provided with the distribution. 1393-- 1394-- - Neither name of the copyright holders nor the names of its 1395-- contributors may be used to endorse or promote products derived from 1396-- this software without specific prior written permission. 1397-- 1398-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS 1399-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 1400-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 1401-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 1402-- HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 1403-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 1404-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS 1405-- OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 1406-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR 1407-- TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE 1408-- USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 1409-- 1410-------------------------------------------------------------------------------- 1411-- $Source: /srv/cvs/cvs.haskell.org/fptools/libraries/network/tests/URITest.hs,v $ 1412-- $Author: gklyne $ 1413-- $Revision: 1.8 $ 1414-- $Log: URITest.hs,v $ 1415-- Revision 1.81 2012/08/01 aaronfriel 1416-- Added additional test case for the "xip.io" service style URLs and absolute URLs prefixed with ipv4 addresses. 1417-- 1418-- Revision 1.8 2005/07/19 22:01:27 gklyne 1419-- Added some additional test cases raised by discussion on URI@w3.org mailing list about 2005-07-19. The test p[roposed by this discussion exposed a subtle bug in relativeFrom not being an exact inverse of relativeTo. 1420-- 1421-- Revision 1.7 2005/06/06 16:31:44 gklyne 1422-- Added two new test cases. 1423-- 1424-- Revision 1.6 2005/05/31 17:18:36 gklyne 1425-- Added some additional test cases triggered by URI-list discussions. 1426-- 1427-- Revision 1.5 2005/04/07 11:09:37 gklyne 1428-- Added test cases for alternate parsing functions (including deprecated 'parseabsoluteURI') 1429-- 1430-- Revision 1.4 2005/04/05 12:47:32 gklyne 1431-- Added test case. 1432-- Changed module name, now requires GHC -main-is to compile. 1433-- All tests run OK with GHC 6.4 on MS-Windows. 1434-- 1435-- Revision 1.3 2004/11/05 17:29:09 gklyne 1436-- Changed password-obscuring logic to reflect late change in revised URI 1437-- specification (password "anonymous" is no longer a special case). 1438-- Updated URI test module to use function 'escapeURIString'. 1439-- (Should unEscapeString be similarly updated?) 1440-- 1441-- Revision 1.2 2004/10/27 13:06:55 gklyne 1442-- Updated URI module function names per: 1443-- http://www.haskell.org//pipermail/cvs-libraries/2004-October/002916.html 1444-- Added test cases to give better covereage of module functions. 1445-- 1446-- Revision 1.1 2004/10/14 16:11:30 gklyne 1447-- Add URI unit test to cvs.haskell.org repository 1448-- 1449-- Revision 1.17 2004/10/14 11:51:09 graham 1450-- Confirm that URITest runs with GHC. 1451-- Fix up some comments and other minor details. 1452-- 1453-- Revision 1.16 2004/10/14 11:45:30 graham 1454-- Use moduke name main for GHC 6.2 1455-- 1456-- Revision 1.15 2004/08/11 11:07:39 graham 1457-- Add new test case. 1458-- 1459-- Revision 1.14 2004/06/30 11:35:27 graham 1460-- Update URI code to use hierarchical libraries for Parsec and Network. 1461-- 1462-- Revision 1.13 2004/06/22 16:19:16 graham 1463-- New URI test case added. 1464-- 1465-- Revision 1.12 2004/04/21 15:13:29 graham 1466-- Add test case 1467-- 1468-- Revision 1.11 2004/04/21 14:54:05 graham 1469-- Fix up some tests 1470-- 1471-- Revision 1.10 2004/04/20 14:54:13 graham 1472-- Fix up test cases related to port number in authority, 1473-- and add some more URI decomposition tests. 1474-- 1475-- Revision 1.9 2004/04/07 15:06:17 graham 1476-- Add extra test case 1477-- Revise syntax in line with changes to RFC2396bis 1478-- 1479-- Revision 1.8 2004/03/17 14:34:58 graham 1480-- Add Network.HTTP files to CVS 1481-- 1482-- Revision 1.7 2004/03/16 14:19:38 graham 1483-- Change licence to BSD style; add nullURI definition; new test cases. 1484-- 1485-- Revision 1.6 2004/02/20 12:12:00 graham 1486-- Add URI normalization functions 1487-- 1488-- Revision 1.5 2004/02/19 23:19:35 graham 1489-- Network.URI module passes all test cases 1490-- 1491-- Revision 1.4 2004/02/17 20:06:02 graham 1492-- Revised URI parser to reflect latest RFC2396bis (-04) 1493-- 1494-- Revision 1.3 2004/02/11 14:32:14 graham 1495-- Added work-in-progress notes. 1496-- 1497-- Revision 1.2 2004/02/02 14:00:39 graham 1498-- Fix optional host name in URI. Add test cases. 1499-- 1500-- Revision 1.1 2004/01/27 21:13:45 graham 1501-- New URI module and test suite added, 1502-- implementing the GHC Network.URI interface. 1503-- 1504