From 42d3982f1e6335cb99c382ddd91c324e5fa458ad Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 20 Apr 2020 15:49:56 +1000 Subject: Updated and fixed tests, fixed Pass_Forward array sliding bug --- src/packrat-lexer.adb | 64 +++++++++++++++++------------ src/packrat-lexer.ads | 8 ---- test/packrat-lexer-debug.adb | 11 ++++- test/packrat-lexer-debug.ads | 6 ++- test/ratnest-tests-lexer.adb | 93 +++++++++++++++++++++++-------------------- test/ratnest-tests-tokens.adb | 17 ++++---- test/test_main.adb | 4 +- 7 files changed, 112 insertions(+), 91 deletions(-) diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb index 319e05c..bd8d7ea 100644 --- a/src/packrat-lexer.adb +++ b/src/packrat-lexer.adb @@ -170,6 +170,36 @@ package body Packrat.Lexer is end Token_Vector_To_Array; + function Slide + (Input : in Element_Array) + return Element_Array + is + subtype Slider is Element_Array (1 .. Input'Length); + begin + return Slider (Input); + end Slide; + + + procedure Internal_Scan_Core + (Input : in Element_Array; + Context : in out Lexer_Context; + Components : in Component_Array) + is + Raise_Error : Boolean; + begin + Raise_Error := True; + for C of Components loop + if C (Input, Context) = Component_Success then + Raise_Error := False; + exit; + end if; + end loop; + if Raise_Error then + Raise_Lexer_Error (Context.Error_Labels, Context.Position); + end if; + end Internal_Scan_Core; + + @@ -181,7 +211,7 @@ package body Packrat.Lexer is Real_Input : Input_Holders.Holder; begin if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Context.Pass_Forward.Element & Input); + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); else Real_Input.Replace_Element (Input); end if; @@ -206,7 +236,7 @@ package body Packrat.Lexer is Real_Input : Input_Holders.Holder; begin if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Context.Pass_Forward.Element & Input); + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); else Real_Input.Replace_Element (Input); end if; @@ -236,7 +266,8 @@ package body Packrat.Lexer is Real_Input.Replace_Element (Input.all); Empty_Input := Real_Input.Element'Length = 0; if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Context.Pass_Forward.Element & Real_Input.Element); + Real_Input.Replace_Element + (Slide (Context.Pass_Forward.Element) & Real_Input.Element); end if; Tidy_Context (Context, Components'Length); @@ -262,7 +293,7 @@ package body Packrat.Lexer is Real_Input : Input_Holders.Holder; begin if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Context.Pass_Forward.Element & Input); + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); else Real_Input.Replace_Element (Input); end if; @@ -298,10 +329,11 @@ package body Packrat.Lexer is Context.Result_So_Far.Clear; loop Real_Input.Replace_Element (Input.all); - Empty_Input := Real_Input.Element'Length = 0 or + Empty_Input := Real_Input.Element'Length = 0 or else Real_Input.Element (Real_Input.Element'First) = Pad_In; if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Context.Pass_Forward.Element & Real_Input.Element); + Real_Input.Replace_Element + (Slide (Context.Pass_Forward.Element) & Real_Input.Element); end if; Tidy_Context (Context, Components'Length); @@ -329,26 +361,6 @@ package body Packrat.Lexer is end Scan_Set_With; - procedure Internal_Scan_Core - (Input : in Element_Array; - Context : in out Lexer_Context; - Components : in Component_Array) - is - Raise_Error : Boolean; - begin - Raise_Error := True; - for C of Components loop - if C (Input, Context) = Component_Success then - Raise_Error := False; - exit; - end if; - end loop; - if Raise_Error then - Raise_Lexer_Error (Context.Error_Labels, Context.Position); - end if; - end Internal_Scan_Core; - - diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads index 9973cdd..a797d7f 100644 --- a/src/packrat-lexer.ads +++ b/src/packrat-lexer.ads @@ -315,14 +315,6 @@ private Allow_Incomplete => True); - - - procedure Internal_Scan_Core - (Input : in Element_Array; - Context : in out Lexer_Context; - Components : in Component_Array); - - end Packrat.Lexer; diff --git a/test/packrat-lexer-debug.adb b/test/packrat-lexer-debug.adb index d4cc2e2..f6c57ef 100644 --- a/test/packrat-lexer-debug.adb +++ b/test/packrat-lexer-debug.adb @@ -67,11 +67,18 @@ package body Packrat.Lexer.Debug is return This.Status; end Status; + function Has_Pass + (This : in Lexer_Context) + return Boolean is + begin + return not This.Pass_Forward.Is_Empty; + end Has_Pass; + function Pass (This : in Lexer_Context) - return access Element_Array is + return Element_Array is begin - return This.Pass_Forward; + return This.Pass_Forward.Element; end Pass; function Length diff --git a/test/packrat-lexer-debug.ads b/test/packrat-lexer-debug.ads index a1cb768..05d05b2 100644 --- a/test/packrat-lexer-debug.ads +++ b/test/packrat-lexer-debug.ads @@ -46,9 +46,13 @@ package Packrat.Lexer.Debug is (This : in Lexer_Context) return Result_Status; + function Has_Pass + (This : in Lexer_Context) + return Boolean; + function Pass (This : in Lexer_Context) - return access Element_Array; + return Element_Array; function Length (Vec : in Token_Vector) diff --git a/test/ratnest-tests-lexer.adb b/test/ratnest-tests-lexer.adb index 9728829..dbdf5d6 100644 --- a/test/ratnest-tests-lexer.adb +++ b/test/ratnest-tests-lexer.adb @@ -1,5 +1,9 @@ +with Ada.Text_IO; +use Ada.Text_IO; + + separate (Ratnest.Tests) package body Lexer is @@ -568,17 +572,17 @@ package body Lexer is begin Comp_Code := My_Stamp (Test_Str1, Context1); if (Slebug.So_Far (Context1).Length /= 1 or else - Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, 3, "abc")) or + Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, "abc")) or Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or - Slebug.Pass (Context1) /= null + Slebug.Has_Pass (Context1) then return Fail; end if; Comp_Code := My_Stamp (Test_Str1, Context1); if (Slebug.So_Far (Context1).Length /= 1 or else - Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, 3, "abc")) or + Slebug.So_Far (Context1).Element (1) /= String_Tokens.Create (One, 1, "abc")) or Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or - Slebug.Pass (Context1) /= null + Slebug.Has_Pass (Context1) then return Fail; end if; @@ -586,7 +590,7 @@ package body Lexer is if Slebug.So_Far (Context2).Length /= 0 or Slebug.Position (Context2) /= 1 or Slebug.Status (Context2) /= Packrat.Needs_More or - (Slebug.Pass (Context2) = null or else Slebug.Pass (Context2).all /= "ab") + (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") then return Fail; end if; @@ -613,21 +617,21 @@ package body Lexer is Comp_Code := My_Ignore (Test_Str1, Context1); if Slebug.So_Far (Context1).Length /= 0 or Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or - Slebug.Pass (Context1) /= null + Slebug.Has_Pass (Context1) then return Fail; end if; Comp_Code := My_Ignore (Test_Str1, Context1); if Slebug.So_Far (Context1).Length /= 0 or Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or - Slebug.Pass (Context1) /= null + Slebug.Has_Pass (Context1) then return Fail; end if; Comp_Code := My_Ignore (Test_Str2, Context2); if Slebug.So_Far (Context2).Length /= 0 or Slebug.Position (Context2) /= 1 or Slebug.Status (Context2) /= Packrat.Needs_More or - (Slebug.Pass (Context2) = null or else Slebug.Pass (Context2).all /= "ab") + (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") then return Fail; end if; @@ -666,10 +670,10 @@ package body Lexer is Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Intended_Result1 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, 3, "one"), - 2 => Word_Tokens.Create (Word, 5, 8, "fine")); + (1 => Word_Tokens.Create (Word, 1, "one"), + 2 => Word_Tokens.Create (Word, 5, "fine")); Intended_Result2 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 10, 12, "day")); + (1 => Word_Tokens.Create (Word, 10, "day")); Actual_Result1 : Word_Tokens.Token_Array := My_Scan (Test_Str, Test_Context); @@ -693,9 +697,9 @@ package body Lexer is Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Intended_Result : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, 3, "one"), - 2 => Word_Tokens.Create (Word, 5, 8, "fine"), - 3 => Word_Tokens.Create (Word, 10, 12, "day")); + (1 => Word_Tokens.Create (Word, 1, "one"), + 2 => Word_Tokens.Create (Word, 5, "fine"), + 3 => Word_Tokens.Create (Word, 10, "day")); Actual_Result : Word_Tokens.Token_Array := My_Scan (Test_Str, Test_Context); @@ -731,14 +735,14 @@ package body Lexer is Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Intended_Result : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, 2, "it"), - 2 => Word_Tokens.Create (Word, 4, 7, "will"), - 3 => Word_Tokens.Create (Word, 9, 14, "happen"), - 4 => Word_Tokens.Create (Word, 17, 21, "again"), - 5 => Word_Tokens.Create (Word, 23, 25, "and"), - 6 => Word_Tokens.Create (Word, 27, 31, "again"), - 7 => Word_Tokens.Create (Word, 33, 35, "and"), - 8 => Word_Tokens.Create (Word, 37, 41, "again")); + (1 => Word_Tokens.Create (Word, 1, "it"), + 2 => Word_Tokens.Create (Word, 4, "will"), + 3 => Word_Tokens.Create (Word, 9, "happen"), + 4 => Word_Tokens.Create (Word, 17, "again"), + 5 => Word_Tokens.Create (Word, 23, "and"), + 6 => Word_Tokens.Create (Word, 27, "again"), + 7 => Word_Tokens.Create (Word, 33, "and"), + 8 => Word_Tokens.Create (Word, 37, "again")); Actual_Result : Word_Tokens.Token_Array := My_Scan (More_Input'Unrestricted_Access, Test_Context); @@ -755,7 +759,7 @@ package body Lexer is is procedure My_Scan is new Swordy.Scan_Set ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Word_Tokens.Create (Blank, 1, 0, "")); + Latin.EOT, Word_Tokens.Create (Blank, 1, "")); Test_Str1 : String (1 .. 10) := "one tw"; Test_Str2 : String (1 .. 10) := "o three"; @@ -763,16 +767,19 @@ package body Lexer is Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Intended_Result1 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, 3, "one"), - 2 => Word_Tokens.Create (Blank, 1, 0, "")); + (1 => Word_Tokens.Create (Word, 1, "one"), + 2 => Word_Tokens.Create (Blank, 1, ""), + 3 => Word_Tokens.Create (Blank, 1, "")); Intended_Result2 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 9, 11, "two"), - 2 => Word_Tokens.Create (Blank, 1, 0, "")); + (1 => Word_Tokens.Create (Word, 9, "two"), + 2 => Word_Tokens.Create (Blank, 1, ""), + 3 => Word_Tokens.Create (Blank, 1, "")); Intended_Result3 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 16, 20, "three"), - 2 => Word_Tokens.Create (Blank, 1, 0, "")); + (1 => Word_Tokens.Create (Word, 16, "three"), + 2 => Word_Tokens.Create (Blank, 1, ""), + 3 => Word_Tokens.Create (Blank, 1, "")); - Actual_Result : Word_Tokens.Token_Array (1 .. 2); + Actual_Result : Word_Tokens.Token_Array (1 .. 3); begin My_Scan (Test_Str1, Test_Context, Actual_Result); if Actual_Result /= Intended_Result1 then @@ -810,22 +817,22 @@ package body Lexer is procedure My_Scan is new Swordy.Scan_Set_With ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Word_Tokens.Create (Blank, 1, 0, "")); + Latin.EOT, Word_Tokens.Create (Blank, 1, "")); Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; Intended_Result1 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 1, 2, "it"), - 2 => Word_Tokens.Create (Word, 4, 7, "will"), - 3 => Word_Tokens.Create (Word, 9, 14, "happen"), - 4 => Word_Tokens.Create (Word, 16, 20, "again"), - 5 => Word_Tokens.Create (Word, 22, 24, "and")); + (1 => Word_Tokens.Create (Word, 1, "it"), + 2 => Word_Tokens.Create (Word, 4, "will"), + 3 => Word_Tokens.Create (Word, 9, "happen"), + 4 => Word_Tokens.Create (Word, 16, "again"), + 5 => Word_Tokens.Create (Word, 22, "and")); Intended_Result2 : Word_Tokens.Token_Array := - (1 => Word_Tokens.Create (Word, 26, 30, "again"), - 2 => Word_Tokens.Create (Word, 32, 34, "and"), - 3 => Word_Tokens.Create (Word, 36, 40, "again"), - 4 => Word_Tokens.Create (Blank, 1, 0, ""), - 5 => Word_Tokens.Create (Blank, 1, 0, "")); + (1 => Word_Tokens.Create (Word, 26, "again"), + 2 => Word_Tokens.Create (Word, 32, "and"), + 3 => Word_Tokens.Create (Word, 36, "again"), + 4 => Word_Tokens.Create (Blank, 1, ""), + 5 => Word_Tokens.Create (Blank, 1, "")); Actual_Result : Word_Tokens.Token_Array (1 .. 5); begin @@ -944,7 +951,7 @@ package body Lexer is procedure My_Scan is new Swordy.Scan_Set ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Word_Tokens.Create (Blank, 1, 0, "")); + Latin.EOT, Word_Tokens.Create (Blank, 1, "")); Test_Str : String := "()()"; Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; @@ -984,7 +991,7 @@ package body Lexer is procedure My_Scan is new Swordy.Scan_Set_With ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Word_Tokens.Create (Blank, 1, 0, "")); + Latin.EOT, Word_Tokens.Create (Blank, 1, "")); Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; diff --git a/test/ratnest-tests-tokens.adb b/test/ratnest-tests-tokens.adb index 7a2588a..41969fd 100644 --- a/test/ratnest-tests-tokens.adb +++ b/test/ratnest-tests-tokens.adb @@ -17,11 +17,11 @@ package body Tokens is A : My_Tokens.Token; begin declare - B : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc"); + B : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); begin A := B; end; - if not A.Initialized or else A.Value /= "abc" then + if My_Tokens.Value (A) /= "abc" then return Fail; end if; return Pass; @@ -35,8 +35,8 @@ package body Tokens is return Test_Result is use type My_Tokens.Token; - A : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc"); - B : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc"); + A : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); + B : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); begin if A /= B then return Fail; @@ -51,12 +51,11 @@ package body Tokens is function Store_Check return Test_Result is - T : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc"); + T : My_Tokens.Token := My_Tokens.Create (One, 1, "abc"); begin - if not T.Initialized or else - T.Label /= One or else - T.Start /= 1 or else T.Finish /= 3 or else - T.Value /= "abc" + if My_Tokens.Label (T) /= One or else + My_Tokens.Start (T) /= 1 or else + My_Tokens.Value (T) /= "abc" then return Fail; end if; diff --git a/test/test_main.adb b/test/test_main.adb index c741a93..a5d5fc5 100644 --- a/test/test_main.adb +++ b/test/test_main.adb @@ -20,7 +20,7 @@ procedure Test_Main is package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); Err : Packrat.Errors.Error_Message := Packrat.Errors.Encode ("A", 1); - Tok : My_Tokens.Token := My_Tokens.Create (A, 1, 3, "abc"); + Tok : My_Tokens.Token := My_Tokens.Create (A, 1, "abc"); begin @@ -37,7 +37,7 @@ begin Run_Tests (Tokens.Tests); New_Line; Put_Line ("Displaying Token debug string output example:"); - Put (Tok.Debug_String); + Put (My_Tokens.Debug_String (Tok)); New_Line; Put_Line ("Running tests for Packrat.Lexer combinators..."); -- cgit