Parser tests, left recursion test

5 files changed, 207 insertions, 13 deletions

diff --git a/curtail.txt b/curtail.txt
index ff418ec..38fd238 100644
--- a/curtail.txt
+++ b/curtail.txt
@@ -1,14 +1,11 @@
 
 
-Scratch space for notes about curtailment
-
-
-
 all results must track curtails
  - done
 
 when merging two results that have curtails for the same combinator, use the smaller curtail
  - done
+ - actually, shouldn't this be the opposite, given that curtails stand for the highest level that a result is valid at?
 
 when updating a result, replace the curtails with the leftrec level for the current context
  - done
@@ -19,5 +16,9 @@ ignore a previous result when the current leftrec level is less than the previou
 the function to check if reusable needs to take into account a +1 for the combinator being currently memoized
  - done
 
+when depth of a curtail is less than or equal to remaining tokens of input after the furthest finish of a result, that curtail can be deleted?
+
+when depth of curtail plus remaining tokens after furthest finish of a result is less than or equal to total input tokens plus one, curtail can be deleted from a result
+
 
 
diff --git a/src/packrat-parsers.adb b/src/packrat-parsers.adb
index 01c4677..7c89984 100644
--- a/src/packrat-parsers.adb
+++ b/src/packrat-parsers.adb
@@ -602,12 +602,15 @@ package body Packrat.Parsers is
             Processed : Result_Sets.Set;
         begin
             if Salt.Status = Failure then
-                Ada.Strings.Unbounded.Append
-                   (Context.Error_String,
-                    Packrat.Errors.Encode (Traits.Label_Enum'Image (Label), Start));
+                declare
+                    Error : String := Packrat.Errors.Encode
+                        (Traits.Label_Enum'Image (Label), Start);
+                begin
+                    if Ada.Strings.Unbounded.Index (Context.Error_String, Error) = 0 then
+                        Ada.Strings.Unbounded.Append (Context.Error_String, Error);
+                    end if;
+                end;
                 return Salt;
-            else
-                Context.Error_String := +"";
             end if;
             for R of Salt.Results loop
                 Current :=
diff --git a/test/rat_tests-parsers.adb b/test/rat_tests-parsers.adb
index 2178097..8d54168 100644
--- a/test/rat_tests-parsers.adb
+++ b/test/rat_tests-parsers.adb
@@ -1000,6 +1000,66 @@ package body Rat_Tests.Parsers is
 
 
 
+    function Parse_Once_Check
+        return Test_Result
+    is
+        pragma Polling (On);
+
+        Input : String := "1+2+3";
+
+        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_2 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number, 3, "2");
+        Number_3 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number, 5, "3");
+
+        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_2, 3)));
+        Expected_Graph.Connect ((Sum_P, 5),
+            ((Sum_P, 3), (Number_3, 5)));
+
+        Expected_Graph.Set_Root ((1 => (Sum_P, 5)));
+        Add_Parse_Once.Reset;
+
+        Actual_Graph := Add_Parse_Once.Parse (Input);
+        if Actual_Graph.Isomorphic (Expected_Graph) then
+            return Pass;
+        else
+            return Fail;
+        end if;
+    end Parse_Once_Check;
+
+
+    function Parse_Once_Exception_Check
+        return Test_Result
+    is
+        pragma Polling (On);
+        use type Packrat.Errors.Error_Info_Array;
+        Input : String := "1 + 2";
+        Expected_Errors : Packrat.Errors.Error_Info_Array :=
+            ((+"PLUS_ERR", 2), (+"EOF_ERR", 2));
+        Result_Graph : Add_Errors.Parser_Result;
+    begin
+        Adder_Parse_Once.Reset;
+        Result_Graph := Adder_Parse_Once.Parse (Input);
+        return Fail;
+    exception
+        when Msg : Packrat.Parser_Error =>
+            if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then
+                return Fail;
+            end if;
+            return Pass;
+    end Parse_Once_Exception_Check;
+
+
+
+
+
     function Default_Result_Check
         return Test_Result
     is
@@ -1015,6 +1075,52 @@ package body Rat_Tests.Parsers is
     end Default_Result_Check;
 
 
