From 731e861f233ab90078c00b3dad5ace4eaed45e95 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sun, 24 May 2020 19:07:23 +1000 Subject: Revamped tests to use the basic-unit-test project --- test/rat_tests-errors.adb | 169 +++++++ test/rat_tests-errors.ads | 32 ++ test/rat_tests-lexer.adb | 1020 +++++++++++++++++++++++++++++++++++++++++ test/rat_tests-lexer.ads | 81 ++++ test/rat_tests-tokens.adb | 71 +++ test/rat_tests-tokens.ads | 22 + test/rat_tests-util.adb | 513 +++++++++++++++++++++ test/rat_tests-util.ads | 48 ++ test/rat_tests.ads | 22 + test/ratnest-tests-errors.adb | 161 ------- test/ratnest-tests-graphs.adb | 140 ------ test/ratnest-tests-lexer.adb | 1016 ---------------------------------------- test/ratnest-tests-tokens.adb | 68 --- test/ratnest-tests-util.adb | 508 -------------------- test/ratnest-tests.adb | 32 -- test/ratnest-tests.ads | 186 -------- test/ratnest.adb | 34 -- test/ratnest.ads | 47 -- test/test_main.adb | 59 ++- 19 files changed, 2024 insertions(+), 2205 deletions(-) create mode 100644 test/rat_tests-errors.adb create mode 100644 test/rat_tests-errors.ads create mode 100644 test/rat_tests-lexer.adb create mode 100644 test/rat_tests-lexer.ads create mode 100644 test/rat_tests-tokens.adb create mode 100644 test/rat_tests-tokens.ads create mode 100644 test/rat_tests-util.adb create mode 100644 test/rat_tests-util.ads create mode 100644 test/rat_tests.ads delete mode 100644 test/ratnest-tests-errors.adb delete mode 100644 test/ratnest-tests-graphs.adb delete mode 100644 test/ratnest-tests-lexer.adb delete mode 100644 test/ratnest-tests-tokens.adb delete mode 100644 test/ratnest-tests-util.adb delete mode 100644 test/ratnest-tests.adb delete mode 100644 test/ratnest-tests.ads delete mode 100644 test/ratnest.adb delete mode 100644 test/ratnest.ads (limited to 'test') diff --git a/test/rat_tests-errors.adb b/test/rat_tests-errors.adb new file mode 100644 index 0000000..75d2c34 --- /dev/null +++ b/test/rat_tests-errors.adb @@ -0,0 +1,169 @@ + + +with Packrat; + + +package body Rat_Tests.Errors is + + + package PE renames Packrat.Errors; + + + + + + function Valid_Message_Check + return Test_Result is + begin + if PE.Valid_Message ("abcde") or PE.Valid_Message ("sSYM") or + PE.Valid_Message ("sSYMp") or PE.Valid_Message ("p345") or + PE.Valid_Message ("pOne") or PE.Valid_Message ("sSYMp1sNEXT") or + PE.Valid_Message ("sSYMp1.2") or PE.Valid_Message ("sABcDp12") or + not PE.Valid_Message ("sSYMp0") or not PE.Valid_Message ("sAp12") or + not PE.Valid_Message ("sNAMEp34sSYMp02") or not PE.Valid_Message ("") or + not PE.Valid_Message ("sA_Bp3") or not PE.Valid_Message ("sAp1sAp1") + then + return Fail; + end if; + return Pass; + end Valid_Message_Check; + + + + + + function Valid_Identifier_Check + return Test_Result + is + Pass_Array : PE.Error_Info_Array := + ((+"A", 1), (+"ABC", 2), (+"AB_CD", 3), (+"A_B_CD", 4)); + Fail_Array : PE.Error_Info_Array := + ((+"_", 1), (+"_A", 2), (+"A_", 3), (+"A__B", 4), (+"A%B", 3)); + begin + for EI of Pass_Array loop + if not PE.Valid_Identifier (EI.Symbol) or + not PE.Valid_Identifier (-EI.Symbol) + then + return Fail; + end if; + end loop; + for EI of Fail_Array loop + if PE.Valid_Identifier (EI.Symbol) or + PE.Valid_Identifier (-EI.Symbol) + then + return Fail; + end if; + end loop; + if not PE.Valid_Identifier_Array (Pass_Array) or + PE.Valid_Identifier_Array (Fail_Array) + then + return Fail; + end if; + return Pass; + end Valid_Identifier_Check; + + + + + + function Join_Check + return Test_Result + is + Array_1 : PE.Error_Info_Array := ((+"A", 1), (+"B", 2)); + Msg_1 : PE.Error_Message := PE.Encode_Array (Array_1); + + Array_2 : PE.Error_Info_Array := ((+"C", 3), (+"D", 4)); + Msg_2 : PE.Error_Message := PE.Encode_Array (Array_2); + + Msg_3 : PE.Error_Message := PE.Join (Msg_1, Msg_2); + + Array_4 : PE.Error_Info_Array := ((+"A", 1), (+"B", 2), (+"C", 3), (+"D", 4)); + Msg_4 : PE.Error_Message := PE.Encode_Array (Array_4); + + Array_5 : PE.Error_Info_Array := ((+"A", 1), (+"B", 4)); + Msg_5 : PE.Error_Message := PE.Encode_Array (Array_5); + + Array_6 : PE.Error_Info_Array := ((+"A", 1), (+"C", 3)); + Msg_6 : PE.Error_Message := PE.Encode_Array (Array_6); + + Msg_7 : PE.Error_Message := PE.Join (Msg_5, Msg_6); + + Array_8 : PE.Error_Info_Array := ((+"A", 1), (+"B", 4), (+"C", 3)); + Msg_8 : PE.Error_Message := PE.Encode_Array (Array_8); + begin + if Msg_3 /= Msg_4 or Msg_7 /= Msg_8 then + return Fail; + end if; + return Pass; + end Join_Check; + + + + + + function Encode_1_Check + return Test_Result is + begin + -- Encode with a String and a Natural + if PE.Encode ("ABC", 15) /= "sABCp15" then + return Fail; + end if; + return Pass; + end Encode_1_Check; + + + function Encode_2_Check + return Test_Result is + begin + -- Encode with an Unbounded_String and a Natural + if PE.Encode (+"ABC", 15) /= "sABCp15" then + return Fail; + end if; + return Pass; + end Encode_2_Check; + + + function Encode_3_Check + return Test_Result is + begin + -- Encode with an Error_Info + if PE.Encode ((+"ABC", 15)) /= "sABCp15" then + return Fail; + end if; + return Pass; + end Encode_3_Check; + + + function Encode_4_Check + return Test_Result is + begin + -- Encode with an Error_Info_Array + if PE.Encode_Array (((+"A", 3), (+"BC", 2), (+"ABC", 1), (+"B", 4))) /= + "sAp3sBCp2sABCp1sBp4" + then + return Fail; + end if; + return Pass; + end Encode_4_Check; + + + + + + function Decode_Check + return Test_Result + is + use type PE.Error_Info_Array; + begin + if PE.Decode ("sAp1sBp3sCp10sDEFp456") /= + ((+"A", 1), (+"B", 3), (+"C", 10), (+"DEF", 456)) + then + return Fail; + end if; + return Pass; + end Decode_Check; + + +end Rat_Tests.Errors; + + diff --git a/test/rat_tests-errors.ads b/test/rat_tests-errors.ads new file mode 100644 index 0000000..adbdded --- /dev/null +++ b/test/rat_tests-errors.ads @@ -0,0 +1,32 @@ + + +with Unit_Tests; +use Unit_Tests; + + +package Rat_Tests.Errors is + + + function Valid_Message_Check return Test_Result; + function Valid_Identifier_Check return Test_Result; + function Join_Check return Test_Result; + function Encode_1_Check return Test_Result; + function Encode_2_Check return Test_Result; + function Encode_3_Check return Test_Result; + function Encode_4_Check return Test_Result; + function Decode_Check return Test_Result; + + Tests : Test_Array := + ((+"Valid_Message", Valid_Message_Check'Access), + (+"Valid_Identifier", Valid_Identifier_Check'Access), + (+"Join", Join_Check'Access), + (+"Encode_1", Encode_1_Check'Access), + (+"Encode_2", Encode_2_Check'Access), + (+"Encode_3", Encode_3_Check'Access), + (+"Encode_4", Encode_4_Check'Access), + (+"Decode", Decode_Check'Access)); + + +end Rat_Tests.Errors; + + diff --git a/test/rat_tests-lexer.adb b/test/rat_tests-lexer.adb new file mode 100644 index 0000000..702de18 --- /dev/null +++ b/test/rat_tests-lexer.adb @@ -0,0 +1,1020 @@ + + +with + + Packrat.Lexer.Debug, + Packrat.Util; + + +package body Rat_Tests.Lexer is + + + package PU renames Packrat.Util; + + + type My_Labels is (One, Two, Three); + + + package String_Tokens is new Packrat.Tokens (My_Labels, Character, String); + package Slexy is new Packrat.Lexer (My_Labels, Character, String, String_Tokens); + package Slebug is new Slexy.Debug; + + + use type Slexy.Combinator_Result; + + + + + + function Join_Check + return Test_Result + is + One : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Success); + Two : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Three : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + + Four : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Failure); + Five : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Failure); + + Six : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Needs_More); + Seven : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Needs_More); + + Eight : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Failure); + + Nine : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Optional_More); + Ten : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Eleven : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + begin + if Slebug.Join (One, Two) /= Three or Slebug.Join (One, Four) /= Five or + Slebug.Join (One, Six) /= Seven or Slebug.Join (Four, Six) /= Four or + Slebug.Join (Five, Two) /= Five or Slebug.Join (Six, Three) /= Eight or + Slebug.Join (Slebug.Empty_Fail, One) /= Slebug.Empty_Fail or + Slebug.Join (Nine, Ten) /= Eleven + then + return Fail; + end if; + return Pass; + end Join_Check; + + + function Equals_Check + return Test_Result + is + One : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Two : Slexy.Combinator_Result := + Slebug.Create_Result (0, Packrat.Failure); + begin + if One = Two or Two /= Slebug.Empty_Fail then + return Fail; + end if; + return Pass; + end Equals_Check; + + + + + + function Sequence_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Match_B is new Slexy.Match ('b'); + function Match_C is new Slexy.Match ('c'); + function Seq_Abc is new Slexy.Sequence + ((Match_A'Unrestricted_Access, + Match_B'Unrestricted_Access, + Match_C'Unrestricted_Access)); + + Test_Str : String := "aababcabcab"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Failure); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (11, Packrat.Needs_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (6, Packrat.Success); + Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; + Result5 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Failure); + begin + if Seq_Abc (Test_Str, 1) /= Result1 or Seq_Abc (Test_Str, 2) /= Result5 or + Seq_Abc (Test_Str, 4) /= Result3 or Seq_Abc (Test_Str, 10) /= Result2 or + Seq_Abc (Test_Str, 3) /= Result4 or + Seq_Abc (Test_Str, Test_Str'Last + 5) /= Result4 + then + return Fail; + end if; + return Pass; + end Sequence_Check; + + + function Count_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Match_B is new Slexy.Match ('b'); + function Count_2A is new Slexy.Count (Match_A, 2); + function Count_3B is new Slexy.Count (Match_B, 3); + + Test_Str : String := "abaabbaaabbbaaaabbbb"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Failure); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Success); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (2, Packrat.Failure); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (20, Packrat.Needs_More); + Result5 : Slexy.Combinator_Result := + Slebug.Create_Result (12, Packrat.Success); + Result6 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Count_2A (Test_Str, 1) /= Result1 or Count_2A (Test_Str, 3) /= Result2 or + Count_3B (Test_Str, 2) /= Result3 or Count_3B (Test_Str, 19) /= Result4 or + Count_3B (Test_Str, 10) /= Result5 or Count_3B (Test_Str, 1) /= Result6 or + Count_2A (Test_Str, 2) /= Result6 or + Count_2A (Test_Str, Test_Str'Last + 5) /= Result6 + then + return Fail; + end if; + return Pass; + end Count_Check; + + + function Many_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Many_0 is new Slexy.Many (Match_A); + function Many_4 is new Slexy.Many (Match_A, 4); + + function Match_B is new Slexy.Match ('b'); + function Match_C is new Slexy.Match ('c'); + function Seq_Abc is new Slexy.Sequence + ((Match_A'Unrestricted_Access, + Match_B'Unrestricted_Access, + Match_C'Unrestricted_Access)); + function Many_Seq_0 is new Slexy.Many (Seq_Abc); + function Many_Seq_4 is new Slexy.Many (Seq_Abc, 4); + + Test_Str : String := "aaabbaaaaabaa"; + Test_Str2 : String := "aababcabcab"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (13, Packrat.Optional_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (10, Packrat.Success); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Failure); + Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; + Result6 : Slexy.Combinator_Result := + Slebug.Create_Result (13, Packrat.Needs_More); + Result7 : Slexy.Combinator_Result := + Slebug.Create_Result (0, Packrat.Success); + Result8 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Optional_More); + Result9 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Needs_More); + begin + if Many_0 (Test_Str, 1) /= Result1 or Many_4 (Test_Str, 1) /= Result4 or + Many_4 (Test_Str, 6) /= Result3 or Many_0 (Test_Str, 4) /= Result7 or + Many_0 (Test_Str, 12) /= Result2 or Many_4 (Test_Str, 12) /= Result6 or + Many_0 (Test_Str, Test_Str'Last + 5) /= Result5 or + Many_Seq_0 (Test_Str2, 4) /= Result8 or Many_Seq_4 (Test_Str2, 4) /= Result9 + then + return Fail; + end if; + return Pass; + end Many_Check; + + + function Many_Until_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Many_Until_0 is new Slexy.Many_Until (Match_A, PU.Is_Digit); + function Many_Until_3 is new Slexy.Many_Until (Match_A, PU.Is_Digit, 3); + + Test_Str : String := "aaaabbaaa123aaa"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Failure); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Success); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (15, Packrat.Needs_More); + Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Many_Until_0 (Test_Str, 1) /= Result1 or + Many_Until_0 (Test_Str, 7) /= Result2 or + Many_Until_3 (Test_Str, 7) /= Result2 or + Many_Until_3 (Test_Str, 13) /= Result3 or + Many_Until_0 (Test_Str, 5) /= Result4 or + Many_Until_0 (Test_Str, Test_Str'Last + 5) /= Result4 or + Many_Until_3 (Test_Str, Test_Str'Last + 5) /= Result4 + then + return Fail; + end if; + return Pass; + end Many_Until_Check; + + + function Satisfy_Check + return Test_Result + is + function Is_123 + (Char : in Character) + return Boolean is + begin + return Char = '1' or Char = '2' or Char = '3'; + end Is_123; + function Is_Abc + (Char : in Character) + return Boolean is + begin + return Char = 'a' or Char = 'b' or Char = 'c'; + end Is_Abc; + + function Satisfy_123 is new Slexy.Satisfy (Is_123); + function Satisfy_Abc is new Slexy.Satisfy (Is_Abc); + + Test_Str : String := "abc123456def"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (2, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (6, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Satisfy_123 (Test_Str, 6) /= Result2 or + Satisfy_Abc (Test_Str, 2) /= Result1 or + Satisfy_Abc (Test_Str, 8) /= Result3 or + Satisfy_123 (Test_Str, Test_Str'Last + 5) /= Result3 + then + return Fail; + end if; + return Pass; + end Satisfy_Check; + + + function Satisfy_With_Check + return Test_Result + is + function Is_Abc + (Char : in Character) + return Boolean is + begin + return Char = 'a' or Char = 'b' or Char = 'c'; + end Is_Abc; + function Is_123 + (Char : in Character) + return Boolean is + begin + return Char = '1' or Char = '2' or Char = '3'; + end Is_123; + function Minus_One + (Char : in Character) + return Character is + begin + return Character'Val (Character'Pos (Char) - 1); + end Minus_One; + + function Satisfy_Bcd is new Slexy.Satisfy_With (Is_Abc, Minus_One); + function Satisfy_234 is new Slexy.Satisfy_With (Is_123, Minus_One); + + Test_Str : String := "abcde12345"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (7, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Satisfy_Bcd (Test_Str, 3) /= Result1 or + Satisfy_234 (Test_Str, 7) /= Result2 or + Satisfy_Bcd (Test_Str, 1) /= Result3 or + Satisfy_234 (Test_Str, Test_Str'Last + 5) /= Result3 + then + return Fail; + end if; + return Pass; + end Satisfy_With_Check; + + + function Match_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Match_Slash is new Slexy.Match ('/'); + function Match_4 is new Slexy.Match ('4'); + + Test_Str : String := "abc1234./5"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Success); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (7, Packrat.Success); + Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Match_A (Test_Str, 1) /= Result1 or + Match_Slash (Test_Str, 9) /= Result2 or + Match_4 (Test_Str, 7) /= Result3 or + Match_A (Test_Str, 3) /= Result4 or + Match_A (Test_Str, Test_Str'Last + 5) /= Result4 + then + return Fail; + end if; + return Pass; + end Match_Check; + + + function Match_With_Check + return Test_Result + is + function Plus_One + (Char : in Character) + return Character is + begin + return Character'Val (Character'Pos (Char) + 1); + end Plus_One; + + function Match_A is new Slexy.Match_With ('b', Plus_One); + function Match_6 is new Slexy.Match_With ('7', Plus_One); + + Test_Str : String := "abc5678"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Match_A (Test_Str, 1) /= Result1 or + Match_6 (Test_Str, 5) /= Result2 or + Match_A (Test_Str, 2) /= Result3 or + Match_A (Test_Str, Test_Str'Last + 5) /= Result3 + then + return Fail; + end if; + return Pass; + end Match_With_Check; + + + function Multimatch_Check + return Test_Result + is + function Match_String1 is new Slexy.Multimatch ("abc"); + function Match_String2 is new Slexy.Multimatch ("hello"); + + Test_Str : String := "abcdefabhelloworldab"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (20, Packrat.Needs_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (13, Packrat.Success); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (8, Packrat.Failure); + Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Match_String1 (Test_Str, 1) /= Result1 or + Match_String1 (Test_Str, 7) /= Result4 or + Match_String2 (Test_Str, 9) /= Result3 or + Match_String2 (Test_Str, 3) /= Result5 or + Match_String1 (Test_Str, 19) /= Result2 or + Match_String1 (Test_Str, Test_Str'Last + 5) /= Result5 + then + return Fail; + end if; + return Pass; + end Multimatch_Check; + + + function Take_Check + return Test_Result + is + function Take_1 is new Slexy.Take; + function Take_5 is new Slexy.Take (5); + + Test_Str : String := "abcdefghi"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (2, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Needs_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (7, Packrat.Success); + Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Take_1 (Test_Str, 2) /= Result1 or Take_5 (Test_Str, 7) /= Result2 or + Take_5 (Test_Str, 3) /= Result3 or + Take_1 (Test_Str, Test_Str'Last + 5) /= Result4 + then + return Fail; + end if; + return Pass; + end Take_Check; + + + function Take_While_Check + return Test_Result + is + function Take_Letters is new Slexy.Take_While (PU.Is_Letter); + function Take_Punch is new Slexy.Take_While (PU.Is_Punctuation); + function Take_Digits is new Slexy.Take_While (PU.Is_Digit); + + Test_Str : String := "abcde,./;'fghi[]=-^563"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (14, Packrat.Success); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (10, Packrat.Success); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (19, Packrat.Success); + Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; + Result6 : Slexy.Combinator_Result := + Slebug.Create_Result (22, Packrat.Optional_More); + begin + if Take_Letters (Test_Str, 2) /= Result1 or + Take_Letters (Test_Str, 13) /= Result2 or + Take_Punch (Test_Str, 6) /= Result3 or + Take_Punch (Test_Str, 17) /= Result4 or + Take_Letters (Test_Str, 7) /= Result5 or + Take_Punch (Test_Str, Test_Str'Last + 5) /= Result5 or + Take_Digits (Test_Str, 20) /= Result6 + then + return Fail; + end if; + return Pass; + end Take_While_Check; + + + function Take_Until_Check + return Test_Result + is + function Take_Till_Punch is new Slexy.Take_Until (PU.Is_Punctuation); + function Take_Till_Digit is new Slexy.Take_Until (PU.Is_Digit); + + Test_Str : String := "abcde12345;;;fghi67"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (10, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (19, Packrat.Optional_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (17, Packrat.Success); + Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Take_Till_Punch (Test_Str, 4) /= Result1 or + Take_Till_Punch (Test_Str, 16) /= Result2 or + Take_Till_Digit (Test_Str, 1) /= Result3 or + Take_Till_Digit (Test_Str, 12) /= Result4 or + Take_Till_Punch (Test_Str, 11) /= Result5 or + Take_Till_Punch (Test_Str, Test_Str'Last + 5) /= Result5 + then + return Fail; + end if; + return Pass; + end Take_Until_Check; + + + function Line_End_Check + return Test_Result + is + function LF_End is new Slexy.Line_End (Latin.LF); + function C_End is new Slexy.Line_End ('c'); + + Test_Str : String := "abcd" & Latin.LF & "e"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if LF_End (Test_Str, 5) /= Result1 or C_End (Test_Str, 3) /= Result2 or + LF_End (Test_Str, Test_Str'Last + 5) /= Result3 or LF_End (Test_Str, 1) /= Result3 + then + return Fail; + end if; + return Pass; + end Line_End_Check; + + + function Input_End_Check + return Test_Result + is + function C_End is new Slexy.Input_End ('c'); + function E_End is new Slexy.Input_End ('e'); + + Test_Str : String := "abcde"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if C_End (Test_Str, 3) /= Result2 or E_End (Test_Str, 5) /= Result1 or + C_End (Test_Str, 6) /= Result3 or E_End (Test_Str, 6) /= Result3 or + C_End (Test_Str, 1) /= Result3 or E_End (Test_Str, Test_Str'Last + 5) /= Result3 + then + return Fail; + end if; + return Pass; + end Input_End_Check; + + + + + + function Stamp_Check + return Test_Result + is + use type String_Tokens.Token; + use type Packrat.Result_Status; + use type Slexy.Component_Result; + + function Match_A is new Slexy.Match ('a'); + function Match_B is new Slexy.Match ('b'); + function Match_C is new Slexy.Match ('c'); + function Seq_Abc is new Slexy.Sequence + ((Match_A'Unrestricted_Access, + Match_B'Unrestricted_Access, + Match_C'Unrestricted_Access)); + function My_Stamp is new Slexy.Stamp (One, Seq_Abc); + + Test_Str1 : String := "abcdefghi"; + Test_Str2 : String := "ab"; + + Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; + Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; + + Comp_Code : Slexy.Component_Result; + begin + Comp_Code := My_Stamp (Test_Str1, Context1); + if (Slebug.So_Far (Context1).Length /= 1 or else + Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, "abc")) or + Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or + Slebug.Has_Pass (Context1) + then + return Fail; + end if; + Comp_Code := My_Stamp (Test_Str1, Context1); + if (Slebug.So_Far (Context1).Length /= 1 or else + Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, "abc")) or + Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or + Slebug.Has_Pass (Context1) + then + return Fail; + end if; + Comp_Code := My_Stamp (Test_Str2, Context2); + if Slebug.So_Far (Context2).Length /= 0 or + Slebug.Position (Context2) /= 1 or + Slebug.Status (Context2) /= Packrat.Needs_More or + (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") + then + return Fail; + end if; + return Pass; + end Stamp_Check; + + + function Ignore_Check + return Test_Result + is + use type Packrat.Result_Status; + + function Match_Abc is new Slexy.Multimatch ("abc"); + function My_Ignore is new Slexy.Ignore (Two, Match_Abc); + + Test_Str1 : String := "abcdefghi"; + Test_Str2 : String := "ab"; + + Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; + Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; + + Comp_Code : Slexy.Component_Result; + begin + Comp_Code := My_Ignore (Test_Str1, Context1); + if Slebug.So_Far (Context1).Length /= 0 or + Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or + Slebug.Has_Pass (Context1) + then + return Fail; + end if; + Comp_Code := My_Ignore (Test_Str1, Context1); + if Slebug.So_Far (Context1).Length /= 0 or + Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or + Slebug.Has_Pass (Context1) + then + return Fail; + end if; + Comp_Code := My_Ignore (Test_Str2, Context2); + if Slebug.So_Far (Context2).Length /= 0 or + Slebug.Position (Context2) /= 1 or Slebug.Status (Context2) /= Packrat.Needs_More or + (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") + then + return Fail; + end if; + return Pass; + end Ignore_Check; + + + + + + type Word_Enum is (Blank, Word, Whitespace); + + package Word_Tokens is new Packrat.Tokens (Word_Enum, Character, String); + package Swordy is new Packrat.Lexer (Word_Enum, Character, String, Word_Tokens); + package Swolbug is new Swordy.Debug; + + use type Word_Tokens.Token; + use type Word_Tokens.Token_Array; + + function Satisfy_Letter is new Swordy.Satisfy (PU.Is_Letter); + function Many_Letter is new Swordy.Many (Satisfy_Letter, 1); + function Satisfy_Whitespace is new Swordy.Satisfy (PU.Is_Whitespace); + function Many_Whitespace is new Swordy.Many (Satisfy_Whitespace, 1); + + function Stamp_Word is new Swordy.Stamp (Word, Many_Letter); + function Ignore_Whitespace is new Swordy.Ignore (Whitespace, Many_Whitespace); + + + function Scan_Check + return Test_Result + is + function My_Scan is new Swordy.Scan + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Str : String := "one fine day"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result1 : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 1, "one"), + 2 => Word_Tokens.Create (Word, 5, "fine")); + Intended_Result2 : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 10, "day")); + + Actual_Result1 : Word_Tokens.Token_Array := + My_Scan (Test_Str, Test_Context); + Actual_Result2 : Word_Tokens.Token_Array := + My_Scan ("", Test_Context); + begin + if Actual_Result1 /= Intended_Result1 or Actual_Result2 /= Intended_Result2 then + return Fail; + end if; + return Pass; + end Scan_Check; + + + function Scan_Only_Check + return Test_Result + is + function My_Scan is new Swordy.Scan_Only + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Str : String := "one fine day"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 1, "one"), + 2 => Word_Tokens.Create (Word, 5, "fine"), + 3 => Word_Tokens.Create (Word, 10, "day")); + + Actual_Result : Word_Tokens.Token_Array := + My_Scan (Test_Str, Test_Context); + begin + if Actual_Result /= Intended_Result then + return Fail; + end if; + return Pass; + end Scan_Only_Check; + + + function Scan_With_Check + return Test_Result + is + Sentinel : Natural := 2; + function More_Input + return String is + begin + if Sentinel > 1 then + Sentinel := 1; + return "it will happen again"; + elsif Sentinel > 0 then + Sentinel := 0; + return " and again and again"; + else + return ""; + end if; + end More_Input; + + function My_Scan is new Swordy.Scan_With + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 1, "it"), + 2 => Word_Tokens.Create (Word, 4, "will"), + 3 => Word_Tokens.Create (Word, 9, "happen"), + 4 => Word_Tokens.Create (Word, 17, "again"), + 5 => Word_Tokens.Create (Word, 23, "and"), + 6 => Word_Tokens.Create (Word, 27, "again"), + 7 => Word_Tokens.Create (Word, 33, "and"), + 8 => Word_Tokens.Create (Word, 37, "again")); + + Actual_Result : Word_Tokens.Token_Array := + My_Scan (More_Input'Unrestricted_Access, Test_Context); + begin + if Actual_Result /= Intended_Result then + return Fail; + end if; + return Pass; + end Scan_With_Check; + + + function Scan_Set_Check + return Test_Result + is + procedure My_Scan is new Swordy.Scan_Set + ((Stamp_Word'Access, Ignore_Whitespace'Access), + Latin.EOT, Word_Tokens.Create (Blank, 1, "")); + + Test_Str1 : String (1 .. 10) := "one tw"; + Test_Str2 : String (1 .. 10) := "o three"; + Test_Str3 : String (1 .. 10) := Latin.EOT & " "; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result1 : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 1, "one"), + 2 => Word_Tokens.Create (Blank, 1, ""), + 3 => Word_Tokens.Create (Blank, 1, "")); + Intended_Result2 : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 9, "two"), + 2 => Word_Tokens.Create (Blank, 1, ""), + 3 => Word_Tokens.Create (Blank, 1, "")); + Intended_Result3 : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 16, "three"), + 2 => Word_Tokens.Create (Blank, 1, ""), + 3 => Word_Tokens.Create (Blank, 1, "")); + + Actual_Result : Word_Tokens.Token_Array (1 .. 3); + begin + My_Scan (Test_Str1, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result1 then + return Fail; + end if; + My_Scan (Test_Str2, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result2 then + return Fail; + end if; + My_Scan (Test_Str3, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result3 then + return Fail; + end if; + return Pass; + end Scan_Set_Check; + + + function Scan_Set_With_Check + return Test_Result + is + Sentinel : Natural := 2; + function More_Input + return String is + begin + if Sentinel > 1 then + Sentinel := 1; + return "it will happen again"; + elsif Sentinel > 0 then + Sentinel := 0; + return " and again and again"; + else + return ""; + end if; + end More_Input; + + procedure My_Scan is new Swordy.Scan_Set_With + ((Stamp_Word'Access, Ignore_Whitespace'Access), + Latin.EOT, Word_Tokens.Create (Blank, 1, "")); + + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result1 : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 1, "it"), + 2 => Word_Tokens.Create (Word, 4, "will"), + 3 => Word_Tokens.Create (Word, 9, "happen"), + 4 => Word_Tokens.Create (Word, 16, "again"), + 5 => Word_Tokens.Create (Word, 22, "and")); + Intended_Result2 : Word_Tokens.Token_Array := + (1 => Word_Tokens.Create (Word, 26, "again"), + 2 => Word_Tokens.Create (Word, 32, "and"), + 3 => Word_Tokens.Create (Word, 36, "again"), + 4 => Word_Tokens.Create (Blank, 1, ""), + 5 => Word_Tokens.Create (Blank, 1, "")); + + Actual_Result : Word_Tokens.Token_Array (1 .. 5); + begin + My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result1 then + return Fail; + end if; + My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result2 then + return Fail; + end if; + return Pass; + end Scan_Set_With_Check; + + + function Scan_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + function My_Scan is new Swordy.Scan + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Str : String := "()()"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + declare + Result : Word_Tokens.Token_Array := My_Scan (Test_Str, Test_Context); + begin + return Fail; + end; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_Error_Check; + + + function Scan_Only_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + function My_Scan is new Swordy.Scan_Only + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Str : String := "()()"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + declare + Result : Word_Tokens.Token_Array := My_Scan (Test_Str, Test_Context); + begin + return Fail; + end; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_Only_Error_Check; + + + function Scan_With_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + Sentinel : Integer := 1; + function Get_Input + return String is + begin + if Sentinel > 0 then + Sentinel := 0; + return "()()"; + else + return ""; + end if; + end Get_Input; + + function My_Scan is new Swordy.Scan_With + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + declare + Result : Word_Tokens.Token_Array := + My_Scan (Get_Input'Unrestricted_Access, Test_Context); + begin + return Fail; + end; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_With_Error_Check; + + + function Scan_Set_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + procedure My_Scan is new Swordy.Scan_Set + ((Stamp_Word'Access, Ignore_Whitespace'Access), + Latin.EOT, Word_Tokens.Create (Blank, 1, "")); + + Test_Str : String := "()()"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Result : Word_Tokens.Token_Array (1 .. 5); + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + My_Scan (Test_Str, Test_Context, Result); + return Fail; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_Set_Error_Check; + + + function Scan_Set_With_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + Sentinel : Integer := 1; + function Get_Input + return String is + begin + if Sentinel > 0 then + Sentinel := 0; + return "()()"; + else + return ""; + end if; + end Get_Input; + + procedure My_Scan is new Swordy.Scan_Set_With + ((Stamp_Word'Access, Ignore_Whitespace'Access), + Latin.EOT, Word_Tokens.Create (Blank, 1, "")); + + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Result : Word_Tokens.Token_Array (1 .. 5); + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + My_Scan (Get_Input'Unrestricted_Access, Test_Context, Result); + return Fail; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_Set_With_Error_Check; + + +end Rat_Tests.Lexer; + + diff --git a/test/rat_tests-lexer.ads b/test/rat_tests-lexer.ads new file mode 100644 index 0000000..bc3045c --- /dev/null +++ b/test/rat_tests-lexer.ads @@ -0,0 +1,81 @@ + + +with Unit_Tests; +use Unit_Tests; + + +package Rat_Tests.Lexer is + + + function Join_Check return Test_Result; + function Equals_Check return Test_Result; + + function Sequence_Check return Test_Result; + function Count_Check return Test_Result; + function Many_Check return Test_Result; + function Many_Until_Check return Test_Result; + + function Satisfy_Check return Test_Result; + function Satisfy_With_Check return Test_Result; + function Match_Check return Test_Result; + function Match_With_Check return Test_Result; + function Multimatch_Check return Test_Result; + function Take_Check return Test_Result; + function Take_While_Check return Test_Result; + function Take_Until_Check return Test_Result; + + function Line_End_Check return Test_Result; + function Input_End_Check return Test_Result; + + Combinator_Tests : Test_Array := + ((+"Join", Join_Check'Access), + (+"Equals", Equals_Check'Access), + (+"Sequence", Sequence_Check'Access), + (+"Count", Count_Check'Access), + (+"Many", Many_Check'Access), + (+"Many_Until", Many_Until_Check'Access), + (+"Satisfy", Satisfy_Check'Access), + (+"Satisfy With", Satisfy_With_Check'Access), + (+"Match", Match_Check'Access), + (+"Match With", Match_With_Check'Access), + (+"Multimatch", Multimatch_Check'Access), + (+"Take", Take_Check'Access), + (+"Take While", Take_While_Check'Access), + (+"Take Until", Take_Until_Check'Access), + (+"Line End", Line_End_Check'Access), + (+"Input_End", Input_End_Check'Access)); + + + function Stamp_Check return Test_Result; + function Ignore_Check return Test_Result; + + function Scan_Check return Test_Result; + function Scan_Only_Check return Test_Result; + function Scan_With_Check return Test_Result; + function Scan_Set_Check return Test_Result; + function Scan_Set_With_Check return Test_Result; + + function Scan_Error_Check return Test_Result; + function Scan_Only_Error_Check return Test_Result; + function Scan_With_Error_Check return Test_Result; + function Scan_Set_Error_Check return Test_Result; + function Scan_Set_With_Error_Check return Test_Result; + + Lexer_Tests : Test_Array := + ((+"Stamp", Stamp_Check'Access), + (+"Ignore", Ignore_Check'Access), + (+"Scan", Scan_Check'Access), + (+"Scan_Only", Scan_Only_Check'Access), + (+"Scan_With", Scan_With_Check'Access), + (+"Scan_Set", Scan_Set_Check'Access), + (+"Scan_Set_With", Scan_Set_With_Check'Access), + (+"Scan Exception", Scan_Error_Check'Access), + (+"Scan_Only Exception", Scan_Only_Error_Check'Access), + (+"Scan_With Exception", Scan_With_Error_Check'Access), + (+"Scan_Set Exception", Scan_Set_Error_Check'Access), + (+"Scan_Set_With Exception", Scan_Set_With_Error_Check'Access)); + + +end Rat_Tests.Lexer; + + diff --git a/test/rat_tests-tokens.adb b/test/rat_tests-tokens.adb new file mode 100644 index 0000000..8bfb516 --- /dev/null +++ b/test/rat_tests-tokens.adb @@ -0,0 +1,71 @@ + + +with Packrat; + + +package body Rat_Tests.Tokens is + + + + type My_Labels is (One, Two, Three); + package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); + + + + + + function Adjust_Check + return Test_Result + is + A : My_Tokens.Token; + begin + declare + B : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); + begin + A := B; + end; + if My_Tokens.Value (A) /= "abc" then + return Fail; + end if; + return Pass; + end Adjust_Check; + + + + + + function Equals_Check + return Test_Result + is + use type My_Tokens.Token; + A : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); + B : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); + begin + if A /= B then + return Fail; + end if; + return Pass; + end Equals_Check; + + + + + + function Store_Check + return Test_Result + is + T : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); + begin + if My_Tokens.Label (T) /= One or else + My_Tokens.Start (T) /= 1 or else + My_Tokens.Value (T) /= "abc" + then + return Fail; + end if; + return Pass; + end Store_Check; + + +end Rat_Tests.Tokens; + + diff --git a/test/rat_tests-tokens.ads b/test/rat_tests-tokens.ads new file mode 100644 index 0000000..1804347 --- /dev/null +++ b/test/rat_tests-tokens.ads @@ -0,0 +1,22 @@ + + +with Unit_Tests; +use Unit_Tests; + + +package Rat_Tests.Tokens is + + + function Adjust_Check return Test_Result; + function Equals_Check return Test_Result; + function Store_Check return Test_Result; + + Tests : Test_Array := + ((+"Adjust", Adjust_Check'Access), + (+"Equals", Equals_Check'Access), + (+"Storage", Store_Check'Access)); + + +end Rat_Tests.Tokens; + + diff --git a/test/rat_tests-util.adb b/test/rat_tests-util.adb new file mode 100644 index 0000000..fe1f890 --- /dev/null +++ b/test/rat_tests-util.adb @@ -0,0 +1,513 @@ + + +with Packrat.Util; + + +package body Rat_Tests.Util is + + + package PU renames Packrat.Util; + + + function In_Set_Check + return Test_Result + is + use type Strmaps.Character_Set; + Set_1 : Strmaps.Character_Set := Strmaps.To_Set ("abcxyz"); + Set_2 : Strmaps.Character_Set := Strmaps.To_Set ("!""#$"); + function Func_1 is new PU.In_Set (Set_1); + function Func_2 is new PU.In_Set (Set_2); + begin + -- Func_1 testing + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('a') - 1 loop + if Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'c' loop + if not Func_1 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('c') + 1 .. Character'Pos ('x') - 1 loop + if Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'x' .. 'z' loop + if not Func_1 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop + if Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + -- Func_2 testing + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop + if Func_2 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '!' .. '$' loop + if not Func_2 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('$') + 1 .. Character'Pos (Character'Last) loop + if Func_2 (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end In_Set_Check; + + + function Not_In_Set_Check + return Test_Result + is + use type Strmaps.Character_Set; + Set_1 : Strmaps.Character_Set := Strmaps.To_Set ("abcxyz"); + Set_2 : Strmaps.Character_Set := Strmaps.To_Set ("!""#$"); + function Func_1 is new PU.Not_In_Set (Set_1); + function Func_2 is new PU.Not_In_Set (Set_2); + begin + -- Func_1 testing + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('a') - 1 loop + if not Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'c' loop + if Func_1 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('c') + 1 .. Character'Pos ('x') - 1 loop + if not Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'x' .. 'z' loop + if Func_1 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop + if not Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + -- Func_2 testing + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop + if not Func_2 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '!' .. '$' loop + if Func_2 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('$') + 1 .. Character'Pos (Character'Last) loop + if not Func_2 (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Not_In_Set_Check; + + + + + + function Is_Digit_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop + if PU.Is_Digit (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '0' .. '9' loop + if not PU.Is_Digit (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('9') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Digit (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Digit_Check; + + + function Is_Hex_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop + if PU.Is_Hex (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '0' .. '9' loop + if not PU.Is_Hex (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('9') + 1 .. Character'Pos ('A') - 1 loop + if PU.Is_Hex (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'A' .. 'F' loop + if not PU.Is_Hex (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('F') + 1 .. Character'Pos ('a') - 1 loop + if PU.Is_Hex (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'f' loop + if not PU.Is_Hex (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('f') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Hex (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Hex_Check; + + + function Is_Letter_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('A') - 1 loop + if PU.Is_Letter (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'A' .. 'Z' loop + if not PU.Is_Letter (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('Z') + 1 .. Character'Pos ('a') - 1 loop + if PU.Is_Letter (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'z' loop + if not PU.Is_Letter (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'First) loop + if PU.Is_Letter (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Letter_Check; + + + function Is_Alphanumeric_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop + if PU.Is_Alphanumeric (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '0' .. '9' loop + if not PU.Is_Alphanumeric (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('9') + 1 .. Character'Pos ('A') - 1 loop + if PU.Is_Alphanumeric (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'A' .. 'Z' loop + if not PU.Is_Alphanumeric (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('Z') + 1 .. Character'Pos ('a') - 1 loop + if PU.Is_Alphanumeric (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'z' loop + if not PU.Is_Alphanumeric (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Alphanumeric (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Alphanumeric_Check; + + + function Is_Punctuation_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '!' .. '/' loop + if not PU.Is_Punctuation (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('/') + 1 .. Character'Pos (':') - 1 loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range ':' .. '@' loop + if not PU.Is_Punctuation (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('@') + 1 .. Character'Pos ('[') - 1 loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '[' .. '`' loop + if not PU.Is_Punctuation (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('`') + 1 .. Character'Pos ('{') - 1 loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '{' .. '~' loop + if not PU.Is_Punctuation (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('~') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Punctuation_Check; + + + function Is_ASCII_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. 127 loop + if not PU.Is_ASCII (Character'Val (I)) then + return Fail; + end if; + end loop; + for I in Integer range 128 .. Character'Pos (Character'Last) loop + if PU.Is_ASCII (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_ASCII_Check; + + + function Is_Extended_ASCII_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. 127 loop + if PU.Is_Extended_ASCII (Character'Val (I)) then + return Fail; + end if; + end loop; + for I in Integer range 128 .. Character'Pos (Character'Last) loop + if not PU.Is_Extended_ASCII (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Extended_ASCII_Check; + + + function Is_Space_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos (' ') - 1 loop + if PU.Is_Space (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Space (' ') then + return Fail; + end if; + for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Space (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Space_Check; + + + function Is_Linespace_Check + return Test_Result is + begin + for I in Integer range + Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 + loop + if PU.Is_Linespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Linespace (Latin.HT) then + return Fail; + end if; + for I in Integer range Character'Pos (Latin.HT) + 1 .. Character'Pos (' ') - 1 loop + if PU.Is_Linespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Linespace (' ') then + return Fail; + end if; + for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Linespace (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Linespace_Check; + + + function Is_End_Of_Line_Check + return Test_Result is + begin + for I in Integer range + Character'Pos (Character'First) .. Character'Pos (Latin.LF) - 1 + loop + if PU.Is_End_Of_Line (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_End_Of_Line (Latin.LF) then + return Fail; + end if; + for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop + if PU.Is_End_Of_Line (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_End_Of_Line (Latin.CR) then + return Fail; + end if; + for I in Integer range + Character'Pos (Latin.CR) + 1 .. Character'Pos (Character'Last) + loop + if PU.Is_End_Of_Line (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_End_Of_Line_Check; + + + function Is_Whitespace_Check + return Test_Result is + begin + for I in Integer range + Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 + loop + if PU.Is_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range Latin.HT .. Latin.LF loop + if not PU.Is_Whitespace (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop + if PU.Is_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Whitespace (Latin.CR) then + return Fail; + end if; + for I in Integer range Character'Pos (Latin.CR) + 1 .. Character'Pos (' ') - 1 loop + if PU.Is_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Whitespace (' ') then + return Fail; + end if; + for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Whitespace_Check; + + + function Not_Whitespace_Check + return Test_Result is + begin + for I in Integer range + Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 + loop + if not PU.Not_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range Latin.HT .. Latin.LF loop + if PU.Not_Whitespace (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop + if not PU.Not_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if PU.Not_Whitespace (Latin.CR) then + return Fail; + end if; + for I in Integer range Character'Pos (Latin.CR) + 1 .. Character'Pos (' ') - 1 loop + if not PU.Not_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if PU.Not_Whitespace (' ') then + return Fail; + end if; + for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop + if not PU.Not_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Not_Whitespace_Check; + + +end Rat_Tests.Util; + + diff --git a/test/rat_tests-util.ads b/test/rat_tests-util.ads new file mode 100644 index 0000000..1b4754a --- /dev/null +++ b/test/rat_tests-util.ads @@ -0,0 +1,48 @@ + + +with Unit_Tests; +use Unit_Tests; + + +package Rat_Tests.Util is + + + function In_Set_Check return Test_Result; + function Not_In_Set_Check return Test_Result; + + Set_Predicate_Tests : Test_Array := + ((+"In_Set", In_Set_Check'Access), + (+"Not_In_Set", Not_In_Set_Check'Access)); + + + function Is_Digit_Check return Test_Result; + function Is_Hex_Check return Test_Result; + function Is_Letter_Check return Test_Result; + function Is_Alphanumeric_Check return Test_Result; + function Is_Punctuation_Check return Test_Result; + function Is_ASCII_Check return Test_Result; + function Is_Extended_ASCII_Check return Test_Result; + function Is_Space_Check return Test_Result; + function Is_Linespace_Check return Test_Result; + function Is_End_Of_Line_Check return Test_Result; + function Is_Whitespace_Check return Test_Result; + function Not_Whitespace_Check return Test_Result; + + Predicate_Tests : Test_Array := + ((+"Is_Digit", Is_Digit_Check'Access), + (+"Is_Hex", Is_Hex_Check'Access), + (+"Is_Letter", Is_Letter_Check'Access), + (+"Is_Alphanumeric", Is_Alphanumeric_Check'Access), + (+"Is_Punctuation", Is_Punctuation_Check'Access), + (+"Is_ASCII", Is_ASCII_Check'Access), + (+"Is_Extended_ASCII", Is_Extended_ASCII_Check'Access), + (+"Is_Space", Is_Space_Check'Access), + (+"Is_Linespace", Is_Linespace_Check'Access), + (+"Is_End_Of_Line", Is_End_Of_Line_Check'Access), + (+"Is_Whitespace", Is_Whitespace_Check'Access), + (+"Not_Whitespace", Not_Whitespace_Check'Access)); + + +end Rat_Tests.Util; + + diff --git a/test/rat_tests.ads b/test/rat_tests.ads new file mode 100644 index 0000000..9593667 --- /dev/null +++ b/test/rat_tests.ads @@ -0,0 +1,22 @@ + + +with + + Ada.Strings.Unbounded, + Ada.Characters.Latin_1, + Ada.Strings.Maps, + Ada.Exceptions; + + +package Rat_Tests is + + + package SU renames Ada.Strings.Unbounded; + package Latin renames Ada.Characters.Latin_1; + package Strmaps renames Ada.Strings.Maps; + package Except renames Ada.Exceptions; + + +end Rat_Tests; + + diff --git a/test/ratnest-tests-errors.adb b/test/ratnest-tests-errors.adb deleted file mode 100644 index 136f6c9..0000000 --- a/test/ratnest-tests-errors.adb +++ /dev/null @@ -1,161 +0,0 @@ - - -separate (Ratnest.Tests) -package body Errors is - - - function Valid_Message_Check - return Test_Result is - begin - if PE.Valid_Message ("abcde") or PE.Valid_Message ("sSYM") or - PE.Valid_Message ("sSYMp") or PE.Valid_Message ("p345") or - PE.Valid_Message ("pOne") or PE.Valid_Message ("sSYMp1sNEXT") or - PE.Valid_Message ("sSYMp1.2") or PE.Valid_Message ("sABcDp12") or - not PE.Valid_Message ("sSYMp0") or not PE.Valid_Message ("sAp12") or - not PE.Valid_Message ("sNAMEp34sSYMp02") or not PE.Valid_Message ("") or - not PE.Valid_Message ("sA_Bp3") or not PE.Valid_Message ("sAp1sAp1") - then - return Fail; - end if; - return Pass; - end Valid_Message_Check; - - - - - - function Valid_Identifier_Check - return Test_Result - is - Pass_Array : PE.Error_Info_Array := - ((+"A", 1), (+"ABC", 2), (+"AB_CD", 3), (+"A_B_CD", 4)); - Fail_Array : PE.Error_Info_Array := - ((+"_", 1), (+"_A", 2), (+"A_", 3), (+"A__B", 4), (+"A%B", 3)); - begin - for EI of Pass_Array loop - if not PE.Valid_Identifier (EI.Symbol) or - not PE.Valid_Identifier (-EI.Symbol) - then - return Fail; - end if; - end loop; - for EI of Fail_Array loop - if PE.Valid_Identifier (EI.Symbol) or - PE.Valid_Identifier (-EI.Symbol) - then - return Fail; - end if; - end loop; - if not PE.Valid_Identifier_Array (Pass_Array) or - PE.Valid_Identifier_Array (Fail_Array) - then - return Fail; - end if; - return Pass; - end Valid_Identifier_Check; - - - - - - function Join_Check - return Test_Result - is - Array_1 : PE.Error_Info_Array := ((+"A", 1), (+"B", 2)); - Msg_1 : PE.Error_Message := PE.Encode_Array (Array_1); - - Array_2 : PE.Error_Info_Array := ((+"C", 3), (+"D", 4)); - Msg_2 : PE.Error_Message := PE.Encode_Array (Array_2); - - Msg_3 : PE.Error_Message := PE.Join (Msg_1, Msg_2); - - Array_4 : PE.Error_Info_Array := ((+"A", 1), (+"B", 2), (+"C", 3), (+"D", 4)); - Msg_4 : PE.Error_Message := PE.Encode_Array (Array_4); - - Array_5 : PE.Error_Info_Array := ((+"A", 1), (+"B", 4)); - Msg_5 : PE.Error_Message := PE.Encode_Array (Array_5); - - Array_6 : PE.Error_Info_Array := ((+"A", 1), (+"C", 3)); - Msg_6 : PE.Error_Message := PE.Encode_Array (Array_6); - - Msg_7 : PE.Error_Message := PE.Join (Msg_5, Msg_6); - - Array_8 : PE.Error_Info_Array := ((+"A", 1), (+"B", 4), (+"C", 3)); - Msg_8 : PE.Error_Message := PE.Encode_Array (Array_8); - begin - if Msg_3 /= Msg_4 or Msg_7 /= Msg_8 then - return Fail; - end if; - return Pass; - end Join_Check; - - - - - - function Encode_1_Check - return Test_Result is - begin - -- Encode with a String and a Natural - if PE.Encode ("ABC", 15) /= "sABCp15" then - return Fail; - end if; - return Pass; - end Encode_1_Check; - - - function Encode_2_Check - return Test_Result is - begin - -- Encode with an Unbounded_String and a Natural - if PE.Encode (+"ABC", 15) /= "sABCp15" then - return Fail; - end if; - return Pass; - end Encode_2_Check; - - - function Encode_3_Check - return Test_Result is - begin - -- Encode with an Error_Info - if PE.Encode ((+"ABC", 15)) /= "sABCp15" then - return Fail; - end if; - return Pass; - end Encode_3_Check; - - - function Encode_4_Check - return Test_Result is - begin - -- Encode with an Error_Info_Array - if PE.Encode_Array (((+"A", 3), (+"BC", 2), (+"ABC", 1), (+"B", 4))) /= - "sAp3sBCp2sABCp1sBp4" - then - return Fail; - end if; - return Pass; - end Encode_4_Check; - - - - - - function Decode_Check - return Test_Result - is - use type PE.Error_Info_Array; - begin - if PE.Decode ("sAp1sBp3sCp10sDEFp456") /= - ((+"A", 1), (+"B", 3), (+"C", 10), (+"DEF", 456)) - then - return Fail; - end if; - return Pass; - end Decode_Check; - - -end Errors; - - diff --git a/test/ratnest-tests-graphs.adb b/test/ratnest-tests-graphs.adb deleted file mode 100644 index 24b03c9..0000000 --- a/test/ratnest-tests-graphs.adb +++ /dev/null @@ -1,140 +0,0 @@ - - -separate (Ratnest.Tests) -package body Graphs is - - - type My_Labels is (One, Two, Three, Four, Five, Six); - - package My_Graphs is new Packrat.Graphs (My_Labels, Character, String); - - - use type My_Graphs.Node; - use type My_Graphs.Cursor; - use type My_Graphs.Graph; - - - function Node_Check - return Test_Result - is - Leafeon : My_Graphs.Node := My_Graphs.Leaf ("abc", 1, 3); - Brancheon : My_Graphs.Node := My_Graphs.Branch (One, 4, 3); - begin - if My_Graphs.Elements (Leafeon) /= "abc" or My_Graphs.Label (Brancheon) /= One or - My_Graphs.Start (Leafeon) /= 1 or My_Graphs.Start (Brancheon) /= 4 or - My_Graphs.Finish (Leafeon) /= 3 or My_Graphs.Finish (Brancheon) /= 3 - then - return Fail; - end if; - return Pass; - end Node_Check; - - - function Empty_Check - return Test_Result is - begin - if not My_Graphs.Empty_Graph.Is_Empty or - not My_Graphs.Is_Nothing (My_Graphs.No_Position) - then - return Fail; - end if; - return Pass; - end Empty_Check; - - - function Attachment_Check - return Test_Result - is - Leaf1 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); - Leaf2 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("def", 4, 6)); - Leaf3 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 4, 6)); - Leaf4 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("def", 1, 3)); - - Brancheon : My_Graphs.Graph := - My_Graphs.Singleton (My_Graphs.Branch (Three, 1, 15)); - - Merge1 : My_Graphs.Graph := Leaf1; - Merge2 : My_Graphs.Graph := Leaf3; - Merge3 : My_Graphs.Graph := Brancheon; - - Cursor1 : My_Graphs.Cursor := Merge3.Root (1); - begin - Merge1.Append (Leaf2); - Merge2.Prepend (Leaf4); - Merge3.Attach_Choice (Cursor1, Merge1); - - if Merge1.Root_Count /= 2 or else - Merge2.Root_Count /= 2 or else - Merge3.Root_Count /= 1 or else - not My_Graphs.Is_Leaf (Merge1.Root (1)) or else - not My_Graphs.Is_Leaf (Merge1.Root (2)) or else - My_Graphs.Elements (Merge1.Root (1)) /= "abc" or else - My_Graphs.Elements (Merge1.Root (2)) /= "def" or else - not My_Graphs.Is_Leaf (Merge2.Root (1)) or else - not My_Graphs.Is_Leaf (Merge2.Root (2)) or else - My_Graphs.Elements (Merge2.Root (1)) /= "def" or else - My_Graphs.Elements (Merge2.Root (2)) /= "abc" or else - not My_Graphs.Is_Branch (Merge3.Root (1)) or else - My_Graphs.Label (Cursor1) /= Three or else - My_Graphs.Child_Count (Cursor1) /= 2 or else - My_Graphs.Elements (My_Graphs.First_Child (Cursor1)) /= "abc" or else - My_Graphs.Elements (My_Graphs.Last_Child (Cursor1)) /= "def" - then - return Fail; - end if; - return Pass; - end Attachment_Check; - - - function Find_Check - return Test_Result - is - Leafeon : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); - Brancheon : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Branch (One, 1, 5)); - Combined : My_Graphs.Graph := Brancheon; - begin - Combined.Attach_Choice (Combined.Root (1), Leafeon); - declare - Expected_Result : My_Graphs.Cursor := My_Graphs.First_Child (Combined.Root (1)); - begin - if Combined.Find ("abc") /= Expected_Result or - Combined.Find ("def") /= My_Graphs.No_Position or - Brancheon.Find ("any") /= My_Graphs.No_Position - then - return Fail; - end if; - end; - return Pass; - end Find_Check; - - - function Find_Subgraph_Check - return Test_Result - is - Leafeon : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Leaf ("abc", 1, 3)); - Branch1 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Branch (One, 1, 4)); - Branch2 : My_Graphs.Graph := My_Graphs.Singleton (My_Graphs.Branch (Two, 1, 5)); - Combined : My_Graphs.Graph := Branch2; - - My_Cursor : My_Graphs.Cursor := Combined.Root (1); - begin - Combined.Attach_Choice (My_Cursor, Branch1); - My_Cursor := My_Graphs.First_Child (My_Cursor); - Combined.Attach_Choice (My_Cursor, Leafeon); - - declare - Expected_Result : My_Graphs.Cursor := My_Graphs.First_Child (My_Cursor); - begin - if My_Graphs.Find_In_Subgraph (My_Cursor, "abc") /= Expected_Result or - My_Graphs.Find_In_Subgraph (My_Cursor, "def") /= My_Graphs.No_Position - then - return Fail; - end if; - end; - return Pass; - end Find_Subgraph_Check; - - -end Graphs; - - diff --git a/test/ratnest-tests-lexer.adb b/test/ratnest-tests-lexer.adb deleted file mode 100644 index dbdf5d6..0000000 --- a/test/ratnest-tests-lexer.adb +++ /dev/null @@ -1,1016 +0,0 @@ - - -with Ada.Text_IO; -use Ada.Text_IO; - - -separate (Ratnest.Tests) -package body Lexer is - - - type My_Labels is (One, Two, Three); - - - package String_Tokens is new Packrat.Tokens (My_Labels, Character, String); - package Slexy is new Packrat.Lexer (My_Labels, Character, String, String_Tokens); - package Slebug is new Slexy.Debug; - - - use type Slexy.Combinator_Result; - - - - - - function Join_Check - return Test_Result - is - One : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success); - Two : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Three : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - - Four : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure); - Five : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure); - - Six : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Needs_More); - Seven : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Needs_More); - - Eight : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Failure); - - Nine : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Optional_More); - Ten : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Eleven : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - begin - if Slebug.Join (One, Two) /= Three or Slebug.Join (One, Four) /= Five or - Slebug.Join (One, Six) /= Seven or Slebug.Join (Four, Six) /= Four or - Slebug.Join (Five, Two) /= Five or Slebug.Join (Six, Three) /= Eight or - Slebug.Join (Slebug.Empty_Fail, One) /= Slebug.Empty_Fail or - Slebug.Join (Nine, Ten) /= Eleven - then - return Fail; - end if; - return Pass; - end Join_Check; - - - function Equals_Check - return Test_Result - is - One : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Two : Slexy.Combinator_Result := - Slebug.Create_Result (0, Packrat.Failure); - begin - if One = Two or Two /= Slebug.Empty_Fail then - return Fail; - end if; - return Pass; - end Equals_Check; - - - - - - function Sequence_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Match_B is new Slexy.Match ('b'); - function Match_C is new Slexy.Match ('c'); - function Seq_Abc is new Slexy.Sequence - ((Match_A'Unrestricted_Access, - Match_B'Unrestricted_Access, - Match_C'Unrestricted_Access)); - - Test_Str : String := "aababcabcab"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Failure); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (11, Packrat.Needs_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (6, Packrat.Success); - Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; - Result5 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Failure); - begin - if Seq_Abc (Test_Str, 1) /= Result1 or Seq_Abc (Test_Str, 2) /= Result5 or - Seq_Abc (Test_Str, 4) /= Result3 or Seq_Abc (Test_Str, 10) /= Result2 or - Seq_Abc (Test_Str, 3) /= Result4 or - Seq_Abc (Test_Str, Test_Str'Last + 5) /= Result4 - then - return Fail; - end if; - return Pass; - end Sequence_Check; - - - function Count_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Match_B is new Slexy.Match ('b'); - function Count_2A is new Slexy.Count (Match_A, 2); - function Count_3B is new Slexy.Count (Match_B, 3); - - Test_Str : String := "abaabbaaabbbaaaabbbb"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Failure); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Success); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Failure); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (20, Packrat.Needs_More); - Result5 : Slexy.Combinator_Result := - Slebug.Create_Result (12, Packrat.Success); - Result6 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Count_2A (Test_Str, 1) /= Result1 or Count_2A (Test_Str, 3) /= Result2 or - Count_3B (Test_Str, 2) /= Result3 or Count_3B (Test_Str, 19) /= Result4 or - Count_3B (Test_Str, 10) /= Result5 or Count_3B (Test_Str, 1) /= Result6 or - Count_2A (Test_Str, 2) /= Result6 or - Count_2A (Test_Str, Test_Str'Last + 5) /= Result6 - then - return Fail; - end if; - return Pass; - end Count_Check; - - - function Many_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Many_0 is new Slexy.Many (Match_A); - function Many_4 is new Slexy.Many (Match_A, 4); - - function Match_B is new Slexy.Match ('b'); - function Match_C is new Slexy.Match ('c'); - function Seq_Abc is new Slexy.Sequence - ((Match_A'Unrestricted_Access, - Match_B'Unrestricted_Access, - Match_C'Unrestricted_Access)); - function Many_Seq_0 is new Slexy.Many (Seq_Abc); - function Many_Seq_4 is new Slexy.Many (Seq_Abc, 4); - - Test_Str : String := "aaabbaaaaabaa"; - Test_Str2 : String := "aababcabcab"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (13, Packrat.Optional_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (10, Packrat.Success); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Failure); - Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; - Result6 : Slexy.Combinator_Result := - Slebug.Create_Result (13, Packrat.Needs_More); - Result7 : Slexy.Combinator_Result := - Slebug.Create_Result (0, Packrat.Success); - Result8 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Optional_More); - Result9 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Needs_More); - begin - if Many_0 (Test_Str, 1) /= Result1 or Many_4 (Test_Str, 1) /= Result4 or - Many_4 (Test_Str, 6) /= Result3 or Many_0 (Test_Str, 4) /= Result7 or - Many_0 (Test_Str, 12) /= Result2 or Many_4 (Test_Str, 12) /= Result6 or - Many_0 (Test_Str, Test_Str'Last + 5) /= Result5 or - Many_Seq_0 (Test_Str2, 4) /= Result8 or Many_Seq_4 (Test_Str2, 4) /= Result9 - then - return Fail; - end if; - return Pass; - end Many_Check; - - - function Many_Until_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Many_Until_0 is new Slexy.Many_Until (Match_A, PU.Is_Digit); - function Many_Until_3 is new Slexy.Many_Until (Match_A, PU.Is_Digit, 3); - - Test_Str : String := "aaaabbaaa123aaa"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Success); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (15, Packrat.Needs_More); - Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Many_Until_0 (Test_Str, 1) /= Result1 or - Many_Until_0 (Test_Str, 7) /= Result2 or - Many_Until_3 (Test_Str, 7) /= Result2 or - Many_Until_3 (Test_Str, 13) /= Result3 or - Many_Until_0 (Test_Str, 5) /= Result4 or - Many_Until_0 (Test_Str, Test_Str'Last + 5) /= Result4 or - Many_Until_3 (Test_Str, Test_Str'Last + 5) /= Result4 - then - return Fail; - end if; - return Pass; - end Many_Until_Check; - - - function Satisfy_Check - return Test_Result - is - function Is_123 - (Char : in Character) - return Boolean is - begin - return Char = '1' or Char = '2' or Char = '3'; - end Is_123; - function Is_Abc - (Char : in Character) - return Boolean is - begin - return Char = 'a' or Char = 'b' or Char = 'c'; - end Is_Abc; - - function Satisfy_123 is new Slexy.Satisfy (Is_123); - function Satisfy_Abc is new Slexy.Satisfy (Is_Abc); - - Test_Str : String := "abc123456def"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (6, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Satisfy_123 (Test_Str, 6) /= Result2 or - Satisfy_Abc (Test_Str, 2) /= Result1 or - Satisfy_Abc (Test_Str, 8) /= Result3 or - Satisfy_123 (Test_Str, Test_Str'Last + 5) /= Result3 - then - return Fail; - end if; - return Pass; - end Satisfy_Check; - - - function Satisfy_With_Check - return Test_Result - is - function Is_Abc - (Char : in Character) - return Boolean is - begin - return Char = 'a' or Char = 'b' or Char = 'c'; - end Is_Abc; - function Is_123 - (Char : in Character) - return Boolean is - begin - return Char = '1' or Char = '2' or Char = '3'; - end Is_123; - function Minus_One - (Char : in Character) - return Character is - begin - return Character'Val (Character'Pos (Char) - 1); - end Minus_One; - - function Satisfy_Bcd is new Slexy.Satisfy_With (Is_Abc, Minus_One); - function Satisfy_234 is new Slexy.Satisfy_With (Is_123, Minus_One); - - Test_Str : String := "abcde12345"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (7, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Satisfy_Bcd (Test_Str, 3) /= Result1 or - Satisfy_234 (Test_Str, 7) /= Result2 or - Satisfy_Bcd (Test_Str, 1) /= Result3 or - Satisfy_234 (Test_Str, Test_Str'Last + 5) /= Result3 - then - return Fail; - end if; - return Pass; - end Satisfy_With_Check; - - - function Match_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Match_Slash is new Slexy.Match ('/'); - function Match_4 is new Slexy.Match ('4'); - - Test_Str : String := "abc1234./5"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Success); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (7, Packrat.Success); - Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Match_A (Test_Str, 1) /= Result1 or - Match_Slash (Test_Str, 9) /= Result2 or - Match_4 (Test_Str, 7) /= Result3 or - Match_A (Test_Str, 3) /= Result4 or - Match_A (Test_Str, Test_Str'Last + 5) /= Result4 - then - return Fail; - end if; - return Pass; - end Match_Check; - - - function Match_With_Check - return Test_Result - is - function Plus_One - (Char : in Character) - return Character is - begin - return Character'Val (Character'Pos (Char) + 1); - end Plus_One; - - function Match_A is new Slexy.Match_With ('b', Plus_One); - function Match_6 is new Slexy.Match_With ('7', Plus_One); - - Test_Str : String := "abc5678"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Match_A (Test_Str, 1) /= Result1 or - Match_6 (Test_Str, 5) /= Result2 or - Match_A (Test_Str, 2) /= Result3 or - Match_A (Test_Str, Test_Str'Last + 5) /= Result3 - then - return Fail; - end if; - return Pass; - end Match_With_Check; - - - function Multimatch_Check - return Test_Result - is - function Match_String1 is new Slexy.Multimatch ("abc"); - function Match_String2 is new Slexy.Multimatch ("hello"); - - Test_Str : String := "abcdefabhelloworldab"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (20, Packrat.Needs_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (13, Packrat.Success); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (8, Packrat.Failure); - Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Match_String1 (Test_Str, 1) /= Result1 or - Match_String1 (Test_Str, 7) /= Result4 or - Match_String2 (Test_Str, 9) /= Result3 or - Match_String2 (Test_Str, 3) /= Result5 or - Match_String1 (Test_Str, 19) /= Result2 or - Match_String1 (Test_Str, Test_Str'Last + 5) /= Result5 - then - return Fail; - end if; - return Pass; - end Multimatch_Check; - - - function Take_Check - return Test_Result - is - function Take_1 is new Slexy.Take; - function Take_5 is new Slexy.Take (5); - - Test_Str : String := "abcdefghi"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Needs_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (7, Packrat.Success); - Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Take_1 (Test_Str, 2) /= Result1 or Take_5 (Test_Str, 7) /= Result2 or - Take_5 (Test_Str, 3) /= Result3 or - Take_1 (Test_Str, Test_Str'Last + 5) /= Result4 - then - return Fail; - end if; - return Pass; - end Take_Check; - - - function Take_While_Check - return Test_Result - is - function Take_Letters is new Slexy.Take_While (PU.Is_Letter); - function Take_Punch is new Slexy.Take_While (PU.Is_Punctuation); - function Take_Digits is new Slexy.Take_While (PU.Is_Digit); - - Test_Str : String := "abcde,./;'fghi[]=-^563"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (14, Packrat.Success); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (10, Packrat.Success); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (19, Packrat.Success); - Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; - Result6 : Slexy.Combinator_Result := - Slebug.Create_Result (22, Packrat.Optional_More); - begin - if Take_Letters (Test_Str, 2) /= Result1 or - Take_Letters (Test_Str, 13) /= Result2 or - Take_Punch (Test_Str, 6) /= Result3 or - Take_Punch (Test_Str, 17) /= Result4 or - Take_Letters (Test_Str, 7) /= Result5 or - Take_Punch (Test_Str, Test_Str'Last + 5) /= Result5 or - Take_Digits (Test_Str, 20) /= Result6 - then - return Fail; - end if; - return Pass; - end Take_While_Check; - - - function Take_Until_Check - return Test_Result - is - function Take_Till_Punch is new Slexy.Take_Until (PU.Is_Punctuation); - function Take_Till_Digit is new Slexy.Take_Until (PU.Is_Digit); - - Test_Str : String := "abcde12345;;;fghi67"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (10, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (19, Packrat.Optional_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (17, Packrat.Success); - Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Take_Till_Punch (Test_Str, 4) /= Result1 or - Take_Till_Punch (Test_Str, 16) /= Result2 or - Take_Till_Digit (Test_Str, 1) /= Result3 or - Take_Till_Digit (Test_Str, 12) /= Result4 or - Take_Till_Punch (Test_Str, 11) /= Result5 or - Take_Till_Punch (Test_Str, Test_Str'Last + 5) /= Result5 - then - return Fail; - end if; - return Pass; - end Take_Until_Check; - - - function Line_End_Check - return Test_Result - is - function LF_End is new Slexy.Line_End (Latin.LF); - function C_End is new Slexy.Line_End ('c'); - - Test_Str : String := "abcd" & Latin.LF & "e"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if LF_End (Test_Str, 5) /= Result1 or C_End (Test_Str, 3) /= Result2 or - LF_End (Test_Str, Test_Str'Last + 5) /= Result3 or LF_End (Test_Str, 1) /= Result3 - then - return Fail; - end if; - return Pass; - end Line_End_Check; - - - function Input_End_Check - return Test_Result - is - function C_End is new Slexy.Input_End ('c'); - function E_End is new Slexy.Input_End ('e'); - - Test_Str : String := "abcde"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if C_End (Test_Str, 3) /= Result2 or E_End (Test_Str, 5) /= Result1 or - C_End (Test_Str, 6) /= Result3 or E_End (Test_Str, 6) /= Result3 or - C_End (Test_Str, 1) /= Result3 or E_End (Test_Str, Test_Str'Last + 5) /= Result3 - then - return Fail; - end if; - return Pass; - end Input_End_Check; - - - - - - function Stamp_Check - return Test_Result - is - use type String_Tokens.Token; - use type Packrat.Result_Status; - use type Slexy.Component_Result; - - function Match_A is new Slexy.Match ('a'); - function Match_B is new Slexy.Match ('b'); - function Match_C is new Slexy.Match ('c'); - function Seq_Abc is new Slexy.Sequence - ((Match_A'Unrestricted_Access, - Match_B'Unrestricted_Access, - Match_C'Unrestricted_Access)); - function My_Stamp is new Slexy.Stamp (One, Seq_Abc); - - Test_Str1 : String := "abcdefghi"; - Test_Str2 : String := "ab"; - - Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; - Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; - - Comp_Code : Slexy.Component_Result; - begin - Comp_Code := My_Stamp (Test_Str1, Context1); - if (Slebug.So_Far (Context1).Length /= 1 or else - Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, "abc")) or - Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or - Slebug.Has_Pass (Context1) - then - return Fail; - end if; - Comp_Code := My_Stamp (Test_Str1, Context1); - if (Slebug.So_Far (Context1).Length /= 1 or else - Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, "abc")) or - Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or - Slebug.Has_Pass (Context1) - then - return Fail; - end if; - Comp_Code := My_Stamp (Test_Str2, Context2); - if Slebug.So_Far (Context2).Length /= 0 or - Slebug.Position (Context2) /= 1 or - Slebug.Status (Context2) /= Packrat.Needs_More or - (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") - then - return Fail; - end if; - return Pass; - end Stamp_Check; - - - function Ignore_Check - return Test_Result - is - use type Packrat.Result_Status; - - function Match_Abc is new Slexy.Multimatch ("abc"); - function My_Ignore is new Slexy.Ignore (Two, Match_Abc); - - Test_Str1 : String := "abcdefghi"; - Test_Str2 : String := "ab"; - - Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; - Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; - - Comp_Code : Slexy.Component_Result; - begin - Comp_Code := My_Ignore (Test_Str1, Context1); - if Slebug.So_Far (Context1).Length /= 0 or - Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or - Slebug.Has_Pass (Context1) - then - return Fail; - end if; - Comp_Code := My_Ignore (Test_Str1, Context1); - if Slebug.So_Far (Context1).Length /= 0 or - Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or - Slebug.Has_Pass (Context1) - then - return Fail; - end if; - Comp_Code := My_Ignore (Test_Str2, Context2); - if Slebug.So_Far (Context2).Length /= 0 or - Slebug.Position (Context2) /= 1 or Slebug.Status (Context2) /= Packrat.Needs_More or - (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") - then - return Fail; - end if; - return Pass; - end Ignore_Check; - - - - - - type Word_Enum is (Blank, Word, Whitespace); - - package Word_Tokens is new Packrat.Tokens (Word_Enum, Character, String); - package Swordy is new Packrat.Lexer (Word_Enum, Character, String, Word_Tokens); - package Swolbug is new Swordy.Debug; - - use type Word_Tokens.Token; - use type Word_Tokens.Token_Array; - - function Satisfy_Letter is new Swordy.Satisfy (PU.Is_Letter); - function Many_Letter is new Swordy.Many (Satisfy_Letter, 1); - function Satisfy_Whitespace is new Swordy.Satisfy (PU.Is_Whitespace); - function Many_Whitespace is new Swordy.Many (Satisfy_Whitespace, 1); - - function Stamp_Word is new Swordy.Stamp (Word, Many_Letter); - function Ignore_Whitespace is new Swordy.Ignore (Whitespace, Many_Whitespace); - - - function Scan_Check - return Test_Result - is - function My_Scan is new Swordy.Scan - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Str : String := "one fine day"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result1 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, "one"), - 2 => Word_Tokens.Create (Word, 5, "fine")); - Intended_Result2 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 10, "day")); - - Actual_Result1 : Word_Tokens.Token_Array := - My_Scan (Test_Str, Test_Context); - Actual_Result2 : Word_Tokens.Token_Array := - My_Scan ("", Test_Context); - begin - if Actual_Result1 /= Intended_Result1 or Actual_Result2 /= Intended_Result2 then - return Fail; - end if; - return Pass; - end Scan_Check; - - - function Scan_Only_Check - return Test_Result - is - function My_Scan is new Swordy.Scan_Only - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Str : String := "one fine day"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, "one"), - 2 => Word_Tokens.Create (Word, 5, "fine"), - 3 => Word_Tokens.Create (Word, 10, "day")); - - Actual_Result : Word_Tokens.Token_Array := - My_Scan (Test_Str, Test_Context); - begin - if Actual_Result /= Intended_Result then - return Fail; - end if; - return Pass; - end Scan_Only_Check; - - - function Scan_With_Check - return Test_Result - is - Sentinel : Natural := 2; - function More_Input - return String is - begin - if Sentinel > 1 then - Sentinel := 1; - return "it will happen again"; - elsif Sentinel > 0 then - Sentinel := 0; - return " and again and again"; - else - return ""; - end if; - end More_Input; - - function My_Scan is new Swordy.Scan_With - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, "it"), - 2 => Word_Tokens.Create (Word, 4, "will"), - 3 => Word_Tokens.Create (Word, 9, "happen"), - 4 => Word_Tokens.Create (Word, 17, "again"), - 5 => Word_Tokens.Create (Word, 23, "and"), - 6 => Word_Tokens.Create (Word, 27, "again"), - 7 => Word_Tokens.Create (Word, 33, "and"), - 8 => Word_Tokens.Create (Word, 37, "again")); - - Actual_Result : Word_Tokens.Token_Array := - My_Scan (More_Input'Unrestricted_Access, Test_Context); - begin - if Actual_Result /= Intended_Result then - return Fail; - end if; - return Pass; - end Scan_With_Check; - - - function Scan_Set_Check - return Test_Result - is - procedure My_Scan is new Swordy.Scan_Set - ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Word_Tokens.Create (Blank, 1, "")); - - Test_Str1 : String (1 .. 10) := "one tw"; - Test_Str2 : String (1 .. 10) := "o three"; - Test_Str3 : String (1 .. 10) := Latin.EOT & " "; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result1 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, "one"), - 2 => Word_Tokens.Create (Blank, 1, ""), - 3 => Word_Tokens.Create (Blank, 1, "")); - Intended_Result2 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 9, "two"), - 2 => Word_Tokens.Create (Blank, 1, ""), - 3 => Word_Tokens.Create (Blank, 1, "")); - Intended_Result3 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 16, "three"), - 2 => Word_Tokens.Create (Blank, 1, ""), - 3 => Word_Tokens.Create (Blank, 1, "")); - - Actual_Result : Word_Tokens.Token_Array (1 .. 3); - begin - My_Scan (Test_Str1, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result1 then - return Fail; - end if; - My_Scan (Test_Str2, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result2 then - return Fail; - end if; - My_Scan (Test_Str3, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result3 then - return Fail; - end if; - return Pass; - end Scan_Set_Check; - - - function Scan_Set_With_Check - return Test_Result - is - Sentinel : Natural := 2; - function More_Input - return String is - begin - if Sentinel > 1 then - Sentinel := 1; - return "it will happen again"; - elsif Sentinel > 0 then - Sentinel := 0; - return " and again and again"; - else - return ""; - end if; - end More_Input; - - procedure My_Scan is new Swordy.Scan_Set_With - ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Word_Tokens.Create (Blank, 1, "")); - - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result1 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, "it"), - 2 => Word_Tokens.Create (Word, 4, "will"), - 3 => Word_Tokens.Create (Word, 9, "happen"), - 4 => Word_Tokens.Create (Word, 16, "again"), - 5 => Word_Tokens.Create (Word, 22, "and")); - Intended_Result2 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 26, "again"), - 2 => Word_Tokens.Create (Word, 32, "and"), - 3 => Word_Tokens.Create (Word, 36, "again"), - 4 => Word_Tokens.Create (Blank, 1, ""), - 5 => Word_Tokens.Create (Blank, 1, "")); - - Actual_Result : Word_Tokens.Token_Array (1 .. 5); - begin - My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result1 then - return Fail; - end if; - My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result2 then - return Fail; - end if; - return Pass; - end Scan_Set_With_Check; - - - function Scan_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - function My_Scan is new Swordy.Scan - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - declare - Result : Word_Tokens.Token_Array := My_Scan (Test_Str, Test_Context); - begin - return Fail; - end; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_Error_Check; - - - function Scan_Only_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - function My_Scan is new Swordy.Scan_Only - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - declare - Result : Word_Tokens.Token_Array := My_Scan (Test_Str, Test_Context); - begin - return Fail; - end; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_Only_Error_Check; - - - function Scan_With_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - Sentinel : Integer := 1; - function Get_Input - return String is - begin - if Sentinel > 0 then - Sentinel := 0; - return "()()"; - else - return ""; - end if; - end Get_Input; - - function My_Scan is new Swordy.Scan_With - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - declare - Result : Word_Tokens.Token_Array := - My_Scan (Get_Input'Unrestricted_Access, Test_Context); - begin - return Fail; - end; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_With_Error_Check; - - - function Scan_Set_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - procedure My_Scan is new Swordy.Scan_Set - ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Word_Tokens.Create (Blank, 1, "")); - - Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Result : Word_Tokens.Token_Array (1 .. 5); - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - My_Scan (Test_Str, Test_Context, Result); - return Fail; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_Set_Error_Check; - - - function Scan_Set_With_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - Sentinel : Integer := 1; - function Get_Input - return String is - begin - if Sentinel > 0 then - Sentinel := 0; - return "()()"; - else - return ""; - end if; - end Get_Input; - - procedure My_Scan is new Swordy.Scan_Set_With - ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Word_Tokens.Create (Blank, 1, "")); - - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Result : Word_Tokens.Token_Array (1 .. 5); - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - My_Scan (Get_Input'Unrestricted_Access, Test_Context, Result); - return Fail; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_Set_With_Error_Check; - - -end Lexer; - - diff --git a/test/ratnest-tests-tokens.adb b/test/ratnest-tests-tokens.adb deleted file mode 100644 index 41969fd..0000000 --- a/test/ratnest-tests-tokens.adb +++ /dev/null @@ -1,68 +0,0 @@ - - -separate (Ratnest.Tests) -package body Tokens is - - - type My_Labels is (One, Two, Three); - package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); - - - - - - function Adjust_Check - return Test_Result - is - A : My_Tokens.Token; - begin - declare - B : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); - begin - A := B; - end; - if My_Tokens.Value (A) /= "abc" then - return Fail; - end if; - return Pass; - end Adjust_Check; - - - - - - function Equals_Check - return Test_Result - is - use type My_Tokens.Token; - A : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); - B : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); - begin - if A /= B then - return Fail; - end if; - return Pass; - end Equals_Check; - - - - - - function Store_Check - return Test_Result - is - T : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); - begin - if My_Tokens.Label (T) /= One or else - My_Tokens.Start (T) /= 1 or else - My_Tokens.Value (T) /= "abc" - then - return Fail; - end if; - return Pass; - end Store_Check; - - -end Tokens; - - diff --git a/test/ratnest-tests-util.adb b/test/ratnest-tests-util.adb deleted file mode 100644 index ca5f235..0000000 --- a/test/ratnest-tests-util.adb +++ /dev/null @@ -1,508 +0,0 @@ - - -separate (Ratnest.Tests) -package body Util is - - - function In_Set_Check - return Test_Result - is - use type Strmaps.Character_Set; - Set_1 : Strmaps.Character_Set := Strmaps.To_Set ("abcxyz"); - Set_2 : Strmaps.Character_Set := Strmaps.To_Set ("!""#$"); - function Func_1 is new PU.In_Set (Set_1); - function Func_2 is new PU.In_Set (Set_2); - begin - -- Func_1 testing - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('a') - 1 loop - if Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'c' loop - if not Func_1 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('c') + 1 .. Character'Pos ('x') - 1 loop - if Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'x' .. 'z' loop - if not Func_1 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop - if Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - -- Func_2 testing - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop - if Func_2 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '!' .. '$' loop - if not Func_2 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('$') + 1 .. Character'Pos (Character'Last) loop - if Func_2 (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end In_Set_Check; - - - function Not_In_Set_Check - return Test_Result - is - use type Strmaps.Character_Set; - Set_1 : Strmaps.Character_Set := Strmaps.To_Set ("abcxyz"); - Set_2 : Strmaps.Character_Set := Strmaps.To_Set ("!""#$"); - function Func_1 is new PU.Not_In_Set (Set_1); - function Func_2 is new PU.Not_In_Set (Set_2); - begin - -- Func_1 testing - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('a') - 1 loop - if not Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'c' loop - if Func_1 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('c') + 1 .. Character'Pos ('x') - 1 loop - if not Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'x' .. 'z' loop - if Func_1 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop - if not Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - -- Func_2 testing - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop - if not Func_2 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '!' .. '$' loop - if Func_2 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('$') + 1 .. Character'Pos (Character'Last) loop - if not Func_2 (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Not_In_Set_Check; - - - - - - function Is_Digit_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop - if PU.Is_Digit (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '0' .. '9' loop - if not PU.Is_Digit (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('9') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Digit (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Digit_Check; - - - function Is_Hex_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop - if PU.Is_Hex (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '0' .. '9' loop - if not PU.Is_Hex (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('9') + 1 .. Character'Pos ('A') - 1 loop - if PU.Is_Hex (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'A' .. 'F' loop - if not PU.Is_Hex (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('F') + 1 .. Character'Pos ('a') - 1 loop - if PU.Is_Hex (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'f' loop - if not PU.Is_Hex (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('f') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Hex (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Hex_Check; - - - function Is_Letter_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('A') - 1 loop - if PU.Is_Letter (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'A' .. 'Z' loop - if not PU.Is_Letter (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('Z') + 1 .. Character'Pos ('a') - 1 loop - if PU.Is_Letter (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'z' loop - if not PU.Is_Letter (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'First) loop - if PU.Is_Letter (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Letter_Check; - - - function Is_Alphanumeric_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop - if PU.Is_Alphanumeric (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '0' .. '9' loop - if not PU.Is_Alphanumeric (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('9') + 1 .. Character'Pos ('A') - 1 loop - if PU.Is_Alphanumeric (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'A' .. 'Z' loop - if not PU.Is_Alphanumeric (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('Z') + 1 .. Character'Pos ('a') - 1 loop - if PU.Is_Alphanumeric (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'z' loop - if not PU.Is_Alphanumeric (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Alphanumeric (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Alphanumeric_Check; - - - function Is_Punctuation_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '!' .. '/' loop - if not PU.Is_Punctuation (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('/') + 1 .. Character'Pos (':') - 1 loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range ':' .. '@' loop - if not PU.Is_Punctuation (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('@') + 1 .. Character'Pos ('[') - 1 loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '[' .. '`' loop - if not PU.Is_Punctuation (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('`') + 1 .. Character'Pos ('{') - 1 loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '{' .. '~' loop - if not PU.Is_Punctuation (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('~') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Punctuation_Check; - - - function Is_ASCII_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. 127 loop - if not PU.Is_ASCII (Character'Val (I)) then - return Fail; - end if; - end loop; - for I in Integer range 128 .. Character'Pos (Character'Last) loop - if PU.Is_ASCII (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_ASCII_Check; - - - function Is_Extended_ASCII_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. 127 loop - if PU.Is_Extended_ASCII (Character'Val (I)) then - return Fail; - end if; - end loop; - for I in Integer range 128 .. Character'Pos (Character'Last) loop - if not PU.Is_Extended_ASCII (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Extended_ASCII_Check; - - - function Is_Space_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos (' ') - 1 loop - if PU.Is_Space (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Space (' ') then - return Fail; - end if; - for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Space (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Space_Check; - - - function Is_Linespace_Check - return Test_Result is - begin - for I in Integer range - Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 - loop - if PU.Is_Linespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Linespace (Latin.HT) then - return Fail; - end if; - for I in Integer range Character'Pos (Latin.HT) + 1 .. Character'Pos (' ') - 1 loop - if PU.Is_Linespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Linespace (' ') then - return Fail; - end if; - for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Linespace (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Linespace_Check; - - - function Is_End_Of_Line_Check - return Test_Result is - begin - for I in Integer range - Character'Pos (Character'First) .. Character'Pos (Latin.LF) - 1 - loop - if PU.Is_End_Of_Line (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_End_Of_Line (Latin.LF) then - return Fail; - end if; - for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop - if PU.Is_End_Of_Line (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_End_Of_Line (Latin.CR) then - return Fail; - end if; - for I in Integer range - Character'Pos (Latin.CR) + 1 .. Character'Pos (Character'Last) - loop - if PU.Is_End_Of_Line (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_End_Of_Line_Check; - - - function Is_Whitespace_Check - return Test_Result is - begin - for I in Integer range - Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 - loop - if PU.Is_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range Latin.HT .. Latin.LF loop - if not PU.Is_Whitespace (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop - if PU.Is_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Whitespace (Latin.CR) then - return Fail; - end if; - for I in Integer range Character'Pos (Latin.CR) + 1 .. Character'Pos (' ') - 1 loop - if PU.Is_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Whitespace (' ') then - return Fail; - end if; - for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Whitespace_Check; - - - function Not_Whitespace_Check - return Test_Result is - begin - for I in Integer range - Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 - loop - if not PU.Not_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range Latin.HT .. Latin.LF loop - if PU.Not_Whitespace (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop - if not PU.Not_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if PU.Not_Whitespace (Latin.CR) then - return Fail; - end if; - for I in Integer range Character'Pos (Latin.CR) + 1 .. Character'Pos (' ') - 1 loop - if not PU.Not_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if PU.Not_Whitespace (' ') then - return Fail; - end if; - for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop - if not PU.Not_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Not_Whitespace_Check; - - -end Util; - - diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb deleted file mode 100644 index dfc8dec..0000000 --- a/test/ratnest-tests.adb +++ /dev/null @@ -1,32 +0,0 @@ - - -with - - Ada.Characters.Latin_1, - Ada.Strings.Maps, - Ada.Exceptions, - Packrat.Lexer.Debug, - Packrat.Graphs, - Packrat.Util; - - -package body Ratnest.Tests is - - - package Latin renames Ada.Characters.Latin_1; - package Strmaps renames Ada.Strings.Maps; - package Except renames Ada.Exceptions; - package PE renames Packrat.Errors; - package PU renames Packrat.Util; - - - package body Errors is separate; - package body Tokens is separate; - package body Lexer is separate; - package body Graphs is separate; - package body Util is separate; - - -end Ratnest.Tests; - - diff --git a/test/ratnest-tests.ads b/test/ratnest-tests.ads deleted file mode 100644 index bd0b4fe..0000000 --- a/test/ratnest-tests.ads +++ /dev/null @@ -1,186 +0,0 @@ - - -package Ratnest.Tests is - - - package Errors is - - function Valid_Message_Check return Test_Result; - function Valid_Identifier_Check return Test_Result; - function Join_Check return Test_Result; - function Encode_1_Check return Test_Result; - function Encode_2_Check return Test_Result; - function Encode_3_Check return Test_Result; - function Encode_4_Check return Test_Result; - function Decode_Check return Test_Result; - - Tests : Test_Array := - ((+"Valid_Message", Valid_Message_Check'Access), - (+"Valid_Identifier", Valid_Identifier_Check'Access), - (+"Join", Join_Check'Access), - (+"Encode_1", Encode_1_Check'Access), - (+"Encode_2", Encode_2_Check'Access), - (+"Encode_3", Encode_3_Check'Access), - (+"Encode_4", Encode_4_Check'Access), - (+"Decode", Decode_Check'Access)); - - end Errors; - - - - - package Tokens is - - function Adjust_Check return Test_Result; - function Equals_Check return Test_Result; - function Store_Check return Test_Result; - - Tests : Test_Array := - ((+"Adjust", Adjust_Check'Access), - (+"Equals", Equals_Check'Access), - (+"Storage", Store_Check'Access)); - - end Tokens; - - - - - package Lexer is - - function Join_Check return Test_Result; - function Equals_Check return Test_Result; - - function Sequence_Check return Test_Result; - function Count_Check return Test_Result; - function Many_Check return Test_Result; - function Many_Until_Check return Test_Result; - - function Satisfy_Check return Test_Result; - function Satisfy_With_Check return Test_Result; - function Match_Check return Test_Result; - function Match_With_Check return Test_Result; - function Multimatch_Check return Test_Result; - function Take_Check return Test_Result; - function Take_While_Check return Test_Result; - function Take_Until_Check return Test_Result; - - function Line_End_Check return Test_Result; - function Input_End_Check return Test_Result; - - Combinator_Tests : Test_Array := - ((+"Join", Join_Check'Access), - (+"Equals", Equals_Check'Access), - (+"Sequence", Sequence_Check'Access), - (+"Count", Count_Check'Access), - (+"Many", Many_Check'Access), - (+"Many_Until", Many_Until_Check'Access), - (+"Satisfy", Satisfy_Check'Access), - (+"Satisfy With", Satisfy_With_Check'Access), - (+"Match", Match_Check'Access), - (+"Match With", Match_With_Check'Access), - (+"Multimatch", Multimatch_Check'Access), - (+"Take", Take_Check'Access), - (+"Take While", Take_While_Check'Access), - (+"Take Until", Take_Until_Check'Access), - (+"Line End", Line_End_Check'Access), - (+"Input_End", Input_End_Check'Access)); - - - function Stamp_Check return Test_Result; - function Ignore_Check return Test_Result; - - function Scan_Check return Test_Result; - function Scan_Only_Check return Test_Result; - function Scan_With_Check return Test_Result; - function Scan_Set_Check return Test_Result; - function Scan_Set_With_Check return Test_Result; - - function Scan_Error_Check return Test_Result; - function Scan_Only_Error_Check return Test_Result; - function Scan_With_Error_Check return Test_Result; - function Scan_Set_Error_Check return Test_Result; - function Scan_Set_With_Error_Check return Test_Result; - - Lexer_Tests : Test_Array := - ((+"Stamp", Stamp_Check'Access), - (+"Ignore", Ignore_Check'Access), - (+"Scan", Scan_Check'Access), - (+"Scan_Only", Scan_Only_Check'Access), - (+"Scan_With", Scan_With_Check'Access), - (+"Scan_Set", Scan_Set_Check'Access), - (+"Scan_Set_With", Scan_Set_With_Check'Access), - (+"Scan Exception", Scan_Error_Check'Access), - (+"Scan_Only Exception", Scan_Only_Error_Check'Access), - (+"Scan_With Exception", Scan_With_Error_Check'Access), - (+"Scan_Set Exception", Scan_Set_Error_Check'Access), - (+"Scan_Set_With Exception", Scan_Set_With_Error_Check'Access)); - - end Lexer; - - - - - package Graphs is - - function Node_Check return Test_Result; - - function Empty_Check return Test_Result; - function Attachment_Check return Test_Result; - function Find_Check return Test_Result; - function Find_Subgraph_Check return Test_Result; - - Graph_Tests : Test_Array := - ((+"Node", Node_Check'Access), - (+"Emptiness", Empty_Check'Access), - (+"Attachment", Attachment_Check'Access), - (+"Find", Find_Check'Access), - (+"Find_Subgraph", Find_Subgraph_Check'Access)); - - end Graphs; - - - - - package Util is - - function In_Set_Check return Test_Result; - function Not_In_Set_Check return Test_Result; - - Set_Predicate_Tests : Test_Array := - ((+"In_Set", In_Set_Check'Access), - (+"Not_In_Set", Not_In_Set_Check'Access)); - - - function Is_Digit_Check return Test_Result; - function Is_Hex_Check return Test_Result; - function Is_Letter_Check return Test_Result; - function Is_Alphanumeric_Check return Test_Result; - function Is_Punctuation_Check return Test_Result; - function Is_ASCII_Check return Test_Result; - function Is_Extended_ASCII_Check return Test_Result; - function Is_Space_Check return Test_Result; - function Is_Linespace_Check return Test_Result; - function Is_End_Of_Line_Check return Test_Result; - function Is_Whitespace_Check return Test_Result; - function Not_Whitespace_Check return Test_Result; - - Predicate_Tests : Test_Array := - ((+"Is_Digit", Is_Digit_Check'Access), - (+"Is_Hex", Is_Hex_Check'Access), - (+"Is_Letter", Is_Letter_Check'Access), - (+"Is_Alphanumeric", Is_Alphanumeric_Check'Access), - (+"Is_Punctuation", Is_Punctuation_Check'Access), - (+"Is_ASCII", Is_ASCII_Check'Access), - (+"Is_Extended_ASCII", Is_Extended_ASCII_Check'Access), - (+"Is_Space", Is_Space_Check'Access), - (+"Is_Linespace", Is_Linespace_Check'Access), - (+"Is_End_Of_Line", Is_End_Of_Line_Check'Access), - (+"Is_Whitespace", Is_Whitespace_Check'Access), - (+"Not_Whitespace", Not_Whitespace_Check'Access)); - - end Util; - - -end Ratnest.Tests; - - diff --git a/test/ratnest.adb b/test/ratnest.adb deleted file mode 100644 index d063b41..0000000 --- a/test/ratnest.adb +++ /dev/null @@ -1,34 +0,0 @@ - - -with - - Ada.Text_IO; - -use - - Ada.Text_IO; - - -package body Ratnest is - - - procedure Run_Tests - (To_Run : in Test_Array) - is - Total_Count : Natural := To_Run'Length; - Failed_Count : Natural := 0; - begin - for T of To_Run loop - if T.Func.all = Fail then - Put_Line ("Failed test " & (-T.Name)); - Failed_Count := Failed_Count + 1; - end if; - end loop; - Put_Line ("Test results" & Integer'Image (Total_Count - Failed_Count) & - " out of" & Integer'Image (Total_Count)); - end Run_Tests; - - -end Ratnest; - - diff --git a/test/ratnest.ads b/test/ratnest.ads deleted file mode 100644 index 24a5162..0000000 --- a/test/ratnest.ads +++ /dev/null @@ -1,47 +0,0 @@ - - -with - - Ada.Strings.Unbounded; - - -package Ratnest is - - - type Test_Result is (Fail, Pass); - - type Test_Function is access function return Test_Result; - - type Test is record - Name : Ada.Strings.Unbounded.Unbounded_String; - Func : Test_Function; - end record; - - type Test_Array is array (Positive range <>) of Test; - - - - - procedure Run_Tests - (To_Run : in Test_Array); - - - - - function "+" - (S : in String) - return Ada.Strings.Unbounded.Unbounded_String - renames Ada.Strings.Unbounded.To_Unbounded_String; - - function "-" - (US : in Ada.Strings.Unbounded.Unbounded_String) - return String - renames Ada.Strings.Unbounded.To_String; - - -private - - -end Ratnest; - - diff --git a/test/test_main.adb b/test/test_main.adb index a5d5fc5..4cba5ec 100644 --- a/test/test_main.adb +++ b/test/test_main.adb @@ -3,19 +3,41 @@ with Ada.Text_IO, + Ada.Command_Line, + Ada.Characters.Latin_1, + Unit_Tests, Packrat, - Ratnest.Tests; + Rat_Tests.Errors, + Rat_Tests.Tokens, + Rat_Tests.Lexer, + Rat_Tests.Util; use Ada.Text_IO, - Ratnest, - Ratnest.Tests; + Unit_Tests; procedure Test_Main is + package Latin renames Ada.Characters.Latin_1; + + + Help_String : String := + "Runs unit tests on the Packrat parser combinator library." & Latin.LF & + "Usage: rattest [switches]" & Latin.LF & + Latin.LF & + "Valid switches:" & Latin.LF & + "--help" & Latin.HT & Latin.HT & "Shows this information" & Latin.LF & + "--verbose" & Latin.HT & "Enables extra verbosity" & Latin.LF & + Latin.LF & + "All other command line input will be ignored."; + + + How_Verbose : Unit_Tests.Verbosity := Weak; + + type My_Labels is (A, B, C); package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); @@ -26,37 +48,48 @@ procedure Test_Main is begin + for N in 1 .. Ada.Command_Line.Argument_Count loop + if Ada.Command_Line.Argument (N) = "--help" then + Put_Line (Help_String); + return; + end if; + end loop; + + for N in 1 .. Ada.Command_Line.Argument_Count loop + if Ada.Command_Line.Argument (N) = "--verbose" then + How_Verbose := Strong; + exit; + end if; + end loop; + + Put_Line ("Running tests for Packrat.Errors..."); - Run_Tests (Errors.Tests); + Run_Tests (Rat_Tests.Errors.Tests, How_Verbose); New_Line; Put_Line ("Displaying Error_Message debug string output example:"); Put (Packrat.Errors.Debug_String (Err)); New_Line; Put_Line ("Running tests for Packrat.Tokens..."); - Run_Tests (Tokens.Tests); + Run_Tests (Rat_Tests.Tokens.Tests, How_Verbose); New_Line; Put_Line ("Displaying Token debug string output example:"); Put (My_Tokens.Debug_String (Tok)); New_Line; Put_Line ("Running tests for Packrat.Lexer combinators..."); - Run_Tests (Lexer.Combinator_Tests); + Run_Tests (Rat_Tests.Lexer.Combinator_Tests, How_Verbose); New_Line; Put_Line ("Running tests for Packrat.Lexer lexing..."); - Run_Tests (Lexer.Lexer_Tests); - New_Line; - - Put_Line ("Running tests for Packrat.Graphs..."); - Run_Tests (Graphs.Graph_Tests); + Run_Tests (Rat_Tests.Lexer.Lexer_Tests, How_Verbose); New_Line; Put_Line ("Running tests for Packrat.Util..."); Put_Line ("Testing set predicates..."); - Run_Tests (Util.Set_Predicate_Tests); + Run_Tests (Rat_Tests.Util.Set_Predicate_Tests, How_Verbose); Put_Line ("Testing ordinary predicates..."); - Run_Tests (Util.Predicate_Tests); + Run_Tests (Rat_Tests.Util.Predicate_Tests, How_Verbose); end Test_Main; -- cgit