From dd9121ec8d91784e6cea4e71cd1fe5c3735d81d8 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 25 Dec 2020 22:13:59 +1100 Subject: Parser tests, left recursion test --- curtail.txt | 9 ++-- src/packrat-parsers.adb | 13 +++--- test/rat_tests-parsers.adb | 106 +++++++++++++++++++++++++++++++++++++++++++++ test/rat_tests-parsers.ads | 85 ++++++++++++++++++++++++++++++++++-- test/test_main.adb | 7 ++- 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; -- cgit