+    function Left_Recursion_Check
+        return Test_Result
+    is
+        pragma Polling (On);
+
+        Input : String := "1-2-3";
+
+        use Left_Sums;
+        Sum_M : 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_2 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number, 3, "2");
+        Number_3 : Parser_Tokens.Token_Type := Parser_Tokens.Create (Number, 5, "3");
+
+        Expected_Graph, Actual_Graph : Parser_Result;
+    begin
+        Expected_Graph.Connect ((Sum_E, 1),
+            (1 => (Number_1, 1)));
+        Expected_Graph.Connect ((Sum_M, 3),
+            ((Sum_E, 1), (Number_2, 3)));
+        Expected_Graph.Connect ((Sum_M, 5),
+            ((Sum_M, 3), (Number_3, 5)));
+
+        Expected_Graph.Set_Root ((1 => (Sum_M, 5)));
+        Sum_Parse_Once.Reset;
+
+        Actual_Graph := Sum_Parse_Once.Parse (Input);
+        if Actual_Graph.Isomorphic (Expected_Graph) then
+            return Pass;
+        else
+            return Fail;
+        end if;
+    end Left_Recursion_Check;
+
+
+
+
+
+begin
+
+
+    Sum_Redir.Set (Sum'Access);
+    Add_Redir.Set (Add'Access);
+    Adder_Redir.Set (Sumer'Access);
+
+
 end Rat_Tests.Parsers;
 
 
diff --git a/test/rat_tests-parsers.ads b/test/rat_tests-parsers.ads
index 5a2d15f..198b622 100644
--- a/test/rat_tests-parsers.ads
+++ b/test/rat_tests-parsers.ads
@@ -14,6 +14,7 @@ use
 private with
 
     Packrat.No_Lex,
+    Packrat.Utilities,
     Packrat.Parsers.Debug,
     Packrat.Errors,
     Packrat.Traits;
@@ -71,10 +72,20 @@ package Rat_Tests.Parsers is
         (+"Not_Empty", Not_Empty_Check'Access));
 
 
+    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_Once Exception", Parse_Once_Exception_Check'Access));
+
+
     function Default_Result_Check return Test_Result;
+    function Left_Recursion_Check return Test_Result;
 
     Other_Tests : Test_Array :=
-       (1 => (+"Default Combinator Result", Default_Result_Check'Access));
+       ((+"Default Combinator Result", Default_Result_Check'Access),
+        (+"Left Recursion", Left_Recursion_Check'Access));
 
 
 private
@@ -88,8 +99,6 @@ private
     package One_Debug is new Pone.Parsers.Debug;
 
 
-
-
     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");
@@ -106,6 +115,76 @@ private
 
 
 
+    type Add_Sub_Labels is (Sum, Number);
+
+    package Left_Sums is new Packrat.No_Lex
+        (Add_Sub_Labels, Character, String);
+
+
+    package Sum_Redir is new Left_Sums.Parsers.Redirect;
+
+    function Sat_Digit is new Left_Sums.Parsers.Satisfy (Packrat.Utilities.Is_Digit);
+    function Factor is new Left_Sums.Parsers.Stamp (Number, Sat_Digit);
+
+    function Match_Plus is new Left_Sums.Parsers.Match ('+');
+    function Match_Minus is new Left_Sums.Parsers.Match ('-');
+    function Sum_Plus is new Left_Sums.Parsers.Sequence
+        ((Sum_Redir.Call'Access, Match_Plus'Access, Factor'Access));
+    function Sum_Minus is new Left_Sums.Parsers.Sequence
+        ((Sum_Redir.Call'Access, Match_Minus'Access, Factor'Access));
+    function Sum_Choice is new Left_Sums.Parsers.Choice
+        ((Sum_Plus'Access, Sum_Minus'Access, Factor'Access));
+    function Sum is new Left_Sums.Parsers.Stamp (Sum, Sum_Choice);
+
+    function Sum_Expr is new Left_Sums.Parsers.Sequence_2 (Sum, Left_Sums.Parsers.End_Of_Input);
+
+    package Sum_Parse_Once is new Left_Sums.Parsers.Parse_Once (Sum_Expr);
+
+
+    package Add_Redir is new Left_Sums.Parsers.Redirect;
+
+    function Add_Plus is new Left_Sums.Parsers.Sequence
+        ((Add_Redir.Call'Access, Match_Plus'Access, Factor'Access));
+    function Add_Choice is new Left_Sums.Parsers.Choice_2 (Add_Plus, Factor);
+    function Add is new Left_Sums.Parsers.Stamp (Sum, Add_Choice);
+
+    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);
+
+
+
+
+    type Add_Error_Labels is (Sum_Err, Plus_Err, Number_Err, Eof_Err);
+
+    package Add_Errors is new Packrat.No_Lex
+        (Add_Error_Labels, Character, String);
+
+
+    package Adder_Redir is new Add_Errors.Parsers.Redirect;
+
+    function Sater_Digit is new Add_Errors.Parsers.Satisfy (Packrat.Utilities.Is_Digit);
+    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 Sumer_Plus is new Add_Errors.Parsers.Sequence
+        ((Adder_Redir.Call'Access, Ignorer_Plus'Access, Stamper_Number'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);
+
+    package Adder_Parse_Once is new Add_Errors.Parsers.Parse_Once (Sumer_Expr);
+
+
+
+
     function Alphanum_Switch
            (Char : in Character)
         return Character;
diff --git a/test/test_main.adb b/test/test_main.adb
index 0aafaf2..6e59445 100644
--- a/test/test_main.adb
+++ b/test/test_main.adb
@@ -3,6 +3,9 @@
 --  This source is licensed under the Sunset License v1.0
 
 
+pragma Polling (On);
+
+
 with
 
     Ada.Text_IO,
@@ -109,8 +112,10 @@ begin
     Put_Line ("Running tests for Packrat.Parsers...");
     Put_Line ("Testing parser combinators...");
     Run_Tests (Rat_Tests.Parsers.Combinator_Tests, How_Verbose);
+    Put_Line ("Testing parser parsers...");
+    Run_Tests (Rat_Tests.Parsers.Parser_Tests, How_Verbose);
     Put_Line ("Testing other tests...");
-    Run_Tests (Rat_Tests.Parsers.Other_Tests, How_Verbose);
+    Run_Tests (Rat_Tests.Parsers.Other_Tests, How_Verbose, 2.0);
 
 
 end Test_Main;