--- /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