diff options
author | Jed Barber <jjbarber@y7mail.com> | 2019-01-12 00:38:45 +1100 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2019-01-12 00:38:45 +1100 |
commit | dc3078a06b5ee52751cfb6fd6cf13b3790632ac4 (patch) | |
tree | 25187b953479f943947e919b7acc1f4a3ca41fe6 | |
parent | 554d2ab14921c48d628b0ffa86cc7492836477ac (diff) |
Packrat.Lexer.Combinators specs and tests complete
-rw-r--r-- | packrat_parser_lib_notes.txt | 9 | ||||
-rw-r--r-- | src/packrat-lexer.adb | 91 | ||||
-rw-r--r-- | src/packrat-lexer.ads | 14 | ||||
-rw-r--r-- | src/packrat-tokens.adb | 18 | ||||
-rw-r--r-- | test/ratnest-tests.adb | 711 | ||||
-rw-r--r-- | test/ratnest-tests.ads | 7 | ||||
-rw-r--r-- | test/ratnest.adb | 2 | ||||
-rw-r--r-- | test/ratnest.ads | 2 |
8 files changed, 677 insertions, 177 deletions
diff --git a/packrat_parser_lib_notes.txt b/packrat_parser_lib_notes.txt index 8c6117c..b85abfe 100644 --- a/packrat_parser_lib_notes.txt +++ b/packrat_parser_lib_notes.txt @@ -158,7 +158,16 @@ Packrat.Lexer - should be possible to place an upper limit on the number of tokens scanned, so as to accommodate a statically sized output array of tokens (and possibly a statically sized input array) +List of datatypes: +Combinator +Combinator_Result + List of funcs: +(for Combinator_Results) +Create_Result +Join +Status + (each of these is generic over an array of lexer_component functions, either Stamp or Ignore as below) Scan - function that returns an array of lexed tokens diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb index f93b65b..0b0f571 100644 --- a/src/packrat-lexer.adb +++ b/src/packrat-lexer.adb @@ -1,8 +1,17 @@ +with + + Ada.Unchecked_Deallocation; + + package body Packrat.Lexer is + procedure Free_Array is new Ada.Unchecked_Deallocation + (Object => Element_Array, Name => Element_Array_Access); + + procedure Initialize (This : in out Combinator_Result) is begin @@ -13,14 +22,24 @@ package body Packrat.Lexer is procedure Adjust (This : in out Combinator_Result) is begin - null; + if This.Value /= null then + declare + New_Array : Element_Array_Access := + new Element_Array (1 .. This.Value.all'Length); + begin + New_Array.all := This.Value.all; + This.Value := New_Array; + end; + end if; end Adjust; procedure Finalize (This : in out Combinator_Result) is begin - null; + if This.Value /= null then + Free_Array (This.Value); + end if; end Finalize; @@ -31,26 +50,78 @@ package body Packrat.Lexer is (Length : in Natural; Status : in Result_Status; Value : in Element_Array) - return Combinator_Result is + return Combinator_Result + is + This : Combinator_Result; begin - return Fail_Result; + This.Length := Length; + This.Status := Status; + This.Value := new Element_Array (1 .. Value'Length); + This.Value.all := Value; + return This; end Create_Result; function Join (Left, Right : in Combinator_Result) - return Combinator_Result is + return Combinator_Result + is + Merge : Combinator_Result; + Left_Valsize, Right_Valsize, Total_Valsize : Natural; begin - return Fail_Result; + if Left.Value /= null then + Left_Valsize := Left.Value.all'Length; + else + Left_Valsize := 0; + end if; + if Right.Value /= null then + Right_Valsize := Right.Value.all'Length; + else + Right_Valsize := 0; + end if; + Total_Valsize := Left_Valsize + Right_Valsize; + + if Left.Status = Success then + Merge.Length := Left.Length + Right.Length; + Merge.Status := Right.Status; + if Total_Valsize /= 0 or Right.Status /= Failure then + Merge.Value := new Element_Array (1 .. Total_Valsize); + if Left_Valsize /= 0 then + Merge.Value.all (1 .. Left_Valsize) := Left.Value.all; + end if; + if Right_Valsize /= 0 then + Merge.Value.all (Left_Valsize + 1 .. Total_Valsize) := Right.Value.all; + end if; + end if; + return Merge; + else + return Left; + end if; end Join; - function Is_Failure + function "=" + (Left, Right : in Combinator_Result) + return Boolean + is + Null_Check : Boolean := + Left.Value = null and Right.Value = null; + Value_Check : Boolean := + Left.Value /= null and then Right.Value /= null and then + Left.Value.all = Right.Value.all; + begin + return Left.Length = Right.Length and + Left.Status = Right.Status and + (Null_Check or Value_Check); + end "="; + + + function Status (This : in Combinator_Result) - return Boolean is + return Result_Status is begin - return True; - end Is_Failure; + return This.Status; + end Status; end Packrat.Lexer; diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads index 81c9d2a..ef08cb5 100644 --- a/src/packrat-lexer.ads +++ b/src/packrat-lexer.ads @@ -11,11 +11,11 @@ generic package Packrat.Lexer is - type Combinator_Result is private; + type Combinator_Result is new Ada.Finalization.Controlled with private; type Combinator is access function - (Input : in Element_Array; - Start : in Positive) + (Input : in Element_Array; + Start : in Positive) return Combinator_Result; type Combinator_Array is array (Positive range <>) of Combinator; @@ -34,10 +34,14 @@ package Packrat.Lexer is (Left, Right : in Combinator_Result) return Combinator_Result; - function Is_Failure - (This : in Combinator_Result) + function "=" + (Left, Right : in Combinator_Result) return Boolean; + function Status + (This : in Combinator_Result) + return Result_Status; + private diff --git a/src/packrat-tokens.adb b/src/packrat-tokens.adb index 70a866a..240ecee 100644 --- a/src/packrat-tokens.adb +++ b/src/packrat-tokens.adb @@ -30,13 +30,17 @@ package body Tokens is procedure Adjust - (This : in out Token) - is - New_Array : Element_Array_Access := - new Element_Array (This.Token_Value'Range); + (This : in out Token) is begin - New_Array.all := This.Token_Value.all; - This.Token_Value := New_Array; + if This.Token_Value /= null then + declare + New_Array : Element_Array_Access := + new Element_Array (1 .. This.Token_Value'Length); + begin + New_Array.all := This.Token_Value.all; + This.Token_Value := New_Array; + end; + end if; end Adjust; @@ -64,7 +68,7 @@ package body Tokens is This.Identifier := Ident; This.Start_At := Start; This.Finish_At := Finish; - This.Token_Value := new Element_Array (Value'Range); + This.Token_Value := new Element_Array (1 .. Value'Length); This.Token_Value.all := Value; return This; end Create; diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb index 0603d09..2613a65 100644 --- a/test/ratnest-tests.adb +++ b/test/ratnest-tests.adb @@ -34,9 +34,9 @@ package body Ratnest.Tests is 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 Failure; + return Fail; end if; - return Success; + return Pass; end Valid_Message_Check; @@ -52,22 +52,22 @@ package body Ratnest.Tests is if not PE.Valid_Identifier (EI.Symbol) or not PE.Valid_Identifier (-EI.Symbol) then - return Failure; + 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 Failure; + return Fail; end if; end loop; if not PE.Valid_Identifier_Array (Pass_Array) or PE.Valid_Identifier_Array (Fail_Array) then - return Failure; + return Fail; end if; - return Success; + return Pass; end Valid_Identifier_Check; @@ -97,9 +97,9 @@ package body Ratnest.Tests is Msg_8 : PE.Error_Message := PE.Encode_Array (Array_8); begin if Msg_3 /= Msg_4 or Msg_7 /= Msg_8 then - return Failure; + return Fail; end if; - return Success; + return Pass; end Join_Check; @@ -108,9 +108,9 @@ package body Ratnest.Tests is begin -- Encode with a String and a Natural if PE.Encode ("ABC", 15) /= "sABCp15" then - return Failure; + return Fail; end if; - return Success; + return Pass; end Encode_1_Check; @@ -119,9 +119,9 @@ package body Ratnest.Tests is begin -- Encode with an Unbounded_String and a Natural if PE.Encode (+"ABC", 15) /= "sABCp15" then - return Failure; + return Fail; end if; - return Success; + return Pass; end Encode_2_Check; @@ -130,9 +130,9 @@ package body Ratnest.Tests is begin -- Encode with an Error_Info if PE.Encode ((+"ABC", 15)) /= "sABCp15" then - return Failure; + return Fail; end if; - return Success; + return Pass; end Encode_3_Check; @@ -143,9 +143,9 @@ package body Ratnest.Tests is if PE.Encode_Array (((+"A", 3), (+"BC", 2), (+"ABC", 1), (+"B", 4))) /= "sAp3sBCp2sABCp1sBp4" then - return Failure; + return Fail; end if; - return Success; + return Pass; end Encode_4_Check; @@ -157,9 +157,9 @@ package body Ratnest.Tests is if PE.Decode ("sAp1sBp3sCp10sDEFp456") /= ((+"A", 1), (+"B", 3), (+"C", 10), (+"DEF", 456)) then - return Failure; + return Fail; end if; - return Success; + return Pass; end Decode_Check; @@ -172,12 +172,13 @@ package body Ratnest.Tests is 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 - type My_Labels is (One, Two, Three); - package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); - A : My_Tokens.Token; begin declare @@ -186,18 +187,29 @@ package body Ratnest.Tests is A := B; end; if not A.Initialized or else A.Value /= "abc" then - return Failure; + return Fail; end if; - return Success; + return Pass; end Adjust_Check; - function Store_Check + function Equals_Check return Test_Result is - type My_Labels is (One, Two, Three); - package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); + use type My_Tokens.Token; + A : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc"); + B : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "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, 3, "abc"); begin if not T.Initialized or else @@ -205,9 +217,9 @@ package body Ratnest.Tests is T.Start /= 1 or else T.Finish /= 3 or else T.Value /= "abc" then - return Failure; + return Fail; end if; - return Success; + return Pass; end Store_Check; @@ -220,115 +232,510 @@ package body Ratnest.Tests is 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 Strombo is new Slexy.Combinators; + + + use type Slexy.Combinator_Result; + + + + + + function Join_Check + return Test_Result + is + One : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "a"); + Two : Slexy.Combinator_Result := + Slexy.Create_Result (2, Packrat.Success, "bc"); + Three : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Success, "abc"); + + Four : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Failure, "xyz"); + Five : Slexy.Combinator_Result := + Slexy.Create_Result (4, Packrat.Failure, "axyz"); + + Six : Slexy.Combinator_Result := + Slexy.Create_Result (4, Packrat.Partial, "cd"); + Seven : Slexy.Combinator_Result := + Slexy.Create_Result (5, Packrat.Partial, "acd"); + begin + if One.Join (Two) /= Three or One.Join (Four) /= Five or + One.Join (Six) /= Seven or Four.Join (Six) /= Four or + Five.Join (Two) /= Five or Six.Join (Three) /= Six or + Slexy.Fail_Result.Join (One) /= Slexy.Fail_Result + then + return Fail; + end if; + return Pass; + end Join_Check; + + + + + function Sequence_Check - return Test_Result is + return Test_Result + is + function Match_A is new Strombo.Match ('a'); + function Match_B is new Strombo.Match ('b'); + function Match_C is new Strombo.Match ('c'); + function Seq_Abc is new Strombo.Sequence + ((Match_A'Unrestricted_Access, + Match_B'Unrestricted_Access, + Match_C'Unrestricted_Access)); + + Test_Str : String := "aababcabcab"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Partial, "a"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (2, Packrat.Partial, "ab"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Success, "abc"); + Result4 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if Seq_Abc (Test_Str, 1) /= Result1 or Seq_Abc (Test_Str, 2) /= Result2 or + Seq_Abc (Test_Str, 4) /= Result3 or Seq_Abc (Test_Str, 10) /= Result2 or + Seq_Abc (Test_Str, 3) /= Result4 + then + return Fail; + end if; + return Pass; end Sequence_Check; function Count_Check - return Test_Result is + return Test_Result + is + function Match_A is new Strombo.Match ('a'); + function Match_B is new Strombo.Match ('b'); + function Count_2A is new Strombo.Count (Match_A, 2); + function Count_3B is new Strombo.Count (Match_B, 3); + + Test_Str : String := "abaabbaaabbbaaaabbbb"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Partial, "a"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (2, Packrat.Success, "aa"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Partial, "b"); + Result4 : Slexy.Combinator_Result := + Slexy.Create_Result (2, Packrat.Partial, "bb"); + Result5 : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Success, "bbb"); + Result6 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + 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, 5) /= Result4 or + Count_3B (Test_Str, 10) /= Result5 or Count_3B (Test_Str, 1) /= Result6 or + Count_2A (Test_Str, 2) /= Result6 or Count_3B (Test_Str, 19) /= Result4 + then + return Fail; + end if; + return Pass; end Count_Check; function Many_Check - return Test_Result is + return Test_Result + is + function Match_A is new Strombo.Match ('a'); + function Many_0 is new Strombo.Many (Match_A); + function Many_4 is new Strombo.Many (Match_A, 4); + + Test_Str : String := "aaabbaaaaab"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Success, "aaa"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Partial, "aaa"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (5, Packrat.Success, "aaaaa"); + Result4 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if Many_0 (Test_Str, 1) /= Result1 or Many_4 (Test_Str, 1) /= Result2 or + Many_4 (Test_Str, 6) /= Result3 or Many_0 (Test_Str, 4) /= Result4 + then + return Fail; + end if; + return Pass; end Many_Check; function Many_Until_Check - return Test_Result is + return Test_Result + is + function Match_A is new Strombo.Match ('a'); + function Many_Until_0 is new Strombo.Many_Until (Match_A, PU.Is_Digit); + function Many_Until_3 is new Strombo.Many_Until (Match_A, PU.Is_Digit, 3); + + Test_Str : String := "aaaabbaa123aaa4"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (4, Packrat.Partial, "aaaa"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (2, Packrat.Success, "aa"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (2, Packrat.Partial, "aa"); + Result4 : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Success, "aaa"); + Result5 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if Many_Until_0 (Test_Str, 1) /= Result1 or + Many_Until_0 (Test_Str, 7) /= Result2 or + Many_Until_3 (Test_Str, 7) /= Result3 or + Many_Until_3 (Test_Str, 12) /= Result4 or + Many_Until_0 (Test_Str, 5) /= Result5 + then + return Fail; + end if; + return Pass; end Many_Until_Check; function Satisfy_Check - return Test_Result is + 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 Strombo.Satisfy (Is_123); + function Satisfy_Abc is new Strombo.Satisfy (Is_Abc); + + Test_Str : String := "abc123456def"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "b"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "3"); + Result3 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if Satisfy_123 (Test_Str, 6) /= Result2 or + Satisfy_Abc (Test_Str, 2) /= Result1 or + Satisfy_Abc (Test_Str, 8) /= Result3 + then + return Fail; + end if; + return Pass; end Satisfy_Check; function Satisfy_With_Check - return Test_Result is + 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 Strombo.Satisfy_With (Is_Abc, Minus_One); + function Satisfy_234 is new Strombo.Satisfy_With (Is_123, Minus_One); + + Test_Str : String := "abcde12345"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "c"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "2"); + Result3 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if Satisfy_Bcd (Test_Str, 3) /= Result1 or + Satisfy_234 (Test_Str, 7) /= Result2 or + Satisfy_Bcd (Test_Str, 1) /= Result3 + then + return Fail; + end if; + return Pass; end Satisfy_With_Check; function Match_Check - return Test_Result is + return Test_Result + is + function Match_A is new Strombo.Match ('a'); + function Match_Slash is new Strombo.Match ('/'); + function Match_4 is new Strombo.Match ('4'); + + Test_Str : String := "abc1234./5"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "a"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "/"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "4"); + Result4 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + 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 + then + return Fail; + end if; + return Pass; end Match_Check; function Match_With_Check - return Test_Result is + 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 Strombo.Match_With ('b', Plus_One); + function Match_6 is new Strombo.Match_With ('7', Plus_One); + + Test_Str : String := "abc5678"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "a"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "6"); + Result3 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if Match_A (Test_Str, 1) /= Result1 or + Match_6 (Test_Str, 5) /= Result2 or + Match_A (Test_Str, 2) /= Result3 + then + return Fail; + end if; + return Pass; end Match_With_Check; function Multimatch_Check - return Test_Result is + return Test_Result + is + function Match_String1 is new Strombo.Multimatch ("abc"); + function Match_String2 is new Strombo.Multimatch ("hello"); + + Test_Str : String := "abcdefabhelloworld"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Success, "abc"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (2, Packrat.Partial, "ab"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (5, Packrat.Success, "hello"); + Result4 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if Match_String1 (Test_Str, 1) /= Result1 or + Match_String1 (Test_Str, 7) /= Result2 or + Match_String2 (Test_Str, 9) /= Result3 or + Match_String2 (Test_Str, 3) /= Result4 + then + return Fail; + end if; + return Pass; end Multimatch_Check; function Take_Check - return Test_Result is + return Test_Result + is + function Take_1 is new Strombo.Take; + function Take_5 is new Strombo.Take (5); + + Test_Str : String := "abcdefghi"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "b"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Partial, "ghi"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (5, Packrat.Success, "cdefg"); + Result4 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + 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, 11) /= Result4 + then + return Fail; + end if; + return Pass; end Take_Check; function Take_While_Check - return Test_Result is + return Test_Result + is + function Take_Letters is new Strombo.Take_While (PU.Is_Letter); + function Take_Punch is new Strombo.Take_While (PU.Is_Punctuation); + + Test_Str : String := "abcde,./;'fghi[]=-^563"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (4, Packrat.Success, "bcde"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (2, Packrat.Success, "hi"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (5, Packrat.Success, ",./;'"); + Result4 : Slexy.Combinator_Result := + Slexy.Create_Result (3, Packrat.Success, "=-^"); + Result5 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + 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 + then + return Fail; + end if; + return Pass; end Take_While_Check; function Take_Until_Check - return Test_Result is + return Test_Result + is + function Take_Till_Punch is new Strombo.Take_Until (PU.Is_Punctuation); + function Take_Till_Digit is new Strombo.Take_Until (PU.Is_Digit); + + Test_Str : String := "abcde12345;;;fghi67"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (7, Packrat.Success, "de12345"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (4, Packrat.Partial, "hi67"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (5, Packrat.Success, "abcde"); + Result4 : Slexy.Combinator_Result := + Slexy.Create_Result (6, Packrat.Success, ";;fghi"); + Result5 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + 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, 20) /= Result5 + then + return Fail; + end if; + return Pass; end Take_Until_Check; function Line_Start_Check - return Test_Result is + return Test_Result + is + function LF_Start is new Strombo.Line_Start (Latin.LF); + function C_Start is new Strombo.Line_Start ('c'); + + Test_Str : String := "abcd" & Latin.LF & "e"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (0, Packrat.Success, ""); + Result2 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if LF_Start (Test_Str, 6) /= Result1 or C_Start (Test_Str, 4) /= Result1 or + LF_Start (Test_Str, 2) /= Result2 or C_Start (Test_Str, 1) /= Result2 + then + return Fail; + end if; + return Pass; end Line_Start_Check; function Line_End_Check - return Test_Result is + return Test_Result + is + function LF_End is new Strombo.Line_End (Latin.LF); + function C_End is new Strombo.Line_End ('c'); + + Test_Str : String := "abcd" & Latin.LF & "e"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "" & Latin.LF); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "c"); + Result3 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + if LF_End (Test_Str, 5) /= Result1 or C_End (Test_Str, 3) /= Result2 or + LF_End (Test_Str, 7) /= Result3 or LF_End (Test_Str, 1) /= Result3 + then + return Fail; + end if; + return Pass; end Line_End_Check; function Input_Start_Check - return Test_Result is + return Test_Result + is + Test_Str : String := "abcde"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (0, Packrat.Success, ""); begin - return Failure; + if Strombo.Input_Start (Test_Str, 1) /= Result1 or + Strombo.Input_Start (Test_Str, 3) /= Slexy.Fail_Result + then + return Fail; + end if; + return Pass; end Input_Start_Check; function Input_End_Check - return Test_Result is + return Test_Result + is + function C_End is new Strombo.Input_End ('c'); + function E_End is new Strombo.Input_End ('e'); + + Test_Str : String := "abcde"; + + Result1 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "e"); + Result2 : Slexy.Combinator_Result := + Slexy.Create_Result (1, Packrat.Success, "c"); + Result3 : Slexy.Combinator_Result := + Slexy.Create_Result (0, Packrat.Success, ""); + Result4 : Slexy.Combinator_Result := Slexy.Fail_Result; begin - return Failure; + 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) /= Result4 + then + return Fail; + end if; + return Pass; end Input_End_Check; @@ -353,46 +760,46 @@ package body Ratnest.Tests is -- 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 Failure; + return Fail; end if; end loop; for C in Character range 'a' .. 'c' loop if not Func_1 (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range 'x' .. 'z' loop if not Func_1 (C) then - return Failure; + 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 Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range '!' .. '$' loop if not Func_2 (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end In_Set_Check; @@ -408,46 +815,46 @@ package body Ratnest.Tests is -- 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 Failure; + return Fail; end if; end loop; for C in Character range 'a' .. 'c' loop if Func_1 (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range 'x' .. 'z' loop if Func_1 (C) then - return Failure; + 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 Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range '!' .. '$' loop if Func_2 (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Not_In_Set_Check; @@ -459,20 +866,20 @@ package body Ratnest.Tests 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 Failure; + return Fail; end if; end loop; for C in Character range '0' .. '9' loop if not PU.Is_Digit (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Digit_Check; @@ -481,40 +888,40 @@ package body Ratnest.Tests 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 Failure; + return Fail; end if; end loop; for C in Character range '0' .. '9' loop if not PU.Is_Hex (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range 'A' .. 'F' loop if not PU.Is_Hex (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range 'a' .. 'f' loop if not PU.Is_Hex (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Hex_Check; @@ -523,30 +930,30 @@ package body Ratnest.Tests 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 Failure; + return Fail; end if; end loop; for C in Character range 'A' .. 'Z' loop if not PU.Is_Letter (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range 'a' .. 'z' loop if not PU.Is_Letter (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Letter_Check; @@ -555,40 +962,40 @@ package body Ratnest.Tests 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 Failure; + return Fail; end if; end loop; for C in Character range '0' .. '9' loop if not PU.Is_Alphanumeric (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range 'A' .. 'Z' loop if not PU.Is_Alphanumeric (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range 'a' .. 'z' loop if not PU.Is_Alphanumeric (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Alphanumeric_Check; @@ -597,50 +1004,50 @@ package body Ratnest.Tests is begin for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop if PU.Is_Punctuation (Character'Val (I)) then - return Failure; + return Fail; end if; end loop; for C in Character range '!' .. '/' loop if not PU.Is_Punctuation (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range ':' .. '@' loop if not PU.Is_Punctuation (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range '[' .. '`' loop if not PU.Is_Punctuation (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; for C in Character range '{' .. '~' loop if not PU.Is_Punctuation (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Punctuation_Check; @@ -649,15 +1056,15 @@ package body Ratnest.Tests is begin for I in Integer range Character'Pos (Character'First) .. 127 loop if not PU.Is_ASCII (Character'Val (I)) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_ASCII_Check; @@ -666,15 +1073,15 @@ package body Ratnest.Tests is begin for I in Integer range Character'Pos (Character'First) .. 127 loop if PU.Is_Extended_ASCII (Character'Val (I)) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Extended_ASCII_Check; @@ -683,18 +1090,18 @@ package body Ratnest.Tests is begin for I in Integer range Character'Pos (Character'First) .. Character'Pos (' ') - 1 loop if PU.Is_Space (Character'Val (I)) then - return Failure; + return Fail; end if; end loop; if not PU.Is_Space (' ') then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Space_Check; @@ -705,26 +1112,26 @@ package body Ratnest.Tests is Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 loop if PU.Is_Linespace (Character'Val (I)) then - return Failure; + return Fail; end if; end loop; if not PU.Is_Linespace (Latin.HT) then - return Failure; + 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 Failure; + return Fail; end if; end loop; if not PU.Is_Linespace (' ') then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Linespace_Check; @@ -735,28 +1142,28 @@ package body Ratnest.Tests is Character'Pos (Character'First) .. Character'Pos (Latin.LF) - 1 loop if PU.Is_End_Of_Line (Character'Val (I)) then - return Failure; + return Fail; end if; end loop; if not PU.Is_End_Of_Line (Latin.LF) then - return Failure; + 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 Failure; + return Fail; end if; end loop; if not PU.Is_End_Of_Line (Latin.CR) then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_End_Of_Line_Check; @@ -767,36 +1174,36 @@ package body Ratnest.Tests is Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 loop if PU.Is_Whitespace (Character'Val (I)) then - return Failure; + return Fail; end if; end loop; for C in Character range Latin.HT .. Latin.LF loop if not PU.Is_Whitespace (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; if not PU.Is_Whitespace (Latin.CR) then - return Failure; + 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 Failure; + return Fail; end if; end loop; if not PU.Is_Whitespace (' ') then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Is_Whitespace_Check; @@ -807,36 +1214,36 @@ package body Ratnest.Tests is Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 loop if not PU.Not_Whitespace (Character'Val (I)) then - return Failure; + return Fail; end if; end loop; for C in Character range Latin.HT .. Latin.LF loop if PU.Not_Whitespace (C) then - return Failure; + 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 Failure; + return Fail; end if; end loop; if PU.Not_Whitespace (Latin.CR) then - return Failure; + 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 Failure; + return Fail; end if; end loop; if PU.Not_Whitespace (' ') then - return Failure; + 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 Failure; + return Fail; end if; end loop; - return Success; + return Pass; end Not_Whitespace_Check; diff --git a/test/ratnest-tests.ads b/test/ratnest-tests.ads index cc67120..5610db5 100644 --- a/test/ratnest-tests.ads +++ b/test/ratnest-tests.ads @@ -32,10 +32,12 @@ package Ratnest.Tests is 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; @@ -45,6 +47,8 @@ package Ratnest.Tests is package Lexer is + function Join_Check return Test_Result; + function Sequence_Check return Test_Result; function Count_Check return Test_Result; function Many_Check return Test_Result; @@ -65,7 +69,8 @@ package Ratnest.Tests is function Input_End_Check return Test_Result; Combinator_Tests : Test_Array := - ((+"Sequence", Sequence_Check'Access), + ((+"Join", Join_Check'Access), + (+"Sequence", Sequence_Check'Access), (+"Count", Count_Check'Access), (+"Many", Many_Check'Access), (+"Many_Until", Many_Until_Check'Access), diff --git a/test/ratnest.adb b/test/ratnest.adb index 8d1493c..d063b41 100644 --- a/test/ratnest.adb +++ b/test/ratnest.adb @@ -19,7 +19,7 @@ package body Ratnest is Failed_Count : Natural := 0; begin for T of To_Run loop - if T.Func.all = Failure then + if T.Func.all = Fail then Put_Line ("Failed test " & (-T.Name)); Failed_Count := Failed_Count + 1; end if; diff --git a/test/ratnest.ads b/test/ratnest.ads index adf2369..24a5162 100644 --- a/test/ratnest.ads +++ b/test/ratnest.ads @@ -8,7 +8,7 @@ with package Ratnest is - type Test_Result is (Failure, Success); + type Test_Result is (Fail, Pass); type Test_Function is access function return Test_Result; |