summaryrefslogtreecommitdiff
path: root/test/ratnest-tests.adb
diff options
context:
space:
mode:
Diffstat (limited to 'test/ratnest-tests.adb')
-rw-r--r--test/ratnest-tests.adb1426
1 files changed, 730 insertions, 696 deletions
diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb
index 72023d0..0603d09 100644
--- a/test/ratnest-tests.adb
+++ b/test/ratnest-tests.adb
@@ -20,793 +20,827 @@ package body Ratnest.Tests is
- function Valid_Message_Check
- return Test_Result is
- begin
- if PE.Valid_Message ("abcde") or PE.Valid_Message ("sSYM") or
- PE.Valid_Message ("sSYMp") or PE.Valid_Message ("p345") or
- PE.Valid_Message ("pOne") or PE.Valid_Message ("sSYMp1sNEXT") or
- PE.Valid_Message ("sSYMp1.2") or PE.Valid_Message ("sABcDp12") or
- not PE.Valid_Message ("sSYMp0") or not PE.Valid_Message ("sAp12") or
- not PE.Valid_Message ("sNAMEp34sSYMp02") or not PE.Valid_Message ("") or
- not PE.Valid_Message ("sA_Bp3") or not PE.Valid_Message ("sAp1sAp1")
- then
- return Failure;
- end if;
- return Success;
- end Valid_Message_Check;
-
-
- function Valid_Identifier_Check
- return Test_Result
- is
- Pass_Array : PE.Error_Info_Array :=
- ((+"A", 1), (+"ABC", 2), (+"AB_CD", 3), (+"A_B_CD", 4));
- Fail_Array : PE.Error_Info_Array :=
- ((+"_", 1), (+"_A", 2), (+"A_", 3), (+"A__B", 4), (+"A%B", 3));
- begin
- for EI of Pass_Array loop
- if not PE.Valid_Identifier (EI.Symbol) or
- not PE.Valid_Identifier (-EI.Symbol)
+ package body Errors is
+
+
+ function Valid_Message_Check
+ return Test_Result is
+ begin
+ if PE.Valid_Message ("abcde") or PE.Valid_Message ("sSYM") or
+ PE.Valid_Message ("sSYMp") or PE.Valid_Message ("p345") or
+ PE.Valid_Message ("pOne") or PE.Valid_Message ("sSYMp1sNEXT") or
+ PE.Valid_Message ("sSYMp1.2") or PE.Valid_Message ("sABcDp12") or
+ not PE.Valid_Message ("sSYMp0") or not PE.Valid_Message ("sAp12") or
+ not PE.Valid_Message ("sNAMEp34sSYMp02") or not PE.Valid_Message ("") or
+ not PE.Valid_Message ("sA_Bp3") or not PE.Valid_Message ("sAp1sAp1")
then
return Failure;
end if;
- end loop;
- for EI of Fail_Array loop
- if PE.Valid_Identifier (EI.Symbol) or
- PE.Valid_Identifier (-EI.Symbol)
+ return Success;
+ end Valid_Message_Check;
+
+
+ function Valid_Identifier_Check
+ return Test_Result
+ is
+ Pass_Array : PE.Error_Info_Array :=
+ ((+"A", 1), (+"ABC", 2), (+"AB_CD", 3), (+"A_B_CD", 4));
+ Fail_Array : PE.Error_Info_Array :=
+ ((+"_", 1), (+"_A", 2), (+"A_", 3), (+"A__B", 4), (+"A%B", 3));
+ begin
+ for EI of Pass_Array loop
+ if not PE.Valid_Identifier (EI.Symbol) or
+ not PE.Valid_Identifier (-EI.Symbol)
+ then
+ return Failure;
+ end if;
+ end loop;
+ for EI of Fail_Array loop
+ if PE.Valid_Identifier (EI.Symbol) or
+ PE.Valid_Identifier (-EI.Symbol)
+ then
+ return Failure;
+ end if;
+ end loop;
+ if not PE.Valid_Identifier_Array (Pass_Array) or
+ PE.Valid_Identifier_Array (Fail_Array)
then
return Failure;
end if;
- end loop;
- if not PE.Valid_Identifier_Array (Pass_Array) or
- PE.Valid_Identifier_Array (Fail_Array)
- then
- return Failure;
- end if;
- return Success;
- end Valid_Identifier_Check;
+ return Success;
+ end Valid_Identifier_Check;
- function Join_Check
- return Test_Result
- is
- Array_1 : PE.Error_Info_Array := ((+"A", 1), (+"B", 2));
- Msg_1 : PE.Error_Message := PE.Encode_Array (Array_1);
+ function Join_Check
+ return Test_Result
+ is
+ Array_1 : PE.Error_Info_Array := ((+"A", 1), (+"B", 2));
+ Msg_1 : PE.Error_Message := PE.Encode_Array (Array_1);
- Array_2 : PE.Error_Info_Array := ((+"C", 3), (+"D", 4));
- Msg_2 : PE.Error_Message := PE.Encode_Array (Array_2);
+ Array_2 : PE.Error_Info_Array := ((+"C", 3), (+"D", 4));
+ Msg_2 : PE.Error_Message := PE.Encode_Array (Array_2);
- Msg_3 : PE.Error_Message := PE.Join (Msg_1, Msg_2);
+ Msg_3 : PE.Error_Message := PE.Join (Msg_1, Msg_2);
- Array_4 : PE.Error_Info_Array := ((+"A", 1), (+"B", 2), (+"C", 3), (+"D", 4));
- Msg_4 : PE.Error_Message := PE.Encode_Array (Array_4);
+ Array_4 : PE.Error_Info_Array := ((+"A", 1), (+"B", 2), (+"C", 3), (+"D", 4));
+ Msg_4 : PE.Error_Message := PE.Encode_Array (Array_4);
- Array_5 : PE.Error_Info_Array := ((+"A", 1), (+"B", 4));
- Msg_5 : PE.Error_Message := PE.Encode_Array (Array_5);
+ Array_5 : PE.Error_Info_Array := ((+"A", 1), (+"B", 4));
+ Msg_5 : PE.Error_Message := PE.Encode_Array (Array_5);
- Array_6 : PE.Error_Info_Array := ((+"A", 1), (+"C", 3));
- Msg_6 : PE.Error_Message := PE.Encode_Array (Array_6);
+ Array_6 : PE.Error_Info_Array := ((+"A", 1), (+"C", 3));
+ Msg_6 : PE.Error_Message := PE.Encode_Array (Array_6);
- Msg_7 : PE.Error_Message := PE.Join (Msg_5, Msg_6);
+ Msg_7 : PE.Error_Message := PE.Join (Msg_5, Msg_6);
- Array_8 : PE.Error_Info_Array := ((+"A", 1), (+"B", 4), (+"C", 3));
- Msg_8 : PE.Error_Message := PE.Encode_Array (Array_8);
- begin
- if Msg_3 /= Msg_4 or Msg_7 /= Msg_8 then
- return Failure;
- end if;
- return Success;
- end Join_Check;
-
-
- function Encode_1_Check
- return Test_Result is
- begin
- -- Encode with a String and a Natural
- if PE.Encode ("ABC", 15) /= "sABCp15" then
- return Failure;
- end if;
- return Success;
- end Encode_1_Check;
-
-
- function Encode_2_Check
- return Test_Result is
- begin
- -- Encode with an Unbounded_String and a Natural
- if PE.Encode (+"ABC", 15) /= "sABCp15" then
- return Failure;
- end if;
- return Success;
- end Encode_2_Check;
+ Array_8 : PE.Error_Info_Array := ((+"A", 1), (+"B", 4), (+"C", 3));
+ Msg_8 : PE.Error_Message := PE.Encode_Array (Array_8);
+ begin
+ if Msg_3 /= Msg_4 or Msg_7 /= Msg_8 then
+ return Failure;
+ end if;
+ return Success;
+ end Join_Check;
- function Encode_3_Check
- return Test_Result is
- begin
- -- Encode with an Error_Info
- if PE.Encode ((+"ABC", 15)) /= "sABCp15" then
- return Failure;
- end if;
- return Success;
- end Encode_3_Check;
-
-
- function Encode_4_Check
- return Test_Result is
- begin
- -- Encode with an Error_Info_Array
- if PE.Encode_Array (((+"A", 3), (+"BC", 2), (+"ABC", 1), (+"B", 4))) /=
- "sAp3sBCp2sABCp1sBp4"
- then
- return Failure;
- end if;
- return Success;
- end Encode_4_Check;
-
-
- function Decode_Check
- return Test_Result
- is
- use type PE.Error_Info_Array;
- begin
- if PE.Decode ("sAp1sBp3sCp10sDEFp456") /=
- ((+"A", 1), (+"B", 3), (+"C", 10), (+"DEF", 456))
- then
- return Failure;
- end if;
- return Success;
- end Decode_Check;
+ function Encode_1_Check
+ return Test_Result is
+ begin
+ -- Encode with a String and a Natural
+ if PE.Encode ("ABC", 15) /= "sABCp15" then
+ return Failure;
+ end if;
+ return Success;
+ end Encode_1_Check;
+ function Encode_2_Check
+ return Test_Result is
+ begin
+ -- Encode with an Unbounded_String and a Natural
+ if PE.Encode (+"ABC", 15) /= "sABCp15" then
+ return Failure;
+ end if;
+ return Success;
+ end Encode_2_Check;
+ function Encode_3_Check
+ return Test_Result is
+ begin
+ -- Encode with an Error_Info
+ if PE.Encode ((+"ABC", 15)) /= "sABCp15" then
+ return Failure;
+ end if;
+ return Success;
+ end Encode_3_Check;
- function Token_Adjust_Check
- return Test_Result
- is
- type My_Labels is (One, Two, Three);
- package My_Tokens is new Packrat.Tokens (My_Labels, Character, String);
- A : My_Tokens.Token;
- begin
- declare
- B : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc");
+ function Encode_4_Check
+ return Test_Result is
begin
- A := B;
- end;
- if not A.Initialized or else A.Value /= "abc" then
- return Failure;
- end if;
- return Success;
- end Token_Adjust_Check;
-
-
- function Token_Store_Check
- return Test_Result
- is
- type My_Labels is (One, Two, Three);
- package My_Tokens is new Packrat.Tokens (My_Labels, Character, String);
-
- T : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc");
- begin
- if not T.Initialized or else
- T.Label /= One or else
- T.Start /= 1 or else T.Finish /= 3 or else
- T.Value /= "abc"
- then
- return Failure;
- end if;
- return Success;
- end Token_Store_Check;
-
+ -- Encode with an Error_Info_Array
+ if PE.Encode_Array (((+"A", 3), (+"BC", 2), (+"ABC", 1), (+"B", 4))) /=
+ "sAp3sBCp2sABCp1sBp4"
+ then
+ return Failure;
+ end if;
+ return Success;
+ end Encode_4_Check;
+ function Decode_Check
+ return Test_Result
+ is
+ use type PE.Error_Info_Array;
+ begin
+ if PE.Decode ("sAp1sBp3sCp10sDEFp456") /=
+ ((+"A", 1), (+"B", 3), (+"C", 10), (+"DEF", 456))
+ then
+ return Failure;
+ end if;
+ return Success;
+ end Decode_Check;
- function Lex_Sequence_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Sequence_Check;
+ end Errors;
- function Lex_Count_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Count_Check;
- function Lex_Many_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Many_Check;
+ package body Tokens is
- function Lex_Many_Until_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Many_Until_Check;
+ function Adjust_Check
+ return Test_Result
+ is
+ type My_Labels is (One, Two, Three);
+ package My_Tokens is new Packrat.Tokens (My_Labels, Character, String);
- function Lex_Satisfy_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Satisfy_Check;
+ A : My_Tokens.Token;
+ begin
+ declare
+ B : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc");
+ begin
+ A := B;
+ end;
+ if not A.Initialized or else A.Value /= "abc" then
+ return Failure;
+ end if;
+ return Success;
+ end Adjust_Check;
- function Lex_Satisfy_With_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Satisfy_With_Check;
+ function Store_Check
+ return Test_Result
+ is
+ type My_Labels is (One, Two, Three);
+ package My_Tokens is new Packrat.Tokens (My_Labels, Character, String);
+ T : My_Tokens.Token := My_Tokens.Create (One, 1, 3, "abc");
+ begin
+ if not T.Initialized or else
+ T.Label /= One or else
+ T.Start /= 1 or else T.Finish /= 3 or else
+ T.Value /= "abc"
+ then
+ return Failure;
+ end if;
+ return Success;
+ end Store_Check;
- function Lex_Match_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Match_Check;
+ end Tokens;
- function Lex_Match_With_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Match_With_Check;
- function Lex_Multimatch_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Multimatch_Check;
- function Lex_Take_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Take_Check;
+ package body Lexer is
- function Lex_Take_While_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Take_While_Check;
+ function Sequence_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Sequence_Check;
- function Lex_Take_Until_Check
- return Test_Result is
- begin
- return Failure;
- end Lex_Take_Until_Check;
+ function Count_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Count_Check;
- function Line_Start_Check
- return Test_Result is
- begin
- return Failure;
- end Line_Start_Check;
+ function Many_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Many_Check;
- function Line_End_Check
- return Test_Result is
- begin
- return Failure;
- end Line_End_Check;
+ function Many_Until_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Many_Until_Check;
- function Input_Start_Check
- return Test_Result is
- begin
- return Failure;
- end Input_Start_Check;
+ function Satisfy_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Satisfy_Check;
- function Input_End_Check
- return Test_Result is
- begin
- return Failure;
- end Input_End_Check;
+ function Satisfy_With_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Satisfy_With_Check;
+ function Match_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Match_Check;
+ function Match_With_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Match_With_Check;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'a' .. 'c' loop
- if not Func_1 (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'x' .. 'z' loop
- if not Func_1 (C) then
- return Failure;
- 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 Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range '!' .. '$' loop
- if not Func_2 (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'a' .. 'c' loop
- if Func_1 (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'x' .. 'z' loop
- if Func_1 (C) then
- return Failure;
- 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 Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range '!' .. '$' loop
- if Func_2 (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Not_In_Set_Check;
+ function Multimatch_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Multimatch_Check;
+ function Take_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Take_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 Failure;
- end if;
- end loop;
- for C in Character range '0' .. '9' loop
- if not PU.Is_Digit (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Is_Digit_Check;
+ function Take_While_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Take_While_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 Failure;
- end if;
- end loop;
- for C in Character range '0' .. '9' loop
- if not PU.Is_Hex (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'A' .. 'F' loop
- if not PU.Is_Hex (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'a' .. 'f' loop
- if not PU.Is_Hex (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Is_Hex_Check;
+ function Take_Until_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Take_Until_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 Failure;
- end if;
- end loop;
- for C in Character range 'A' .. 'Z' loop
- if not PU.Is_Letter (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'a' .. 'z' loop
- if not PU.Is_Letter (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Is_Letter_Check;
+ function Line_Start_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Line_Start_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 Failure;
- end if;
- end loop;
- for C in Character range '0' .. '9' loop
- if not PU.Is_Alphanumeric (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'A' .. 'Z' loop
- if not PU.Is_Alphanumeric (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range 'a' .. 'z' loop
- if not PU.Is_Alphanumeric (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Is_Alphanumeric_Check;
+ function Line_End_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Line_End_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 Failure;
- end if;
- end loop;
- for C in Character range '!' .. '/' loop
- if not PU.Is_Punctuation (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range ':' .. '@' loop
- if not PU.Is_Punctuation (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range '[' .. '`' loop
- if not PU.Is_Punctuation (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- for C in Character range '{' .. '~' loop
- if not PU.Is_Punctuation (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Is_Punctuation_Check;
+ function Input_Start_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Input_Start_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 Failure;
- end if;
- end loop;
- for I in Integer range 128 .. Character'Pos (Character'Last) loop
- if PU.Is_ASCII (Character'Val (I)) then
- return Failure;
- end if;
- end loop;
- return Success;
- end Is_ASCII_Check;
+ function Input_End_Check
+ return Test_Result is
+ begin
+ return Failure;
+ end Input_End_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 Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Is_Extended_ASCII_Check;
-
+ end Lexer;
- 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 Failure;
- end if;
- end loop;
- if not PU.Is_Space (' ') then
- return Failure;
- end if;
- for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop
- if PU.Is_Space (Character'Val (I)) then
- return Failure;
- end if;
- end loop;
- return Success;
- 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 Failure;
- end if;
- end loop;
- if not PU.Is_Linespace (Latin.HT) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- if not PU.Is_Linespace (' ') then
- return Failure;
- end if;
- for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop
- if PU.Is_Linespace (Character'Val (I)) then
- return Failure;
- end if;
- end loop;
- return Success;
- 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 Failure;
- end if;
- end loop;
- if not PU.Is_End_Of_Line (Latin.LF) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- if not PU.Is_End_Of_Line (Latin.CR) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Is_End_Of_Line_Check;
+ package body Util is
- 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 Failure;
- end if;
- end loop;
- for C in Character range Latin.HT .. Latin.LF loop
- if not PU.Is_Whitespace (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- if not PU.Is_Whitespace (Latin.CR) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- if not PU.Is_Whitespace (' ') then
- return Failure;
- end if;
- for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop
- if PU.Is_Whitespace (Character'Val (I)) then
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'a' .. 'c' loop
+ if not Func_1 (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'x' .. 'z' loop
+ if not Func_1 (C) then
+ return Failure;
+ 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 Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range '!' .. '$' loop
+ if not Func_2 (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'a' .. 'c' loop
+ if Func_1 (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'x' .. 'z' loop
+ if Func_1 (C) then
+ return Failure;
+ 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 Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range '!' .. '$' loop
+ if Func_2 (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range '0' .. '9' loop
+ if not PU.Is_Digit (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range '0' .. '9' loop
+ if not PU.Is_Hex (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'A' .. 'F' loop
+ if not PU.Is_Hex (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'a' .. 'f' loop
+ if not PU.Is_Hex (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'A' .. 'Z' loop
+ if not PU.Is_Letter (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'a' .. 'z' loop
+ if not PU.Is_Letter (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range '0' .. '9' loop
+ if not PU.Is_Alphanumeric (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'A' .. 'Z' loop
+ if not PU.Is_Alphanumeric (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range 'a' .. 'z' loop
+ if not PU.Is_Alphanumeric (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range '!' .. '/' loop
+ if not PU.Is_Punctuation (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range ':' .. '@' loop
+ if not PU.Is_Punctuation (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range '[' .. '`' loop
+ if not PU.Is_Punctuation (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range '{' .. '~' loop
+ if not PU.Is_Punctuation (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for I in Integer range 128 .. Character'Pos (Character'Last) loop
+ if PU.Is_ASCII (Character'Val (I)) then
+ return Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ if not PU.Is_Space (' ') then
return Failure;
end if;
- end loop;
- return Success;
- end Is_Whitespace_Check;
+ for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop
+ if PU.Is_Space (Character'Val (I)) then
+ return Failure;
+ end if;
+ end loop;
+ return Success;
+ end Is_Space_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 Failure;
- end if;
- end loop;
- for C in Character range Latin.HT .. Latin.LF loop
- if PU.Not_Whitespace (C) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- if PU.Not_Whitespace (Latin.CR) then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- if PU.Not_Whitespace (' ') then
- return Failure;
- 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 Failure;
- end if;
- end loop;
- return Success;
- end Not_Whitespace_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 Failure;
+ end if;
+ end loop;
+ if not PU.Is_Linespace (Latin.HT) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ if not PU.Is_Linespace (' ') then
+ return Failure;
+ end if;
+ for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop
+ if PU.Is_Linespace (Character'Val (I)) then
+ return Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ if not PU.Is_End_Of_Line (Latin.LF) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ if not PU.Is_End_Of_Line (Latin.CR) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range Latin.HT .. Latin.LF loop
+ if not PU.Is_Whitespace (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ if not PU.Is_Whitespace (Latin.CR) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ if not PU.Is_Whitespace (' ') then
+ return Failure;
+ end if;
+ for I in Integer range Character'Pos (' ') + 1 .. Character'Pos (Character'Last) loop
+ if PU.Is_Whitespace (Character'Val (I)) then
+ return Failure;
+ end if;
+ end loop;
+ return Success;
+ 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 Failure;
+ end if;
+ end loop;
+ for C in Character range Latin.HT .. Latin.LF loop
+ if PU.Not_Whitespace (C) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ if PU.Not_Whitespace (Latin.CR) then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ if PU.Not_Whitespace (' ') then
+ return Failure;
+ 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 Failure;
+ end if;
+ end loop;
+ return Success;
+ end Not_Whitespace_Check;
+
+
+ end Util;
end Ratnest.Tests;
generated by cgit (git 2.30.0) at 2024-04-29 20:15:55 +0000