summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2020-12-25 22:13:59 +1100
committerJed Barber <jjbarber@y7mail.com>2020-12-25 22:13:59 +1100
commitdd9121ec8d91784e6cea4e71cd1fe5c3735d81d8 (patch)
treeb8447cdadc2adc5026a78a4240e3e111f9423999
parent9d5eccf7d6662e897eaa1b6b5f16fba0aa5a5f38 (diff)
Parser tests, left recursion test
-rw-r--r--curtail.txt9
-rw-r--r--src/packrat-parsers.adb13
-rw-r--r--test/rat_tests-parsers.adb106
-rw-r--r--test/rat_tests-parsers.ads85
-rw-r--r--test/test_main.adb7
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;