diff options
| -rw-r--r-- | src/packrat-errors.adb | 24 | ||||
| -rw-r--r-- | src/packrat-errors.ads | 5 | ||||
| -rw-r--r-- | src/packrat-parsers.adb | 94 | ||||
| -rw-r--r-- | test/rat_tests-parsers.adb | 145 | ||||
| -rw-r--r-- | test/rat_tests-parsers.ads | 21 |
5 files changed, 255 insertions, 34 deletions
diff --git a/src/packrat-errors.adb b/src/packrat-errors.adb index 3f7c38f..0122b7d 100644 --- a/src/packrat-errors.adb +++ b/src/packrat-errors.adb @@ -313,6 +313,30 @@ package body Packrat.Errors is end Decode; + + + + function Equivalent + (Left, Right : in Error_Info_Array) + return Boolean + is + Marked : array (Left'Range) of Boolean := (others => False); + begin + if Left'Length /= Right'Length then + return False; + end if; + for L_Index in Left'Range loop + for R of Right loop + if Left (L_Index) = R and not Marked (L_Index) then + Marked (L_Index) := True; + exit; + end if; + end loop; + end loop; + return (for all M of Marked => M = True); + end Equivalent; + + end Packrat.Errors; diff --git a/src/packrat-errors.ads b/src/packrat-errors.ads index 50fa966..d3b38c3 100644 --- a/src/packrat-errors.ads +++ b/src/packrat-errors.ads @@ -79,6 +79,11 @@ package Packrat.Errors is return Error_Info_Array; + function Equivalent + (Left, Right : in Error_Info_Array) + return Boolean; + + end Packrat.Errors; diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb index abb2736..26d5343 100644 --- a/src/packrat-parsers.adb +++ b/src/packrat-parsers.adb @@ -313,7 +313,6 @@ package body Packrat.Parsers is Target.Results.Union (Add.Results); Target.Status := Add.Status; when Needs_More => - null; Target.Status := Add.Status; when Failure => null; @@ -343,6 +342,9 @@ package body Packrat.Parsers is Salt, Temp : Combinator_Result; Adjust : Result_Sets.Set; begin + if From.Status = Failure or From.Status = Needs_More then + return From; + end if; Salt.Curtails := From.Curtails; for R of From.Results loop Temp := Next (Input, Context, R.Finish + 1); @@ -356,6 +358,9 @@ package body Packrat.Parsers is Temp.Results := Adjust; Merge (Salt, Temp); end loop; + if Salt.Status = Failure and From.Status = Optional_More then + Salt.Status := Needs_More; + end if; return Salt; end Continue; @@ -739,7 +744,8 @@ package body Packrat.Parsers is end if; Salt := Params (Params'First) (Input, Context, Start); for I in Integer range Params'First + 1 .. Params'Last loop - exit when Salt.Status = Failure; + exit when Salt.Status = Failure or + (Context.Allow_Incomplete and Salt.Status = Needs_More); declare function Cont_Param is new Continue (Params (I).all); begin @@ -773,6 +779,7 @@ package body Packrat.Parsers is begin Salt := Part_One (Input, Context, Start); Salt := Cont_Param (Salt, Input, Context); + Complete_Status (Salt, Context.Allow_Incomplete); return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Sequence_2'Access), Actual); @@ -816,11 +823,14 @@ package body Packrat.Parsers is is function Actual (Context : in out Parser_Context) - return Combinator_Result is + return Combinator_Result + is + Salt : Combinator_Result; begin - return Merge - (Choice_One (Input, Context, Start), - Choice_Two (Input, Context, Start)); + Merge (Salt, Choice_One (Input, Context, Start)); + Merge (Salt, Choice_Two (Input, Context, Start)); + Complete_Status (Salt, Context.Allow_Incomplete); + return Salt; end Actual; function Memo is new Memoize (To_Key (Start, Choice_2'Access), Actual); function Curt is new Curtailment (To_Key (Start, Choice_2'Access), Input, Memo); @@ -1128,7 +1138,11 @@ package body Packrat.Parsers is Part : Combo_Result_Part; Salt : Combinator_Result; begin - if Start <= Input'Last and then Test (Input (Start)) then + if Start > Input'Last then + if Context.Allow_Incomplete then + Salt.Status := Needs_More; + end if; + elsif Test (Input (Start)) then Part.Finish := Start; Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); Salt.Results.Include (Part); @@ -1155,7 +1169,11 @@ package body Packrat.Parsers is Part : Combo_Result_Part; Salt : Combinator_Result; begin - if Start <= Input'Last and then Test (Change (Input (Start))) then + if Start > Input'Last then + if Context.Allow_Incomplete then + Salt.Status := Needs_More; + end if; + elsif Test (Change (Input (Start))) then Part.Finish := Start; Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); Salt.Results.Include (Part); @@ -1183,7 +1201,11 @@ package body Packrat.Parsers is Part : Combo_Result_Part; Salt : Combinator_Result; begin - if Start <= Input'Last and then Input (Start) = Item then + if Start > Input'Last then + if Context.Allow_Incomplete then + Salt.Status := Needs_More; + end if; + elsif Input (Start) = Item then Part.Finish := Start; Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); Salt.Results.Include (Part); @@ -1211,7 +1233,11 @@ package body Packrat.Parsers is Part : Combo_Result_Part; Salt : Combinator_Result; begin - if Start <= Input'Last and then Change (Input (Start)) = Item then + if Start > Input'Last then + if Context.Allow_Incomplete then + Salt.Status := Needs_More; + end if; + elsif Change (Input (Start)) = Item then Part.Finish := Start; Part.Value := Elem_Holds.To_Holder (Input (Start .. Start)); Salt.Results.Include (Part); @@ -1239,7 +1265,11 @@ package body Packrat.Parsers is Part : Combo_Result_Part; begin if Start > Input'Last then - return Salt : Combinator_Result; + return Salt : Combinator_Result do + if Context.Allow_Incomplete then + Salt.Status := Needs_More; + end if; + end return; elsif Items'Length = 0 then return Empty (Input, Context, Start); end if; @@ -1280,10 +1310,9 @@ package body Packrat.Parsers is is Part : Combo_Result_Part; begin - if Start > Input'Last then - return Salt : Combinator_Result; - end if; - if Input'Last - Start < Number - 1 then + if Start > Input'Last or else + Input'Last - Start < Number - 1 + then return Salt : Combinator_Result do if Context.Allow_Incomplete then Salt.Status := Needs_More; @@ -1316,8 +1345,14 @@ package body Packrat.Parsers is Part : Combo_Result_Part; My_Finish : Positive := Start; begin - if Start > Input'Last or else not Test (Input (Start)) then - return Empty_Fail; + if Start > Input'Last then + return Salt : Combinator_Result do + if Context.Allow_Incomplete then + Salt.Status := Needs_More; + end if; + end return; + elsif not Test (Input (Start)) then + return Salt : Combinator_Result; end if; while My_Finish <= Input'Last and then Test (Input (My_Finish)) loop My_Finish := My_Finish + 1; @@ -1350,8 +1385,14 @@ package body Packrat.Parsers is Part : Combo_Result_Part; My_Finish : Positive := Start; begin - if Start > Input'Last or else Test (Input (Start)) then - return Empty_Fail; + if Start > Input'Last then + return Salt : Combinator_Result do + if Context.Allow_Incomplete then + Salt.Status := Needs_More; + end if; + end return; + elsif Test (Input (Start)) then + return Salt : Combinator_Result; end if; while My_Finish <= Input'Last and then not Test (Input (My_Finish)) loop My_Finish := My_Finish + 1; @@ -1405,6 +1446,13 @@ package body Packrat.Parsers is end if; end loop; Salt.Results.Assign (Adjust); + if Salt.Results.Is_Empty then + if Salt.Status = Success then + Salt.Status := Failure; + elsif Salt.Status = Optional_More then + Salt.Status := Needs_More; + end if; + end if; return Salt; end Not_Empty; @@ -1416,7 +1464,13 @@ package body Packrat.Parsers is return Combinator_Result is begin if Start > Input'Last then - return Empty (Input, Context, Start); + if Context.Allow_Incomplete then + return Salt : Combinator_Result do + Salt.Status := Needs_More; + end return; + else + return Empty (Input, Context, Start); + end if; else return Salt : Combinator_Result; end if; diff --git a/test/rat_tests-parsers.adb b/test/rat_tests-parsers.adb index 8d54168..be3c1cd 100644 --- a/test/rat_tests-parsers.adb +++ b/test/rat_tests-parsers.adb @@ -602,7 +602,7 @@ package body Rat_Tests.Parsers is begin if One_Debug.Status (Result1) /= Packrat.Success or One_Debug.Status (Result2) /= Packrat.Failure or - One_Debug.Status (Result3) /= Packrat.Failure + One_Debug.Status (Result3) /= Packrat.Needs_More then return Fail; end if; @@ -641,7 +641,7 @@ package body Rat_Tests.Parsers is 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.Needs_More then return Fail; end if; @@ -679,7 +679,7 @@ package body Rat_Tests.Parsers is 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.Needs_More then return Fail; end if; @@ -758,7 +758,7 @@ package body Rat_Tests.Parsers is begin if One_Debug.Status (Result1) /= Packrat.Failure or One_Debug.Status (Result2) /= Packrat.Success or - One_Debug.Status (Result3) /= Packrat.Failure or + One_Debug.Status (Result3) /= Packrat.Needs_More or One_Debug.Status (Result4) /= Packrat.Needs_More then return Fail; @@ -800,7 +800,7 @@ package body Rat_Tests.Parsers is if One_Debug.Status (Result1) /= Packrat.Success or One_Debug.Status (Result2) /= Packrat.Success or One_Debug.Status (Result3) /= Packrat.Needs_More or - One_Debug.Status (Result4) /= Packrat.Failure + One_Debug.Status (Result4) /= Packrat.Needs_More then return Fail; end if; @@ -1000,6 +1000,134 @@ package body Rat_Tests.Parsers is + function Parse_Parts_Check + return Test_Result + is + pragma Polling (On); + + -- 1+2+3+4 + Input1 : String := "1+"; + Input2 : String := "2+3"; + Input3 : String := "+4"; + Input4 : String := ""; + + use Add_Errors; + Add_1 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Sum_Err, 1, ""); + Add_3 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Sum_Err, 3, ""); + Add_5 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Sum_Err, 5, ""); + Add_7 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Sum_Err, 7, ""); + Number_1 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number_Err, 1, "1"); + Number_3 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number_Err, 3, "2"); + Number_5 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number_Err, 5, "3"); + Number_7 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number_Err, 7, "4"); + + Expected_Graph, Actual_Graph : Parser_Result; + begin + Expected_Graph.Connect ((Add_7, 7), + (1 => (Number_7, 7))); + Expected_Graph.Connect ((Add_5, 7), + ((Number_5, 5), (Add_7, 7))); + Expected_Graph.Connect ((Add_3, 7), + ((Number_3, 3), (Add_5, 7))); + Expected_Graph.Connect ((Add_1, 7), + ((Number_1, 1), (Add_3, 7))); + + Expected_Graph.Set_Root ((1 => (Add_1, 7))); + Adder_Parse_Parts.Reset; + + Adder_Parse_Parts.Parse (Input1, Actual_Graph); + Adder_Parse_Parts.Parse (Input2, Actual_Graph); + Adder_Parse_Parts.Parse (Input3, Actual_Graph); + Adder_Parse_Parts.Parse (Input4, Actual_Graph); + + if Actual_Graph.Isomorphic (Expected_Graph) then + return Pass; + else + return Fail; + end if; + end Parse_Parts_Check; + + + function Parse_Parts_Left_Check + return Test_Result + is + pragma Polling (On); + + -- 1+2+3+4 + Input1 : String := "1+"; + Input2 : String := "2+3"; + Input3 : String := "+4"; + Input4 : String := ""; + + use Left_Sums; + Sum_P : Parser_Tokens.Token_Type := Parser_Tokens.Create (Sum, 1, "+"); + Sum_E : Parser_Tokens.Token_Type := Parser_Tokens.Create (Sum, 1, ""); + Number_1 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number, 1, "1"); + Number_3 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number, 3, "2"); + Number_5 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number, 5, "3"); + Number_7 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number, 7, "4"); + + Expected_Graph, Actual_Graph : Parser_Result; + begin + Expected_Graph.Connect ((Sum_E, 1), + (1 => (Number_1, 1))); + Expected_Graph.Connect ((Sum_P, 3), + ((Sum_E, 1), (Number_3, 3))); + Expected_Graph.Connect ((Sum_P, 5), + ((Sum_P, 3), (Number_5, 5))); + Expected_Graph.Connect ((Sum_P, 7), + ((Sum_P, 5), (Number_7, 7))); + + Expected_Graph.Set_Root ((1 => (Sum_P, 7))); + Add_Parse_Parts.Reset; + + Add_Parse_Parts.Parse (Input1, Actual_Graph); + Add_Parse_Parts.Parse (Input2, Actual_Graph); + Add_Parse_Parts.Parse (Input3, Actual_Graph); + Add_Parse_Parts.Parse (Input4, Actual_Graph); + + if Actual_Graph.Isomorphic (Expected_Graph) then + return Pass; + else + return Fail; + end if; + end Parse_Parts_Left_Check; + + + function Parse_Parts_Exception_Check + return Test_Result + is + pragma Polling (On); + use type Packrat.Errors.Error_Info_Array; + + -- 1+2+ 3+4 + Input1 : String := "1+"; + Input2 : String := "2+ 3"; + Input3 : String := "+4"; + Input4 : String := ""; + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"EOF_ERR", 2), (+"EOF_ERR", 4), (+"NUMBER_ERR", 5), (+"SUM_ERR", 5)); + Result_Graph : Add_Errors.Parser_Result; + begin + Adder_Parse_Parts.Reset; + Adder_Parse_Parts.Parse (Input1, Result_Graph); + Adder_Parse_Parts.Parse (Input2, Result_Graph); + Adder_Parse_Parts.Parse (Input3, Result_Graph); + Adder_Parse_Parts.Parse (Input4, Result_Graph); + return Fail; + exception + when Msg : Packrat.Parser_Error => + if Packrat.Errors.Equivalent + (Packrat.Errors.Decode (Except.Exception_Message (Msg)), Expected_Errors) + then + return Pass; + else + return Fail; + end if; + end Parse_Parts_Exception_Check; + + function Parse_Once_Check return Test_Result is @@ -1050,10 +1178,13 @@ package body Rat_Tests.Parsers is return Fail; exception when Msg : Packrat.Parser_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + if Packrat.Errors.Equivalent + (Packrat.Errors.Decode (Except.Exception_Message (Msg)), Expected_Errors) + then + return Pass; + else return Fail; end if; - return Pass; end Parse_Once_Exception_Check; diff --git a/test/rat_tests-parsers.ads b/test/rat_tests-parsers.ads index 198b622..bca6e30 100644 --- a/test/rat_tests-parsers.ads +++ b/test/rat_tests-parsers.ads @@ -72,11 +72,17 @@ package Rat_Tests.Parsers is (+"Not_Empty", Not_Empty_Check'Access)); + function Parse_Parts_Check return Test_Result; + function Parse_Parts_Left_Check return Test_Result; + function Parse_Parts_Exception_Check return Test_Result; function Parse_Once_Check return Test_Result; function Parse_Once_Exception_Check return Test_Result; Parser_Tests : Test_Array := - ((+"Parse_Once", Parse_Once_Check'Access), + ((+"Parse_Parts", Parse_Parts_Check'Access), + (+"Parse_Parts Left Recursive", Parse_Parts_Left_Check'Access), + (+"Parse_Parts Exception", Parse_Parts_Exception_Check'Access), + (+"Parse_Once", Parse_Once_Check'Access), (+"Parse_Once Exception", Parse_Once_Exception_Check'Access)); @@ -151,6 +157,7 @@ private function Add_Expr is new Left_Sums.Parsers.Sequence_2 (Add, Left_Sums.Parsers.End_Of_Input); package Add_Parse_Once is new Left_Sums.Parsers.Parse_Once (Add_Expr); + package Add_Parse_Parts is new Left_Sums.Parsers.Parse_Parts (Add_Expr); @@ -167,20 +174,20 @@ private function Stamper_Number is new Add_Errors.Parsers.Stamp (Number_Err, Sater_Digit); function Matcher_Plus is new Add_Errors.Parsers.Match ('+'); - function Stamper_Plus is new Add_Errors.Parsers.Stamp (Plus_Err, Matcher_Plus); - function Ignorer_Plus is new Add_Errors.Parsers.Ignore (Stamper_Plus); + function Discarder_Plus is new Add_Errors.Parsers.Discard (Plus_Err, Matcher_Plus); function Sumer_Plus is new Add_Errors.Parsers.Sequence - ((Adder_Redir.Call'Access, Ignorer_Plus'Access, Stamper_Number'Access)); + ((Stamper_Number'Access, Discarder_Plus'Access, Adder_Redir.Call'Access)); function Sumer_Choice is new Add_Errors.Parsers.Choice ((Sumer_Plus'Access, Stamper_Number'Access)); function Sumer is new Add_Errors.Parsers.Stamp (Sum_Err, Sumer_Choice); - function Stamper_End is new Add_Errors.Parsers.Stamp (Eof_Err, Add_Errors.Parsers.End_Of_Input); - function Ignorer_End is new Add_Errors.Parsers.Ignore (Stamper_End); - function Sumer_Expr is new Add_Errors.Parsers.Sequence_2 (Sumer, Ignorer_End); + function Discarder_End is new Add_Errors.Parsers.Discard + (Eof_Err, Add_Errors.Parsers.End_Of_Input); + function Sumer_Expr is new Add_Errors.Parsers.Sequence_2 (Sumer, Discarder_End); package Adder_Parse_Once is new Add_Errors.Parsers.Parse_Once (Sumer_Expr); + package Adder_Parse_Parts is new Add_Errors.Parsers.Parse_Parts (Sumer_Expr); |