From 81c4526fa275a256bfefe0f8a7cd638369ea1252 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 28 Nov 2020 16:24:04 +1100 Subject: Cleaned up Lexer, Util package names --- src/packrat-lexer.adb | 686 --------------------------- src/packrat-lexer.ads | 327 ------------- src/packrat-lexers.adb | 686 +++++++++++++++++++++++++++ src/packrat-lexers.ads | 327 +++++++++++++ src/packrat-util.adb | 147 ------ src/packrat-util.ads | 80 ---- src/packrat-utilities.adb | 147 ++++++ src/packrat-utilities.ads | 77 ++++ test/packrat-lexer-debug.adb | 119 ----- test/packrat-lexer-debug.ads | 89 ---- test/packrat-lexers-debug.adb | 119 +++++ test/packrat-lexers-debug.ads | 89 ++++ test/rat_tests-lexer.adb | 1022 ----------------------------------------- test/rat_tests-lexer.ads | 81 ---- test/rat_tests-lexers.adb | 1022 +++++++++++++++++++++++++++++++++++++++++ test/rat_tests-lexers.ads | 81 ++++ test/rat_tests-util.adb | 513 --------------------- test/rat_tests-util.ads | 48 -- test/rat_tests-utilities.adb | 513 +++++++++++++++++++++ test/rat_tests-utilities.ads | 48 ++ test/test_main.adb | 18 +- 21 files changed, 3118 insertions(+), 3121 deletions(-) delete mode 100644 src/packrat-lexer.adb delete mode 100644 src/packrat-lexer.ads create mode 100644 src/packrat-lexers.adb create mode 100644 src/packrat-lexers.ads delete mode 100644 src/packrat-util.adb delete mode 100644 src/packrat-util.ads create mode 100644 src/packrat-utilities.adb create mode 100644 src/packrat-utilities.ads delete mode 100644 test/packrat-lexer-debug.adb delete mode 100644 test/packrat-lexer-debug.ads create mode 100644 test/packrat-lexers-debug.adb create mode 100644 test/packrat-lexers-debug.ads delete mode 100644 test/rat_tests-lexer.adb delete mode 100644 test/rat_tests-lexer.ads create mode 100644 test/rat_tests-lexers.adb create mode 100644 test/rat_tests-lexers.ads delete mode 100644 test/rat_tests-util.adb delete mode 100644 test/rat_tests-util.ads create mode 100644 test/rat_tests-utilities.adb create mode 100644 test/rat_tests-utilities.ads diff --git a/src/packrat-lexer.adb b/src/packrat-lexer.adb deleted file mode 100644 index 486aae5..0000000 --- a/src/packrat-lexer.adb +++ /dev/null @@ -1,686 +0,0 @@ - - -with - - Packrat.Errors; - - -package body Packrat.Lexer is - - - function Join - (Left, Right : in Combinator_Result) - return Combinator_Result is - begin - if Left.Status = Success or Left.Status = Optional_More then - return (Integer'Max (Left.Finish, Right.Finish), Right.Status); - elsif Left.Status = Needs_More then - return (Left.Finish, Failure); - else - return Left; - end if; - end Join; - - - - - - function Stamp - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result - is - Current_Result : Combinator_Result := - Combo (Input, Context.Position); - begin - if Context.Status /= Success or Context.Position > Input'Last or - Context.Empty_Labels.Contains (Label) - then - return Component_Failure; - end if; - - if (Current_Result.Status = Needs_More and not Context.Allow_Incomplete) or - Current_Result.Status = Failure - then - Context.Error_Labels.Append (Label); - return Component_Failure; - end if; - - if (Current_Result.Status = Optional_More and not Context.Allow_Incomplete) or - Current_Result.Status = Success - then - Context.Result_So_Far.Append (Traits.Tokens.Create - (Label, - Context.Position + Context.Offset, - Input (Context.Position .. Current_Result.Finish))); - if Current_Result.Finish = 0 then - Context.Empty_Labels.Insert (Label); - else - Context.Empty_Labels.Clear; - Context.Position := Current_Result.Finish + 1; - end if; - else - Context.Status := Current_Result.Status; - Context.Pass_Forward.Replace_Element - (Input (Context.Position .. Current_Result.Finish)); - Context.Empty_Labels.Clear; - end if; - - Context.Error_Labels.Clear; - return Component_Success; - end Stamp; - - - function Ignore - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result - is - Current_Result : Combinator_Result := - Combo (Input, Context.Position); - begin - if Context.Status /= Success or Context.Position > Input'Last or - Context.Empty_Labels.Contains (Label) - then - return Component_Failure; - end if; - - if (Current_Result.Status = Needs_More and not Context.Allow_Incomplete) or - Current_Result.Status = Failure - then - Context.Error_Labels.Append (Label); - return Component_Failure; - end if; - - if (Current_Result.Status = Optional_More and not Context.Allow_Incomplete) or - Current_Result.Status = Success - then - if Current_Result.Finish = 0 then - Context.Empty_Labels.Insert (Label); - else - Context.Empty_Labels.Clear; - Context.Position := Current_Result.Finish + 1; - end if; - else - Context.Status := Current_Result.Status; - Context.Pass_Forward.Replace_Element - (Input (Context.Position .. Current_Result.Finish)); - Context.Empty_Labels.Clear; - end if; - - Context.Error_Labels.Clear; - return Component_Success; - end Ignore; - - - - - - procedure Tidy_Context - (Details : in out Lexer_Context; - Number_Comp : in Ada.Containers.Count_Type) is - begin - Details.Pass_Forward.Clear; - - Details.Empty_Labels.Clear; - Details.Error_Labels.Clear; - Details.Error_Labels.Reserve_Capacity (Number_Comp); - - Details.Offset := Details.Offset + Details.Position - 1; - Details.Position := 1; - Details.Status := Success; - end Tidy_Context; - - - procedure Raise_Lexer_Error - (Label_List : in Label_Vectors.Vector; - Position : in Positive) - is - Error_Info_List : Packrat.Errors.Error_Info_Array - (Label_List.First_Index .. Label_List.Last_Index); - begin - for I in Integer range Error_Info_List'First .. Error_Info_List'Last loop - Error_Info_List (I).Symbol := +Traits.Label_Enum'Image (Label_List.Element (I)); - Error_Info_List (I).Position := Position; - end loop; - raise Lexer_Error with Packrat.Errors.Encode_Array (Error_Info_List); - end Raise_Lexer_Error; - - - function Token_Vector_To_Array - (Input_Vector : in Token_Vectors.Vector) - return Traits.Tokens.Token_Array - is - Result_Array : Traits.Tokens.Token_Array (1 .. Integer (Input_Vector.Length)); - begin - for I in Integer range 1 .. Integer (Input_Vector.Length) loop - Result_Array (I) := Input_Vector.Element (I); - end loop; - return Result_Array; - end Token_Vector_To_Array; - - - procedure Token_Vector_To_Array - (Input_Vector : in Token_Vectors.Vector; - Padding : in Traits.Tokens.Token; - Output_Array : out Traits.Tokens.Token_Array) is - begin - for N in Integer range 1 .. Output_Array'Length loop - if N <= Integer (Input_Vector.Length) then - Output_Array (Output_Array'First + N - 1) := Input_Vector.Element (N); - else - Output_Array (Output_Array'First + N - 1) := Padding; - end if; - end loop; - end Token_Vector_To_Array; - - - function Slide - (Input : in Traits.Element_Array) - return Traits.Element_Array - is - subtype Slider is Traits.Element_Array (1 .. Input'Length); - begin - return Slider (Input); - end Slide; - - - procedure Internal_Scan_Core - (Input : in Traits.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; - - - - - - function Scan - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array - is - Real_Input : Input_Holders.Holder; - begin - if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); - else - Real_Input.Replace_Element (Input); - end if; - - Tidy_Context (Context, Components'Length); - Context.Result_So_Far.Clear; - Context.Allow_Incomplete := Input'Length > 0; - - while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop - Internal_Scan_Core (Real_Input.Element, Context, Components); - end loop; - - return Token_Vector_To_Array (Context.Result_So_Far); - end Scan; - - - function Scan_Only - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array - is - Real_Input : Input_Holders.Holder; - begin - if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); - else - Real_Input.Replace_Element (Input); - end if; - - Tidy_Context (Context, Components'Length); - Context.Result_So_Far.Clear; - Context.Allow_Incomplete := False; - - while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop - Internal_Scan_Core (Real_Input.Element, Context, Components); - end loop; - - return Token_Vector_To_Array (Context.Result_So_Far); - end Scan_Only; - - - function Scan_With - (Input : in With_Input; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array - is - Real_Input : Input_Holders.Holder; - Empty_Input : Boolean; - begin - Context.Result_So_Far.Clear; - loop - 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 - (Slide (Context.Pass_Forward.Element) & Real_Input.Element); - end if; - - Tidy_Context (Context, Components'Length); - Context.Allow_Incomplete := not Empty_Input; - - while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop - Internal_Scan_Core (Real_Input.Element, Context, Components); - end loop; - - if Empty_Input then - exit; - end if; - end loop; - return Token_Vector_To_Array (Context.Result_So_Far); - end Scan_With; - - - procedure Scan_Set - (Input : in Traits.Element_Array; - Context : in out Lexer_Context; - Output : out Traits.Tokens.Token_Array) - is - Real_Input : Input_Holders.Holder; - begin - if not Context.Pass_Forward.Is_Empty then - Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); - else - Real_Input.Replace_Element (Input); - end if; - - Tidy_Context (Context, Components'Length); - Context.Result_So_Far.Clear; - Context.Allow_Incomplete := not (Input'Length = 0 or else Input (Input'First) = Pad_In); - - while Context.Status = Success and then - Integer (Context.Result_So_Far.Length) < Output'Length and then - Context.Position <= Real_Input.Element'Length and then - Real_Input.Element (Context.Position) /= Pad_In - loop - Internal_Scan_Core (Real_Input.Element, Context, Components); - end loop; - - if Integer (Context.Result_So_Far.Length) = Output'Length then - Context.Pass_Forward.Replace_Element - (Real_Input.Element (Context.Position .. Real_Input.Element'Last)); - end if; - Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output); - end Scan_Set; - - - procedure Scan_Set_With - (Input : in With_Input; - Context : in out Lexer_Context; - Output : out Traits.Tokens.Token_Array) - is - Real_Input : Input_Holders.Holder; - Empty_Input : Boolean; - begin - Context.Result_So_Far.Clear; - loop - Real_Input.Replace_Element (Input.all); - 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 - (Slide (Context.Pass_Forward.Element) & Real_Input.Element); - end if; - - Tidy_Context (Context, Components'Length); - Context.Allow_Incomplete := not Empty_Input; - - while Context.Status = Success and then - Integer (Context.Result_So_Far.Length) < Output'Length and then - Context.Position <= Real_Input.Element'Length and then - Real_Input.Element (Context.Position) /= Pad_In - loop - Internal_Scan_Core (Real_Input.Element, Context, Components); - end loop; - - if Empty_Input then - exit; - end if; - - if Integer (Context.Result_So_Far.Length) = Output'Length then - Context.Pass_Forward.Replace_Element - (Real_Input.Element (Context.Position .. Real_Input.Element'Last)); - exit; - end if; - end loop; - Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output); - end Scan_Set_With; - - - - - - function Sequence - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result - is - Result : Combinator_Result := (0, Success); - Position : Positive := Start; - begin - if Start > Input'Last then - return Empty_Fail; - end if; - for C of Params loop - if Position > Input'Last then - Result.Status := Needs_More; - exit; - end if; - Result := Join (Result, C (Input, Position)); - exit when Result.Status = Failure; - Position := Result.Finish + 1; - end loop; - return Result; - end Sequence; - - - function Count - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result - is - Result : Combinator_Result := (0, Success); - Position : Positive := Start; - begin - if Start > Input'Last then - return Empty_Fail; - end if; - for I in Integer range 1 .. Number loop - if Position > Input'Last then - Result.Status := Needs_More; - exit; - end if; - Result := Join (Result, Param (Input, Position)); - exit when Result.Status = Failure; - Position := Result.Finish + 1; - end loop; - return Result; - end Count; - - - function Many - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result - is - Result : Combinator_Result := (0, Success); - Temp : Combinator_Result; - Position : Positive := Start; - Counter : Natural := 0; - begin - if Start > Input'Last then - return Empty_Fail; - end if; - loop - exit when Position > Input'Last; - Temp := Param (Input, Position); - exit when Temp.Status = Failure or Temp.Status = Needs_More; - Result := Join (Result, Temp); - Counter := Counter + 1; - Position := Result.Finish + 1; - end loop; - if Counter < Minimum then - if Position > Input'Last or Temp.Status = Needs_More then - Result.Status := Needs_More; - else - Result.Status := Failure; - end if; - elsif Position > Input'Last or Temp.Status = Needs_More then - Result.Status := Optional_More; - else - Result.Status := Success; - end if; - return Result; - end Many; - - - function Many_Until - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result - is - Result : Combinator_Result := (0, Success); - Temp : Combinator_Result; - Position : Positive := Start; - Counter : Natural := 0; - begin - if Start > Input'Last then - return Empty_Fail; - end if; - loop - exit when Position > Input'Last; - Temp := Param (Input, Position); - exit when Temp.Status = Failure or Temp.Status = Needs_More or Test (Input (Position)); - Result := Join (Result, Temp); - Counter := Counter + 1; - Position := Result.Finish + 1; - end loop; - if Counter < Minimum then - if Position > Input'Last or Temp.Status = Needs_More then - Result.Status := Needs_More; - else - Result.Status := Failure; - end if; - elsif Position > Input'Last then - Result.Status := Needs_More; - elsif Temp.Status = Needs_More and Test (Input (Position)) then - Result.Status := Optional_More; - elsif Test (Input (Position)) then - Result.Status := Success; - else - Result.Status := Failure; - end if; - return Result; - end Many_Until; - - - - - - function Satisfy - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Test (Input (Start)) then - return (Start, Success); - else - return Empty_Fail; - end if; - end Satisfy; - - - function Satisfy_With - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Test (Change (Input (Start))) then - return (Start, Success); - else - return Empty_Fail; - end if; - end Satisfy_With; - - - function Match - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Input (Start) = Item then - return (Start, Success); - else - return Empty_Fail; - end if; - end Match; - - - function Match_With - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Change (Input (Start)) = Item then - return (Start, Success); - else - return Empty_Fail; - end if; - end Match_With; - - - function Multimatch - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result - is - Current_Offset : Natural := 0; - begin - if Items'Length = 0 then - return (0, Success); - end if; - - if Input'Last - Start + 1 <= 0 then - return Empty_Fail; - end if; - - while Input (Start + Current_Offset) = Items (Items'First + Current_Offset) loop - if Items'First + Current_Offset = Items'Last then - return (Start + Current_Offset, Success); - elsif Start + Current_Offset = Input'Last then - return (Start + Current_Offset, Needs_More); - end if; - Current_Offset := Current_Offset + 1; - end loop; - if Current_Offset = 0 then - return Empty_Fail; - else - return (Start + Current_Offset - 1, Failure); - end if; - end Multimatch; - - - function Take - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Start + Number - 1 > Input'Last then - return (Input'Last, Needs_More); - else - return (Start + Number - 1, Success); - end if; - end Take; - - - function Take_While - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result - is - Finish : Positive := Start; - Status : Result_Status; - begin - if Start > Input'Last or else not Test (Input (Start)) then - return Empty_Fail; - end if; - while Finish <= Input'Last and then Test (Input (Finish)) loop - Finish := Finish + 1; - end loop; - if Finish > Input'Last then - Status := Optional_More; - else - Status := Success; - end if; - return (Finish - 1, Status); - end Take_While; - - - function Take_Until - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result - is - Finish : Positive := Start; - Status : Result_Status; - begin - if Start > Input'Last or else Test (Input (Start)) then - return Empty_Fail; - end if; - while Finish <= Input'Last and then not Test (Input (Finish)) loop - Finish := Finish + 1; - end loop; - if Finish > Input'Last then - Status := Optional_More; - else - Status := Success; - end if; - return (Finish - 1, Status); - end Take_Until; - - - - - - function Line_End - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Input (Start) = EOL_Item then - return (Start, Success); - else - return Empty_Fail; - end if; - end Line_End; - - - function Input_End - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result is - begin - if Start > Input'Last then - return Empty_Fail; - elsif Input (Start) = EOF_Item then - return (Start, Success); - else - return Empty_Fail; - end if; - end Input_End; - - -end Packrat.Lexer; - - diff --git a/src/packrat-lexer.ads b/src/packrat-lexer.ads deleted file mode 100644 index b8090c9..0000000 --- a/src/packrat-lexer.ads +++ /dev/null @@ -1,327 +0,0 @@ - - -with - - Packrat.Traits; - -private with - - Ada.Containers.Vectors, - Ada.Containers.Ordered_Sets; - - -generic - - with package Traits is new Packrat.Traits (<>); - -package Packrat.Lexer is - - - type Combinator_Result is private; - - type Combinator is access function - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - type Combinator_Array is array (Positive range <>) of Combinator; - - - - - type Lexer_Context is private; - - Empty_Context : constant Lexer_Context; - - - - - type Component_Result is private; - - type Component is access function - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result; - - type Component_Array is array (Positive range <>) of Component; - - - - - type With_Input is access function - return Traits.Element_Array; - - - - - generic - Label : in Traits.Label_Enum; - with function Combo - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - function Stamp - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result; - - generic - Label : in Traits.Label_Enum; - with function Combo - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - function Ignore - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Component_Result; - - - - - generic - Components : in Component_Array; - function Scan - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array; - - generic - Components : in Component_Array; - function Scan_Only - (Input : in Traits.Element_Array; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array; - - generic - Components : in Component_Array; - function Scan_With - (Input : in With_Input; - Context : in out Lexer_Context) - return Traits.Tokens.Token_Array; - - generic - Components : in Component_Array; - Pad_In : in Traits.Element_Type; - Pad_Out : in Traits.Tokens.Token; - procedure Scan_Set - (Input : in Traits.Element_Array; - Context : in out Lexer_Context; - Output : out Traits.Tokens.Token_Array); - - generic - Components : in Component_Array; - Pad_In : in Traits.Element_Type; - Pad_Out : in Traits.Tokens.Token; - procedure Scan_Set_With - (Input : in With_Input; - Context : in out Lexer_Context; - Output : out Traits.Tokens.Token_Array); - - - - - generic - Params : in Combinator_Array; - function Sequence - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Param - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - Number : in Positive; - function Count - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Param - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - Minimum : in Natural := 0; - function Many - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Param - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - with function Test - (Item : in Traits.Element_Type) - return Boolean; - Minimum : in Natural := 0; - function Many_Until - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - - - - generic - with function Test - (Item : in Traits.Element_Type) - return Boolean; - function Satisfy - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Test - (Item : in Traits.Element_Type) - return Boolean; - with function Change - (From : in Traits.Element_Type) - return Traits.Element_Type; - function Satisfy_With - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - Item : in Traits.Element_Type; - function Match - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - Item : in Traits.Element_Type; - with function Change - (From : in Traits.Element_Type) - return Traits.Element_Type; - function Match_With - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - Items : in Traits.Element_Array; - function Multimatch - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - Number : in Positive := 1; - function Take - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Test - (Item : in Traits.Element_Type) - return Boolean; - function Take_While - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - with function Test - (Item : in Traits.Element_Type) - return Boolean; - function Take_Until - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - - - - generic - EOL_Item : in Traits.Element_Type; - function Line_End - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - generic - EOF_Item : in Traits.Element_Type; - function Input_End - (Input : in Traits.Element_Array; - Start : in Positive) - return Combinator_Result; - - -private - - - use type Traits.Label_Enum; - use type Traits.Element_Type; - use type Traits.Element_Array; - - - - - package Token_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Traits.Tokens.Token, - "=" => Traits.Tokens."="); - - package Label_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Traits.Label_Enum); - - package Label_Sets is new Ada.Containers.Ordered_Sets - (Element_Type => Traits.Label_Enum); - - package Input_Holders is new Ada.Containers.Indefinite_Holders - (Element_Type => Traits.Element_Array); - - - - - type Combinator_Result is record - Finish : Natural; - Status : Result_Status; - end record; - - Empty_Fail : constant Combinator_Result := - (Finish => 0, - Status => Failure); - - - - - type Component_Result is (Component_Failure, Component_Success); - - - - - type Lexer_Context is record - Result_So_Far : Token_Vectors.Vector; - Position : Positive := 1; - Offset : Natural := 0; - Status : Result_Status := Success; - Pass_Forward : Input_Holders.Holder; - Empty_Labels : Label_Sets.Set; - Error_Labels : Label_Vectors.Vector; - Allow_Incomplete : Boolean := True; - end record; - - Empty_Context : constant Lexer_Context := - (Result_So_Far => Token_Vectors.Empty_Vector, - Position => 1, - Offset => 0, - Status => Success, - Pass_Forward => Input_Holders.Empty_Holder, - Empty_Labels => Label_Sets.Empty_Set, - Error_Labels => Label_Vectors.Empty_Vector, - Allow_Incomplete => True); - - -end Packrat.Lexer; - - diff --git a/src/packrat-lexers.adb b/src/packrat-lexers.adb new file mode 100644 index 0000000..fc63e4a --- /dev/null +++ b/src/packrat-lexers.adb @@ -0,0 +1,686 @@ + + +with + + Packrat.Errors; + + +package body Packrat.Lexers is + + + function Join + (Left, Right : in Combinator_Result) + return Combinator_Result is + begin + if Left.Status = Success or Left.Status = Optional_More then + return (Integer'Max (Left.Finish, Right.Finish), Right.Status); + elsif Left.Status = Needs_More then + return (Left.Finish, Failure); + else + return Left; + end if; + end Join; + + + + + + function Stamp + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result + is + Current_Result : Combinator_Result := + Combo (Input, Context.Position); + begin + if Context.Status /= Success or Context.Position > Input'Last or + Context.Empty_Labels.Contains (Label) + then + return Component_Failure; + end if; + + if (Current_Result.Status = Needs_More and not Context.Allow_Incomplete) or + Current_Result.Status = Failure + then + Context.Error_Labels.Append (Label); + return Component_Failure; + end if; + + if (Current_Result.Status = Optional_More and not Context.Allow_Incomplete) or + Current_Result.Status = Success + then + Context.Result_So_Far.Append (Traits.Tokens.Create + (Label, + Context.Position + Context.Offset, + Input (Context.Position .. Current_Result.Finish))); + if Current_Result.Finish = 0 then + Context.Empty_Labels.Insert (Label); + else + Context.Empty_Labels.Clear; + Context.Position := Current_Result.Finish + 1; + end if; + else + Context.Status := Current_Result.Status; + Context.Pass_Forward.Replace_Element + (Input (Context.Position .. Current_Result.Finish)); + Context.Empty_Labels.Clear; + end if; + + Context.Error_Labels.Clear; + return Component_Success; + end Stamp; + + + function Ignore + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result + is + Current_Result : Combinator_Result := + Combo (Input, Context.Position); + begin + if Context.Status /= Success or Context.Position > Input'Last or + Context.Empty_Labels.Contains (Label) + then + return Component_Failure; + end if; + + if (Current_Result.Status = Needs_More and not Context.Allow_Incomplete) or + Current_Result.Status = Failure + then + Context.Error_Labels.Append (Label); + return Component_Failure; + end if; + + if (Current_Result.Status = Optional_More and not Context.Allow_Incomplete) or + Current_Result.Status = Success + then + if Current_Result.Finish = 0 then + Context.Empty_Labels.Insert (Label); + else + Context.Empty_Labels.Clear; + Context.Position := Current_Result.Finish + 1; + end if; + else + Context.Status := Current_Result.Status; + Context.Pass_Forward.Replace_Element + (Input (Context.Position .. Current_Result.Finish)); + Context.Empty_Labels.Clear; + end if; + + Context.Error_Labels.Clear; + return Component_Success; + end Ignore; + + + + + + procedure Tidy_Context + (Details : in out Lexer_Context; + Number_Comp : in Ada.Containers.Count_Type) is + begin + Details.Pass_Forward.Clear; + + Details.Empty_Labels.Clear; + Details.Error_Labels.Clear; + Details.Error_Labels.Reserve_Capacity (Number_Comp); + + Details.Offset := Details.Offset + Details.Position - 1; + Details.Position := 1; + Details.Status := Success; + end Tidy_Context; + + + procedure Raise_Lexer_Error + (Label_List : in Label_Vectors.Vector; + Position : in Positive) + is + Error_Info_List : Packrat.Errors.Error_Info_Array + (Label_List.First_Index .. Label_List.Last_Index); + begin + for I in Integer range Error_Info_List'First .. Error_Info_List'Last loop + Error_Info_List (I).Symbol := +Traits.Label_Enum'Image (Label_List.Element (I)); + Error_Info_List (I).Position := Position; + end loop; + raise Lexer_Error with Packrat.Errors.Encode_Array (Error_Info_List); + end Raise_Lexer_Error; + + + function Token_Vector_To_Array + (Input_Vector : in Token_Vectors.Vector) + return Traits.Tokens.Token_Array + is + Result_Array : Traits.Tokens.Token_Array (1 .. Integer (Input_Vector.Length)); + begin + for I in Integer range 1 .. Integer (Input_Vector.Length) loop + Result_Array (I) := Input_Vector.Element (I); + end loop; + return Result_Array; + end Token_Vector_To_Array; + + + procedure Token_Vector_To_Array + (Input_Vector : in Token_Vectors.Vector; + Padding : in Traits.Tokens.Token; + Output_Array : out Traits.Tokens.Token_Array) is + begin + for N in Integer range 1 .. Output_Array'Length loop + if N <= Integer (Input_Vector.Length) then + Output_Array (Output_Array'First + N - 1) := Input_Vector.Element (N); + else + Output_Array (Output_Array'First + N - 1) := Padding; + end if; + end loop; + end Token_Vector_To_Array; + + + function Slide + (Input : in Traits.Element_Array) + return Traits.Element_Array + is + subtype Slider is Traits.Element_Array (1 .. Input'Length); + begin + return Slider (Input); + end Slide; + + + procedure Internal_Scan_Core + (Input : in Traits.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; + + + + + + function Scan + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Traits.Tokens.Token_Array + is + Real_Input : Input_Holders.Holder; + begin + if not Context.Pass_Forward.Is_Empty then + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); + else + Real_Input.Replace_Element (Input); + end if; + + Tidy_Context (Context, Components'Length); + Context.Result_So_Far.Clear; + Context.Allow_Incomplete := Input'Length > 0; + + while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop + Internal_Scan_Core (Real_Input.Element, Context, Components); + end loop; + + return Token_Vector_To_Array (Context.Result_So_Far); + end Scan; + + + function Scan_Only + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Traits.Tokens.Token_Array + is + Real_Input : Input_Holders.Holder; + begin + if not Context.Pass_Forward.Is_Empty then + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); + else + Real_Input.Replace_Element (Input); + end if; + + Tidy_Context (Context, Components'Length); + Context.Result_So_Far.Clear; + Context.Allow_Incomplete := False; + + while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop + Internal_Scan_Core (Real_Input.Element, Context, Components); + end loop; + + return Token_Vector_To_Array (Context.Result_So_Far); + end Scan_Only; + + + function Scan_With + (Input : in With_Input; + Context : in out Lexer_Context) + return Traits.Tokens.Token_Array + is + Real_Input : Input_Holders.Holder; + Empty_Input : Boolean; + begin + Context.Result_So_Far.Clear; + loop + 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 + (Slide (Context.Pass_Forward.Element) & Real_Input.Element); + end if; + + Tidy_Context (Context, Components'Length); + Context.Allow_Incomplete := not Empty_Input; + + while Context.Status = Success and Context.Position <= Real_Input.Element'Length loop + Internal_Scan_Core (Real_Input.Element, Context, Components); + end loop; + + if Empty_Input then + exit; + end if; + end loop; + return Token_Vector_To_Array (Context.Result_So_Far); + end Scan_With; + + + procedure Scan_Set + (Input : in Traits.Element_Array; + Context : in out Lexer_Context; + Output : out Traits.Tokens.Token_Array) + is + Real_Input : Input_Holders.Holder; + begin + if not Context.Pass_Forward.Is_Empty then + Real_Input.Replace_Element (Slide (Context.Pass_Forward.Element) & Input); + else + Real_Input.Replace_Element (Input); + end if; + + Tidy_Context (Context, Components'Length); + Context.Result_So_Far.Clear; + Context.Allow_Incomplete := not (Input'Length = 0 or else Input (Input'First) = Pad_In); + + while Context.Status = Success and then + Integer (Context.Result_So_Far.Length) < Output'Length and then + Context.Position <= Real_Input.Element'Length and then + Real_Input.Element (Context.Position) /= Pad_In + loop + Internal_Scan_Core (Real_Input.Element, Context, Components); + end loop; + + if Integer (Context.Result_So_Far.Length) = Output'Length then + Context.Pass_Forward.Replace_Element + (Real_Input.Element (Context.Position .. Real_Input.Element'Last)); + end if; + Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output); + end Scan_Set; + + + procedure Scan_Set_With + (Input : in With_Input; + Context : in out Lexer_Context; + Output : out Traits.Tokens.Token_Array) + is + Real_Input : Input_Holders.Holder; + Empty_Input : Boolean; + begin + Context.Result_So_Far.Clear; + loop + Real_Input.Replace_Element (Input.all); + 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 + (Slide (Context.Pass_Forward.Element) & Real_Input.Element); + end if; + + Tidy_Context (Context, Components'Length); + Context.Allow_Incomplete := not Empty_Input; + + while Context.Status = Success and then + Integer (Context.Result_So_Far.Length) < Output'Length and then + Context.Position <= Real_Input.Element'Length and then + Real_Input.Element (Context.Position) /= Pad_In + loop + Internal_Scan_Core (Real_Input.Element, Context, Components); + end loop; + + if Empty_Input then + exit; + end if; + + if Integer (Context.Result_So_Far.Length) = Output'Length then + Context.Pass_Forward.Replace_Element + (Real_Input.Element (Context.Position .. Real_Input.Element'Last)); + exit; + end if; + end loop; + Token_Vector_To_Array (Context.Result_So_Far, Pad_Out, Output); + end Scan_Set_With; + + + + + + function Sequence + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result + is + Result : Combinator_Result := (0, Success); + Position : Positive := Start; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + for C of Params loop + if Position > Input'Last then + Result.Status := Needs_More; + exit; + end if; + Result := Join (Result, C (Input, Position)); + exit when Result.Status = Failure; + Position := Result.Finish + 1; + end loop; + return Result; + end Sequence; + + + function Count + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result + is + Result : Combinator_Result := (0, Success); + Position : Positive := Start; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + for I in Integer range 1 .. Number loop + if Position > Input'Last then + Result.Status := Needs_More; + exit; + end if; + Result := Join (Result, Param (Input, Position)); + exit when Result.Status = Failure; + Position := Result.Finish + 1; + end loop; + return Result; + end Count; + + + function Many + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result + is + Result : Combinator_Result := (0, Success); + Temp : Combinator_Result; + Position : Positive := Start; + Counter : Natural := 0; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + loop + exit when Position > Input'Last; + Temp := Param (Input, Position); + exit when Temp.Status = Failure or Temp.Status = Needs_More; + Result := Join (Result, Temp); + Counter := Counter + 1; + Position := Result.Finish + 1; + end loop; + if Counter < Minimum then + if Position > Input'Last or Temp.Status = Needs_More then + Result.Status := Needs_More; + else + Result.Status := Failure; + end if; + elsif Position > Input'Last or Temp.Status = Needs_More then + Result.Status := Optional_More; + else + Result.Status := Success; + end if; + return Result; + end Many; + + + function Many_Until + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result + is + Result : Combinator_Result := (0, Success); + Temp : Combinator_Result; + Position : Positive := Start; + Counter : Natural := 0; + begin + if Start > Input'Last then + return Empty_Fail; + end if; + loop + exit when Position > Input'Last; + Temp := Param (Input, Position); + exit when Temp.Status = Failure or Temp.Status = Needs_More or Test (Input (Position)); + Result := Join (Result, Temp); + Counter := Counter + 1; + Position := Result.Finish + 1; + end loop; + if Counter < Minimum then + if Position > Input'Last or Temp.Status = Needs_More then + Result.Status := Needs_More; + else + Result.Status := Failure; + end if; + elsif Position > Input'Last then + Result.Status := Needs_More; + elsif Temp.Status = Needs_More and Test (Input (Position)) then + Result.Status := Optional_More; + elsif Test (Input (Position)) then + Result.Status := Success; + else + Result.Status := Failure; + end if; + return Result; + end Many_Until; + + + + + + function Satisfy + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Test (Input (Start)) then + return (Start, Success); + else + return Empty_Fail; + end if; + end Satisfy; + + + function Satisfy_With + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Test (Change (Input (Start))) then + return (Start, Success); + else + return Empty_Fail; + end if; + end Satisfy_With; + + + function Match + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Input (Start) = Item then + return (Start, Success); + else + return Empty_Fail; + end if; + end Match; + + + function Match_With + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Change (Input (Start)) = Item then + return (Start, Success); + else + return Empty_Fail; + end if; + end Match_With; + + + function Multimatch + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result + is + Current_Offset : Natural := 0; + begin + if Items'Length = 0 then + return (0, Success); + end if; + + if Input'Last - Start + 1 <= 0 then + return Empty_Fail; + end if; + + while Input (Start + Current_Offset) = Items (Items'First + Current_Offset) loop + if Items'First + Current_Offset = Items'Last then + return (Start + Current_Offset, Success); + elsif Start + Current_Offset = Input'Last then + return (Start + Current_Offset, Needs_More); + end if; + Current_Offset := Current_Offset + 1; + end loop; + if Current_Offset = 0 then + return Empty_Fail; + else + return (Start + Current_Offset - 1, Failure); + end if; + end Multimatch; + + + function Take + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Start + Number - 1 > Input'Last then + return (Input'Last, Needs_More); + else + return (Start + Number - 1, Success); + end if; + end Take; + + + function Take_While + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result + is + Finish : Positive := Start; + Status : Result_Status; + begin + if Start > Input'Last or else not Test (Input (Start)) then + return Empty_Fail; + end if; + while Finish <= Input'Last and then Test (Input (Finish)) loop + Finish := Finish + 1; + end loop; + if Finish > Input'Last then + Status := Optional_More; + else + Status := Success; + end if; + return (Finish - 1, Status); + end Take_While; + + + function Take_Until + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result + is + Finish : Positive := Start; + Status : Result_Status; + begin + if Start > Input'Last or else Test (Input (Start)) then + return Empty_Fail; + end if; + while Finish <= Input'Last and then not Test (Input (Finish)) loop + Finish := Finish + 1; + end loop; + if Finish > Input'Last then + Status := Optional_More; + else + Status := Success; + end if; + return (Finish - 1, Status); + end Take_Until; + + + + + + function Line_End + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Input (Start) = EOL_Item then + return (Start, Success); + else + return Empty_Fail; + end if; + end Line_End; + + + function Input_End + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result is + begin + if Start > Input'Last then + return Empty_Fail; + elsif Input (Start) = EOF_Item then + return (Start, Success); + else + return Empty_Fail; + end if; + end Input_End; + + +end Packrat.Lexers; + + diff --git a/src/packrat-lexers.ads b/src/packrat-lexers.ads new file mode 100644 index 0000000..57fc462 --- /dev/null +++ b/src/packrat-lexers.ads @@ -0,0 +1,327 @@ + + +with + + Packrat.Traits; + +private with + + Ada.Containers.Vectors, + Ada.Containers.Ordered_Sets; + + +generic + + with package Traits is new Packrat.Traits (<>); + +package Packrat.Lexers is + + + type Combinator_Result is private; + + type Combinator is access function + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + type Combinator_Array is array (Positive range <>) of Combinator; + + + + + type Lexer_Context is private; + + Empty_Context : constant Lexer_Context; + + + + + type Component_Result is private; + + type Component is access function + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result; + + type Component_Array is array (Positive range <>) of Component; + + + + + type With_Input is access function + return Traits.Element_Array; + + + + + generic + Label : in Traits.Label_Enum; + with function Combo + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + function Stamp + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result; + + generic + Label : in Traits.Label_Enum; + with function Combo + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + function Ignore + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Component_Result; + + + + + generic + Components : in Component_Array; + function Scan + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Traits.Tokens.Token_Array; + + generic + Components : in Component_Array; + function Scan_Only + (Input : in Traits.Element_Array; + Context : in out Lexer_Context) + return Traits.Tokens.Token_Array; + + generic + Components : in Component_Array; + function Scan_With + (Input : in With_Input; + Context : in out Lexer_Context) + return Traits.Tokens.Token_Array; + + generic + Components : in Component_Array; + Pad_In : in Traits.Element_Type; + Pad_Out : in Traits.Tokens.Token; + procedure Scan_Set + (Input : in Traits.Element_Array; + Context : in out Lexer_Context; + Output : out Traits.Tokens.Token_Array); + + generic + Components : in Component_Array; + Pad_In : in Traits.Element_Type; + Pad_Out : in Traits.Tokens.Token; + procedure Scan_Set_With + (Input : in With_Input; + Context : in out Lexer_Context; + Output : out Traits.Tokens.Token_Array); + + + + + generic + Params : in Combinator_Array; + function Sequence + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + Number : in Positive; + function Count + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + Minimum : in Natural := 0; + function Many + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Param + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + with function Test + (Item : in Traits.Element_Type) + return Boolean; + Minimum : in Natural := 0; + function Many_Until + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + + + + generic + with function Test + (Item : in Traits.Element_Type) + return Boolean; + function Satisfy + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Traits.Element_Type) + return Boolean; + with function Change + (From : in Traits.Element_Type) + return Traits.Element_Type; + function Satisfy_With + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + Item : in Traits.Element_Type; + function Match + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + Item : in Traits.Element_Type; + with function Change + (From : in Traits.Element_Type) + return Traits.Element_Type; + function Match_With + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + Items : in Traits.Element_Array; + function Multimatch + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + Number : in Positive := 1; + function Take + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Traits.Element_Type) + return Boolean; + function Take_While + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + with function Test + (Item : in Traits.Element_Type) + return Boolean; + function Take_Until + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + + + + generic + EOL_Item : in Traits.Element_Type; + function Line_End + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + generic + EOF_Item : in Traits.Element_Type; + function Input_End + (Input : in Traits.Element_Array; + Start : in Positive) + return Combinator_Result; + + +private + + + use type Traits.Label_Enum; + use type Traits.Element_Type; + use type Traits.Element_Array; + + + + + package Token_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Traits.Tokens.Token, + "=" => Traits.Tokens."="); + + package Label_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Traits.Label_Enum); + + package Label_Sets is new Ada.Containers.Ordered_Sets + (Element_Type => Traits.Label_Enum); + + package Input_Holders is new Ada.Containers.Indefinite_Holders + (Element_Type => Traits.Element_Array); + + + + + type Combinator_Result is record + Finish : Natural; + Status : Result_Status; + end record; + + Empty_Fail : constant Combinator_Result := + (Finish => 0, + Status => Failure); + + + + + type Component_Result is (Component_Failure, Component_Success); + + + + + type Lexer_Context is record + Result_So_Far : Token_Vectors.Vector; + Position : Positive := 1; + Offset : Natural := 0; + Status : Result_Status := Success; + Pass_Forward : Input_Holders.Holder; + Empty_Labels : Label_Sets.Set; + Error_Labels : Label_Vectors.Vector; + Allow_Incomplete : Boolean := True; + end record; + + Empty_Context : constant Lexer_Context := + (Result_So_Far => Token_Vectors.Empty_Vector, + Position => 1, + Offset => 0, + Status => Success, + Pass_Forward => Input_Holders.Empty_Holder, + Empty_Labels => Label_Sets.Empty_Set, + Error_Labels => Label_Vectors.Empty_Vector, + Allow_Incomplete => True); + + +end Packrat.Lexers; + + diff --git a/src/packrat-util.adb b/src/packrat-util.adb deleted file mode 100644 index c1335e0..0000000 --- a/src/packrat-util.adb +++ /dev/null @@ -1,147 +0,0 @@ - - -with - - Ada.Characters.Latin_1; - - -package body Packrat.Util is - - - package Latin renames Ada.Characters.Latin_1; - package Strmaps renames Ada.Strings.Maps; - - - - - function In_Set - (Element : in Character) - return Boolean is - begin - return Strmaps.Is_In (Element, Set); - end In_Set; - - - function Not_In_Set - (Element : in Character) - return Boolean is - begin - return not Strmaps.Is_In (Element, Set); - end Not_In_Set; - - - - - - function Is_Digit - (Char : in Character) - return Boolean is - begin - return (Char >= '0' and Char <= '9'); - end Is_Digit; - - - function Is_Hex - (Char : in Character) - return Boolean is - begin - return - (Char >= '0' and Char <= '9') or - (Char >= 'A' and Char <= 'F') or - (Char >= 'a' and Char <= 'f'); - end Is_Hex; - - - function Is_Letter - (Char : in Character) - return Boolean is - begin - return - (Char >= 'A' and Char <= 'Z') or - (Char >= 'a' and Char <= 'z'); - end Is_Letter; - - - function Is_Alphanumeric - (Char : in Character) - return Boolean is - begin - return Is_Digit (Char) or Is_Letter (Char); - end Is_Alphanumeric; - - - function Is_Punctuation - (Char : in Character) - return Boolean is - begin - return - (Char >= '!' and Char <= '/') or - (Char >= ':' and Char <= '@') or - (Char >= '[' and Char <= '`') or - (Char >= '{' and Char <= '~'); - end Is_Punctuation; - - - function Is_ASCII - (Char : in Character) - return Boolean is - begin - return Char <= Character'Val (127); - end Is_ASCII; - - - function Is_Extended_ASCII - (Char : in Character) - return Boolean is - begin - return Char >= Character'Val (128); - end Is_Extended_ASCII; - - - function Is_Space - (Char : in Character) - return Boolean is - begin - return Char = ' '; - end Is_Space; - - - function Is_Linespace - (Char : in Character) - return Boolean is - begin - return (Char = ' ' or Char = Latin.HT); - end Is_Linespace; - - - function Is_End_Of_Line - (Char : in Character) - return Boolean is - begin - return (Char = Latin.LF or Char = Latin.CR); - end Is_End_Of_Line; - - - function Is_Whitespace - (Char : in Character) - return Boolean is - begin - return - Char = Latin.HT or - Char = Latin.LF or - Char = Latin.CR or - Char = ' '; - end Is_Whitespace; - - - function Not_Whitespace - (Char : in Character) - return Boolean is - begin - return not Is_Whitespace (Char); - end Not_Whitespace; - - -end Packrat.Util; - - diff --git a/src/packrat-util.ads b/src/packrat-util.ads deleted file mode 100644 index cada441..0000000 --- a/src/packrat-util.ads +++ /dev/null @@ -1,80 +0,0 @@ - - -with - - Ada.Strings.Maps; - - -package Packrat.Util is - - - generic - Set : in Ada.Strings.Maps.Character_Set; - function In_Set - (Element : in Character) - return Boolean; - - generic - Set : in Ada.Strings.Maps.Character_Set; - function Not_In_Set - (Element : in Character) - return Boolean; - - - - - function Is_Digit - (Char : in Character) - return Boolean; - - function Is_Hex - (Char : in Character) - return Boolean; - - function Is_Letter - (Char : in Character) - return Boolean; - - function Is_Alphanumeric - (Char : in Character) - return Boolean; - - function Is_Punctuation - (Char : in Character) - return Boolean; - - function Is_ASCII - (Char : in Character) - return Boolean; - - function Is_Extended_ASCII - (Char : in Character) - return Boolean; - - function Is_Space - (Char : in Character) - return Boolean; - - function Is_Linespace - (Char : in Character) - return Boolean; - - function Is_End_Of_Line - (Char : in Character) - return Boolean; - - function Is_Whitespace - (Char : in Character) - return Boolean; - - function Not_Whitespace - (Char : in Character) - return Boolean; - - -private - - -end Packrat.Util; - - diff --git a/src/packrat-utilities.adb b/src/packrat-utilities.adb new file mode 100644 index 0000000..97e4272 --- /dev/null +++ b/src/packrat-utilities.adb @@ -0,0 +1,147 @@ + + +with + + Ada.Characters.Latin_1; + + +package body Packrat.Utilities is + + + package Latin renames Ada.Characters.Latin_1; + package Strmaps renames Ada.Strings.Maps; + + + + + function In_Set + (Element : in Character) + return Boolean is + begin + return Strmaps.Is_In (Element, Set); + end In_Set; + + + function Not_In_Set + (Element : in Character) + return Boolean is + begin + return not Strmaps.Is_In (Element, Set); + end Not_In_Set; + + + + + + function Is_Digit + (Char : in Character) + return Boolean is + begin + return (Char >= '0' and Char <= '9'); + end Is_Digit; + + + function Is_Hex + (Char : in Character) + return Boolean is + begin + return + (Char >= '0' and Char <= '9') or + (Char >= 'A' and Char <= 'F') or + (Char >= 'a' and Char <= 'f'); + end Is_Hex; + + + function Is_Letter + (Char : in Character) + return Boolean is + begin + return + (Char >= 'A' and Char <= 'Z') or + (Char >= 'a' and Char <= 'z'); + end Is_Letter; + + + function Is_Alphanumeric + (Char : in Character) + return Boolean is + begin + return Is_Digit (Char) or Is_Letter (Char); + end Is_Alphanumeric; + + + function Is_Punctuation + (Char : in Character) + return Boolean is + begin + return + (Char >= '!' and Char <= '/') or + (Char >= ':' and Char <= '@') or + (Char >= '[' and Char <= '`') or + (Char >= '{' and Char <= '~'); + end Is_Punctuation; + + + function Is_ASCII + (Char : in Character) + return Boolean is + begin + return Char <= Character'Val (127); + end Is_ASCII; + + + function Is_Extended_ASCII + (Char : in Character) + return Boolean is + begin + return Char >= Character'Val (128); + end Is_Extended_ASCII; + + + function Is_Space + (Char : in Character) + return Boolean is + begin + return Char = ' '; + end Is_Space; + + + function Is_Linespace + (Char : in Character) + return Boolean is + begin + return (Char = ' ' or Char = Latin.HT); + end Is_Linespace; + + + function Is_End_Of_Line + (Char : in Character) + return Boolean is + begin + return (Char = Latin.LF or Char = Latin.CR); + end Is_End_Of_Line; + + + function Is_Whitespace + (Char : in Character) + return Boolean is + begin + return + Char = Latin.HT or + Char = Latin.LF or + Char = Latin.CR or + Char = ' '; + end Is_Whitespace; + + + function Not_Whitespace + (Char : in Character) + return Boolean is + begin + return not Is_Whitespace (Char); + end Not_Whitespace; + + +end Packrat.Utilities; + + diff --git a/src/packrat-utilities.ads b/src/packrat-utilities.ads new file mode 100644 index 0000000..15cd357 --- /dev/null +++ b/src/packrat-utilities.ads @@ -0,0 +1,77 @@ + + +with + + Ada.Strings.Maps; + + +package Packrat.Utilities is + + + generic + Set : in Ada.Strings.Maps.Character_Set; + function In_Set + (Element : in Character) + return Boolean; + + generic + Set : in Ada.Strings.Maps.Character_Set; + function Not_In_Set + (Element : in Character) + return Boolean; + + + + + function Is_Digit + (Char : in Character) + return Boolean; + + function Is_Hex + (Char : in Character) + return Boolean; + + function Is_Letter + (Char : in Character) + return Boolean; + + function Is_Alphanumeric + (Char : in Character) + return Boolean; + + function Is_Punctuation + (Char : in Character) + return Boolean; + + function Is_ASCII + (Char : in Character) + return Boolean; + + function Is_Extended_ASCII + (Char : in Character) + return Boolean; + + function Is_Space + (Char : in Character) + return Boolean; + + function Is_Linespace + (Char : in Character) + return Boolean; + + function Is_End_Of_Line + (Char : in Character) + return Boolean; + + function Is_Whitespace + (Char : in Character) + return Boolean; + + function Not_Whitespace + (Char : in Character) + return Boolean; + + +end Packrat.Utilities; + + diff --git a/test/packrat-lexer-debug.adb b/test/packrat-lexer-debug.adb deleted file mode 100644 index 40dbd87..0000000 --- a/test/packrat-lexer-debug.adb +++ /dev/null @@ -1,119 +0,0 @@ - - -package body Packrat.Lexer.Debug is - - - function Create_Result - (Finish : in Natural; - Status : in Result_Status) - return Combinator_Result is - begin - return (Finish, Status); - end Create_Result; - - - function Join - (Left, Right : in Combinator_Result) - return Combinator_Result is - begin - if Left.Status = Success or Left.Status = Optional_More then - return Right; - elsif Left.Status = Needs_More then - return (Left.Finish, Failure); - else - return Left; - end if; - end Join; - - - function Status - (This : in Combinator_Result) - return Result_Status is - begin - return This.Status; - end Status; - - - function Debug_String - (This : in Combinator_Result) - return String is - begin - return Integer'Image (This.Finish) - & " " & Result_Status'Image (This.Status); - end Debug_String; - - - - - - function So_Far - (This : in Lexer_Context) - return Token_Vector is - begin - return (This.Result_So_Far with null record); - end So_Far; - - function Position - (This : in Lexer_Context) - return Positive is - begin - return This.Position; - end Position; - - function Status - (This : in Lexer_Context) - return Result_Status is - begin - 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 Traits.Element_Array is - begin - return This.Pass_Forward.Element; - end Pass; - - function Length - (Vec : in Token_Vector) - return Natural is - begin - return Integer (Token_Vectors.Vector (Vec).Length); - end Length; - - function Element - (Vec : in Token_Vector; - Dex : in Positive) - return Traits.Tokens.Token is - begin - return Token_Vectors.Vector (Vec).Element (Dex); - end Element; - - - - - function Is_Failure - (Result : in Component_Result) - return Boolean is - begin - return Result = Component_Failure; - end Is_Failure; - - function Is_Success - (Result : in Component_Result) - return Boolean is - begin - return Result = Component_Success; - end Is_Success; - - -end Packrat.Lexer.Debug; - - diff --git a/test/packrat-lexer-debug.ads b/test/packrat-lexer-debug.ads deleted file mode 100644 index bd6c2de..0000000 --- a/test/packrat-lexer-debug.ads +++ /dev/null @@ -1,89 +0,0 @@ - - -with - - Ada.Containers.Vectors; - - -generic -package Packrat.Lexer.Debug is - - - Empty_Fail : constant Combinator_Result; - - - function Create_Result - (Finish : in Natural; - Status : in Result_Status) - return Combinator_Result; - - function Join - (Left, Right : in Combinator_Result) - return Combinator_Result; - - function Status - (This : in Combinator_Result) - return Result_Status; - - function Debug_String - (This : in Combinator_Result) - return String; - - - - - type Token_Vector is tagged private; - - function So_Far - (This : in Lexer_Context) - return Token_Vector; - - function Position - (This : in Lexer_Context) - return Positive; - - function Status - (This : in Lexer_Context) - return Result_Status; - - function Has_Pass - (This : in Lexer_Context) - return Boolean; - - function Pass - (This : in Lexer_Context) - return Traits.Element_Array; - - function Length - (Vec : in Token_Vector) - return Natural; - - function Element - (Vec : in Token_Vector; - Dex : in Positive) - return Traits.Tokens.Token; - - - - - function Is_Failure - (Result : in Component_Result) - return Boolean; - - function Is_Success - (Result : in Component_Result) - return Boolean; - - -private - - - Empty_Fail : constant Combinator_Result := Packrat.Lexer.Empty_Fail; - - - type Token_Vector is new Token_Vectors.Vector with null record; - - -end Packrat.Lexer.Debug; - - diff --git a/test/packrat-lexers-debug.adb b/test/packrat-lexers-debug.adb new file mode 100644 index 0000000..d748fd4 --- /dev/null +++ b/test/packrat-lexers-debug.adb @@ -0,0 +1,119 @@ + + +package body Packrat.Lexers.Debug is + + + function Create_Result + (Finish : in Natural; + Status : in Result_Status) + return Combinator_Result is + begin + return (Finish, Status); + end Create_Result; + + + function Join + (Left, Right : in Combinator_Result) + return Combinator_Result is + begin + if Left.Status = Success or Left.Status = Optional_More then + return Right; + elsif Left.Status = Needs_More then + return (Left.Finish, Failure); + else + return Left; + end if; + end Join; + + + function Status + (This : in Combinator_Result) + return Result_Status is + begin + return This.Status; + end Status; + + + function Debug_String + (This : in Combinator_Result) + return String is + begin + return Integer'Image (This.Finish) + & " " & Result_Status'Image (This.Status); + end Debug_String; + + + + + + function So_Far + (This : in Lexer_Context) + return Token_Vector is + begin + return (This.Result_So_Far with null record); + end So_Far; + + function Position + (This : in Lexer_Context) + return Positive is + begin + return This.Position; + end Position; + + function Status + (This : in Lexer_Context) + return Result_Status is + begin + 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 Traits.Element_Array is + begin + return This.Pass_Forward.Element; + end Pass; + + function Length + (Vec : in Token_Vector) + return Natural is + begin + return Integer (Token_Vectors.Vector (Vec).Length); + end Length; + + function Element + (Vec : in Token_Vector; + Dex : in Positive) + return Traits.Tokens.Token is + begin + return Token_Vectors.Vector (Vec).Element (Dex); + end Element; + + + + + function Is_Failure + (Result : in Component_Result) + return Boolean is + begin + return Result = Component_Failure; + end Is_Failure; + + function Is_Success + (Result : in Component_Result) + return Boolean is + begin + return Result = Component_Success; + end Is_Success; + + +end Packrat.Lexers.Debug; + + diff --git a/test/packrat-lexers-debug.ads b/test/packrat-lexers-debug.ads new file mode 100644 index 0000000..5c5320a --- /dev/null +++ b/test/packrat-lexers-debug.ads @@ -0,0 +1,89 @@ + + +with + + Ada.Containers.Vectors; + + +generic +package Packrat.Lexers.Debug is + + + Empty_Fail : constant Combinator_Result; + + + function Create_Result + (Finish : in Natural; + Status : in Result_Status) + return Combinator_Result; + + function Join + (Left, Right : in Combinator_Result) + return Combinator_Result; + + function Status + (This : in Combinator_Result) + return Result_Status; + + function Debug_String + (This : in Combinator_Result) + return String; + + + + + type Token_Vector is tagged private; + + function So_Far + (This : in Lexer_Context) + return Token_Vector; + + function Position + (This : in Lexer_Context) + return Positive; + + function Status + (This : in Lexer_Context) + return Result_Status; + + function Has_Pass + (This : in Lexer_Context) + return Boolean; + + function Pass + (This : in Lexer_Context) + return Traits.Element_Array; + + function Length + (Vec : in Token_Vector) + return Natural; + + function Element + (Vec : in Token_Vector; + Dex : in Positive) + return Traits.Tokens.Token; + + + + + function Is_Failure + (Result : in Component_Result) + return Boolean; + + function Is_Success + (Result : in Component_Result) + return Boolean; + + +private + + + Empty_Fail : constant Combinator_Result := Packrat.Lexers.Empty_Fail; + + + type Token_Vector is new Token_Vectors.Vector with null record; + + +end Packrat.Lexers.Debug; + + diff --git a/test/rat_tests-lexer.adb b/test/rat_tests-lexer.adb deleted file mode 100644 index 531d175..0000000 --- a/test/rat_tests-lexer.adb +++ /dev/null @@ -1,1022 +0,0 @@ - - -with - - Packrat.Errors, - Packrat.Traits, - Packrat.Lexer.Debug, - Packrat.Util; - - -package body Rat_Tests.Lexer is - - - package PU renames Packrat.Util; - - - type My_Labels is (One, Two, Three); - - - package Slexy_Traits is new Packrat.Traits (My_Labels, Character, String); - package Slexy is new Packrat.Lexer (Slexy_Traits); - package Slebug is new Slexy.Debug; - - - use type Slexy.Combinator_Result; - - - - - - function Join_Check - return Test_Result - is - One : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success); - Two : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Three : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - - Four : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure); - Five : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure); - - Six : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Needs_More); - Seven : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Needs_More); - - Eight : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Failure); - - Nine : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Optional_More); - Ten : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Eleven : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - begin - if Slebug.Join (One, Two) /= Three or Slebug.Join (One, Four) /= Five or - Slebug.Join (One, Six) /= Seven or Slebug.Join (Four, Six) /= Four or - Slebug.Join (Five, Two) /= Five or Slebug.Join (Six, Three) /= Eight or - Slebug.Join (Slebug.Empty_Fail, One) /= Slebug.Empty_Fail or - Slebug.Join (Nine, Ten) /= Eleven - then - return Fail; - end if; - return Pass; - end Join_Check; - - - function Equals_Check - return Test_Result - is - One : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Two : Slexy.Combinator_Result := - Slebug.Create_Result (0, Packrat.Failure); - begin - if One = Two or Two /= Slebug.Empty_Fail then - return Fail; - end if; - return Pass; - end Equals_Check; - - - - - - function Sequence_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Match_B is new Slexy.Match ('b'); - function Match_C is new Slexy.Match ('c'); - function Seq_Abc is new Slexy.Sequence - ((Match_A'Unrestricted_Access, - Match_B'Unrestricted_Access, - Match_C'Unrestricted_Access)); - - Test_Str : String := "aababcabcab"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Failure); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (11, Packrat.Needs_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (6, Packrat.Success); - Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; - Result5 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Failure); - begin - if Seq_Abc (Test_Str, 1) /= Result1 or Seq_Abc (Test_Str, 2) /= Result5 or - Seq_Abc (Test_Str, 4) /= Result3 or Seq_Abc (Test_Str, 10) /= Result2 or - Seq_Abc (Test_Str, 3) /= Result4 or - Seq_Abc (Test_Str, Test_Str'Last + 5) /= Result4 - then - return Fail; - end if; - return Pass; - end Sequence_Check; - - - function Count_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Match_B is new Slexy.Match ('b'); - function Count_2A is new Slexy.Count (Match_A, 2); - function Count_3B is new Slexy.Count (Match_B, 3); - - Test_Str : String := "abaabbaaabbbaaaabbbb"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Failure); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Success); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Failure); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (20, Packrat.Needs_More); - Result5 : Slexy.Combinator_Result := - Slebug.Create_Result (12, Packrat.Success); - Result6 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Count_2A (Test_Str, 1) /= Result1 or Count_2A (Test_Str, 3) /= Result2 or - Count_3B (Test_Str, 2) /= Result3 or Count_3B (Test_Str, 19) /= Result4 or - Count_3B (Test_Str, 10) /= Result5 or Count_3B (Test_Str, 1) /= Result6 or - Count_2A (Test_Str, 2) /= Result6 or - Count_2A (Test_Str, Test_Str'Last + 5) /= Result6 - then - return Fail; - end if; - return Pass; - end Count_Check; - - - function Many_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Many_0 is new Slexy.Many (Match_A); - function Many_4 is new Slexy.Many (Match_A, 4); - - function Match_B is new Slexy.Match ('b'); - function Match_C is new Slexy.Match ('c'); - function Seq_Abc is new Slexy.Sequence - ((Match_A'Unrestricted_Access, - Match_B'Unrestricted_Access, - Match_C'Unrestricted_Access)); - function Many_Seq_0 is new Slexy.Many (Seq_Abc); - function Many_Seq_4 is new Slexy.Many (Seq_Abc, 4); - - Test_Str : String := "aaabbaaaaabaa"; - Test_Str2 : String := "aababcabcab"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (13, Packrat.Optional_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (10, Packrat.Success); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Failure); - Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; - Result6 : Slexy.Combinator_Result := - Slebug.Create_Result (13, Packrat.Needs_More); - Result7 : Slexy.Combinator_Result := - Slebug.Create_Result (0, Packrat.Success); - Result8 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Optional_More); - Result9 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Needs_More); - begin - if Many_0 (Test_Str, 1) /= Result1 or Many_4 (Test_Str, 1) /= Result4 or - Many_4 (Test_Str, 6) /= Result3 or Many_0 (Test_Str, 4) /= Result7 or - Many_0 (Test_Str, 12) /= Result2 or Many_4 (Test_Str, 12) /= Result6 or - Many_0 (Test_Str, Test_Str'Last + 5) /= Result5 or - Many_Seq_0 (Test_Str2, 4) /= Result8 or Many_Seq_4 (Test_Str2, 4) /= Result9 - then - return Fail; - end if; - return Pass; - end Many_Check; - - - function Many_Until_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Many_Until_0 is new Slexy.Many_Until (Match_A, PU.Is_Digit); - function Many_Until_3 is new Slexy.Many_Until (Match_A, PU.Is_Digit, 3); - - Test_Str : String := "aaaabbaaa123aaa"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (4, Packrat.Failure); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Success); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (15, Packrat.Needs_More); - Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Many_Until_0 (Test_Str, 1) /= Result1 or - Many_Until_0 (Test_Str, 7) /= Result2 or - Many_Until_3 (Test_Str, 7) /= Result2 or - Many_Until_3 (Test_Str, 13) /= Result3 or - Many_Until_0 (Test_Str, 5) /= Result4 or - Many_Until_0 (Test_Str, Test_Str'Last + 5) /= Result4 or - Many_Until_3 (Test_Str, Test_Str'Last + 5) /= Result4 - then - return Fail; - end if; - return Pass; - end Many_Until_Check; - - - function Satisfy_Check - return Test_Result - is - function Is_123 - (Char : in Character) - return Boolean is - begin - return Char = '1' or Char = '2' or Char = '3'; - end Is_123; - function Is_Abc - (Char : in Character) - return Boolean is - begin - return Char = 'a' or Char = 'b' or Char = 'c'; - end Is_Abc; - - function Satisfy_123 is new Slexy.Satisfy (Is_123); - function Satisfy_Abc is new Slexy.Satisfy (Is_Abc); - - Test_Str : String := "abc123456def"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (6, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Satisfy_123 (Test_Str, 6) /= Result2 or - Satisfy_Abc (Test_Str, 2) /= Result1 or - Satisfy_Abc (Test_Str, 8) /= Result3 or - Satisfy_123 (Test_Str, Test_Str'Last + 5) /= Result3 - then - return Fail; - end if; - return Pass; - end Satisfy_Check; - - - function Satisfy_With_Check - return Test_Result - is - function Is_Abc - (Char : in Character) - return Boolean is - begin - return Char = 'a' or Char = 'b' or Char = 'c'; - end Is_Abc; - function Is_123 - (Char : in Character) - return Boolean is - begin - return Char = '1' or Char = '2' or Char = '3'; - end Is_123; - function Minus_One - (Char : in Character) - return Character is - begin - return Character'Val (Character'Pos (Char) - 1); - end Minus_One; - - function Satisfy_Bcd is new Slexy.Satisfy_With (Is_Abc, Minus_One); - function Satisfy_234 is new Slexy.Satisfy_With (Is_123, Minus_One); - - Test_Str : String := "abcde12345"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (7, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Satisfy_Bcd (Test_Str, 3) /= Result1 or - Satisfy_234 (Test_Str, 7) /= Result2 or - Satisfy_Bcd (Test_Str, 1) /= Result3 or - Satisfy_234 (Test_Str, Test_Str'Last + 5) /= Result3 - then - return Fail; - end if; - return Pass; - end Satisfy_With_Check; - - - function Match_Check - return Test_Result - is - function Match_A is new Slexy.Match ('a'); - function Match_Slash is new Slexy.Match ('/'); - function Match_4 is new Slexy.Match ('4'); - - Test_Str : String := "abc1234./5"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Success); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (7, Packrat.Success); - Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Match_A (Test_Str, 1) /= Result1 or - Match_Slash (Test_Str, 9) /= Result2 or - Match_4 (Test_Str, 7) /= Result3 or - Match_A (Test_Str, 3) /= Result4 or - Match_A (Test_Str, Test_Str'Last + 5) /= Result4 - then - return Fail; - end if; - return Pass; - end Match_Check; - - - function Match_With_Check - return Test_Result - is - function Plus_One - (Char : in Character) - return Character is - begin - return Character'Val (Character'Pos (Char) + 1); - end Plus_One; - - function Match_A is new Slexy.Match_With ('b', Plus_One); - function Match_6 is new Slexy.Match_With ('7', Plus_One); - - Test_Str : String := "abc5678"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (1, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Match_A (Test_Str, 1) /= Result1 or - Match_6 (Test_Str, 5) /= Result2 or - Match_A (Test_Str, 2) /= Result3 or - Match_A (Test_Str, Test_Str'Last + 5) /= Result3 - then - return Fail; - end if; - return Pass; - end Match_With_Check; - - - function Multimatch_Check - return Test_Result - is - function Match_String1 is new Slexy.Multimatch ("abc"); - function Match_String2 is new Slexy.Multimatch ("hello"); - - Test_Str : String := "abcdefabhelloworldab"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (20, Packrat.Needs_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (13, Packrat.Success); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (8, Packrat.Failure); - Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Match_String1 (Test_Str, 1) /= Result1 or - Match_String1 (Test_Str, 7) /= Result4 or - Match_String2 (Test_Str, 9) /= Result3 or - Match_String2 (Test_Str, 3) /= Result5 or - Match_String1 (Test_Str, 19) /= Result2 or - Match_String1 (Test_Str, Test_Str'Last + 5) /= Result5 - then - return Fail; - end if; - return Pass; - end Multimatch_Check; - - - function Take_Check - return Test_Result - is - function Take_1 is new Slexy.Take; - function Take_5 is new Slexy.Take (5); - - Test_Str : String := "abcdefghi"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (2, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (9, Packrat.Needs_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (7, Packrat.Success); - Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Take_1 (Test_Str, 2) /= Result1 or Take_5 (Test_Str, 7) /= Result2 or - Take_5 (Test_Str, 3) /= Result3 or - Take_1 (Test_Str, Test_Str'Last + 5) /= Result4 - then - return Fail; - end if; - return Pass; - end Take_Check; - - - function Take_While_Check - return Test_Result - is - function Take_Letters is new Slexy.Take_While (PU.Is_Letter); - function Take_Punch is new Slexy.Take_While (PU.Is_Punctuation); - function Take_Digits is new Slexy.Take_While (PU.Is_Digit); - - Test_Str : String := "abcde,./;'fghi[]=-^563"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (14, Packrat.Success); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (10, Packrat.Success); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (19, Packrat.Success); - Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; - Result6 : Slexy.Combinator_Result := - Slebug.Create_Result (22, Packrat.Optional_More); - begin - if Take_Letters (Test_Str, 2) /= Result1 or - Take_Letters (Test_Str, 13) /= Result2 or - Take_Punch (Test_Str, 6) /= Result3 or - Take_Punch (Test_Str, 17) /= Result4 or - Take_Letters (Test_Str, 7) /= Result5 or - Take_Punch (Test_Str, Test_Str'Last + 5) /= Result5 or - Take_Digits (Test_Str, 20) /= Result6 - then - return Fail; - end if; - return Pass; - end Take_While_Check; - - - function Take_Until_Check - return Test_Result - is - function Take_Till_Punch is new Slexy.Take_Until (PU.Is_Punctuation); - function Take_Till_Digit is new Slexy.Take_Until (PU.Is_Digit); - - Test_Str : String := "abcde12345;;;fghi67"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (10, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (19, Packrat.Optional_More); - Result3 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result4 : Slexy.Combinator_Result := - Slebug.Create_Result (17, Packrat.Success); - Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if Take_Till_Punch (Test_Str, 4) /= Result1 or - Take_Till_Punch (Test_Str, 16) /= Result2 or - Take_Till_Digit (Test_Str, 1) /= Result3 or - Take_Till_Digit (Test_Str, 12) /= Result4 or - Take_Till_Punch (Test_Str, 11) /= Result5 or - Take_Till_Punch (Test_Str, Test_Str'Last + 5) /= Result5 - then - return Fail; - end if; - return Pass; - end Take_Until_Check; - - - function Line_End_Check - return Test_Result - is - function LF_End is new Slexy.Line_End (Latin.LF); - function C_End is new Slexy.Line_End ('c'); - - Test_Str : String := "abcd" & Latin.LF & "e"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if LF_End (Test_Str, 5) /= Result1 or C_End (Test_Str, 3) /= Result2 or - LF_End (Test_Str, Test_Str'Last + 5) /= Result3 or LF_End (Test_Str, 1) /= Result3 - then - return Fail; - end if; - return Pass; - end Line_End_Check; - - - function Input_End_Check - return Test_Result - is - function C_End is new Slexy.Input_End ('c'); - function E_End is new Slexy.Input_End ('e'); - - Test_Str : String := "abcde"; - - Result1 : Slexy.Combinator_Result := - Slebug.Create_Result (5, Packrat.Success); - Result2 : Slexy.Combinator_Result := - Slebug.Create_Result (3, Packrat.Success); - Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; - begin - if C_End (Test_Str, 3) /= Result2 or E_End (Test_Str, 5) /= Result1 or - C_End (Test_Str, 6) /= Result3 or E_End (Test_Str, 6) /= Result3 or - C_End (Test_Str, 1) /= Result3 or E_End (Test_Str, Test_Str'Last + 5) /= Result3 - then - return Fail; - end if; - return Pass; - end Input_End_Check; - - - - - - function Stamp_Check - return Test_Result - is - use type Slexy_Traits.Tokens.Token; - use type Packrat.Result_Status; - use type Slexy.Component_Result; - - function Match_A is new Slexy.Match ('a'); - function Match_B is new Slexy.Match ('b'); - function Match_C is new Slexy.Match ('c'); - function Seq_Abc is new Slexy.Sequence - ((Match_A'Unrestricted_Access, - Match_B'Unrestricted_Access, - Match_C'Unrestricted_Access)); - function My_Stamp is new Slexy.Stamp (One, Seq_Abc); - - Test_Str1 : String := "abcdefghi"; - Test_Str2 : String := "ab"; - - Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; - Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; - - Comp_Code : Slexy.Component_Result; - begin - Comp_Code := My_Stamp (Test_Str1, Context1); - if (Slebug.So_Far (Context1).Length /= 1 or else - Slebug.So_Far (Context1).Element (1) /= Slexy_Traits.Tokens.Create (One, 1, "abc")) or - Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or - 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) /= Slexy_Traits.Tokens.Create (One, 1, "abc")) or - Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or - Slebug.Has_Pass (Context1) - then - return Fail; - end if; - Comp_Code := My_Stamp (Test_Str2, Context2); - if Slebug.So_Far (Context2).Length /= 0 or - Slebug.Position (Context2) /= 1 or - Slebug.Status (Context2) /= Packrat.Needs_More or - (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") - then - return Fail; - end if; - return Pass; - end Stamp_Check; - - - function Ignore_Check - return Test_Result - is - use type Packrat.Result_Status; - - function Match_Abc is new Slexy.Multimatch ("abc"); - function My_Ignore is new Slexy.Ignore (Two, Match_Abc); - - Test_Str1 : String := "abcdefghi"; - Test_Str2 : String := "ab"; - - Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; - Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; - - Comp_Code : Slexy.Component_Result; - begin - 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.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.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 - (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") - then - return Fail; - end if; - return Pass; - end Ignore_Check; - - - - - - type Word_Enum is (Blank, Word, Whitespace); - - package Swordy_Traits is new Packrat.Traits (Word_Enum, Character, String); - package Swordy is new Packrat.Lexer (Swordy_Traits); - package Swolbug is new Swordy.Debug; - - use type Swordy_Traits.Tokens.Token; - use type Swordy_Traits.Tokens.Token_Array; - - function Satisfy_Letter is new Swordy.Satisfy (PU.Is_Letter); - function Many_Letter is new Swordy.Many (Satisfy_Letter, 1); - function Satisfy_Whitespace is new Swordy.Satisfy (PU.Is_Whitespace); - function Many_Whitespace is new Swordy.Many (Satisfy_Whitespace, 1); - - function Stamp_Word is new Swordy.Stamp (Word, Many_Letter); - function Ignore_Whitespace is new Swordy.Ignore (Whitespace, Many_Whitespace); - - - function Scan_Check - return Test_Result - is - function My_Scan is new Swordy.Scan - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Str : String := "one fine day"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result1 : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), - 2 => Swordy_Traits.Tokens.Create (Word, 5, "fine")); - Intended_Result2 : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 10, "day")); - - Actual_Result1 : Swordy_Traits.Tokens.Token_Array := - My_Scan (Test_Str, Test_Context); - Actual_Result2 : Swordy_Traits.Tokens.Token_Array := - My_Scan ("", Test_Context); - begin - if Actual_Result1 /= Intended_Result1 or Actual_Result2 /= Intended_Result2 then - return Fail; - end if; - return Pass; - end Scan_Check; - - - function Scan_Only_Check - return Test_Result - is - function My_Scan is new Swordy.Scan_Only - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Str : String := "one fine day"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), - 2 => Swordy_Traits.Tokens.Create (Word, 5, "fine"), - 3 => Swordy_Traits.Tokens.Create (Word, 10, "day")); - - Actual_Result : Swordy_Traits.Tokens.Token_Array := - My_Scan (Test_Str, Test_Context); - begin - if Actual_Result /= Intended_Result then - return Fail; - end if; - return Pass; - end Scan_Only_Check; - - - function Scan_With_Check - return Test_Result - is - Sentinel : Natural := 2; - function More_Input - return String is - begin - if Sentinel > 1 then - Sentinel := 1; - return "it will happen again"; - elsif Sentinel > 0 then - Sentinel := 0; - return " and again and again"; - else - return ""; - end if; - end More_Input; - - function My_Scan is new Swordy.Scan_With - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 1, "it"), - 2 => Swordy_Traits.Tokens.Create (Word, 4, "will"), - 3 => Swordy_Traits.Tokens.Create (Word, 9, "happen"), - 4 => Swordy_Traits.Tokens.Create (Word, 17, "again"), - 5 => Swordy_Traits.Tokens.Create (Word, 23, "and"), - 6 => Swordy_Traits.Tokens.Create (Word, 27, "again"), - 7 => Swordy_Traits.Tokens.Create (Word, 33, "and"), - 8 => Swordy_Traits.Tokens.Create (Word, 37, "again")); - - Actual_Result : Swordy_Traits.Tokens.Token_Array := - My_Scan (More_Input'Unrestricted_Access, Test_Context); - begin - if Actual_Result /= Intended_Result then - return Fail; - end if; - return Pass; - end Scan_With_Check; - - - function Scan_Set_Check - return Test_Result - is - procedure My_Scan is new Swordy.Scan_Set - ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); - - Test_Str1 : String (1 .. 10) := "one tw"; - Test_Str2 : String (1 .. 10) := "o three"; - Test_Str3 : String (1 .. 10) := Latin.EOT & " "; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result1 : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), - 2 => Swordy_Traits.Tokens.Create (Blank, 1, ""), - 3 => Swordy_Traits.Tokens.Create (Blank, 1, "")); - Intended_Result2 : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 9, "two"), - 2 => Swordy_Traits.Tokens.Create (Blank, 1, ""), - 3 => Swordy_Traits.Tokens.Create (Blank, 1, "")); - Intended_Result3 : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 16, "three"), - 2 => Swordy_Traits.Tokens.Create (Blank, 1, ""), - 3 => Swordy_Traits.Tokens.Create (Blank, 1, "")); - - Actual_Result : Swordy_Traits.Tokens.Token_Array (1 .. 3); - begin - My_Scan (Test_Str1, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result1 then - return Fail; - end if; - My_Scan (Test_Str2, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result2 then - return Fail; - end if; - My_Scan (Test_Str3, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result3 then - return Fail; - end if; - return Pass; - end Scan_Set_Check; - - - function Scan_Set_With_Check - return Test_Result - is - Sentinel : Natural := 2; - function More_Input - return String is - begin - if Sentinel > 1 then - Sentinel := 1; - return "it will happen again"; - elsif Sentinel > 0 then - Sentinel := 0; - return " and again and again"; - else - return ""; - end if; - end More_Input; - - procedure My_Scan is new Swordy.Scan_Set_With - ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); - - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Intended_Result1 : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 1, "it"), - 2 => Swordy_Traits.Tokens.Create (Word, 4, "will"), - 3 => Swordy_Traits.Tokens.Create (Word, 9, "happen"), - 4 => Swordy_Traits.Tokens.Create (Word, 16, "again"), - 5 => Swordy_Traits.Tokens.Create (Word, 22, "and")); - Intended_Result2 : Swordy_Traits.Tokens.Token_Array := - (1 => Swordy_Traits.Tokens.Create (Word, 26, "again"), - 2 => Swordy_Traits.Tokens.Create (Word, 32, "and"), - 3 => Swordy_Traits.Tokens.Create (Word, 36, "again"), - 4 => Swordy_Traits.Tokens.Create (Blank, 1, ""), - 5 => Swordy_Traits.Tokens.Create (Blank, 1, "")); - - Actual_Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); - begin - My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result1 then - return Fail; - end if; - My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); - if Actual_Result /= Intended_Result2 then - return Fail; - end if; - return Pass; - end Scan_Set_With_Check; - - - function Scan_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - function My_Scan is new Swordy.Scan - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - declare - Result : Swordy_Traits.Tokens.Token_Array := My_Scan (Test_Str, Test_Context); - begin - return Fail; - end; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_Error_Check; - - - function Scan_Only_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - function My_Scan is new Swordy.Scan_Only - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - declare - Result : Swordy_Traits.Tokens.Token_Array := My_Scan (Test_Str, Test_Context); - begin - return Fail; - end; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_Only_Error_Check; - - - function Scan_With_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - Sentinel : Integer := 1; - function Get_Input - return String is - begin - if Sentinel > 0 then - Sentinel := 0; - return "()()"; - else - return ""; - end if; - end Get_Input; - - function My_Scan is new Swordy.Scan_With - ((Stamp_Word'Access, Ignore_Whitespace'Access)); - - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - declare - Result : Swordy_Traits.Tokens.Token_Array := - My_Scan (Get_Input'Unrestricted_Access, Test_Context); - begin - return Fail; - end; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_With_Error_Check; - - - function Scan_Set_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - procedure My_Scan is new Swordy.Scan_Set - ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); - - Test_Str : String := "()()"; - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - My_Scan (Test_Str, Test_Context, Result); - return Fail; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_Set_Error_Check; - - - function Scan_Set_With_Error_Check - return Test_Result - is - use type Packrat.Errors.Error_Info_Array; - - Sentinel : Integer := 1; - function Get_Input - return String is - begin - if Sentinel > 0 then - Sentinel := 0; - return "()()"; - else - return ""; - end if; - end Get_Input; - - procedure My_Scan is new Swordy.Scan_Set_With - ((Stamp_Word'Access, Ignore_Whitespace'Access), - Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); - - Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; - - Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); - - Expected_Errors : Packrat.Errors.Error_Info_Array := - ((+"WORD", 1), (+"WHITESPACE", 1)); - begin - My_Scan (Get_Input'Unrestricted_Access, Test_Context, Result); - return Fail; - exception - when Msg : Packrat.Lexer_Error => - if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then - return Fail; - end if; - return Pass; - end Scan_Set_With_Error_Check; - - -end Rat_Tests.Lexer; - - diff --git a/test/rat_tests-lexer.ads b/test/rat_tests-lexer.ads deleted file mode 100644 index bc3045c..0000000 --- a/test/rat_tests-lexer.ads +++ /dev/null @@ -1,81 +0,0 @@ - - -with Unit_Tests; -use Unit_Tests; - - -package Rat_Tests.Lexer is - - - function Join_Check return Test_Result; - function Equals_Check return Test_Result; - - function Sequence_Check return Test_Result; - function Count_Check return Test_Result; - function Many_Check return Test_Result; - function Many_Until_Check return Test_Result; - - function Satisfy_Check return Test_Result; - function Satisfy_With_Check return Test_Result; - function Match_Check return Test_Result; - function Match_With_Check return Test_Result; - function Multimatch_Check return Test_Result; - function Take_Check return Test_Result; - function Take_While_Check return Test_Result; - function Take_Until_Check return Test_Result; - - function Line_End_Check return Test_Result; - function Input_End_Check return Test_Result; - - Combinator_Tests : Test_Array := - ((+"Join", Join_Check'Access), - (+"Equals", Equals_Check'Access), - (+"Sequence", Sequence_Check'Access), - (+"Count", Count_Check'Access), - (+"Many", Many_Check'Access), - (+"Many_Until", Many_Until_Check'Access), - (+"Satisfy", Satisfy_Check'Access), - (+"Satisfy With", Satisfy_With_Check'Access), - (+"Match", Match_Check'Access), - (+"Match With", Match_With_Check'Access), - (+"Multimatch", Multimatch_Check'Access), - (+"Take", Take_Check'Access), - (+"Take While", Take_While_Check'Access), - (+"Take Until", Take_Until_Check'Access), - (+"Line End", Line_End_Check'Access), - (+"Input_End", Input_End_Check'Access)); - - - function Stamp_Check return Test_Result; - function Ignore_Check return Test_Result; - - function Scan_Check return Test_Result; - function Scan_Only_Check return Test_Result; - function Scan_With_Check return Test_Result; - function Scan_Set_Check return Test_Result; - function Scan_Set_With_Check return Test_Result; - - function Scan_Error_Check return Test_Result; - function Scan_Only_Error_Check return Test_Result; - function Scan_With_Error_Check return Test_Result; - function Scan_Set_Error_Check return Test_Result; - function Scan_Set_With_Error_Check return Test_Result; - - Lexer_Tests : Test_Array := - ((+"Stamp", Stamp_Check'Access), - (+"Ignore", Ignore_Check'Access), - (+"Scan", Scan_Check'Access), - (+"Scan_Only", Scan_Only_Check'Access), - (+"Scan_With", Scan_With_Check'Access), - (+"Scan_Set", Scan_Set_Check'Access), - (+"Scan_Set_With", Scan_Set_With_Check'Access), - (+"Scan Exception", Scan_Error_Check'Access), - (+"Scan_Only Exception", Scan_Only_Error_Check'Access), - (+"Scan_With Exception", Scan_With_Error_Check'Access), - (+"Scan_Set Exception", Scan_Set_Error_Check'Access), - (+"Scan_Set_With Exception", Scan_Set_With_Error_Check'Access)); - - -end Rat_Tests.Lexer; - - diff --git a/test/rat_tests-lexers.adb b/test/rat_tests-lexers.adb new file mode 100644 index 0000000..0087f60 --- /dev/null +++ b/test/rat_tests-lexers.adb @@ -0,0 +1,1022 @@ + + +with + + Packrat.Errors, + Packrat.Traits, + Packrat.Lexers.Debug, + Packrat.Utilities; + + +package body Rat_Tests.Lexers is + + + package PU renames Packrat.Utilities; + + + type My_Labels is (One, Two, Three); + + + package Slexy_Traits is new Packrat.Traits (My_Labels, Character, String); + package Slexy is new Packrat.Lexers (Slexy_Traits); + package Slebug is new Slexy.Debug; + + + use type Slexy.Combinator_Result; + + + + + + function Join_Check + return Test_Result + is + One : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Success); + Two : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Three : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + + Four : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Failure); + Five : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Failure); + + Six : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Needs_More); + Seven : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Needs_More); + + Eight : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Failure); + + Nine : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Optional_More); + Ten : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Eleven : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + begin + if Slebug.Join (One, Two) /= Three or Slebug.Join (One, Four) /= Five or + Slebug.Join (One, Six) /= Seven or Slebug.Join (Four, Six) /= Four or + Slebug.Join (Five, Two) /= Five or Slebug.Join (Six, Three) /= Eight or + Slebug.Join (Slebug.Empty_Fail, One) /= Slebug.Empty_Fail or + Slebug.Join (Nine, Ten) /= Eleven + then + return Fail; + end if; + return Pass; + end Join_Check; + + + function Equals_Check + return Test_Result + is + One : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Two : Slexy.Combinator_Result := + Slebug.Create_Result (0, Packrat.Failure); + begin + if One = Two or Two /= Slebug.Empty_Fail then + return Fail; + end if; + return Pass; + end Equals_Check; + + + + + + function Sequence_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Match_B is new Slexy.Match ('b'); + function Match_C is new Slexy.Match ('c'); + function Seq_Abc is new Slexy.Sequence + ((Match_A'Unrestricted_Access, + Match_B'Unrestricted_Access, + Match_C'Unrestricted_Access)); + + Test_Str : String := "aababcabcab"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Failure); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (11, Packrat.Needs_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (6, Packrat.Success); + Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; + Result5 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Failure); + begin + if Seq_Abc (Test_Str, 1) /= Result1 or Seq_Abc (Test_Str, 2) /= Result5 or + Seq_Abc (Test_Str, 4) /= Result3 or Seq_Abc (Test_Str, 10) /= Result2 or + Seq_Abc (Test_Str, 3) /= Result4 or + Seq_Abc (Test_Str, Test_Str'Last + 5) /= Result4 + then + return Fail; + end if; + return Pass; + end Sequence_Check; + + + function Count_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Match_B is new Slexy.Match ('b'); + function Count_2A is new Slexy.Count (Match_A, 2); + function Count_3B is new Slexy.Count (Match_B, 3); + + Test_Str : String := "abaabbaaabbbaaaabbbb"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Failure); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Success); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (2, Packrat.Failure); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (20, Packrat.Needs_More); + Result5 : Slexy.Combinator_Result := + Slebug.Create_Result (12, Packrat.Success); + Result6 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Count_2A (Test_Str, 1) /= Result1 or Count_2A (Test_Str, 3) /= Result2 or + Count_3B (Test_Str, 2) /= Result3 or Count_3B (Test_Str, 19) /= Result4 or + Count_3B (Test_Str, 10) /= Result5 or Count_3B (Test_Str, 1) /= Result6 or + Count_2A (Test_Str, 2) /= Result6 or + Count_2A (Test_Str, Test_Str'Last + 5) /= Result6 + then + return Fail; + end if; + return Pass; + end Count_Check; + + + function Many_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Many_0 is new Slexy.Many (Match_A); + function Many_4 is new Slexy.Many (Match_A, 4); + + function Match_B is new Slexy.Match ('b'); + function Match_C is new Slexy.Match ('c'); + function Seq_Abc is new Slexy.Sequence + ((Match_A'Unrestricted_Access, + Match_B'Unrestricted_Access, + Match_C'Unrestricted_Access)); + function Many_Seq_0 is new Slexy.Many (Seq_Abc); + function Many_Seq_4 is new Slexy.Many (Seq_Abc, 4); + + Test_Str : String := "aaabbaaaaabaa"; + Test_Str2 : String := "aababcabcab"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (13, Packrat.Optional_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (10, Packrat.Success); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Failure); + Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; + Result6 : Slexy.Combinator_Result := + Slebug.Create_Result (13, Packrat.Needs_More); + Result7 : Slexy.Combinator_Result := + Slebug.Create_Result (0, Packrat.Success); + Result8 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Optional_More); + Result9 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Needs_More); + begin + if Many_0 (Test_Str, 1) /= Result1 or Many_4 (Test_Str, 1) /= Result4 or + Many_4 (Test_Str, 6) /= Result3 or Many_0 (Test_Str, 4) /= Result7 or + Many_0 (Test_Str, 12) /= Result2 or Many_4 (Test_Str, 12) /= Result6 or + Many_0 (Test_Str, Test_Str'Last + 5) /= Result5 or + Many_Seq_0 (Test_Str2, 4) /= Result8 or Many_Seq_4 (Test_Str2, 4) /= Result9 + then + return Fail; + end if; + return Pass; + end Many_Check; + + + function Many_Until_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Many_Until_0 is new Slexy.Many_Until (Match_A, PU.Is_Digit); + function Many_Until_3 is new Slexy.Many_Until (Match_A, PU.Is_Digit, 3); + + Test_Str : String := "aaaabbaaa123aaa"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (4, Packrat.Failure); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Success); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (15, Packrat.Needs_More); + Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Many_Until_0 (Test_Str, 1) /= Result1 or + Many_Until_0 (Test_Str, 7) /= Result2 or + Many_Until_3 (Test_Str, 7) /= Result2 or + Many_Until_3 (Test_Str, 13) /= Result3 or + Many_Until_0 (Test_Str, 5) /= Result4 or + Many_Until_0 (Test_Str, Test_Str'Last + 5) /= Result4 or + Many_Until_3 (Test_Str, Test_Str'Last + 5) /= Result4 + then + return Fail; + end if; + return Pass; + end Many_Until_Check; + + + function Satisfy_Check + return Test_Result + is + function Is_123 + (Char : in Character) + return Boolean is + begin + return Char = '1' or Char = '2' or Char = '3'; + end Is_123; + function Is_Abc + (Char : in Character) + return Boolean is + begin + return Char = 'a' or Char = 'b' or Char = 'c'; + end Is_Abc; + + function Satisfy_123 is new Slexy.Satisfy (Is_123); + function Satisfy_Abc is new Slexy.Satisfy (Is_Abc); + + Test_Str : String := "abc123456def"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (2, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (6, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Satisfy_123 (Test_Str, 6) /= Result2 or + Satisfy_Abc (Test_Str, 2) /= Result1 or + Satisfy_Abc (Test_Str, 8) /= Result3 or + Satisfy_123 (Test_Str, Test_Str'Last + 5) /= Result3 + then + return Fail; + end if; + return Pass; + end Satisfy_Check; + + + function Satisfy_With_Check + return Test_Result + is + function Is_Abc + (Char : in Character) + return Boolean is + begin + return Char = 'a' or Char = 'b' or Char = 'c'; + end Is_Abc; + function Is_123 + (Char : in Character) + return Boolean is + begin + return Char = '1' or Char = '2' or Char = '3'; + end Is_123; + function Minus_One + (Char : in Character) + return Character is + begin + return Character'Val (Character'Pos (Char) - 1); + end Minus_One; + + function Satisfy_Bcd is new Slexy.Satisfy_With (Is_Abc, Minus_One); + function Satisfy_234 is new Slexy.Satisfy_With (Is_123, Minus_One); + + Test_Str : String := "abcde12345"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (7, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Satisfy_Bcd (Test_Str, 3) /= Result1 or + Satisfy_234 (Test_Str, 7) /= Result2 or + Satisfy_Bcd (Test_Str, 1) /= Result3 or + Satisfy_234 (Test_Str, Test_Str'Last + 5) /= Result3 + then + return Fail; + end if; + return Pass; + end Satisfy_With_Check; + + + function Match_Check + return Test_Result + is + function Match_A is new Slexy.Match ('a'); + function Match_Slash is new Slexy.Match ('/'); + function Match_4 is new Slexy.Match ('4'); + + Test_Str : String := "abc1234./5"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Success); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (7, Packrat.Success); + Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Match_A (Test_Str, 1) /= Result1 or + Match_Slash (Test_Str, 9) /= Result2 or + Match_4 (Test_Str, 7) /= Result3 or + Match_A (Test_Str, 3) /= Result4 or + Match_A (Test_Str, Test_Str'Last + 5) /= Result4 + then + return Fail; + end if; + return Pass; + end Match_Check; + + + function Match_With_Check + return Test_Result + is + function Plus_One + (Char : in Character) + return Character is + begin + return Character'Val (Character'Pos (Char) + 1); + end Plus_One; + + function Match_A is new Slexy.Match_With ('b', Plus_One); + function Match_6 is new Slexy.Match_With ('7', Plus_One); + + Test_Str : String := "abc5678"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (1, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Match_A (Test_Str, 1) /= Result1 or + Match_6 (Test_Str, 5) /= Result2 or + Match_A (Test_Str, 2) /= Result3 or + Match_A (Test_Str, Test_Str'Last + 5) /= Result3 + then + return Fail; + end if; + return Pass; + end Match_With_Check; + + + function Multimatch_Check + return Test_Result + is + function Match_String1 is new Slexy.Multimatch ("abc"); + function Match_String2 is new Slexy.Multimatch ("hello"); + + Test_Str : String := "abcdefabhelloworldab"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (20, Packrat.Needs_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (13, Packrat.Success); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (8, Packrat.Failure); + Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Match_String1 (Test_Str, 1) /= Result1 or + Match_String1 (Test_Str, 7) /= Result4 or + Match_String2 (Test_Str, 9) /= Result3 or + Match_String2 (Test_Str, 3) /= Result5 or + Match_String1 (Test_Str, 19) /= Result2 or + Match_String1 (Test_Str, Test_Str'Last + 5) /= Result5 + then + return Fail; + end if; + return Pass; + end Multimatch_Check; + + + function Take_Check + return Test_Result + is + function Take_1 is new Slexy.Take; + function Take_5 is new Slexy.Take (5); + + Test_Str : String := "abcdefghi"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (2, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (9, Packrat.Needs_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (7, Packrat.Success); + Result4 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Take_1 (Test_Str, 2) /= Result1 or Take_5 (Test_Str, 7) /= Result2 or + Take_5 (Test_Str, 3) /= Result3 or + Take_1 (Test_Str, Test_Str'Last + 5) /= Result4 + then + return Fail; + end if; + return Pass; + end Take_Check; + + + function Take_While_Check + return Test_Result + is + function Take_Letters is new Slexy.Take_While (PU.Is_Letter); + function Take_Punch is new Slexy.Take_While (PU.Is_Punctuation); + function Take_Digits is new Slexy.Take_While (PU.Is_Digit); + + Test_Str : String := "abcde,./;'fghi[]=-^563"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (14, Packrat.Success); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (10, Packrat.Success); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (19, Packrat.Success); + Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; + Result6 : Slexy.Combinator_Result := + Slebug.Create_Result (22, Packrat.Optional_More); + begin + if Take_Letters (Test_Str, 2) /= Result1 or + Take_Letters (Test_Str, 13) /= Result2 or + Take_Punch (Test_Str, 6) /= Result3 or + Take_Punch (Test_Str, 17) /= Result4 or + Take_Letters (Test_Str, 7) /= Result5 or + Take_Punch (Test_Str, Test_Str'Last + 5) /= Result5 or + Take_Digits (Test_Str, 20) /= Result6 + then + return Fail; + end if; + return Pass; + end Take_While_Check; + + + function Take_Until_Check + return Test_Result + is + function Take_Till_Punch is new Slexy.Take_Until (PU.Is_Punctuation); + function Take_Till_Digit is new Slexy.Take_Until (PU.Is_Digit); + + Test_Str : String := "abcde12345;;;fghi67"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (10, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (19, Packrat.Optional_More); + Result3 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result4 : Slexy.Combinator_Result := + Slebug.Create_Result (17, Packrat.Success); + Result5 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if Take_Till_Punch (Test_Str, 4) /= Result1 or + Take_Till_Punch (Test_Str, 16) /= Result2 or + Take_Till_Digit (Test_Str, 1) /= Result3 or + Take_Till_Digit (Test_Str, 12) /= Result4 or + Take_Till_Punch (Test_Str, 11) /= Result5 or + Take_Till_Punch (Test_Str, Test_Str'Last + 5) /= Result5 + then + return Fail; + end if; + return Pass; + end Take_Until_Check; + + + function Line_End_Check + return Test_Result + is + function LF_End is new Slexy.Line_End (Latin.LF); + function C_End is new Slexy.Line_End ('c'); + + Test_Str : String := "abcd" & Latin.LF & "e"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if LF_End (Test_Str, 5) /= Result1 or C_End (Test_Str, 3) /= Result2 or + LF_End (Test_Str, Test_Str'Last + 5) /= Result3 or LF_End (Test_Str, 1) /= Result3 + then + return Fail; + end if; + return Pass; + end Line_End_Check; + + + function Input_End_Check + return Test_Result + is + function C_End is new Slexy.Input_End ('c'); + function E_End is new Slexy.Input_End ('e'); + + Test_Str : String := "abcde"; + + Result1 : Slexy.Combinator_Result := + Slebug.Create_Result (5, Packrat.Success); + Result2 : Slexy.Combinator_Result := + Slebug.Create_Result (3, Packrat.Success); + Result3 : Slexy.Combinator_Result := Slebug.Empty_Fail; + begin + if C_End (Test_Str, 3) /= Result2 or E_End (Test_Str, 5) /= Result1 or + C_End (Test_Str, 6) /= Result3 or E_End (Test_Str, 6) /= Result3 or + C_End (Test_Str, 1) /= Result3 or E_End (Test_Str, Test_Str'Last + 5) /= Result3 + then + return Fail; + end if; + return Pass; + end Input_End_Check; + + + + + + function Stamp_Check + return Test_Result + is + use type Slexy_Traits.Tokens.Token; + use type Packrat.Result_Status; + use type Slexy.Component_Result; + + function Match_A is new Slexy.Match ('a'); + function Match_B is new Slexy.Match ('b'); + function Match_C is new Slexy.Match ('c'); + function Seq_Abc is new Slexy.Sequence + ((Match_A'Unrestricted_Access, + Match_B'Unrestricted_Access, + Match_C'Unrestricted_Access)); + function My_Stamp is new Slexy.Stamp (One, Seq_Abc); + + Test_Str1 : String := "abcdefghi"; + Test_Str2 : String := "ab"; + + Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; + Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; + + Comp_Code : Slexy.Component_Result; + begin + Comp_Code := My_Stamp (Test_Str1, Context1); + if (Slebug.So_Far (Context1).Length /= 1 or else + Slebug.So_Far (Context1).Element (1) /= Slexy_Traits.Tokens.Create (One, 1, "abc")) or + Slebug.Position (Context1) /= 4 or Slebug.Status (Context1) /= Packrat.Success or + 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) /= Slexy_Traits.Tokens.Create (One, 1, "abc")) or + Slebug.Position (Context1) /= 4 or not Slebug.Is_Failure (Comp_Code) or + Slebug.Has_Pass (Context1) + then + return Fail; + end if; + Comp_Code := My_Stamp (Test_Str2, Context2); + if Slebug.So_Far (Context2).Length /= 0 or + Slebug.Position (Context2) /= 1 or + Slebug.Status (Context2) /= Packrat.Needs_More or + (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") + then + return Fail; + end if; + return Pass; + end Stamp_Check; + + + function Ignore_Check + return Test_Result + is + use type Packrat.Result_Status; + + function Match_Abc is new Slexy.Multimatch ("abc"); + function My_Ignore is new Slexy.Ignore (Two, Match_Abc); + + Test_Str1 : String := "abcdefghi"; + Test_Str2 : String := "ab"; + + Context1 : Slexy.Lexer_Context := Slexy.Empty_Context; + Context2 : Slexy.Lexer_Context := Slexy.Empty_Context; + + Comp_Code : Slexy.Component_Result; + begin + 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.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.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 + (not Slebug.Has_Pass (Context2) or else Slebug.Pass (Context2) /= "ab") + then + return Fail; + end if; + return Pass; + end Ignore_Check; + + + + + + type Word_Enum is (Blank, Word, Whitespace); + + package Swordy_Traits is new Packrat.Traits (Word_Enum, Character, String); + package Swordy is new Packrat.Lexers (Swordy_Traits); + package Swolbug is new Swordy.Debug; + + use type Swordy_Traits.Tokens.Token; + use type Swordy_Traits.Tokens.Token_Array; + + function Satisfy_Letter is new Swordy.Satisfy (PU.Is_Letter); + function Many_Letter is new Swordy.Many (Satisfy_Letter, 1); + function Satisfy_Whitespace is new Swordy.Satisfy (PU.Is_Whitespace); + function Many_Whitespace is new Swordy.Many (Satisfy_Whitespace, 1); + + function Stamp_Word is new Swordy.Stamp (Word, Many_Letter); + function Ignore_Whitespace is new Swordy.Ignore (Whitespace, Many_Whitespace); + + + function Scan_Check + return Test_Result + is + function My_Scan is new Swordy.Scan + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Str : String := "one fine day"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result1 : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), + 2 => Swordy_Traits.Tokens.Create (Word, 5, "fine")); + Intended_Result2 : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 10, "day")); + + Actual_Result1 : Swordy_Traits.Tokens.Token_Array := + My_Scan (Test_Str, Test_Context); + Actual_Result2 : Swordy_Traits.Tokens.Token_Array := + My_Scan ("", Test_Context); + begin + if Actual_Result1 /= Intended_Result1 or Actual_Result2 /= Intended_Result2 then + return Fail; + end if; + return Pass; + end Scan_Check; + + + function Scan_Only_Check + return Test_Result + is + function My_Scan is new Swordy.Scan_Only + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Str : String := "one fine day"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), + 2 => Swordy_Traits.Tokens.Create (Word, 5, "fine"), + 3 => Swordy_Traits.Tokens.Create (Word, 10, "day")); + + Actual_Result : Swordy_Traits.Tokens.Token_Array := + My_Scan (Test_Str, Test_Context); + begin + if Actual_Result /= Intended_Result then + return Fail; + end if; + return Pass; + end Scan_Only_Check; + + + function Scan_With_Check + return Test_Result + is + Sentinel : Natural := 2; + function More_Input + return String is + begin + if Sentinel > 1 then + Sentinel := 1; + return "it will happen again"; + elsif Sentinel > 0 then + Sentinel := 0; + return " and again and again"; + else + return ""; + end if; + end More_Input; + + function My_Scan is new Swordy.Scan_With + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 1, "it"), + 2 => Swordy_Traits.Tokens.Create (Word, 4, "will"), + 3 => Swordy_Traits.Tokens.Create (Word, 9, "happen"), + 4 => Swordy_Traits.Tokens.Create (Word, 17, "again"), + 5 => Swordy_Traits.Tokens.Create (Word, 23, "and"), + 6 => Swordy_Traits.Tokens.Create (Word, 27, "again"), + 7 => Swordy_Traits.Tokens.Create (Word, 33, "and"), + 8 => Swordy_Traits.Tokens.Create (Word, 37, "again")); + + Actual_Result : Swordy_Traits.Tokens.Token_Array := + My_Scan (More_Input'Unrestricted_Access, Test_Context); + begin + if Actual_Result /= Intended_Result then + return Fail; + end if; + return Pass; + end Scan_With_Check; + + + function Scan_Set_Check + return Test_Result + is + procedure My_Scan is new Swordy.Scan_Set + ((Stamp_Word'Access, Ignore_Whitespace'Access), + Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); + + Test_Str1 : String (1 .. 10) := "one tw"; + Test_Str2 : String (1 .. 10) := "o three"; + Test_Str3 : String (1 .. 10) := Latin.EOT & " "; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result1 : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 1, "one"), + 2 => Swordy_Traits.Tokens.Create (Blank, 1, ""), + 3 => Swordy_Traits.Tokens.Create (Blank, 1, "")); + Intended_Result2 : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 9, "two"), + 2 => Swordy_Traits.Tokens.Create (Blank, 1, ""), + 3 => Swordy_Traits.Tokens.Create (Blank, 1, "")); + Intended_Result3 : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 16, "three"), + 2 => Swordy_Traits.Tokens.Create (Blank, 1, ""), + 3 => Swordy_Traits.Tokens.Create (Blank, 1, "")); + + Actual_Result : Swordy_Traits.Tokens.Token_Array (1 .. 3); + begin + My_Scan (Test_Str1, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result1 then + return Fail; + end if; + My_Scan (Test_Str2, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result2 then + return Fail; + end if; + My_Scan (Test_Str3, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result3 then + return Fail; + end if; + return Pass; + end Scan_Set_Check; + + + function Scan_Set_With_Check + return Test_Result + is + Sentinel : Natural := 2; + function More_Input + return String is + begin + if Sentinel > 1 then + Sentinel := 1; + return "it will happen again"; + elsif Sentinel > 0 then + Sentinel := 0; + return " and again and again"; + else + return ""; + end if; + end More_Input; + + procedure My_Scan is new Swordy.Scan_Set_With + ((Stamp_Word'Access, Ignore_Whitespace'Access), + Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); + + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Intended_Result1 : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 1, "it"), + 2 => Swordy_Traits.Tokens.Create (Word, 4, "will"), + 3 => Swordy_Traits.Tokens.Create (Word, 9, "happen"), + 4 => Swordy_Traits.Tokens.Create (Word, 16, "again"), + 5 => Swordy_Traits.Tokens.Create (Word, 22, "and")); + Intended_Result2 : Swordy_Traits.Tokens.Token_Array := + (1 => Swordy_Traits.Tokens.Create (Word, 26, "again"), + 2 => Swordy_Traits.Tokens.Create (Word, 32, "and"), + 3 => Swordy_Traits.Tokens.Create (Word, 36, "again"), + 4 => Swordy_Traits.Tokens.Create (Blank, 1, ""), + 5 => Swordy_Traits.Tokens.Create (Blank, 1, "")); + + Actual_Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); + begin + My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result1 then + return Fail; + end if; + My_Scan (More_Input'Unrestricted_Access, Test_Context, Actual_Result); + if Actual_Result /= Intended_Result2 then + return Fail; + end if; + return Pass; + end Scan_Set_With_Check; + + + function Scan_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + function My_Scan is new Swordy.Scan + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Str : String := "()()"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + declare + Result : Swordy_Traits.Tokens.Token_Array := My_Scan (Test_Str, Test_Context); + begin + return Fail; + end; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_Error_Check; + + + function Scan_Only_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + function My_Scan is new Swordy.Scan_Only + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Str : String := "()()"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + declare + Result : Swordy_Traits.Tokens.Token_Array := My_Scan (Test_Str, Test_Context); + begin + return Fail; + end; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_Only_Error_Check; + + + function Scan_With_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + Sentinel : Integer := 1; + function Get_Input + return String is + begin + if Sentinel > 0 then + Sentinel := 0; + return "()()"; + else + return ""; + end if; + end Get_Input; + + function My_Scan is new Swordy.Scan_With + ((Stamp_Word'Access, Ignore_Whitespace'Access)); + + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + declare + Result : Swordy_Traits.Tokens.Token_Array := + My_Scan (Get_Input'Unrestricted_Access, Test_Context); + begin + return Fail; + end; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_With_Error_Check; + + + function Scan_Set_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + procedure My_Scan is new Swordy.Scan_Set + ((Stamp_Word'Access, Ignore_Whitespace'Access), + Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); + + Test_Str : String := "()()"; + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + My_Scan (Test_Str, Test_Context, Result); + return Fail; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_Set_Error_Check; + + + function Scan_Set_With_Error_Check + return Test_Result + is + use type Packrat.Errors.Error_Info_Array; + + Sentinel : Integer := 1; + function Get_Input + return String is + begin + if Sentinel > 0 then + Sentinel := 0; + return "()()"; + else + return ""; + end if; + end Get_Input; + + procedure My_Scan is new Swordy.Scan_Set_With + ((Stamp_Word'Access, Ignore_Whitespace'Access), + Latin.EOT, Swordy_Traits.Tokens.Create (Blank, 1, "")); + + Test_Context : Swordy.Lexer_Context := Swordy.Empty_Context; + + Result : Swordy_Traits.Tokens.Token_Array (1 .. 5); + + Expected_Errors : Packrat.Errors.Error_Info_Array := + ((+"WORD", 1), (+"WHITESPACE", 1)); + begin + My_Scan (Get_Input'Unrestricted_Access, Test_Context, Result); + return Fail; + exception + when Msg : Packrat.Lexer_Error => + if Packrat.Errors.Decode (Except.Exception_Message (Msg)) /= Expected_Errors then + return Fail; + end if; + return Pass; + end Scan_Set_With_Error_Check; + + +end Rat_Tests.Lexers; + + diff --git a/test/rat_tests-lexers.ads b/test/rat_tests-lexers.ads new file mode 100644 index 0000000..0cf86b7 --- /dev/null +++ b/test/rat_tests-lexers.ads @@ -0,0 +1,81 @@ + + +with Unit_Tests; +use Unit_Tests; + + +package Rat_Tests.Lexers is + + + function Join_Check return Test_Result; + function Equals_Check return Test_Result; + + function Sequence_Check return Test_Result; + function Count_Check return Test_Result; + function Many_Check return Test_Result; + function Many_Until_Check return Test_Result; + + function Satisfy_Check return Test_Result; + function Satisfy_With_Check return Test_Result; + function Match_Check return Test_Result; + function Match_With_Check return Test_Result; + function Multimatch_Check return Test_Result; + function Take_Check return Test_Result; + function Take_While_Check return Test_Result; + function Take_Until_Check return Test_Result; + + function Line_End_Check return Test_Result; + function Input_End_Check return Test_Result; + + Combinator_Tests : Test_Array := + ((+"Join", Join_Check'Access), + (+"Equals", Equals_Check'Access), + (+"Sequence", Sequence_Check'Access), + (+"Count", Count_Check'Access), + (+"Many", Many_Check'Access), + (+"Many_Until", Many_Until_Check'Access), + (+"Satisfy", Satisfy_Check'Access), + (+"Satisfy With", Satisfy_With_Check'Access), + (+"Match", Match_Check'Access), + (+"Match With", Match_With_Check'Access), + (+"Multimatch", Multimatch_Check'Access), + (+"Take", Take_Check'Access), + (+"Take While", Take_While_Check'Access), + (+"Take Until", Take_Until_Check'Access), + (+"Line End", Line_End_Check'Access), + (+"Input_End", Input_End_Check'Access)); + + + function Stamp_Check return Test_Result; + function Ignore_Check return Test_Result; + + function Scan_Check return Test_Result; + function Scan_Only_Check return Test_Result; + function Scan_With_Check return Test_Result; + function Scan_Set_Check return Test_Result; + function Scan_Set_With_Check return Test_Result; + + function Scan_Error_Check return Test_Result; + function Scan_Only_Error_Check return Test_Result; + function Scan_With_Error_Check return Test_Result; + function Scan_Set_Error_Check return Test_Result; + function Scan_Set_With_Error_Check return Test_Result; + + Lexer_Tests : Test_Array := + ((+"Stamp", Stamp_Check'Access), + (+"Ignore", Ignore_Check'Access), + (+"Scan", Scan_Check'Access), + (+"Scan_Only", Scan_Only_Check'Access), + (+"Scan_With", Scan_With_Check'Access), + (+"Scan_Set", Scan_Set_Check'Access), + (+"Scan_Set_With", Scan_Set_With_Check'Access), + (+"Scan Exception", Scan_Error_Check'Access), + (+"Scan_Only Exception", Scan_Only_Error_Check'Access), + (+"Scan_With Exception", Scan_With_Error_Check'Access), + (+"Scan_Set Exception", Scan_Set_Error_Check'Access), + (+"Scan_Set_With Exception", Scan_Set_With_Error_Check'Access)); + + +end Rat_Tests.Lexers; + + diff --git a/test/rat_tests-util.adb b/test/rat_tests-util.adb deleted file mode 100644 index fe1f890..0000000 --- a/test/rat_tests-util.adb +++ /dev/null @@ -1,513 +0,0 @@ - - -with Packrat.Util; - - -package body Rat_Tests.Util is - - - package PU renames Packrat.Util; - - - function In_Set_Check - return Test_Result - is - use type Strmaps.Character_Set; - Set_1 : Strmaps.Character_Set := Strmaps.To_Set ("abcxyz"); - Set_2 : Strmaps.Character_Set := Strmaps.To_Set ("!""#$"); - function Func_1 is new PU.In_Set (Set_1); - function Func_2 is new PU.In_Set (Set_2); - begin - -- Func_1 testing - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('a') - 1 loop - if Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'c' loop - if not Func_1 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('c') + 1 .. Character'Pos ('x') - 1 loop - if Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'x' .. 'z' loop - if not Func_1 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop - if Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - -- Func_2 testing - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop - if Func_2 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '!' .. '$' loop - if not Func_2 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('$') + 1 .. Character'Pos (Character'Last) loop - if Func_2 (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end In_Set_Check; - - - function Not_In_Set_Check - return Test_Result - is - use type Strmaps.Character_Set; - Set_1 : Strmaps.Character_Set := Strmaps.To_Set ("abcxyz"); - Set_2 : Strmaps.Character_Set := Strmaps.To_Set ("!""#$"); - function Func_1 is new PU.Not_In_Set (Set_1); - function Func_2 is new PU.Not_In_Set (Set_2); - begin - -- Func_1 testing - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('a') - 1 loop - if not Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'c' loop - if Func_1 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('c') + 1 .. Character'Pos ('x') - 1 loop - if not Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'x' .. 'z' loop - if Func_1 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop - if not Func_1 (Character'Val (I)) then - return Fail; - end if; - end loop; - -- Func_2 testing - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop - if not Func_2 (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '!' .. '$' loop - if Func_2 (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('$') + 1 .. Character'Pos (Character'Last) loop - if not Func_2 (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Not_In_Set_Check; - - - - - - function Is_Digit_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop - if PU.Is_Digit (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '0' .. '9' loop - if not PU.Is_Digit (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('9') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Digit (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Digit_Check; - - - function Is_Hex_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop - if PU.Is_Hex (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '0' .. '9' loop - if not PU.Is_Hex (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('9') + 1 .. Character'Pos ('A') - 1 loop - if PU.Is_Hex (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'A' .. 'F' loop - if not PU.Is_Hex (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('F') + 1 .. Character'Pos ('a') - 1 loop - if PU.Is_Hex (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'f' loop - if not PU.Is_Hex (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('f') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Hex (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Hex_Check; - - - function Is_Letter_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('A') - 1 loop - if PU.Is_Letter (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'A' .. 'Z' loop - if not PU.Is_Letter (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('Z') + 1 .. Character'Pos ('a') - 1 loop - if PU.Is_Letter (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'z' loop - if not PU.Is_Letter (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'First) loop - if PU.Is_Letter (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Letter_Check; - - - function Is_Alphanumeric_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop - if PU.Is_Alphanumeric (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '0' .. '9' loop - if not PU.Is_Alphanumeric (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('9') + 1 .. Character'Pos ('A') - 1 loop - if PU.Is_Alphanumeric (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'A' .. 'Z' loop - if not PU.Is_Alphanumeric (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('Z') + 1 .. Character'Pos ('a') - 1 loop - if PU.Is_Alphanumeric (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range 'a' .. 'z' loop - if not PU.Is_Alphanumeric (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Alphanumeric (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Alphanumeric_Check; - - - function Is_Punctuation_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '!' .. '/' loop - if not PU.Is_Punctuation (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('/') + 1 .. Character'Pos (':') - 1 loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range ':' .. '@' loop - if not PU.Is_Punctuation (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('@') + 1 .. Character'Pos ('[') - 1 loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '[' .. '`' loop - if not PU.Is_Punctuation (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('`') + 1 .. Character'Pos ('{') - 1 loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range '{' .. '~' loop - if not PU.Is_Punctuation (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos ('~') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Punctuation (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Punctuation_Check; - - - function Is_ASCII_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. 127 loop - if not PU.Is_ASCII (Character'Val (I)) then - return Fail; - end if; - end loop; - for I in Integer range 128 .. Character'Pos (Character'Last) loop - if PU.Is_ASCII (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_ASCII_Check; - - - function Is_Extended_ASCII_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. 127 loop - if PU.Is_Extended_ASCII (Character'Val (I)) then - return Fail; - end if; - end loop; - for I in Integer range 128 .. Character'Pos (Character'Last) loop - if not PU.Is_Extended_ASCII (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Extended_ASCII_Check; - - - function Is_Space_Check - return Test_Result is - begin - for I in Integer range Character'Pos (Character'First) .. Character'Pos (' ') - 1 loop - if PU.Is_Space (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Space (' ') then - return Fail; - end if; - for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Space (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Space_Check; - - - function Is_Linespace_Check - return Test_Result is - begin - for I in Integer range - Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 - loop - if PU.Is_Linespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Linespace (Latin.HT) then - return Fail; - end if; - for I in Integer range Character'Pos (Latin.HT) + 1 .. Character'Pos (' ') - 1 loop - if PU.Is_Linespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Linespace (' ') then - return Fail; - end if; - for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Linespace (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Linespace_Check; - - - function Is_End_Of_Line_Check - return Test_Result is - begin - for I in Integer range - Character'Pos (Character'First) .. Character'Pos (Latin.LF) - 1 - loop - if PU.Is_End_Of_Line (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_End_Of_Line (Latin.LF) then - return Fail; - end if; - for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop - if PU.Is_End_Of_Line (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_End_Of_Line (Latin.CR) then - return Fail; - end if; - for I in Integer range - Character'Pos (Latin.CR) + 1 .. Character'Pos (Character'Last) - loop - if PU.Is_End_Of_Line (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_End_Of_Line_Check; - - - function Is_Whitespace_Check - return Test_Result is - begin - for I in Integer range - Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 - loop - if PU.Is_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range Latin.HT .. Latin.LF loop - if not PU.Is_Whitespace (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop - if PU.Is_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Whitespace (Latin.CR) then - return Fail; - end if; - for I in Integer range Character'Pos (Latin.CR) + 1 .. Character'Pos (' ') - 1 loop - if PU.Is_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if not PU.Is_Whitespace (' ') then - return Fail; - end if; - for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop - if PU.Is_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Is_Whitespace_Check; - - - function Not_Whitespace_Check - return Test_Result is - begin - for I in Integer range - Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 - loop - if not PU.Not_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - for C in Character range Latin.HT .. Latin.LF loop - if PU.Not_Whitespace (C) then - return Fail; - end if; - end loop; - for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop - if not PU.Not_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if PU.Not_Whitespace (Latin.CR) then - return Fail; - end if; - for I in Integer range Character'Pos (Latin.CR) + 1 .. Character'Pos (' ') - 1 loop - if not PU.Not_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - if PU.Not_Whitespace (' ') then - return Fail; - end if; - for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop - if not PU.Not_Whitespace (Character'Val (I)) then - return Fail; - end if; - end loop; - return Pass; - end Not_Whitespace_Check; - - -end Rat_Tests.Util; - - diff --git a/test/rat_tests-util.ads b/test/rat_tests-util.ads deleted file mode 100644 index 1b4754a..0000000 --- a/test/rat_tests-util.ads +++ /dev/null @@ -1,48 +0,0 @@ - - -with Unit_Tests; -use Unit_Tests; - - -package Rat_Tests.Util is - - - function In_Set_Check return Test_Result; - function Not_In_Set_Check return Test_Result; - - Set_Predicate_Tests : Test_Array := - ((+"In_Set", In_Set_Check'Access), - (+"Not_In_Set", Not_In_Set_Check'Access)); - - - function Is_Digit_Check return Test_Result; - function Is_Hex_Check return Test_Result; - function Is_Letter_Check return Test_Result; - function Is_Alphanumeric_Check return Test_Result; - function Is_Punctuation_Check return Test_Result; - function Is_ASCII_Check return Test_Result; - function Is_Extended_ASCII_Check return Test_Result; - function Is_Space_Check return Test_Result; - function Is_Linespace_Check return Test_Result; - function Is_End_Of_Line_Check return Test_Result; - function Is_Whitespace_Check return Test_Result; - function Not_Whitespace_Check return Test_Result; - - Predicate_Tests : Test_Array := - ((+"Is_Digit", Is_Digit_Check'Access), - (+"Is_Hex", Is_Hex_Check'Access), - (+"Is_Letter", Is_Letter_Check'Access), - (+"Is_Alphanumeric", Is_Alphanumeric_Check'Access), - (+"Is_Punctuation", Is_Punctuation_Check'Access), - (+"Is_ASCII", Is_ASCII_Check'Access), - (+"Is_Extended_ASCII", Is_Extended_ASCII_Check'Access), - (+"Is_Space", Is_Space_Check'Access), - (+"Is_Linespace", Is_Linespace_Check'Access), - (+"Is_End_Of_Line", Is_End_Of_Line_Check'Access), - (+"Is_Whitespace", Is_Whitespace_Check'Access), - (+"Not_Whitespace", Not_Whitespace_Check'Access)); - - -end Rat_Tests.Util; - - diff --git a/test/rat_tests-utilities.adb b/test/rat_tests-utilities.adb new file mode 100644 index 0000000..c1bb790 --- /dev/null +++ b/test/rat_tests-utilities.adb @@ -0,0 +1,513 @@ + + +with Packrat.Utilities; + + +package body Rat_Tests.Utilities is + + + package PU renames Packrat.Utilities; + + + function In_Set_Check + return Test_Result + is + use type Strmaps.Character_Set; + Set_1 : Strmaps.Character_Set := Strmaps.To_Set ("abcxyz"); + Set_2 : Strmaps.Character_Set := Strmaps.To_Set ("!""#$"); + function Func_1 is new PU.In_Set (Set_1); + function Func_2 is new PU.In_Set (Set_2); + begin + -- Func_1 testing + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('a') - 1 loop + if Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'c' loop + if not Func_1 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('c') + 1 .. Character'Pos ('x') - 1 loop + if Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'x' .. 'z' loop + if not Func_1 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop + if Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + -- Func_2 testing + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop + if Func_2 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '!' .. '$' loop + if not Func_2 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('$') + 1 .. Character'Pos (Character'Last) loop + if Func_2 (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end In_Set_Check; + + + function Not_In_Set_Check + return Test_Result + is + use type Strmaps.Character_Set; + Set_1 : Strmaps.Character_Set := Strmaps.To_Set ("abcxyz"); + Set_2 : Strmaps.Character_Set := Strmaps.To_Set ("!""#$"); + function Func_1 is new PU.Not_In_Set (Set_1); + function Func_2 is new PU.Not_In_Set (Set_2); + begin + -- Func_1 testing + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('a') - 1 loop + if not Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'c' loop + if Func_1 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('c') + 1 .. Character'Pos ('x') - 1 loop + if not Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'x' .. 'z' loop + if Func_1 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop + if not Func_1 (Character'Val (I)) then + return Fail; + end if; + end loop; + -- Func_2 testing + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop + if not Func_2 (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '!' .. '$' loop + if Func_2 (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('$') + 1 .. Character'Pos (Character'Last) loop + if not Func_2 (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Not_In_Set_Check; + + + + + + function Is_Digit_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop + if PU.Is_Digit (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '0' .. '9' loop + if not PU.Is_Digit (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('9') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Digit (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Digit_Check; + + + function Is_Hex_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop + if PU.Is_Hex (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '0' .. '9' loop + if not PU.Is_Hex (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('9') + 1 .. Character'Pos ('A') - 1 loop + if PU.Is_Hex (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'A' .. 'F' loop + if not PU.Is_Hex (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('F') + 1 .. Character'Pos ('a') - 1 loop + if PU.Is_Hex (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'f' loop + if not PU.Is_Hex (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('f') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Hex (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Hex_Check; + + + function Is_Letter_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('A') - 1 loop + if PU.Is_Letter (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'A' .. 'Z' loop + if not PU.Is_Letter (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('Z') + 1 .. Character'Pos ('a') - 1 loop + if PU.Is_Letter (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'z' loop + if not PU.Is_Letter (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'First) loop + if PU.Is_Letter (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Letter_Check; + + + function Is_Alphanumeric_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('0') - 1 loop + if PU.Is_Alphanumeric (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '0' .. '9' loop + if not PU.Is_Alphanumeric (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('9') + 1 .. Character'Pos ('A') - 1 loop + if PU.Is_Alphanumeric (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'A' .. 'Z' loop + if not PU.Is_Alphanumeric (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('Z') + 1 .. Character'Pos ('a') - 1 loop + if PU.Is_Alphanumeric (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range 'a' .. 'z' loop + if not PU.Is_Alphanumeric (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('z') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Alphanumeric (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Alphanumeric_Check; + + + function Is_Punctuation_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos ('!') - 1 loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '!' .. '/' loop + if not PU.Is_Punctuation (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('/') + 1 .. Character'Pos (':') - 1 loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range ':' .. '@' loop + if not PU.Is_Punctuation (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('@') + 1 .. Character'Pos ('[') - 1 loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '[' .. '`' loop + if not PU.Is_Punctuation (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('`') + 1 .. Character'Pos ('{') - 1 loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range '{' .. '~' loop + if not PU.Is_Punctuation (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos ('~') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Punctuation (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Punctuation_Check; + + + function Is_ASCII_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. 127 loop + if not PU.Is_ASCII (Character'Val (I)) then + return Fail; + end if; + end loop; + for I in Integer range 128 .. Character'Pos (Character'Last) loop + if PU.Is_ASCII (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_ASCII_Check; + + + function Is_Extended_ASCII_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. 127 loop + if PU.Is_Extended_ASCII (Character'Val (I)) then + return Fail; + end if; + end loop; + for I in Integer range 128 .. Character'Pos (Character'Last) loop + if not PU.Is_Extended_ASCII (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Extended_ASCII_Check; + + + function Is_Space_Check + return Test_Result is + begin + for I in Integer range Character'Pos (Character'First) .. Character'Pos (' ') - 1 loop + if PU.Is_Space (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Space (' ') then + return Fail; + end if; + for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Space (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Space_Check; + + + function Is_Linespace_Check + return Test_Result is + begin + for I in Integer range + Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 + loop + if PU.Is_Linespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Linespace (Latin.HT) then + return Fail; + end if; + for I in Integer range Character'Pos (Latin.HT) + 1 .. Character'Pos (' ') - 1 loop + if PU.Is_Linespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Linespace (' ') then + return Fail; + end if; + for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Linespace (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Linespace_Check; + + + function Is_End_Of_Line_Check + return Test_Result is + begin + for I in Integer range + Character'Pos (Character'First) .. Character'Pos (Latin.LF) - 1 + loop + if PU.Is_End_Of_Line (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_End_Of_Line (Latin.LF) then + return Fail; + end if; + for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop + if PU.Is_End_Of_Line (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_End_Of_Line (Latin.CR) then + return Fail; + end if; + for I in Integer range + Character'Pos (Latin.CR) + 1 .. Character'Pos (Character'Last) + loop + if PU.Is_End_Of_Line (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_End_Of_Line_Check; + + + function Is_Whitespace_Check + return Test_Result is + begin + for I in Integer range + Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 + loop + if PU.Is_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range Latin.HT .. Latin.LF loop + if not PU.Is_Whitespace (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop + if PU.Is_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Whitespace (Latin.CR) then + return Fail; + end if; + for I in Integer range Character'Pos (Latin.CR) + 1 .. Character'Pos (' ') - 1 loop + if PU.Is_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if not PU.Is_Whitespace (' ') then + return Fail; + end if; + for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop + if PU.Is_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Is_Whitespace_Check; + + + function Not_Whitespace_Check + return Test_Result is + begin + for I in Integer range + Character'Pos (Character'First) .. Character'Pos (Latin.HT) - 1 + loop + if not PU.Not_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + for C in Character range Latin.HT .. Latin.LF loop + if PU.Not_Whitespace (C) then + return Fail; + end if; + end loop; + for I in Integer range Character'Pos (Latin.LF) + 1 .. Character'Pos (Latin.CR) - 1 loop + if not PU.Not_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if PU.Not_Whitespace (Latin.CR) then + return Fail; + end if; + for I in Integer range Character'Pos (Latin.CR) + 1 .. Character'Pos (' ') - 1 loop + if not PU.Not_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + if PU.Not_Whitespace (' ') then + return Fail; + end if; + for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop + if not PU.Not_Whitespace (Character'Val (I)) then + return Fail; + end if; + end loop; + return Pass; + end Not_Whitespace_Check; + + +end Rat_Tests.Utilities; + + diff --git a/test/rat_tests-utilities.ads b/test/rat_tests-utilities.ads new file mode 100644 index 0000000..b3fcaee --- /dev/null +++ b/test/rat_tests-utilities.ads @@ -0,0 +1,48 @@ + + +with Unit_Tests; +use Unit_Tests; + + +package Rat_Tests.Utilities is + + + function In_Set_Check return Test_Result; + function Not_In_Set_Check return Test_Result; + + Set_Predicate_Tests : Test_Array := + ((+"In_Set", In_Set_Check'Access), + (+"Not_In_Set", Not_In_Set_Check'Access)); + + + function Is_Digit_Check return Test_Result; + function Is_Hex_Check return Test_Result; + function Is_Letter_Check return Test_Result; + function Is_Alphanumeric_Check return Test_Result; + function Is_Punctuation_Check return Test_Result; + function Is_ASCII_Check return Test_Result; + function Is_Extended_ASCII_Check return Test_Result; + function Is_Space_Check return Test_Result; + function Is_Linespace_Check return Test_Result; + function Is_End_Of_Line_Check return Test_Result; + function Is_Whitespace_Check return Test_Result; + function Not_Whitespace_Check return Test_Result; + + Predicate_Tests : Test_Array := + ((+"Is_Digit", Is_Digit_Check'Access), + (+"Is_Hex", Is_Hex_Check'Access), + (+"Is_Letter", Is_Letter_Check'Access), + (+"Is_Alphanumeric", Is_Alphanumeric_Check'Access), + (+"Is_Punctuation", Is_Punctuation_Check'Access), + (+"Is_ASCII", Is_ASCII_Check'Access), + (+"Is_Extended_ASCII", Is_Extended_ASCII_Check'Access), + (+"Is_Space", Is_Space_Check'Access), + (+"Is_Linespace", Is_Linespace_Check'Access), + (+"Is_End_Of_Line", Is_End_Of_Line_Check'Access), + (+"Is_Whitespace", Is_Whitespace_Check'Access), + (+"Not_Whitespace", Not_Whitespace_Check'Access)); + + +end Rat_Tests.Utilities; + + diff --git a/test/test_main.adb b/test/test_main.adb index ebca4fd..af59fdf 100644 --- a/test/test_main.adb +++ b/test/test_main.adb @@ -10,8 +10,8 @@ with Packrat.Tokens, Rat_Tests.Errors, Rat_Tests.Tokens, - Rat_Tests.Lexer, - Rat_Tests.Util, + Rat_Tests.Lexers, + Rat_Tests.Utilities, Rat_Tests.Parse_Graphs; use @@ -79,19 +79,19 @@ begin Put (My_Tokens.Debug_String (Tok)); New_Line; - Put_Line ("Running tests for Packrat.Lexer combinators..."); - Run_Tests (Rat_Tests.Lexer.Combinator_Tests, How_Verbose); + Put_Line ("Running tests for Packrat.Lexers combinators..."); + Run_Tests (Rat_Tests.Lexers.Combinator_Tests, How_Verbose); New_Line; - Put_Line ("Running tests for Packrat.Lexer lexing..."); - Run_Tests (Rat_Tests.Lexer.Lexer_Tests, How_Verbose); + Put_Line ("Running tests for Packrat.Lexers lexing..."); + Run_Tests (Rat_Tests.Lexers.Lexer_Tests, How_Verbose); New_Line; - Put_Line ("Running tests for Packrat.Util..."); + Put_Line ("Running tests for Packrat.Utilities..."); Put_Line ("Testing set predicates..."); - Run_Tests (Rat_Tests.Util.Set_Predicate_Tests, How_Verbose); + Run_Tests (Rat_Tests.Utilities.Set_Predicate_Tests, How_Verbose); Put_Line ("Testing ordinary predicates..."); - Run_Tests (Rat_Tests.Util.Predicate_Tests, How_Verbose); + Run_Tests (Rat_Tests.Utilities.Predicate_Tests, How_Verbose); New_Line; Put_Line ("Running tests for Packrat.Parse_Graphs..."); -- cgit