From 2adeae8eb1bc8437b392bed07f1858363f95ab8a Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 12 Dec 2020 12:49:01 +1100 Subject: More bugfixes and Parser unit tests --- example/ssss.adb | 6 +- src/packrat-parsers.adb | 119 +++++++--------- test/rat_tests-parsers.adb | 347 ++++++++++++++++++++++++++++++++++++++++----- test/rat_tests-parsers.ads | 30 +++- 4 files changed, 402 insertions(+), 100 deletions(-) diff --git a/example/ssss.adb b/example/ssss.adb index 56f980d..387c02c 100644 --- a/example/ssss.adb +++ b/example/ssss.adb @@ -16,7 +16,7 @@ procedure Ssss is Input : String := "xxxx"; - type Parser_Labels is (S); + type Parser_Labels is (S, X); package My_Rat is new Packrat.No_Lex (Parser_Labels, Character, String); @@ -26,8 +26,10 @@ procedure Ssss is package S_Redir is new My_Rat.Parsers.Redirect; function Match_X is new My_Rat.Parsers.Match ('x'); + function Let_X is new My_Rat.Parsers.Stamp (X, Match_X); + function S_Seq is new My_Rat.Parsers.Sequence - ((Match_X'Access, S_Redir.Call'Access, S_Redir.Call'Access)); + ((Let_X'Access, S_Redir.Call'Access, S_Redir.Call'Access)); function S_Choice is new My_Rat.Parsers.Choice ((S_Seq'Access, My_Rat.Parsers.Empty'Access)); function S is new My_Rat.Parsers.Stamp (S, S_Choice); diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb index 875a765..63dcb00 100644 --- a/src/packrat-parsers.adb +++ b/src/packrat-parsers.adb @@ -9,13 +9,40 @@ with package body Packrat.Parsers is + function Element + (Hold : in Elem_Holds.Holder) + return Traits.Element_Array is + begin + if Hold.Is_Empty then + return Value : Traits.Element_Array (1 .. 0); + else + return Hold.Element; + end if; + end Element; + + + function Element + (Hold : in Tok_Holds.Holder) + return Traits.Tokens.Finished_Token_Array is + begin + if Hold.Is_Empty then + return Value : Traits.Tokens.Finished_Token_Array (1 .. 0); + else + return Hold.Element; + end if; + end Element; + + + + + function "<" (Left, Right : in Elem_Holds.Holder) return Boolean is use Traits; begin - return Left.Element < Right.Element; + return Element (Left) < Element (Right); end "<"; @@ -25,7 +52,7 @@ package body Packrat.Parsers is is use type Traits.Tokens.Finished_Token_Array; begin - return Left.Element < Right.Element; + return Element (Left) < Element (Right); end "<"; @@ -72,33 +99,6 @@ package body Packrat.Parsers is - function Element - (Hold : in Elem_Holds.Holder) - return Traits.Element_Array is - begin - if Hold.Is_Empty then - return Value : Traits.Element_Array (1 .. 0); - else - return Hold.Element; - end if; - end Element; - - - function Element - (Hold : in Tok_Holds.Holder) - return Traits.Tokens.Finished_Token_Array is - begin - if Hold.Is_Empty then - return Value : Traits.Tokens.Finished_Token_Array (1 .. 0); - else - return Hold.Element; - end if; - end Element; - - - - - function To_Key (Start : in Positive; Func : access function @@ -268,7 +268,9 @@ package body Packrat.Parsers is when Optional_More => Target.Results.Union (Add.Results); Target.Status := Optional_More; - when Needs_More | Failure => + when Needs_More => + Target.Status := Optional_More; + when Failure => null; end case; when Optional_More => @@ -283,9 +285,7 @@ package body Packrat.Parsers is when Success | Optional_More => Target := Add; Target.Status := Optional_More; - when Needs_More => - Target.Results.Union (Add.Results); - when Failure => + when Needs_More | Failure => null; end case; when Failure => @@ -663,9 +663,7 @@ package body Packrat.Parsers is is Salt : Combinator_Result; begin - if Start > Input'Last then - return Empty_Fail; - elsif Params'Length = 0 then + if Params'Length = 0 then return Empty (Input, Context, Start); end if; Salt := Params (Params'First) (Input, Context, Start); @@ -725,9 +723,7 @@ package body Packrat.Parsers is is Salt : Combinator_Result; begin - if Start > Input'Last then - return Empty_Fail; - elsif Params'Length = 0 then + if Params'Length = 0 then return Empty (Input, Context, Start); end if; for C of Params loop @@ -779,9 +775,6 @@ package body Packrat.Parsers is Salt : Combinator_Result; Counter : Natural := 0; begin - if Start > Input'Last then - return Empty_Fail; - end if; Salt := Param (Input, Context, Start); while Salt.Status /= Failure loop Counter := Counter + 1; @@ -820,9 +813,6 @@ package body Packrat.Parsers is Salt, Temp : Combinator_Result; Counter : Natural := 0; begin - if Start > Input'Last then - return Salt; - end if; if Minimum = 0 then Merge (Salt, Empty (Input, Context, Start)); end if; @@ -911,7 +901,13 @@ package body Packrat.Parsers is return Empty (Input, Context, Start); end if; when Failure => - return Empty (Input, Context, Start); + if Context.Allow_Incomplete and Start > Input'Last then + return Salt : Combinator_Result do + Salt.Status := Needs_More; + end return; + else + return Empty (Input, Context, Start); + end if; end case; end Actual; function Curt is new Curtailment (To_Key (Start, Not_Followed_By'Access), Input, Actual); @@ -960,9 +956,6 @@ package body Packrat.Parsers is function Not_Empty_Param is new Not_Empty (Param); Salt : Combinator_Result := Empty (Input, Context, Start); begin - if Start > Input'Last then - return Empty_Fail; - end if; Merge (Salt, Not_Empty_Param (Input, Context, Start)); Complete_Status (Salt, Context.Allow_Incomplete); return Salt; @@ -1174,31 +1167,29 @@ package body Packrat.Parsers is is use type Traits.Element_Array; Part : Combo_Result_Part; - My_Offset : Natural; begin if Start > Input'Last then - return Empty_Fail; + return Salt : Combinator_Result; elsif Items'Length = 0 then return Empty (Input, Context, Start); end if; if Input'Last - Start < Items'Length - 1 then - if not Context.Allow_Incomplete then - return Empty_Fail; - end if; - My_Offset := Input'Last - Start; - else - My_Offset := Items'Length - 1; + return Salt : Combinator_Result do + if Context.Allow_Incomplete and Input (Start .. Input'Last) = + Items (Items'First .. Items'First + Input'Last - Start) + then + Salt.Status := Needs_More; + end if; + end return; end if; - if Input (Start .. Start + My_Offset) /= - Items (Items'First .. Items'First + My_Offset) - then - return Empty_Fail; + if Input (Start .. Start + Items'Length - 1) /= Items (Items'First .. Items'Last) then + return Salt : Combinator_Result; end if; return Salt : Combinator_Result do - Part.Finish := Start + My_Offset; - Part.Value := Elem_Holds.To_Holder (Input (Start .. Start + My_Offset)); + Part.Finish := Start + Items'Length - 1; + Part.Value := Elem_Holds.To_Holder (Input (Start .. Start + Items'Length - 1)); Salt.Results.Include (Part); - Salt.Status := (if My_Offset < Items'Length - 1 then Needs_More else Success); + Salt.Status := Success; end return; end Actual; function Call is new Memoize (To_Key (Start, Multimatch'Access), Actual); diff --git a/test/rat_tests-parsers.adb b/test/rat_tests-parsers.adb index 9368d6d..872925a 100644 --- a/test/rat_tests-parsers.adb +++ b/test/rat_tests-parsers.adb @@ -35,6 +35,208 @@ package body Rat_Tests.Parsers is + function Sequence_Check + return Test_Result + is + Input : String := "abcdefghi"; + Context1, Context2 : Pone.Parsers.Parser_Context := One_Debug.Empty_Context; + Result1 : Pone.Parsers.Combinator_Result := Seq_ABCDEFG (Input, Context1, 1); + Result2 : Pone.Parsers.Combinator_Result := Seq_ABCDEFG (Input, Context2, 4); + begin + if One_Debug.Status (Result1) /= Packrat.Success or + One_Debug.Status (Result2) /= Packrat.Failure + then + return Fail; + end if; + declare + Result1_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result1); + begin + if Result1_Parts'Length /= 1 or + One_Debug.Parts (Result2)'Length /= 0 + then + return Fail; + end if; + if One_Debug.Finish (Result1_Parts (1)) /= 7 or + One_Debug.Value (Result1_Parts (1)) /= "abcdefg" or + One_Debug.Tokens (Result1_Parts (1))'Length /= 0 + then + return Fail; + end if; + end; + return Pass; + end Sequence_Check; + + + function Sequence_2_Check + return Test_Result + is + Input : String := "aaaaa"; + Input2 : String := "aaaab"; + Context1, Context2, Context3, Context4 : Pone.Parsers.Parser_Context := + One_Debug.Empty_Context; + function Match_A is new Pone.Parsers.Match ('a'); + function Many_A is new Pone.Parsers.Many (Match_A, 0); + function Two_A is new Pone.Parsers.Multimatch ("aa"); + function Seq_A is new Pone.Parsers.Sequence_2 (Many_A, Two_A); + Result1 : Pone.Parsers.Combinator_Result := Seq_A (Input, Context1, 1); + Result2 : Pone.Parsers.Combinator_Result := Seq_A (Input, Context2, 5); + Result3 : Pone.Parsers.Combinator_Result := Seq_A (Input2, Context3, 1); + Result4 : Pone.Parsers.Combinator_Result := Seq_A (Input2, Context4, 4); + begin + if One_Debug.Status (Result1) /= Packrat.Optional_More or + One_Debug.Status (Result2) /= Packrat.Needs_More or + One_Debug.Status (Result3) /= Packrat.Success or + One_Debug.Status (Result4) /= Packrat.Failure + then + return Fail; + end if; + declare + Result1_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result1); + Result3_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result3); + begin + if Result1_Parts'Length /= 4 or + One_Debug.Parts (Result2)'Length /= 0 or + Result3_Parts'Length /= 3 or + One_Debug.Parts (Result4)'Length /= 0 + then + return Fail; + end if; + if One_Debug.Finish (Result1_Parts (1)) /= 2 or + One_Debug.Finish (Result1_Parts (2)) /= 3 or + One_Debug.Finish (Result1_Parts (3)) /= 4 or + One_Debug.Finish (Result1_Parts (4)) /= 5 + then + return Fail; + end if; + if One_Debug.Value (Result1_Parts (1)) /= "aa" or + One_Debug.Value (Result1_Parts (2)) /= "aaa" or + One_Debug.Value (Result1_Parts (3)) /= "aaaa" or + One_Debug.Value (Result1_Parts (4)) /= "aaaaa" + then + return Fail; + end if; + if (for some P of Result1_Parts => One_Debug.Tokens (P)'Length /= 0) then + return Fail; + end if; + if One_Debug.Finish (Result3_Parts (1)) /= 2 or + One_Debug.Finish (Result3_Parts (2)) /= 3 or + One_Debug.Finish (Result3_Parts (3)) /= 4 + then + return Fail; + end if; + if One_Debug.Value (Result3_Parts (1)) /= "aa" or + One_Debug.Value (Result3_Parts (2)) /= "aaa" or + One_Debug.Value (Result3_Parts (3)) /= "aaaa" + then + return Fail; + end if; + if (for some P of Result3_Parts => One_Debug.Tokens (P)'Length /= 0) then + return Fail; + end if; + end; + return Pass; + end Sequence_2_Check; + + + function Choice_Check + return Test_Result + is + Input : String := "cccdefg"; + Context1, Context2, Context3 : Pone.Parsers.Parser_Context := One_Debug.Empty_Context; + Result1 : Pone.Parsers.Combinator_Result := Choose_CCCDE (Input, Context1, 1); + Result2 : Pone.Parsers.Combinator_Result := Choose_CCCDE (Input, Context2, 3); + Result3 : Pone.Parsers.Combinator_Result := Choose_CCCDE (Input, Context3, 5); + begin + if One_Debug.Status (Result1) /= Packrat.Success or + One_Debug.Status (Result2) /= Packrat.Success or + One_Debug.Status (Result3) /= Packrat.Failure + then + return Fail; + end if; + declare + Result1_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result1); + Result2_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result2); + begin + if Result1_Parts'Length /= 4 or + Result2_Parts'Length /= 1 or + One_Debug.Parts (Result3)'Length /= 0 + then + return Fail; + end if; + if One_Debug.Finish (Result1_Parts (1)) /= 1 or + One_Debug.Finish (Result1_Parts (2)) /= 2 or + One_Debug.Finish (Result1_Parts (3)) /= 3 or + One_Debug.Finish (Result1_Parts (4)) /= 5 + then + return Fail; + end if; + if One_Debug.Value (Result1_Parts (1)) /= "c" or + One_Debug.Value (Result1_Parts (2)) /= "cc" or + One_Debug.Value (Result1_Parts (3)) /= "ccc" or + One_Debug.Value (Result1_Parts (4)) /= "cccde" + then + return Fail; + end if; + if (for some P of Result1_Parts => One_Debug.Tokens (P)'Length /= 0) then + return Fail; + end if; + if One_Debug.Finish (Result2_Parts (1)) /= 3 or + One_Debug.Value (Result2_Parts (1)) /= "c" or + One_Debug.Tokens (Result2_Parts (1))'Length /= 0 + then + return Fail; + end if; + end; + return Pass; + end Choice_Check; + + + function Choice_2_Check + return Test_Result + is + Input : String := "matmat"; + Input2 : String := "ma"; + Context1, Context2, Context3 : Pone.Parsers.Parser_Context := One_Debug.Empty_Context; + function Match_Mat is new Pone.Parsers.Multimatch ("mat"); + function Match_Match is new Pone.Parsers.Multimatch ("match"); + function Choo_Choo is new Pone.Parsers.Choice_2 (Match_Mat, Match_Match); + Result1 : Pone.Parsers.Combinator_Result := Choo_Choo (Input, Context1, 1); + Result2 : Pone.Parsers.Combinator_Result := Choo_Choo (Input, Context2, 4); + Result3 : Pone.Parsers.Combinator_Result := Choo_Choo (Input2, Context3, 1); + begin + if One_Debug.Status (Result1) /= Packrat.Success or + One_Debug.Status (Result2) /= Packrat.Optional_More or + One_Debug.Status (Result3) /= Packrat.Needs_More + then + return Fail; + end if; + declare + Result1_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result1); + Result2_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result2); + begin + if Result1_Parts'Length /= 1 or + Result2_Parts'Length /= 1 or + One_Debug.Parts (Result3)'Length /= 0 + then + return Fail; + end if; + if One_Debug.Finish (Result1_Parts (1)) /= 3 or + One_Debug.Value (Result1_Parts (1)) /= "mat" or + One_Debug.Tokens (Result1_Parts (1))'Length /= 0 + then + return Fail; + end if; + if One_Debug.Finish (Result2_Parts (1)) /= 6 or + One_Debug.Value (Result2_Parts (1)) /= "mat" or + One_Debug.Tokens (Result2_Parts (1))'Length /= 0 + then + return Fail; + end if; + end; + return Pass; + end Choice_2_Check; + + function Count_Check return Test_Result is @@ -66,7 +268,7 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result1_Parts (1)) /= 3 or - One_Debug.Value (Result1_Parts (1))'Length /= 3 or + One_Debug.Value (Result1_Parts (1)) /= "aaa" or One_Debug.Tokens (Result1_Parts (1))'Length /= 0 then return Fail; @@ -113,10 +315,10 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Value (Result1_Parts (1))'Length /= 0 or - One_Debug.Value (Result1_Parts (2))'Length /= 1 or - One_Debug.Value (Result1_Parts (3))'Length /= 2 or - One_Debug.Value (Result1_Parts (4))'Length /= 3 or - One_Debug.Value (Result1_Parts (5))'Length /= 4 + One_Debug.Value (Result1_Parts (2)) /= "a" or + One_Debug.Value (Result1_Parts (3)) /= "ab" or + One_Debug.Value (Result1_Parts (4)) /= "abc" or + One_Debug.Value (Result1_Parts (5)) /= "abcd" then return Fail; end if; @@ -139,11 +341,11 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Value (Result3_Parts (1))'Length /= 0 or - One_Debug.Value (Result3_Parts (2))'Length /= 1 or - One_Debug.Value (Result3_Parts (3))'Length /= 2 or - One_Debug.Value (Result3_Parts (4))'Length /= 3 or - One_Debug.Value (Result3_Parts (5))'Length /= 4 or - One_Debug.Value (Result3_Parts (6))'Length /= 5 + One_Debug.Value (Result3_Parts (2)) /= "e" or + One_Debug.Value (Result3_Parts (3)) /= "ef" or + One_Debug.Value (Result3_Parts (4)) /= "efg" or + One_Debug.Value (Result3_Parts (5)) /= "efgh" or + One_Debug.Value (Result3_Parts (6)) /= "efghi" then return Fail; end if; @@ -191,8 +393,8 @@ package body Rat_Tests.Parsers is then return Fail; end if; - if One_Debug.Value (Result1_Parts (1))'Length /= 3 or - One_Debug.Value (Result1_Parts (2))'Length /= 4 + if One_Debug.Value (Result1_Parts (1)) /= "abc" or + One_Debug.Value (Result1_Parts (2)) /= "abcd" then return Fail; end if; @@ -207,9 +409,9 @@ package body Rat_Tests.Parsers is then return Fail; end if; - if One_Debug.Value (Result3_Parts (1))'Length /= 3 or - One_Debug.Value (Result3_Parts (2))'Length /= 4 or - One_Debug.Value (Result3_Parts (3))'Length /= 5 + if One_Debug.Value (Result3_Parts (1)) /= "efg" or + One_Debug.Value (Result3_Parts (2)) /= "efgh" or + One_Debug.Value (Result3_Parts (3)) /= "efghi" then return Fail; end if; @@ -224,6 +426,80 @@ package body Rat_Tests.Parsers is end Many_Min_Check; + function Followed_By_Check + return Test_Result + is + Input : String := "abc12de3"; + Context1, Context2, Context3 : Pone.Parsers.Parser_Context := One_Debug.Empty_Context; + function Sat_Digit is new Pone.Parsers.Satisfy (Packrat.Utilities.Is_Digit); + function Digit_Follows is new Pone.Parsers.Followed_By (Sat_Digit); + Result1 : Pone.Parsers.Combinator_Result := Digit_Follows (Input, Context1, 3); + Result2 : Pone.Parsers.Combinator_Result := Digit_Follows (Input, Context2, 4); + Result3 : Pone.Parsers.Combinator_Result := Digit_Follows (Input, Context3, 9); + begin + if One_Debug.Status (Result1) /= Packrat.Failure or + One_Debug.Status (Result2) /= Packrat.Success or + One_Debug.Status (Result3) /= Packrat.Needs_More + then + return Fail; + end if; + declare + Result2_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result2); + begin + if One_Debug.Parts (Result1)'Length /= 0 or + Result2_Parts'Length /= 1 or + One_Debug.Parts (Result3)'Length /= 0 + then + return Fail; + end if; + if One_Debug.Finish (Result2_Parts (1)) /= 3 or + One_Debug.Value (Result2_Parts (1))'Length /= 0 or + One_Debug.Tokens (Result2_Parts (1))'Length /= 0 + then + return Fail; + end if; + end; + return Pass; + end Followed_By_Check; + + + function Not_Followed_By_Check + return Test_Result + is + Input : String := "abc12de3"; + Context1, Context2, Context3 : Pone.Parsers.Parser_Context := One_Debug.Empty_Context; + function Sat_Digit is new Pone.Parsers.Satisfy (Packrat.Utilities.Is_Digit); + function Digit_Not_Follows is new Pone.Parsers.Not_Followed_By (Sat_Digit); + Result1 : Pone.Parsers.Combinator_Result := Digit_Not_Follows (Input, Context1, 3); + Result2 : Pone.Parsers.Combinator_Result := Digit_Not_Follows (Input, Context2, 4); + Result3 : Pone.Parsers.Combinator_Result := Digit_Not_Follows (Input, Context3, 9); + begin + if One_Debug.Status (Result1) /= Packrat.Success or + One_Debug.Status (Result2) /= Packrat.Failure or + One_Debug.Status (Result3) /= Packrat.Needs_More + then + return Fail; + end if; + declare + Result1_Parts : One_Debug.Result_Part_Array := One_Debug.Parts (Result1); + begin + if Result1_Parts'Length /= 1 or + One_Debug.Parts (Result2)'Length /= 0 or + One_Debug.Parts (Result3)'Length /= 0 + then + return Fail; + end if; + if One_Debug.Finish (Result1_Parts (1)) /= 2 or + One_Debug.Value (Result1_Parts (1))'Length /= 0 or + One_Debug.Tokens (Result1_Parts (1))'Length /= 0 + then + return Fail; + end if; + end; + return Pass; + end Not_Followed_By_Check; + + function Many_Until_Nomin_Check return Test_Result is @@ -257,7 +533,7 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result1_Parts (1)) /= 3 or - One_Debug.Value (Result1_Parts (1))'Length /= 3 or + One_Debug.Value (Result1_Parts (1)) /= "abc" or One_Debug.Tokens (Result1_Parts (1))'Length /= 0 then return Fail; @@ -301,7 +577,7 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result1_Parts (1)) /= 5 or - One_Debug.Value (Result1_Parts (1))'Length /= 5 or + One_Debug.Value (Result1_Parts (1)) /= "abcde" or One_Debug.Tokens (Result1_Parts (1))'Length /= 0 then return Fail; @@ -339,7 +615,7 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result1_Parts (1)) /= 2 or - One_Debug.Value (Result1_Parts (1))'Length /= 1 or + One_Debug.Value (Result1_Parts (1)) /= "b" or One_Debug.Tokens (Result1_Parts (1))'Length /= 0 then return Fail; @@ -378,7 +654,7 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result2_Parts (1)) /= 6 or - One_Debug.Value (Result2_Parts (1))'Length /= 1 or + One_Debug.Value (Result2_Parts (1)) /= "3" or One_Debug.Tokens (Result2_Parts (1))'Length /= 0 then return Fail; @@ -416,7 +692,7 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result2_Parts (1)) /= 5 or - One_Debug.Value (Result2_Parts (1))'Length /= 1 or + One_Debug.Value (Result2_Parts (1)) /= "b" or One_Debug.Tokens (Result2_Parts (1))'Length /= 0 then return Fail; @@ -454,7 +730,7 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result1_Parts (1)) /= 3 or - One_Debug.Value (Result1_Parts (1))'Length /= 1 or + One_Debug.Value (Result1_Parts (1)) /= "a" or One_Debug.Tokens (Result1_Parts (1))'Length /= 0 then return Fail; @@ -468,15 +744,19 @@ package body Rat_Tests.Parsers is return Test_Result is Input : String := "abcdefghi"; - Context1, Context2, Context3 : Pone.Parsers.Parser_Context := One_Debug.Empty_Context; + Context1, Context2, Context3, Context4 : Pone.Parsers.Parser_Context := + One_Debug.Empty_Context; function Multi is new Pone.Parsers.Multimatch ("def"); + function Multi2 is new Pone.Parsers.Multimatch ("hijk"); Result1 : Pone.Parsers.Combinator_Result := Multi (Input, Context1, 2); Result2 : Pone.Parsers.Combinator_Result := Multi (Input, Context2, 4); Result3 : Pone.Parsers.Combinator_Result := Multi (Input, Context3, 300); + Result4 : Pone.Parsers.Combinator_Result := Multi2 (Input, Context4, 8); begin if One_Debug.Status (Result1) /= Packrat.Failure or One_Debug.Status (Result2) /= Packrat.Success or - One_Debug.Status (Result3) /= Packrat.Failure + One_Debug.Status (Result3) /= Packrat.Failure or + One_Debug.Status (Result4) /= Packrat.Needs_More then return Fail; end if; @@ -485,12 +765,13 @@ package body Rat_Tests.Parsers is begin if One_Debug.Parts (Result1)'Length /= 0 or Result2_Parts'Length /= 1 or - One_Debug.Parts (Result3)'Length /= 0 + One_Debug.Parts (Result3)'Length /= 0 or + One_Debug.Parts (Result4)'Length /= 0 then return Fail; end if; if One_Debug.Finish (Result2_Parts (1)) /= 6 or - One_Debug.Value (Result2_Parts (1))'Length /= 3 or + One_Debug.Value (Result2_Parts (1)) /= "def" or One_Debug.Tokens (Result2_Parts (1))'Length /= 0 then return Fail; @@ -532,10 +813,10 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result1_Parts (1)) /= 2 or - One_Debug.Value (Result1_Parts (1))'Length /= 2 or + One_Debug.Value (Result1_Parts (1)) /= "ab" or One_Debug.Tokens (Result1_Parts (1))'Length /= 0 or One_Debug.Finish (Result2_Parts (1)) /= 7 or - One_Debug.Value (Result2_Parts (1))'Length /= 5 or + One_Debug.Value (Result2_Parts (1)) /= "cdefg" or One_Debug.Tokens (Result2_Parts (1))'Length /= 0 then return Fail; @@ -572,10 +853,10 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result1_Parts (1)) /= 3 or - One_Debug.Value (Result1_Parts (1))'Length /= 2 or + One_Debug.Value (Result1_Parts (1)) /= "bc" or One_Debug.Tokens (Result1_Parts (1))'Length /= 0 or One_Debug.Finish (Result3_Parts (1)) /= 9 or - One_Debug.Value (Result3_Parts (1))'Length /= 3 or + One_Debug.Value (Result3_Parts (1)) /= "def" or One_Debug.Tokens (Result3_Parts (1))'Length /= 0 then return Fail; @@ -612,10 +893,10 @@ package body Rat_Tests.Parsers is return Fail; end if; if One_Debug.Finish (Result1_Parts (1)) /= 3 or - One_Debug.Value (Result1_Parts (1))'Length /= 2 or + One_Debug.Value (Result1_Parts (1)) /= "bc" or One_Debug.Tokens (Result1_Parts (1))'Length /= 0 or One_Debug.Finish (Result3_Parts (1)) /= 9 or - One_Debug.Value (Result3_Parts (1))'Length /= 2 or + One_Debug.Value (Result3_Parts (1)) /= "ef" or One_Debug.Tokens (Result3_Parts (1))'Length /= 0 then return Fail; @@ -698,8 +979,8 @@ package body Rat_Tests.Parsers is then return Fail; end if; - if One_Debug.Value (Result1_Parts (1))'Length /= 1 or - One_Debug.Value (Result1_Parts (2))'Length /= 2 + if One_Debug.Value (Result1_Parts (1)) /= "a" or + One_Debug.Value (Result1_Parts (2)) /= "aa" then return Fail; end if; diff --git a/test/rat_tests-parsers.ads b/test/rat_tests-parsers.ads index a70f41e..2b71f86 100644 --- a/test/rat_tests-parsers.ads +++ b/test/rat_tests-parsers.ads @@ -19,9 +19,15 @@ private with package Rat_Tests.Parsers is + function Sequence_Check return Test_Result; + function Sequence_2_Check return Test_Result; + function Choice_Check return Test_Result; + function Choice_2_Check return Test_Result; function Count_Check return Test_Result; function Many_Nomin_Check return Test_Result; function Many_Min_Check return Test_Result; + function Followed_By_Check return Test_Result; + function Not_Followed_By_Check return Test_Result; function Many_Until_Nomin_Check return Test_Result; function Many_Until_Min_Check return Test_Result; @@ -39,9 +45,15 @@ package Rat_Tests.Parsers is function Not_Empty_Check return Test_Result; Combinator_Tests : Test_Array := - ((+"Count", Count_Check'Access), + ((+"Sequence", Sequence_Check'Access), + (+"Sequence_2", Sequence_2_Check'Access), + (+"Choice", Choice_Check'Access), + (+"Choice_2", Choice_2_Check'Access), + (+"Count", Count_Check'Access), (+"Many No Minimum", Many_Nomin_Check'Access), (+"Many With Minimum", Many_Min_Check'Access), + (+"Followed_By", Followed_By_Check'Access), + (+"Not_Followed_By", Not_Followed_By_Check'Access), (+"Many_Until No Minimum", Many_Until_Nomin_Check'Access), (+"Many_Until With Minimum", Many_Until_Min_Check'Access), (+"Satisfy", Satisfy_Check'Access), @@ -75,6 +87,22 @@ private + function Match_AB is new Pone.Parsers.Multimatch ("ab"); + function Match_CDE is new Pone.Parsers.Multimatch ("cde"); + function Match_FG is new Pone.Parsers.Multimatch ("fg"); + function Seq_ABCDEFG is new Pone.Parsers.Sequence + ((Match_AB'Access, Match_CDE'Access, Match_FG'Access)); + + function Match_C is new Pone.Parsers.Match ('c'); + function Many_C is new Pone.Parsers.Many (Match_C, 1); + function Match_CC is new Pone.Parsers.Multimatch ("cc"); + function Match_CCCDE is new Pone.Parsers.Multimatch ("cccde"); + function Choose_CCCDE is new Pone.Parsers.Choice + ((Many_C'Access, Match_CC'Access, Match_CCCDE'Access)); + + + + function Alphanum_Switch (Char : in Character) return Character; -- cgit