diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/rat_tests-parsers.adb | 106 | ||||
| -rw-r--r-- | test/rat_tests-parsers.ads | 85 | ||||
| -rw-r--r-- | test/test_main.adb | 7 |
3 files changed, 194 insertions, 4 deletions
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; |