aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/packrat-errors-parts.adb95
-rw-r--r--src/packrat-errors.adb196
-rw-r--r--src/packrat.ads11
-rw-r--r--test/ratnest-tests.adb4
4 files changed, 294 insertions, 12 deletions
diff --git a/src/packrat-errors-parts.adb b/src/packrat-errors-parts.adb
new file mode 100644
index 0000000..5ad3482
--- /dev/null
+++ b/src/packrat-errors-parts.adb
@@ -0,0 +1,95 @@
+
+
+with
+
+ Ada.Strings.Fixed,
+ Ada.Strings.Maps;
+
+use type
+
+ Ada.Strings.Maps.Character_Set;
+
+
+separate (Packrat.Errors)
+package body Parts is
+
+
+ package Str renames Ada.Strings;
+ package Fix renames Ada.Strings.Fixed;
+ package Map renames Ada.Strings.Maps;
+
+
+ ID_Start, ID_Finish : Positive := 1;
+ Pos_Start, Pos_Finish : Positive := 1;
+ Error_Count : Natural := Fix.Count (Message, Map.To_Set ('s'));
+
+
+ Letter_Range : Map.Character_Range := ('A', 'Z');
+ Digit_Range : Map.Character_Range := ('0', '9');
+ ID_Set : Map.Character_Set := Map.To_Set (Letter_Range) or Map.To_Set ('_');
+ Pos_Set : Map.Character_Set := Map.To_Set (Digit_Range);
+
+
+ function Length
+ return Natural is
+ begin
+ return Error_Count;
+ end Length;
+
+
+ procedure Reset_Position is
+ begin
+ ID_Start := 1;
+ ID_Finish := 1;
+ Pos_Start := 1;
+ Pos_Finish := 1;
+ end Reset_Position;
+
+
+ procedure Set_Position
+ (To : in Positive) is
+ begin
+ ID_Start := To;
+ ID_Finish := To;
+ Pos_Start := To;
+ Pos_Finish := To;
+ end Set_Position;
+
+
+ procedure Next_ID_Token
+ (Start : out Positive;
+ Finish : out Natural) is
+ begin
+ Fix.Find_Token (Message, ID_Set, Pos_Finish, Str.Inside, ID_Start, ID_Finish);
+ Start := ID_Start;
+ Finish := ID_Finish;
+ Pos_Finish := ID_Finish;
+ end Next_ID_Token;
+
+
+ procedure Next_Pos_Token
+ (Start : out Positive;
+ Finish : out Natural) is
+ begin
+ Fix.Find_Token (Message, Pos_Set, ID_Finish, Str.Inside, Pos_Start, Pos_Finish);
+ Start := Pos_Start;
+ Finish := Pos_Finish;
+ ID_Finish := Pos_Finish;
+ end Next_Pos_Token;
+
+
+ procedure Next_Full_Token
+ (Start : out Positive;
+ Finish : out Natural)
+ is
+ Dummy : Natural;
+ begin
+ Next_ID_Token (Start, Dummy);
+ Next_Pos_Token (Dummy, Finish);
+ Start := Start - 1;
+ end Next_Full_Token;
+
+
+end Parts;
+
+
diff --git a/src/packrat-errors.adb b/src/packrat-errors.adb
index 44b9202..cb54e97 100644
--- a/src/packrat-errors.adb
+++ b/src/packrat-errors.adb
@@ -1,10 +1,94 @@
+with
+
+ Ada.Strings.Fixed,
+ Ada.Characters.Handling;
+
+
separate (Packrat)
package body Errors is
package SU renames Ada.Strings.Unbounded;
+ package SF renames Ada.Strings.Fixed;
+ package CH renames Ada.Characters.Handling;
+
+
+
+
+
+ function Image
+ (Num : in Natural)
+ return String
+ is
+ Raw : String := Integer'Image (Num);
+ begin
+ return Raw (1 + 1 .. Raw'Length);
+ end Image;
+
+
+ function Is_Upper
+ (Char : in Character)
+ return Boolean is
+ begin
+ return Char >= 'A' and Char <= 'Z';
+ end Is_Upper;
+
+
+ function Is_Lower
+ (Char : in Character)
+ return Boolean is
+ begin
+ return Char >= 'a' and Char <= 'z';
+ end Is_Lower;
+
+
+ function Is_Letter
+ (Char : in Character)
+ return Boolean is
+ begin
+ return Is_Upper (Char) or Is_Lower (Char);
+ end Is_Letter;
+
+
+ function Is_Digit
+ (Char : in Character)
+ return Boolean is
+ begin
+ return Char >= '0' and Char <= '9';
+ end Is_Digit;
+
+
+
+
+
+ generic
+ Message : in String;
+ package Parts is
+
+ function Length
+ return Natural;
+
+ procedure Reset_Position;
+
+ procedure Set_Position
+ (To : in Positive);
+
+ procedure Next_ID_Token
+ (Start : out Positive;
+ Finish : out Natural);
+
+ procedure Next_Pos_Token
+ (Start : out Positive;
+ Finish : out Natural);
+
+ procedure Next_Full_Token
+ (Start : out Positive;
+ Finish : out Natural);
+
+ end Parts;
+ package body Parts is separate;
@@ -14,6 +98,29 @@ package body Errors is
(Check : in String)
return Boolean is
begin
+ if Check'Length < 1 then
+ return False;
+ end if;
+ if not Is_Letter (Check (Check'First)) then
+ return False;
+ end if;
+ for N in Integer range Check'First + 1 .. Check'Last - 1 loop
+ if not Is_Letter (Check (N)) and
+ not Is_Digit (Check (N)) and
+ Check (N) /= '_'
+ then
+ return False;
+ end if;
+ if Check (N) = '_' and
+ ((not Is_Letter (Check (N - 1)) and not Is_Digit (Check (N - 1))) or
+ (not Is_Letter (Check (N + 1)) and not Is_Digit (Check (N + 1))))
+ then
+ return False;
+ end if;
+ end loop;
+ if not Is_Letter (Check (Check'Last)) and not Is_Digit (Check (Check'Last)) then
+ return False;
+ end if;
return True;
end Valid_Identifier;
@@ -22,7 +129,7 @@ package body Errors is
(Check : in SU.Unbounded_String)
return Boolean is
begin
- return True;
+ return Valid_Identifier (-Check);
end Valid_Identifier;
@@ -30,14 +137,46 @@ package body Errors is
(Check : in Error_Info_Array)
return Boolean is
begin
+ for EI of Check loop
+ if not Valid_Identifier (-EI.Symbol) then
+ return False;
+ end if;
+ end loop;
return True;
end Valid_Identifier_Array;
function Valid_Message
(Check : in String)
- return Boolean is
+ return Boolean
+ is
+ S_Place, P_Place : Natural := 1;
begin
+ while S_Place <= Check'Length loop
+ if Check (S_Place) /= 's' then
+ return False;
+ end if;
+ P_Place := SF.Index (Check, "p", S_Place);
+ if (P_Place < S_Place) then
+ return False;
+ end if;
+ declare
+ ID : String := Check (S_Place + 1 .. P_Place - 1);
+ begin
+ if not Valid_Identifier (ID) or ID /= CH.To_Upper (ID) then
+ return False;
+ end if;
+ end;
+ P_Place := P_Place + 1;
+ if P_Place > Check'Length or else not Is_Digit (Check (P_Place)) then
+ return False;
+ end if;
+ loop
+ P_Place := P_Place + 1;
+ exit when P_Place > Check'Length or else not Is_Digit (Check (P_Place));
+ end loop;
+ S_Place := P_Place;
+ end loop;
return True;
end Valid_Message;
@@ -47,9 +186,32 @@ package body Errors is
function Join
(Left, Right : in Error_Message)
- return Error_Message is
+ return Error_Message
+ is
+ package Left_Parts is new Parts (Left);
+ package Right_Parts is new Parts (Right);
+
+ LS, LF, RS, RF : Natural;
+ Add : Boolean;
+
+ Result : SU.Unbounded_String := +Left;
begin
- return "";
+ for R in Integer range 1 .. Right_Parts.Length loop
+ Add := True;
+ Right_Parts.Next_Full_Token (RS, RF);
+ for L in Integer range 1 .. Left_Parts.Length loop
+ Left_Parts.Next_Full_Token (LS, LF);
+ if Left (LS .. LF) = Right (RS .. RF) then
+ Add := False;
+ exit;
+ end if;
+ end loop;
+ if Add then
+ SU.Append (Result, +Right (RS .. RF));
+ end if;
+ Left_Parts.Reset_Position;
+ end loop;
+ return -Result;
end Join;
@@ -61,7 +223,7 @@ package body Errors is
Pos : in Natural)
return Error_Message is
begin
- return "";
+ return "s" & CH.To_Upper (Name) & "p" & Image (Pos);
end Encode;
@@ -70,7 +232,7 @@ package body Errors is
Pos : in Natural)
return Error_Message is
begin
- return "";
+ return Encode (-Name, Pos);
end Encode;
@@ -78,15 +240,20 @@ package body Errors is
(Info : in Error_Info)
return Error_Message is
begin
- return "";
+ return Encode (-Info.Symbol, Info.Position);
end Encode;
function Encode_Array
(Info : in Error_Info_Array)
- return Error_Message is
+ return Error_Message
+ is
+ Result : SU.Unbounded_String := SU.To_Unbounded_String (0);
begin
- return "";
+ for EI of Info loop
+ SU.Append (Result, (Encode (-EI.Symbol, EI.Position)));
+ end loop;
+ return -Result;
end Encode_Array;
@@ -94,8 +261,17 @@ package body Errors is
(Msg : in Error_Message)
return Error_Info_Array
is
- Result : Error_Info_Array (1 .. 0);
+ package Msg_Parts is new Parts (Msg);
+
+ Result : Error_Info_Array (1 .. Msg_Parts.Length);
+ Start, Finish : Natural;
begin
+ for EI of Result loop
+ Msg_Parts.Next_ID_Token (Start, Finish);
+ EI.Symbol := +Msg (Start .. Finish);
+ Msg_Parts.Next_Pos_Token (Start, Finish);
+ EI.Position := Integer'Value (Msg (Start .. Finish));
+ end loop;
return Result;
end Decode;
diff --git a/src/packrat.ads b/src/packrat.ads
index 628923f..1c81958 100644
--- a/src/packrat.ads
+++ b/src/packrat.ads
@@ -91,6 +91,17 @@ package Packrat is
private
+ function "+"
+ (S : in String)
+ return Ada.Strings.Unbounded.Unbounded_String
+ renames Ada.Strings.Unbounded.To_Unbounded_String;
+
+ function "-"
+ (US : in Ada.Strings.Unbounded.Unbounded_String)
+ return String
+ renames Ada.Strings.Unbounded.To_String;
+
+
end Packrat;
diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb
index 2e3478a..df17775 100644
--- a/test/ratnest-tests.adb
+++ b/test/ratnest-tests.adb
@@ -28,7 +28,7 @@ package body Ratnest.Tests is
PE.Valid_Message ("sSYMp1.2") or PE.Valid_Message ("sABcDp12") or
not PE.Valid_Message ("sSYMp0") or not PE.Valid_Message ("sAp12") or
not PE.Valid_Message ("sNAMEp34sSYMp02") or not PE.Valid_Message ("") or
- not PE.Valid_Message ("sA_Bp3")
+ not PE.Valid_Message ("sA_Bp3") or not PE.Valid_Message ("sAp1sAp1")
then
return Failure;
end if;
@@ -42,7 +42,7 @@ package body Ratnest.Tests is
Pass_Array : PE.Error_Info_Array :=
((+"A", 1), (+"ABC", 2), (+"AB_CD", 3), (+"A_B_CD", 4));
Fail_Array : PE.Error_Info_Array :=
- ((+"_", 1), (+"_A", 2), (+"A_", 3), (+"A__B", 4));
+ ((+"_", 1), (+"_A", 2), (+"A_", 3), (+"A__B", 4), (+"A%B", 3));
begin
for EI of Pass_Array loop
if not PE.Valid_Identifier (EI.Symbol) or
generated by cgit (git 2.30.0) at 2025-10-31 02:43:13 +0000