summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2020-04-20 15:49:56 +1000
committerJed Barber <jjbarber@y7mail.com>2020-04-20 15:49:56 +1000
commit42d3982f1e6335cb99c382ddd91c324e5fa458ad (patch)
treefe7208dc36dd42d82552d7d1044d9ebb6a4ea570
parentd8e6a2bcf74f1059f83c681e646fd8a22876e737 (diff)
Updated and fixed tests, fixed Pass_Forward array sliding bug
-rw-r--r--src/packrat-lexer.adb64
-rw-r--r--src/packrat-lexer.ads8
-rw-r--r--test/packrat-lexer-debug.adb11
-rw-r--r--test/packrat-lexer-debug.ads6
-rw-r--r--test/ratnest-tests-lexer.adb93
-rw-r--r--test/ratnest-tests-tokens.adb17
-rw-r--r--test/test_main.adb4
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...");