+++ /dev/null
-#directory "..";;
-#load "netstring.cma";;
-
-open Neturl;;
-
-
-let expect_malformed_url f =
- try ignore(f()); false with Malformed_URL -> true;;
-
-let works f =
- not (expect_malformed_url f)
-;;
-
-(**********************************************************************)
-(* extract_url_scheme *)
-(**********************************************************************)
-
-let t001 () =
- extract_url_scheme "a:bc" = "a" &&
- extract_url_scheme "A:bc" = "a" &&
- extract_url_scheme "a:b:c" = "a" &&
- extract_url_scheme "a+b-c:d:e" = "a+b-c"
-;;
-
-
-let t002 () =
- let test s =
- try ignore(extract_url_scheme s); false with Malformed_URL -> true
- in
- test "a" &&
- test "a/b:c" &&
- test "%61:b" &&
- test "a%3ab"
-;;
-
-(**********************************************************************)
-(* url_syntax *)
-(**********************************************************************)
-
-let hashtbl_for_all f h =
- let b = ref true in
- Hashtbl.iter
- (fun k v -> b := !b && f k v)
- h;
- !b
-;;
-
-let t010 () =
- url_syntax_is_valid null_url_syntax &&
- url_syntax_is_valid ip_url_syntax &&
- hashtbl_for_all
- (fun _ syn ->
- url_syntax_is_valid syn
- )
- common_url_syntax
-;;
-
-let t011 () =
- url_syntax_is_valid (partial_url_syntax null_url_syntax) &&
- url_syntax_is_valid (partial_url_syntax ip_url_syntax) &&
- hashtbl_for_all
- (fun _ syn ->
- url_syntax_is_valid (partial_url_syntax syn)
- )
- common_url_syntax
-;;
-
-let t012 () =
- let f = fun _ -> true in
- let syn =
- { url_enable_scheme = Url_part_not_recognized;
- url_enable_user = Url_part_required;
- url_enable_password = Url_part_allowed;
- url_enable_host = Url_part_required;
- url_enable_port = Url_part_not_recognized;
- url_enable_path = Url_part_required;
- url_enable_param = Url_part_not_recognized;
- url_enable_query = Url_part_not_recognized;
- url_enable_fragment = Url_part_required;
- url_enable_other = Url_part_not_recognized;
- url_accepts_8bits = false;
- url_is_valid = f;
- } in
- let syn' = partial_url_syntax syn in
-
- (syn'.url_enable_scheme = Url_part_not_recognized) &&
- (syn'.url_enable_user = Url_part_allowed) &&
- (syn'.url_enable_password = Url_part_allowed) &&
- (syn'.url_enable_host = Url_part_allowed) &&
- (syn'.url_enable_port = Url_part_not_recognized) &&
- (syn'.url_enable_path = Url_part_allowed) &&
- (syn'.url_enable_param = Url_part_not_recognized) &&
- (syn'.url_enable_query = Url_part_not_recognized) &&
- (syn'.url_enable_fragment = Url_part_allowed) &&
- (syn'.url_enable_other = Url_part_not_recognized) &&
- (syn'.url_is_valid == f) &&
-
- url_syntax_is_valid syn &&
- url_syntax_is_valid syn'
-;;
-
-(**********************************************************************)
-(* make_url *)
-(**********************************************************************)
-
-let t020 () =
- (* Basic functionality: *)
- let http_syn = Hashtbl.find common_url_syntax "http" in
-
- let u1 = make_url
- (* default: not encoded *)
- ~scheme:"http"
- ~user:"U"
- ~password:"%()~$@"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"?";""]
- http_syn in
-
- url_provides
- ~scheme:true ~user:true ~password:true ~host:true ~port:true ~path:true
- u1 &&
-
- not
- (url_provides
- ~scheme:true ~user:true ~password:true ~host:true ~port:true ~path:true
- ~query:true u1) &&
-
- (url_syntax_of_url u1 == http_syn) &&
-
- (url_scheme u1 = "http") &&
- (url_user u1 = "U") &&
- (url_password u1 = "%()~$@") &&
- (url_host u1 = "a.b.c") &&
- (url_port u1 = 81) &&
- (url_path u1 = ["";"?";""]) &&
-
- (url_user ~encoded:true u1 = "U") &&
- (url_password ~encoded:true u1 = "%25()%7E$%40") &&
- (url_path ~encoded:true u1 = ["";"%3F";""]) &&
-
- string_of_url u1 = "http://U:%25()%7E$%40@a.b.c:81/%3F/"
-;;
-
-
-let t021 () =
- (* Basic functionality: *)
- let http_syn = Hashtbl.find common_url_syntax "http" in
-
- let u1 = make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"%55"
- ~password:"%25()%7e$%40"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"%3F";""]
- http_syn in
-
- url_provides
- ~scheme:true ~user:true ~password:true ~host:true ~port:true ~path:true
- u1 &&
-
- not
- (url_provides
- ~scheme:true ~user:true ~password:true ~host:true ~port:true ~path:true
- ~query:true u1) &&
-
- (url_syntax_of_url u1 == http_syn) &&
-
- (url_scheme u1 = "http") &&
- (url_user u1 = "U") &&
- (url_password u1 = "%()~$@") &&
- (url_host u1 = "a.b.c") &&
- (url_port u1 = 81) &&
- (url_path u1 = ["";"?";""]) &&
-
- (url_user ~encoded:true u1 = "%55") &&
- (url_password ~encoded:true u1 = "%25()%7e$%40") &&
- (url_path ~encoded:true u1 = ["";"%3F";""]) &&
-
- string_of_url u1 = "http://%55:%25()%7e$%40@a.b.c:81/%3F/"
-;;
-
-
-(* NEGATIVE TESTS *)
-
-let t030 () =
- (* It is not possible to add a component which is not recognized *)
- let http_syn = Hashtbl.find common_url_syntax "http" in
-
- expect_malformed_url
- (fun () ->
- make_url
- ~scheme:"http"
- ~user:"U"
- ~password:"%()~$@"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"?";""]
- ~fragment:"abc"
- http_syn)
-;;
-
-
-let t031 () =
- (* It is not possible to put malformed '%'-encodings into the URL *)
- let http_syn = Hashtbl.find common_url_syntax "http" in
-
- works (* reference *)
- (fun () ->
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:"XX"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"a";""]
- http_syn) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:"%XX"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"a";""]
- http_syn) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:"%X"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"a";""]
- http_syn) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:"%"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"a";""]
- http_syn)
-;;
-
-let t032 () =
- (* It is not possible to put unsafe characters into the URL *)
- let http_syn = Hashtbl.find common_url_syntax "http" in
-
- let make c =
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:(String.make 1 c)
- ~host:"a.b.c"
- ~port:81
- ~path:["";"a";""]
- http_syn
- in
-
- works (fun () -> make 'a') && (* reference *)
-
- (* List of unsafe characters taken from RFC1738: *)
- expect_malformed_url (fun () -> make '<') &&
- expect_malformed_url (fun () -> make '>') &&
- expect_malformed_url (fun () -> make '"') &&
- expect_malformed_url (fun () -> make '#') &&
- (* Note: '#' would be considered as reserved if fragments were enabled *)
- expect_malformed_url (fun () -> make '%') &&
- expect_malformed_url (fun () -> make '{') &&
- expect_malformed_url (fun () -> make '}') &&
- expect_malformed_url (fun () -> make '|') &&
- expect_malformed_url (fun () -> make '\\') &&
- expect_malformed_url (fun () -> make '^') &&
- expect_malformed_url (fun () -> make '[') &&
- expect_malformed_url (fun () -> make ']') &&
- expect_malformed_url (fun () -> make '`') &&
- expect_malformed_url (fun () -> make '~') &&
- (* Note: '~' is considered as safe in paths: *)
- works
- (fun () ->
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:"a"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"~";""]
- http_syn)
-;;
-
-let t033 () =
- (* It is not possible to put reserved characters into the URL *)
- let http_syn = Hashtbl.find common_url_syntax "http" in
-
- let make_password c =
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:(String.make 1 c)
- ~host:"a.b.c"
- ~port:81
- ~path:["";"a";""]
- http_syn
- in
- let make_path c =
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:"a"
- ~host:"a.b.c"
- ~port:81
- ~path:["";String.make 1 c;""]
- http_syn
- in
- let make_query c =
- make_url
- ~encoded:true
- ~scheme:"http"
- ~user:"U"
- ~password:"a"
- ~host:"a.b.c"
- ~port:81
- ~path:["";"a";""]
- ~query:(String.make 1 c)
- http_syn
- in
-
- (* Note: There is a difference between RFC 1738 and RFC 1808 regarding
- * which characters are reserved. RFC 1808 defines a fixed set of characters
- * as reserved while RFC 1738 defines the reserved characters depending
- * on the scheme.
- * This implementation of URLs follows RFC 1738 (because of practical
- * reasons).
- *)
-
- works (fun () -> make_password 'a') && (* reference *)
- works (fun () -> make_path 'a') &&
- works (fun () -> make_query 'a') &&
-
- expect_malformed_url (fun () -> make_password ':') &&
- expect_malformed_url (fun () -> make_password '@') &&
- expect_malformed_url (fun () -> make_password '/') &&
- works (fun () -> make_password ';') &&
- works (fun () -> make_password '?') &&
- works (fun () -> make_password '=') &&
- works (fun () -> make_password '&') &&
-
- (* Note: ';' is allowed in path and query because parameters are not
- * recognized in HTTP syntax.
- *)
-
- expect_malformed_url (fun () -> make_path '/') &&
- expect_malformed_url (fun () -> make_path '?') &&
- works (fun () -> make_path ':') &&
- works (fun () -> make_path '@') &&
- works (fun () -> make_path ';') &&
- works (fun () -> make_path '=') &&
- works (fun () -> make_path '&') &&
-
- expect_malformed_url (fun () -> make_query '?') &&
- works (fun () -> make_query '/') &&
- works (fun () -> make_query ':') &&
- works (fun () -> make_query '@') &&
- works (fun () -> make_query ';') &&
- works (fun () -> make_query '=') &&
- works (fun () -> make_query '&')
-;;
-
-
-let t034 () =
- (* It is not possible to create a URL with a password, but without user;
- * and neither to create a URL with a port, but without host;
- * and neither to create a URL with a user, but without host
- *)
-
- expect_malformed_url
- (fun () ->
- make_url
- ~scheme:"http"
- ~password:"a"
- ~host:"a.b.c"
- ~path:["";"a";""]
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~scheme:"http"
- ~user:"U"
- ~path:["";"a";""]
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~scheme:"http"
- ~port:81
- ~path:["";"a";""]
- ip_url_syntax)
-;;
-
-
-let t035 () =
- (* It is not possible to create a URL with illegal scheme prefix *)
-
- (* reference: *)
- works
- (fun () ->
- make_url
- ~scheme:"a"
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~scheme:":"
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~scheme:"a=b"
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~scheme:"a%62b"
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~scheme:"a&b"
- ip_url_syntax)
-;;
-
-
-let t036 () =
- (* It is not possible to have a path with double slashes *)
-
- (* reference: *)
- works
- (fun () ->
- make_url
- ~path:["";"a";""]
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~path:["";""]
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~path:["a";"";""]
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~path:["";"";"a"]
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~path:["a";"";"a"]
- ip_url_syntax)
-;;
-
-
-let t037 () =
- (* It is not possible to have port numbers outside 0..65535 *)
-
- (* reference: *)
- works
- (fun () ->
- make_url
- ~host:"a"
- ~port:1
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~host:"a"
- ~port:(-1)
- ip_url_syntax) &&
-
- expect_malformed_url
- (fun () ->
- make_url
- ~host:"a"
- ~port:65536
- ip_url_syntax)
-;;
-
-
-let t038 () =
- (* Several cases which are not allowed. *)
-
- expect_malformed_url
- (fun () ->
- make_url
- ~host:"a"
- ~path:["a"]
- ip_url_syntax
- ) && (* illegal: host + relative path *)
-
- expect_malformed_url
- (fun () ->
- make_url
- ~host:"a"
- ~path:[]
- ~param:["x"]
- ip_url_syntax
- ) && (* illegal: host + no path + params *)
-
- expect_malformed_url
- (fun () ->
- make_url
- ~host:"a"
- ~path:[]
- ~query:"x"
- ip_url_syntax
- ) (* illegal: host + no path + query *)
-;;
-
-(**********************************************************************)
-(* url_of_string *)
-(**********************************************************************)
-
-let t050 () =
- (* absolute URLs with ip_url_syntax *)
- let identical s =
- string_of_url (url_of_string ip_url_syntax s) = s in
-
- let fails s =
- try ignore(url_of_string ip_url_syntax s); false
- with Malformed_URL -> true
- in
-
- identical "http:" &&
-
- identical "http://host" &&
- identical "http://user@host" &&
- identical "http://user:password@host" &&
- identical "http://user@host:99" &&
- identical "http://user:password@host:99" &&
-
- identical "http://host/" &&
- identical "http://user@host/" &&
- identical "http://user:password@host/" &&
- identical "http://user@host:99/" &&
- identical "http://user:password@host:99/" &&
-
- identical "http://host/a/b" &&
- identical "http://user@host/a/b" &&
- identical "http://user:password@host/a/b" &&
- identical "http://user@host:99/a/b" &&
- identical "http://user:password@host:99/a/b" &&
-
- identical "http://host/a/b/" &&
- identical "http://user@host/a/b/" &&
- identical "http://user:password@host/a/b/" &&
- identical "http://user@host:99/a/b/" &&
- identical "http://user:password@host:99/a/b/" &&
-
- identical "http://host/?a=b&c=d" &&
- identical "http://user@host/?a=b&c=d" &&
- identical "http://user:password@host/?a=b&c=d" &&
- identical "http://user@host:99/?a=b&c=d" &&
- identical "http://user:password@host:99/?a=b&c=d" &&
-
- fails "http://host?a=b&c=d" &&
- fails "http://user@host?a=b&c=d" &&
- fails "http://user:password@host?a=b&c=d" &&
- fails "http://user@host:99?a=b&c=d" &&
- fails "http://user:password@host:99?a=b&c=d" &&
-
- identical "http://host/?a=/&c=/" &&
- identical "http://user@host/?a=/&c=/" &&
- identical "http://user:password@host/?a=/&c=/" &&
- identical "http://user@host:99/?a=/&c=/" &&
- identical "http://user:password@host:99/?a=/&c=/" &&
-
- identical "http://host/;a;b" &&
- identical "http://user@host/;a;b" &&
- identical "http://user:password@host/;a;b" &&
- identical "http://user@host:99/;a;b" &&
- identical "http://user:password@host:99/;a;b" &&
-
- fails "http://host;a;b" &&
- fails "http://user@host;a;b" &&
- fails "http://user:password@host;a;b" &&
- fails "http://user@host:99;a;b" &&
- fails "http://user:password@host:99;a;b" &&
-
- identical "http://host/;a;b?a=b&c=d" &&
- identical "http://user@host/;a;b?a=b&c=d" &&
- identical "http://user:password@host/;a;b?a=b&c=d" &&
- identical "http://user@host:99/;a;b?a=b&c=d" &&
- identical "http://user:password@host:99/;a;b?a=b&c=d" &&
-
- identical "http:#f" &&
-
- identical "http://host#f" &&
- identical "http://user@host#f" &&
- identical "http://user:password@host#f" &&
- identical "http://user@host:99#f" &&
- identical "http://user:password@host:99#f" &&
-
- identical "http://host/;a;b?a=b&c=d#f" &&
- identical "http://user@host/;a;b?a=b&c=d#f" &&
- identical "http://user:password@host/;a;b?a=b&c=d#f" &&
- identical "http://user@host:99/;a;b?a=b&c=d#f" &&
- identical "http://user:password@host:99/;a;b?a=b&c=d#f" &&
-
- true
-;;
-
-
-let t051 () =
- (* relative URLs with ip_url_syntax *)
- let identical s =
- string_of_url (url_of_string ip_url_syntax s) = s in
-
- let fails s =
- try ignore(url_of_string ip_url_syntax s); false
- with Malformed_URL -> true
- in
-
- identical "//host" &&
- identical "//user@host" &&
- identical "//user:password@host" &&
- identical "//user@host:99" &&
- identical "//user:password@host:99" &&
-
- identical "//host/" &&
- identical "//user@host/" &&
- identical "//user:password@host/" &&
- identical "//user@host:99/" &&
- identical "//user:password@host:99/" &&
-
- identical "//host#f" &&
- identical "//user@host#f" &&
- identical "//user:password@host#f" &&
- identical "//user@host:99#f" &&
- identical "//user:password@host:99#f" &&
-
- identical "/" &&
- identical "/a" &&
- identical "/a/" &&
- identical "/a/a" &&
-
- identical "/;a;b" &&
- identical "/a;a;b" &&
- identical "/a/;a;b" &&
- identical "/a/a;a;b" &&
-
- identical "/?a=b&c=d" &&
- identical "/a?a=b&c=d" &&
- identical "/a/?a=b&c=d" &&
- identical "/a/a?a=b&c=d" &&
-
- identical "/;a;b?a=b&c=d" &&
- identical "/a;a;b?a=b&c=d" &&
- identical "/a/;a;b?a=b&c=d" &&
- identical "/a/a;a;b?a=b&c=d" &&
-
- identical "/#f" &&
- identical "/a#f" &&
- identical "/a/#f" &&
- identical "/a/a#f" &&
-
- identical "/;a;b#f" &&
- identical "/a;a;b#f" &&
- identical "/a/;a;b#f" &&
- identical "/a/a;a;b#f" &&
-
- identical "/;a;b?a=b&c=d#f" &&
- identical "/a;a;b?a=b&c=d#f" &&
- identical "/a/;a;b?a=b&c=d#f" &&
- identical "/a/a;a;b?a=b&c=d#f" &&
-
- identical "" &&
- identical "a" &&
- identical "a/" &&
- identical "a/a" &&
-
- identical ";a;b" &&
- identical "a;a;b" &&
- identical "a/;a;b" &&
- identical "a/a;a;b" &&
-
- identical "?a=b&c=d" &&
- identical "a?a=b&c=d" &&
- identical "a/?a=b&c=d" &&
- identical "a/a?a=b&c=d" &&
-
- identical ";a;b?a=b&c=d" &&
- identical "a;a;b?a=b&c=d" &&
- identical "a/;a;b?a=b&c=d" &&
- identical "a/a;a;b?a=b&c=d" &&
-
- identical "#f" &&
- identical "a#f" &&
- identical "a/#f" &&
- identical "a/a#f" &&
-
- identical ";a;b#f" &&
- identical "a;a;b#f" &&
- identical "a/;a;b#f" &&
- identical "a/a;a;b#f" &&
-
- identical ";a;b?a=b&c=d#f" &&
- identical "a;a;b?a=b&c=d#f" &&
- identical "a/;a;b?a=b&c=d#f" &&
- identical "a/a;a;b?a=b&c=d#f" &&
-
- identical "." &&
- identical "./" &&
- identical "./a" &&
-
- identical ".;a;b" &&
- identical "./;a;b" &&
- identical "./a;a;b" &&
-
- identical ".?a=b&c=d" &&
- identical "./?a=b&c=d" &&
- identical "./a?a=b&c=d" &&
-
- identical ".;a;b?a=b&c=d" &&
- identical "./;a;b?a=b&c=d" &&
- identical "./a;a;b?a=b&c=d" &&
-
- identical ".#f" &&
- identical "./#f" &&
- identical "./a#f" &&
-
- identical ".;a;b#f" &&
- identical "./;a;b#f" &&
- identical "./a;a;b#f" &&
-
- identical ".;a;b?a=b&c=d#f" &&
- identical "./;a;b?a=b&c=d#f" &&
- identical "./a;a;b?a=b&c=d#f" &&
-
- identical ".." &&
- identical "../" &&
- identical "../a" &&
-
- identical "..;a;b" &&
- identical "../;a;b" &&
- identical "../a;a;b" &&
-
- identical "..?a=b&c=d" &&
- identical "../?a=b&c=d" &&
- identical "../a?a=b&c=d" &&
-
- identical "..;a;b?a=b&c=d" &&
- identical "../;a;b?a=b&c=d" &&
- identical "../a;a;b?a=b&c=d" &&
-
- identical "..#f" &&
- identical "../#f" &&
- identical "../a#f" &&
-
- identical "..;a;b#f" &&
- identical "../;a;b#f" &&
- identical "../a;a;b#f" &&
-
- identical "..;a;b?a=b&c=d#f" &&
- identical "../;a;b?a=b&c=d#f" &&
- identical "../a;a;b?a=b&c=d#f" &&
-
- string_of_url
- (make_url ~path:["a:b"] ip_url_syntax) = "a%3Ab" &&
-
- string_of_url
- (make_url ~encoded:true ~path:["a:b"] ip_url_syntax) = "./a:b" &&
-
- true
-;;
-
-
-let t052 () =
- (* mailto: URLs *)
- let mailto_syn = Hashtbl.find common_url_syntax "mailto" in
-
- let identical s =
- string_of_url (url_of_string mailto_syn s) = s in
-
- let fails s =
- try ignore(url_of_string mailto_syn s); false
- with Malformed_URL -> true
- in
-
- identical "mailto:user@host" &&
- identical "mailto:user@host;?;?" &&
- fails "mailto:user@host#f"
-;;
-
-(**********************************************************************)
-(* split_path/join_path/norm_path: *)
-(**********************************************************************)
-
-let t060 () =
- (split_path "" = []) &&
- (split_path "/" = [ "" ]) &&
- (split_path "/a" = [ ""; "a" ]) &&
- (split_path "a" = [ "a" ]) &&
- (split_path "a/" = [ "a"; "" ]) &&
- (split_path "/a/" = [ ""; "a"; "" ]) &&
- (split_path "/a/b" = [ ""; "a"; "b" ]) &&
- (split_path "/a/b/" = [ ""; "a"; "b"; "" ]) &&
- (split_path "/a/b/c" = [ ""; "a"; "b"; "c" ]) &&
-
- (join_path [] = "") &&
- (join_path [ "" ] = "/") &&
- (join_path [ ""; "a" ] = "/a") &&
- (join_path [ "a" ] = "a") &&
- (join_path [ "a"; "" ] = "a/") &&
- (join_path [ ""; "a"; "" ] = "/a/") &&
- (join_path [ ""; "a"; "b" ] = "/a/b") &&
- (join_path [ ""; "a"; "b"; "" ] = "/a/b/") &&
- (join_path [ ""; "a"; "b"; "c" ] = "/a/b/c") &&
-
- true
-;;
-
-
-let t061 () =
- (norm_path ["."] = []) &&
- (norm_path ["."; ""] = []) &&
- (norm_path ["a"; "."] = ["a"; ""]) &&
- (norm_path ["a"; "b"; "."] = ["a"; "b"; ""]) &&
- (norm_path ["a"; "b"; ".."] = ["a"; ""]) &&
- (norm_path ["a"; "."; "b"; "."] = ["a"; "b"; ""]) &&
- (norm_path [".."] = [".."; ""]) &&
- (norm_path [".."; ""] = [".."; ""]) &&
- (norm_path ["a"; "b"; ".."; "c" ] = ["a"; "c"]) &&
- (norm_path ["a"; "b"; ".."; "c"; ""] = ["a"; "c"; ""]) &&
- (norm_path ["";"";"a";"";"b"] = [""; "a"; "b"]) &&
- (norm_path ["a"; "b"; ""; ".."; "c"; ""] = ["a"; "c"; ""]) &&
- (norm_path ["a"; ".."] = []) &&
- (norm_path ["";""] = [""]) &&
- (norm_path [""] = [""]) &&
- (norm_path [] = []) &&
-
- true
-;;
-
-(**********************************************************************)
-(* apply_relative_url: *)
-(**********************************************************************)
-
-let t070() =
- (* Examples taken from RFC 1808 *)
- let url = url_of_string ip_url_syntax in
- let base = url "http://a/b/c/d;p?q#f" in
- let aru = apply_relative_url base in
-
- (aru (url "g:h") = url "g:h") &&
- (aru (url "g") = url "http://a/b/c/g") &&
- (aru (url "./g") = url "http://a/b/c/g") &&
- (aru (url "g/") = url "http://a/b/c/g/") &&
- (aru (url "/g") = url "http://a/g") &&
- (aru (url "//g") = url "http://g") &&
- (aru (url "?y") = url "http://a/b/c/d;p?y") &&
- (aru (url "g?y") = url "http://a/b/c/g?y") &&
- (aru (url "g?y/./x") = url "http://a/b/c/g?y/./x") &&
- (aru (url "#s") = url "http://a/b/c/d;p?q#s") &&
- (aru (url "g#s") = url "http://a/b/c/g#s") &&
- (aru (url "g#s/./x") = url "http://a/b/c/g#s/./x") &&
- (aru (url "g?y#s") = url "http://a/b/c/g?y#s") &&
- (aru (url ";x") = url "http://a/b/c/d;x") &&
- (aru (url "g;x") = url "http://a/b/c/g;x") &&
- (aru (url "g;x?y#s") = url "http://a/b/c/g;x?y#s") &&
- (aru (url ".") = url "http://a/b/c/") &&
- (aru (url "./") = url "http://a/b/c/") &&
- (aru (url "..") = url "http://a/b/") &&
- (aru (url "../") = url "http://a/b/") &&
- (aru (url "../g") = url "http://a/b/g") &&
- (aru (url "../..") = url "http://a/") &&
- (aru (url "../../") = url "http://a/") &&
- (aru (url "../../g") = url "http://a/g") &&
-
- (aru (url "") = url "http://a/b/c/d;p?q#f") &&
- (aru (url "../../../g") = url "http://a/../g") &&
- (aru (url "../../../../g") = url "http://a/../../g") &&
- (aru (url "/./g") = url "http://a/./g") &&
- (aru (url "/../g") = url "http://a/../g") &&
- (aru (url "g.") = url "http://a/b/c/g.") &&
- (aru (url ".g") = url "http://a/b/c/.g") &&
- (aru (url "g..") = url "http://a/b/c/g..") &&
- (aru (url "..g") = url "http://a/b/c/..g") &&
- (aru (url "./../g") = url "http://a/b/g") &&
- (aru (url "./g/.") = url "http://a/b/c/g/") &&
- (aru (url "g/./h") = url "http://a/b/c/g/h") &&
- (aru (url "g/../h") = url "http://a/b/c/h") &&
- (aru (url "http:g") = url "http:g") &&
- (aru (url "http:") = url "http:") &&
-
- true
-;;
-
-
-(**********************************************************************)
-
-let test f n =
- if f() then
- print_endline ("Test " ^ n ^ " ok")
- else
- print_endline ("Test " ^ n ^ " FAILED!!!!");
- flush stdout
-;;
-
-test t001 "001";
-test t002 "002";
-
-test t010 "010";
-test t011 "011";
-test t012 "012";
-
-test t020 "020";
-test t021 "021";
-
-test t030 "030";
-test t031 "031";
-test t032 "032";
-test t033 "033";
-test t034 "034";
-test t035 "035";
-test t036 "036";
-test t037 "037";
-test t038 "038";
-
-test t050 "050";
-test t051 "051";
-test t052 "052";
-
-test t060 "060";
-test t061 "061";
-
-test t070 "070";
-()
-;;
projects / helm.git / blobdiff