Piecewise parsing fixed, unit tested

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);