Initial comit - Clone
This commit is contained in:
86
test/calendar_test.ml
Normal file
86
test/calendar_test.ml
Normal file
@@ -0,0 +1,86 @@
|
||||
let data_sure =
|
||||
[
|
||||
Def.{ day = 1; month = 1; year = 1900; delta = 0; prec = Sure };
|
||||
Def.{ day = 0; month = 1; year = 1900; delta = 0; prec = Sure };
|
||||
Def.{ day = 0; month = 0; year = 1900; delta = 0; prec = Sure };
|
||||
]
|
||||
|
||||
let data_oryear =
|
||||
[
|
||||
Def.
|
||||
{
|
||||
day = 1;
|
||||
month = 1;
|
||||
year = 1900;
|
||||
delta = 0;
|
||||
prec = OrYear { day2 = 1; month2 = 1; year2 = 1901; delta2 = 0 };
|
||||
};
|
||||
Def.
|
||||
{
|
||||
day = 0;
|
||||
month = 1;
|
||||
year = 1900;
|
||||
delta = 0;
|
||||
prec = OrYear { day2 = 0; month2 = 1; year2 = 1901; delta2 = 0 };
|
||||
};
|
||||
Def.
|
||||
{
|
||||
day = 0;
|
||||
month = 0;
|
||||
year = 1900;
|
||||
delta = 0;
|
||||
prec = OrYear { day2 = 0; month2 = 0; year2 = 1901; delta2 = 0 };
|
||||
};
|
||||
]
|
||||
|
||||
open Alcotest
|
||||
open Calendar
|
||||
|
||||
(* TODO Fmt *)
|
||||
let testable_calendar = testable Fmt.nop ( = )
|
||||
|
||||
let round_trip of_ to_ l () =
|
||||
let f d = of_ (to_ d) in
|
||||
(* todo should iter in v? *)
|
||||
List.iter (fun d -> (check testable_calendar) "" d (f d)) l
|
||||
|
||||
let v =
|
||||
[
|
||||
( (* this fail because Calendars library does not work on incomplete dates (day|month) = 0 *)
|
||||
"calendar-sdn",
|
||||
[
|
||||
test_case "Calendar gregorian <-> sdn" `Quick
|
||||
(round_trip (gregorian_of_sdn Def.Sure) sdn_of_gregorian data_sure);
|
||||
test_case "Calendar julian <-> sdn" `Quick
|
||||
(round_trip (julian_of_sdn Def.Sure) sdn_of_julian data_sure);
|
||||
test_case "Calendar french <-> sdn" `Quick
|
||||
(round_trip (french_of_sdn Def.Sure) sdn_of_french data_sure);
|
||||
test_case "Calendar hebrew <-> sdn" `Quick
|
||||
(round_trip (hebrew_of_sdn Def.Sure) sdn_of_hebrew data_sure);
|
||||
] );
|
||||
( "calendar-greg",
|
||||
[
|
||||
test_case "Calendar gregorian <-> julian" `Quick
|
||||
(round_trip gregorian_of_julian julian_of_gregorian
|
||||
(data_sure @ data_oryear));
|
||||
test_case "Calendar gregorian <-> french" `Quick
|
||||
(round_trip gregorian_of_french french_of_gregorian
|
||||
(data_sure @ data_oryear));
|
||||
test_case "Calendar gregorian <-> hebrew" `Quick
|
||||
(round_trip gregorian_of_hebrew hebrew_of_gregorian
|
||||
(data_sure @ data_oryear));
|
||||
] );
|
||||
]
|
||||
|
||||
(*
|
||||
|
||||
let suite =
|
||||
[
|
||||
"Calendar"
|
||||
>::: []
|
||||
(* @ (sdn_round_trip "gregorian" Calendar.sdn_of_gregorian Calendar.gregorian_of_sdn)
|
||||
* @ (sdn_round_trip "julian" Calendar.sdn_of_julian Calendar.julian_of_sdn)
|
||||
* @ (sdn_round_trip "french" Calendar.sdn_of_french Calendar.french_of_sdn)
|
||||
* @ (sdn_round_trip "hebrew" Calendar.sdn_of_hebrew Calendar.hebrew_of_sdn) *)
|
||||
]
|
||||
*)
|
||||
4
test/dune.in
Normal file
4
test/dune.in
Normal file
@@ -0,0 +1,4 @@
|
||||
(test
|
||||
(name test)
|
||||
(modules test sosa_test place_test calendar_test wiki_test merge_test util_test)
|
||||
(libraries alcotest geneweb %%%GWDB_PKG%%% %%%SOSA_PKG%%% fmt))
|
||||
54
test/merge_test.ml
Normal file
54
test/merge_test.ml
Normal file
@@ -0,0 +1,54 @@
|
||||
open Alcotest
|
||||
open Geneweb
|
||||
open Def
|
||||
|
||||
let empty_string = 0
|
||||
let quest_string = 1
|
||||
let ascend parents = { Gwdb.no_ascend with Def.parents }
|
||||
let descend children = { Def.children }
|
||||
let union family = { Def.family }
|
||||
let couple a b = Adef.couple a b
|
||||
|
||||
let person i =
|
||||
{ (Mutil.empty_person empty_string quest_string) with occ = i; key_index = i }
|
||||
|
||||
let family i = { (Mutil.empty_family empty_string) with fam_index = i }
|
||||
let iper (i : int) : Gwdb.iper = Obj.magic i
|
||||
|
||||
let test_is_ancestor () =
|
||||
let child = person 0 in
|
||||
let father = person 1 in
|
||||
let mother = person 2 in
|
||||
let persons = [| child; father; mother |] in
|
||||
let ascends = [| ascend (Some 0); ascend None; ascend None |] in
|
||||
let unions = [| union [||]; union [| 0 |]; union [| 0 |] |] in
|
||||
let families = [| family 0 |] in
|
||||
let couples = [| couple 1 2 |] in
|
||||
let descends = [| descend [| 0 |] |] in
|
||||
let strings = [| ""; "?" |] in
|
||||
let base_notes =
|
||||
{ nread = (fun _ _ -> ""); norigin_file = ""; efiles = (fun () -> []) }
|
||||
in
|
||||
let data =
|
||||
( (persons, ascends, unions),
|
||||
(families, couples, descends),
|
||||
strings,
|
||||
base_notes )
|
||||
in
|
||||
let base = Gwdb.make "is_ancestor_base" [] data in
|
||||
let child = Gwdb.poi base (iper 0) in
|
||||
let father = Gwdb.poi base (iper 1) in
|
||||
let mother = Gwdb.poi base (iper 2) in
|
||||
(check bool) "is_ancetor child father" false
|
||||
(MergeInd.is_ancestor base child father);
|
||||
(check bool) "is_ancetor father child" true
|
||||
(MergeInd.is_ancestor base father child);
|
||||
(check bool) "is_ancetor mother child" true
|
||||
(MergeInd.is_ancestor base mother child);
|
||||
()
|
||||
|
||||
let v =
|
||||
[
|
||||
( "mergeind-ancestor",
|
||||
[ test_case "MergeInd.is_ancestor" `Quick test_is_ancestor ] );
|
||||
]
|
||||
68
test/place_test.ml
Normal file
68
test/place_test.ml
Normal file
@@ -0,0 +1,68 @@
|
||||
open Geneweb
|
||||
open Alcotest
|
||||
|
||||
let normalize () =
|
||||
(check string) "" "foo-bar, boobar (baz)"
|
||||
(Place.normalize "[foo-bar] - boobar (baz)");
|
||||
(check string) "" "[foo-bar - boobar (baz)"
|
||||
(Place.normalize "[foo-bar - boobar (baz)");
|
||||
(check string) "" "[foo-bar] boobar (baz)"
|
||||
(Place.normalize "[foo-bar] boobar (baz)");
|
||||
()
|
||||
|
||||
let split_suburb () =
|
||||
(check (pair string string))
|
||||
""
|
||||
("foo-bar", "boobar (baz)")
|
||||
(Place.split_suburb "[foo-bar] - boobar (baz)");
|
||||
(check (pair string string))
|
||||
"test split suburb emdash - 93"
|
||||
("foo-bar", "boobar (baz)")
|
||||
(Place.split_suburb "[foo-bar] – boobar (baz)");
|
||||
(check (pair string string))
|
||||
"test split suburb endash - 94"
|
||||
("foo-bar", "boobar (baz)")
|
||||
(Place.split_suburb "[foo-bar] — boobar (baz)");
|
||||
(check (pair string string))
|
||||
"" ("", "boobar (baz)")
|
||||
(Place.split_suburb "boobar (baz)");
|
||||
()
|
||||
|
||||
let only_suburb () =
|
||||
(check string) "" "foo-bar" (Place.only_suburb "[foo-bar] - boobar (baz)");
|
||||
(check string) "" "" (Place.only_suburb "boobar (baz)");
|
||||
()
|
||||
|
||||
let without_suburb () =
|
||||
(check string) "" "boobar (baz)"
|
||||
(Place.without_suburb "[foo-bar] - boobar (baz)");
|
||||
(check string) "" "boobar (baz)" (Place.without_suburb "boobar (baz)");
|
||||
()
|
||||
|
||||
let compare_places () =
|
||||
(check int) "" 0 (Place.compare_places "boobar (baz)" "boobar (baz)");
|
||||
(check int) "" (-1) (Place.compare_places "baz (boobar)" "boobar (baz)");
|
||||
(check int) "" (-1)
|
||||
(Place.compare_places "baz (boobar)" "[foo-bar] - baz (boobar)");
|
||||
(check int) "" (-1)
|
||||
(Place.compare_places "[bar-foo] - baz (boobar)" "[foo-bar] - baz (boobar)");
|
||||
(check int) "" (-1)
|
||||
(Place.compare_places "[foo-bar] - baz (boobar)" "[bar-foo] - boobar (baz)");
|
||||
(check int) "" (-1)
|
||||
(Place.compare_places "[foo-bar] - ebaz (boobar)"
|
||||
"[bar-foo] - éboobar (baz)");
|
||||
(check int) "" (-1)
|
||||
(Place.compare_places "[foo-bar] - baz, boobar, barboo"
|
||||
"[foo-bar] - baz, boobar, barboo, bam");
|
||||
()
|
||||
|
||||
let v =
|
||||
[
|
||||
("place-normalize", [ test_case "Place normalize" `Quick normalize ]);
|
||||
( "place-split-suburb",
|
||||
[ test_case "Place split suburb" `Quick split_suburb ] );
|
||||
("place-only-suburb", [ test_case "Place only suburb" `Quick only_suburb ]);
|
||||
( "place-without-suburb",
|
||||
[ test_case "Place without suburb" `Quick only_suburb ] );
|
||||
("place-compare", [ test_case "Place compare" `Quick compare_places ]);
|
||||
]
|
||||
70
test/sosa_test.ml
Normal file
70
test/sosa_test.ml
Normal file
@@ -0,0 +1,70 @@
|
||||
open Alcotest
|
||||
|
||||
(* TODO Fmt *)
|
||||
let testable_sosa = testable Fmt.nop Sosa.eq
|
||||
|
||||
let sosa_eq () =
|
||||
(check testable_sosa) "0 = 0" Sosa.zero Sosa.zero;
|
||||
(check testable_sosa) "1 = 1" Sosa.one Sosa.one;
|
||||
(check @@ neg @@ testable_sosa) "0 <> 1" Sosa.zero Sosa.one;
|
||||
(check @@ neg @@ testable_sosa) "1 <> 0" Sosa.one Sosa.zero;
|
||||
()
|
||||
|
||||
let sosa_int () =
|
||||
(check testable_sosa) "of_int 0" Sosa.zero (Sosa.of_int 0);
|
||||
(check testable_sosa) "of_int 1" Sosa.one (Sosa.of_int 1);
|
||||
()
|
||||
|
||||
let sosa_string () =
|
||||
(check testable_sosa) {|of_string "0"|} Sosa.zero (Sosa.of_string "0");
|
||||
(check testable_sosa) {|of_string "1"|} Sosa.one (Sosa.of_string "1");
|
||||
(check string) "to_string zero" "0" (Sosa.to_string Sosa.zero);
|
||||
(check string) "to_string one" "1" (Sosa.to_string Sosa.one);
|
||||
(check string) "test sosa 1" "1"
|
||||
(Sosa.to_string (Sosa.div (Sosa.of_int 1000) 1000));
|
||||
(check string) "test sosa 2" "2"
|
||||
(Sosa.to_string (Sosa.div (Sosa.of_int 2000) 1000));
|
||||
(check string) "test sosa div" "234"
|
||||
(Sosa.to_string (Sosa.div (Sosa.of_int 234000) 1000));
|
||||
(* %let;tmp;%expr(xxx-((xxx/1000)*1000))%in; *)
|
||||
(check string) "test sosa sub/div" "234"
|
||||
(Sosa.to_string
|
||||
(Sosa.sub (Sosa.of_int 1234)
|
||||
(Sosa.mul (Sosa.div (Sosa.of_int 1234) 1000) 1000)));
|
||||
(check string) "test sosa div/10/10/10" "234"
|
||||
(Sosa.to_string
|
||||
(Sosa.sub (Sosa.of_int 1234)
|
||||
(Sosa.mul
|
||||
(Sosa.div (Sosa.div (Sosa.div (Sosa.of_int 1234) 10) 10) 10)
|
||||
1000)));
|
||||
()
|
||||
|
||||
let sosa_pp () =
|
||||
let ints = [ 1; 10; 100; 1000; 10000; 100000; 1000000 ] in
|
||||
let strings =
|
||||
[ "1"; "10"; "100"; "1,000"; "10,000"; "100,000"; "1,000,000" ]
|
||||
in
|
||||
let l = List.combine ints strings in
|
||||
List.iter
|
||||
(fun (i, s) -> (check string) "" s (Sosa.to_string_sep "," (Sosa.of_int i)))
|
||||
l
|
||||
|
||||
let sosa_gen () =
|
||||
let sosas = List.init 15 (fun i -> i + 1) in
|
||||
let generations = [ 1; 2; 2; 3; 3; 3; 3; 4; 4; 4; 4; 4; 4; 4; 4 ] in
|
||||
let l = List.combine sosas generations in
|
||||
List.iter (fun (i, gen) -> (check int) "" gen (Sosa.gen (Sosa.of_int i))) l
|
||||
|
||||
let sosa_branches () =
|
||||
let l = [ 0; 0; 1; 1; 0 ] in
|
||||
(check (list int)) "branch 38" l (Sosa.branches @@ Sosa.of_int 38)
|
||||
|
||||
let v =
|
||||
[
|
||||
("sosa-eq", [ test_case "Sosa equality" `Quick sosa_eq ]);
|
||||
("sosa-int", [ test_case "Sosa <-> int" `Quick sosa_int ]);
|
||||
("sosa-string", [ test_case "Sosa <-> string" `Quick sosa_string ]);
|
||||
("sosa-pp", [ test_case "Sosa pretty print" `Quick sosa_pp ]);
|
||||
("sosa-gen", [ test_case "Sosa generation" `Quick sosa_gen ]);
|
||||
("sosa-branches", [ test_case "Sosa branches" `Quick sosa_branches ]);
|
||||
]
|
||||
12
test/test.ml
Normal file
12
test/test.ml
Normal file
@@ -0,0 +1,12 @@
|
||||
open Alcotest
|
||||
|
||||
let () =
|
||||
let known_failures = [| "calendar-sdn" |] in
|
||||
let is_ci = Option.is_some (Sys.getenv_opt "GENEWEB_CI") in
|
||||
let filter ~name ~index:_ =
|
||||
if is_ci then if Array.mem name known_failures then `Skip else `Run
|
||||
else `Run
|
||||
in
|
||||
run ~and_exit:false "Geneweb" ~filter
|
||||
(Sosa_test.v @ Place_test.v @ Calendar_test.v @ Wiki_test.v @ Merge_test.v
|
||||
@ Util_test.v)
|
||||
238
test/util_test.ml
Normal file
238
test/util_test.ml
Normal file
@@ -0,0 +1,238 @@
|
||||
open Alcotest
|
||||
open Geneweb
|
||||
|
||||
let mutil_contains () =
|
||||
let str = "foo bar" in
|
||||
let test t b = (check bool) t b (Mutil.contains str t) in
|
||||
test "foo" true;
|
||||
test "baz" false;
|
||||
test "foo_b" false;
|
||||
test "foo b" true;
|
||||
test "foo__b" false;
|
||||
test "bar__" false;
|
||||
test "r" true;
|
||||
test "" true
|
||||
|
||||
let mutil_start_with () =
|
||||
check_raises "" (Invalid_argument "start_with") (fun () ->
|
||||
ignore @@ Mutil.start_with "foo" (-1) "foo");
|
||||
check_raises "" (Invalid_argument "start_with") (fun () ->
|
||||
ignore @@ Mutil.start_with "foo" 4 "foo");
|
||||
(check bool) "Mutil.start_with \"foo\" 0 \"foo\"" true
|
||||
(Mutil.start_with "foo" 0 "foo");
|
||||
(check bool) "not (Mutil.start_with \"bar\" 0 \"foo\")" true
|
||||
(not @@ Mutil.start_with "bar" 0 "foo");
|
||||
(check bool) "Mutil.start_with \"\" 0 \"foo\"" true
|
||||
(Mutil.start_with "" 0 "foo");
|
||||
()
|
||||
|
||||
let mutil_arabian_romian _ =
|
||||
let test a r =
|
||||
(check int) "arabian_of_roman" a (Mutil.arabian_of_roman r);
|
||||
(check string) "roman_of_arabian" r (Mutil.roman_of_arabian a)
|
||||
in
|
||||
test 39 "XXXIX";
|
||||
test 246 "CCXLVI";
|
||||
test 421 "CDXXI";
|
||||
test 160 "CLX";
|
||||
test 207 "CCVII";
|
||||
test 1066 "MLXVI"
|
||||
|
||||
let test_particles =
|
||||
[
|
||||
"da_";
|
||||
"dal_";
|
||||
"de_la_";
|
||||
"de_";
|
||||
"del_";
|
||||
"della_";
|
||||
"des_";
|
||||
"du_";
|
||||
"d'";
|
||||
"van_";
|
||||
"von_";
|
||||
]
|
||||
|
||||
let mutil_compare_after_particle _ =
|
||||
let particles = Mutil.compile_particles test_particles in
|
||||
let test a b =
|
||||
let test exp a b =
|
||||
let cmp = Mutil.compare_after_particle particles in
|
||||
(check int) "" exp (cmp a b)
|
||||
in
|
||||
test (-1) a b;
|
||||
test 1 b a;
|
||||
test 0 a a;
|
||||
test 0 b b
|
||||
in
|
||||
test "de la fontaine" "de musset";
|
||||
test "de montaine" "de la nusset";
|
||||
test "de sade" "de sévigné";
|
||||
test "de lattre de tassigny" "de montgolfier";
|
||||
test "des cars" "du guesclin";
|
||||
test "d'aboville" "d'artagnan";
|
||||
test "descartes" "dupont"
|
||||
|
||||
let mutil_string_of_int_sep _ =
|
||||
let test sep exp int =
|
||||
(check string) "" exp (Mutil.string_of_int_sep sep int)
|
||||
in
|
||||
test "," "1" 1;
|
||||
test "," "10" 10;
|
||||
test "," "100" 100;
|
||||
test "," "1,000" 1000;
|
||||
test "," "10,000" 10000;
|
||||
test "," "100,000" 100000;
|
||||
test "," "1,000,000" 1000000
|
||||
|
||||
let name_title _ =
|
||||
let test exp = List.iter (fun s -> (check string) "" exp (Name.title s)) in
|
||||
test "Jean-Baptiste"
|
||||
[ "jean-baptiste"; "JEAN-baptiste"; "Jean-Baptiste"; "jeaN-baptistE" ]
|
||||
|
||||
let utf8_sub _ =
|
||||
let test ?pad e s i j =
|
||||
let i = Utf8.get s i in
|
||||
(check string) "" e (Utf8.sub ?pad s i j)
|
||||
in
|
||||
test "日" "日本語" 0 1;
|
||||
test "日本語" "日本語" 0 3;
|
||||
test "語" "日本語" 2 1;
|
||||
test "ε" "ελληνικά" 0 1;
|
||||
test "ελληνικά" "ελληνικά" 0 8;
|
||||
test "λ" "ελληνικά" 1 1;
|
||||
test "ά" "ελληνικά" 7 1;
|
||||
test "š" "švédčina" 0 1;
|
||||
test "švédčina" "švédčina" 0 8;
|
||||
test "a" "švédčina" 7 1
|
||||
|
||||
let util_name_with_roman_number _ =
|
||||
let test r a = (check (option string)) "" r (Util.name_with_roman_number a) in
|
||||
test (Some "XXXIX XXXIX") "39 39";
|
||||
test (Some "XXXIX x XXXIX") "39 x 39";
|
||||
test (Some "foo CCXLVI") "foo 246";
|
||||
test (Some "bar CDXXI baz") "bar 421 baz";
|
||||
test (Some "bar CLX baz CCVII") "bar 160 baz 207";
|
||||
test None "foo bar baz"
|
||||
|
||||
let printer_safe x = (x : Adef.safe_string :> string)
|
||||
let printer_encoded x = (x : Adef.encoded_string :> string)
|
||||
let printer_escaped x = (x : Adef.escaped_string :> string)
|
||||
|
||||
let util_safe_html _ =
|
||||
(check string) ""
|
||||
{|<a href="localhost:2318/foo_w?lang=fr&acte=123">foo</a>|}
|
||||
(Util.safe_html {|<a href="localhost:2318/foo_w?lang=fr&acte=123">foo</a>|}
|
||||
:> string);
|
||||
(check string) ""
|
||||
{|<a href="localhost:2318/foo_w?lang=fr&image=on">foo</a>|}
|
||||
(Util.safe_html {|<a href="localhost:2318/foo_w?lang=fr&image=on">foo</a>|}
|
||||
:> string)
|
||||
|
||||
let util_transl_a_of_b _ =
|
||||
let conf = Config.empty in
|
||||
let conf =
|
||||
{
|
||||
conf with
|
||||
env = ("lang", Adef.encoded "fr") :: conf.env;
|
||||
vowels = [ "a"; "e"; "i"; "o"; "u"; "y" ];
|
||||
}
|
||||
in
|
||||
Hashtbl.add conf.lexicon "%1 of %2" "%1 d[e |']%2";
|
||||
let test aaa (s1, s2, s2_raw) =
|
||||
let bbb = Util.transl_a_of_b conf s1 s2 s2_raw in
|
||||
(check string) "" aaa bbb
|
||||
in
|
||||
test "naissance de <b>Jean</b>" ("naissance", "<b>Jean</b>", "Jean");
|
||||
test "naissance d'<b>André</b>" ("naissance", "<b>André</b>", "André")
|
||||
|
||||
let util_string_with_macros _ =
|
||||
let conf = Config.empty in
|
||||
(check string) ""
|
||||
{|<a href="mailto:jean@dupond.net">jean@dupond.net</a> - le 1 & 2|}
|
||||
(Util.string_with_macros conf [] {|jean@dupond.net - le 1 & 2|})
|
||||
|
||||
let util_escape_html _ =
|
||||
(check string) ""
|
||||
{|<a href="mailto:jean@dupond.net">jean@dupond.net</a> - le 1 &amp; 2|}
|
||||
(Util.escape_html
|
||||
{|<a href="mailto:jean@dupond.net">jean@dupond.net</a> - le 1 & 2|}
|
||||
:> string)
|
||||
|
||||
let datedisplay_string_of_date _ =
|
||||
let open Def in
|
||||
let conf = Config.empty in
|
||||
let conf =
|
||||
{
|
||||
conf with
|
||||
env = ("lang", Adef.encoded "co") :: conf.env;
|
||||
vowels = [ "a"; "e"; "i"; "o"; "u"; "y" ];
|
||||
}
|
||||
in
|
||||
Hashtbl.add conf.lexicon "(date)"
|
||||
"1<sup>u</sup> d[i |']%m %y/%d d[i |']%m %y/d[i |']%m %y/in u %y";
|
||||
Hashtbl.add conf.lexicon "(month)"
|
||||
"ghjennaghju/ferraghju/marzu/aprile/maghju/ghjugnu/lugliu/aostu/sittembre/uttobre/nuvembre/dicembre";
|
||||
let test aaa cal (d, m, y) =
|
||||
let date =
|
||||
Dgreg ({ day = d; month = m; year = y; prec = Sure; delta = 0 }, cal)
|
||||
in
|
||||
let bbb :> string = DateDisplay.string_of_date conf date in
|
||||
(check string) "" aaa bbb
|
||||
in
|
||||
test "4 d'aostu 1974" Dgregorian (4, 8, 1974);
|
||||
test "4 di sittembre 1974" Dgregorian (4, 9, 1974);
|
||||
test "1<sup>u</sup> di ferraghju 1974" Dgregorian (1, 2, 1974);
|
||||
test "di marzu 1974" Dgregorian (0, 3, 1974);
|
||||
test "d'aprile 1974" Dgregorian (0, 4, 1974);
|
||||
test "in u 1974" Dgregorian (0, 0, 1974);
|
||||
Hashtbl.add conf.lexicon "(date)"
|
||||
"1<sup>u</sup> d[i']%m %y/%d d[i %m %y/d[i |'%m %y/in u %y";
|
||||
test "1<sup>u</sup> d[i']ferraghju 1974" Dgregorian (1, 2, 1974);
|
||||
test "d[i |'marzu 1975" Dgregorian (0, 3, 1975);
|
||||
test "4 d[i sittembre 1974" Dgregorian (4, 9, 1974)
|
||||
|
||||
let start_with_vowel _ =
|
||||
let conf = Config.empty in
|
||||
let conf =
|
||||
{ conf with vowels = [ "a"; "e"; "i"; "o"; "u"; "y"; "ae"; "oe" ] }
|
||||
in
|
||||
(check bool) "Start with vowel abc" true (Util.start_with_vowel conf "abc");
|
||||
(check bool) "Start with vowel Abc" true (Util.start_with_vowel conf "Abc");
|
||||
(check bool) "Start with vowel Æbc" true (Util.start_with_vowel conf "Æbc");
|
||||
(check bool) "Start with vowel Ébc" true (Util.start_with_vowel conf "Ébc");
|
||||
(check bool) "Start with vowel Ÿbc" true (Util.start_with_vowel conf "Ÿbc");
|
||||
(check bool) "Start with vowel øbc" true (Util.start_with_vowel conf "øbc");
|
||||
(check bool) "Start with vowel def" false (Util.start_with_vowel conf "def");
|
||||
()
|
||||
|
||||
let v =
|
||||
[
|
||||
( "mutil",
|
||||
[
|
||||
test_case "Mutil.contains" `Quick mutil_contains;
|
||||
test_case "Mutil.start_with" `Quick mutil_start_with;
|
||||
test_case "Mutil arabian-roman" `Quick mutil_arabian_romian;
|
||||
test_case "Mutil particule" `Quick mutil_compare_after_particle;
|
||||
test_case "Mutil.string_of_int_sep" `Quick mutil_compare_after_particle;
|
||||
] );
|
||||
("name", [ test_case "Name.title" `Quick name_title ]);
|
||||
( "utf8",
|
||||
[
|
||||
test_case "Utf8.sub" `Quick utf8_sub;
|
||||
test_case "Utf8.name_with_roman_number" `Quick
|
||||
util_name_with_roman_number;
|
||||
] );
|
||||
( "util",
|
||||
[
|
||||
test_case "Util.safe_html" `Quick util_safe_html;
|
||||
test_case "Util.transl_a_of_b" `Quick util_transl_a_of_b;
|
||||
test_case "Util.string_with_macros" `Quick util_string_with_macros;
|
||||
test_case "Util.escape_html" `Quick util_escape_html;
|
||||
test_case "Util.start_with_vowel" `Quick start_with_vowel;
|
||||
] );
|
||||
( "date-display",
|
||||
[
|
||||
test_case "DateDisplay.string_of_date" `Quick datedisplay_string_of_date;
|
||||
] );
|
||||
]
|
||||
77
test/wiki_test.ml
Normal file
77
test/wiki_test.ml
Normal file
@@ -0,0 +1,77 @@
|
||||
(*
|
||||
let pp_wiki_link = function
|
||||
| WLpage (a, b, c, d, e) ->
|
||||
"WLpage "
|
||||
^ [%show: int * (string list * string) * string * string * string]
|
||||
(a, b, c, d, e)
|
||||
| WLperson (a, b, c, d) ->
|
||||
"WLperson"
|
||||
^ [%show: int * (string * string * int) * string * string option]
|
||||
(a, Obj.magic b, c, d)
|
||||
| WLwizard (a, b, c) -> "WLwizard" ^ [%show: int * string * string] (a, b, c)
|
||||
| WLnone -> "WLnone"
|
||||
*)
|
||||
|
||||
open Alcotest
|
||||
open Geneweb
|
||||
open NotesLinks
|
||||
|
||||
let f s =
|
||||
let len = String.length s in
|
||||
let rec loop acc i =
|
||||
if i = len then List.rev acc
|
||||
else
|
||||
match misc_notes_link s i with
|
||||
| (WLpage (j, _, _, _, _) | WLperson (j, _, _, _) | WLwizard (j, _, _)) as
|
||||
x ->
|
||||
loop (x :: acc) j
|
||||
| WLnone -> (
|
||||
match acc with
|
||||
| [] -> loop (WLnone :: acc) (i + 1)
|
||||
| hd :: _ ->
|
||||
if hd <> WLnone then loop (WLnone :: acc) (i + 1)
|
||||
else loop acc (i + 1))
|
||||
in
|
||||
loop [] 0
|
||||
|
||||
let l =
|
||||
[
|
||||
( [
|
||||
WLpage (13, ([], "aaa"), "aaa", "", "bbb");
|
||||
WLnone;
|
||||
WLperson (26, ("ccc", "ddd", 0), "ccc ddd", None);
|
||||
WLnone;
|
||||
],
|
||||
"[[[aaa/bbb]]], [[ccc/ddd]], http://site.com/eee#fff" );
|
||||
( [
|
||||
WLnone;
|
||||
WLperson (12, ("aaa", "bbb", 0), "aaa bbb", None);
|
||||
WLnone;
|
||||
WLperson (25, ("ccc", "ddd", 0), "ccc ddd", None);
|
||||
WLnone;
|
||||
],
|
||||
"[[[aaa/bbb]], [[ccc/ddd]], http://site.com/eee#fff" );
|
||||
([ WLnone ], "[[[aaa/");
|
||||
([ WLnone ], "[[[]]]");
|
||||
([ WLnone ], "[[[w");
|
||||
([ WLnone ], "[[]]");
|
||||
([ WLnone ], "[[w");
|
||||
( [ WLpage (34, ([], "d_azincourt"), "d_azincourt", "", "d'Azincourt") ],
|
||||
"[[[d_azincourt/d'Azincourt]]]" );
|
||||
]
|
||||
|
||||
(* todo fix Fmt *)
|
||||
let testable_wiki = testable Fmt.nop ( = )
|
||||
|
||||
let test expected s () =
|
||||
(check (list testable_wiki)) "" expected (f s);
|
||||
()
|
||||
|
||||
let v =
|
||||
[
|
||||
( "misc-notes-link",
|
||||
(* todo List.map here or in test? *)
|
||||
List.map
|
||||
(fun (expected, s) -> test_case "Wiki links" `Quick (test expected s))
|
||||
l );
|
||||
]
|
||||
Reference in New Issue
Block a user