From 04d0e994b69cb8d80dcd8beca17d8fe2eadaea6b Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 11 Jan 2019 12:17:15 +1100 Subject: Refactored Ratnest.Tests into nested subpackages --- test/ratnest-tests.adb | 1426 +++++++++++++++++++++++++----------------------- test/ratnest-tests.ads | 230 ++++---- test/test_main.adb | 18 +- 3 files changed, 865 insertions(+), 809 deletions(-) (limited to 'test') 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; diff --git a/test/ratnest-tests.ads b/test/ratnest-tests.ads index e9ea347..cc67120 100644 --- a/test/ratnest-tests.ads +++ b/test/ratnest-tests.ads @@ -3,114 +3,128 @@ package Ratnest.Tests is - function Valid_Message_Check return Test_Result; - function Valid_Identifier_Check return Test_Result; - function Join_Check return Test_Result; - function Encode_1_Check return Test_Result; - function Encode_2_Check return Test_Result; - function Encode_3_Check return Test_Result; - function Encode_4_Check return Test_Result; - function Decode_Check return Test_Result; - - Error_Tests : Test_Array := - ((+"Valid_Message", Valid_Message_Check'Access), - (+"Valid_Identifier", Valid_Identifier_Check'Access), - (+"Join", Join_Check'Access), - (+"Encode_1", Encode_1_Check'Access), - (+"Encode_2", Encode_2_Check'Access), - (+"Encode_3", Encode_3_Check'Access), - (+"Encode_4", Encode_4_Check'Access), - (+"Decode", Decode_Check'Access)); - - - - - function Token_Adjust_Check return Test_Result; - function Token_Store_Check return Test_Result; - - Token_Tests : Test_Array := - ((+"Adjust", Token_Adjust_Check'Access), - (+"Storage", Token_Store_Check'Access)); - - - - - function Lex_Sequence_Check return Test_Result; - function Lex_Count_Check return Test_Result; - function Lex_Many_Check return Test_Result; - function Lex_Many_Until_Check return Test_Result; - - function Lex_Satisfy_Check return Test_Result; - function Lex_Satisfy_With_Check return Test_Result; - function Lex_Match_Check return Test_Result; - function Lex_Match_With_Check return Test_Result; - function Lex_Multimatch_Check return Test_Result; - function Lex_Take_Check return Test_Result; - function Lex_Take_While_Check return Test_Result; - function Lex_Take_Until_Check return Test_Result; - - function Line_Start_Check return Test_Result; - function Line_End_Check return Test_Result; - function Input_Start_Check return Test_Result; - function Input_End_Check return Test_Result; - - Lexer_Combinator_Tests : Test_Array := - ((+"Sequence", Lex_Sequence_Check'Access), - (+"Count", Lex_Count_Check'Access), - (+"Many", Lex_Many_Check'Access), - (+"Many_Until", Lex_Many_Until_Check'Access), - (+"Satisfy", Lex_Satisfy_Check'Access), - (+"Satisfy With", Lex_Satisfy_With_Check'Access), - (+"Match", Lex_Match_Check'Access), - (+"Match With", Lex_Match_With_Check'Access), - (+"Multimatch", Lex_Multimatch_Check'Access), - (+"Take", Lex_Take_Check'Access), - (+"Take While", Lex_Take_While_Check'Access), - (+"Take Until", Lex_Take_Until_Check'Access), - (+"Line Start", Line_Start_Check'Access), - (+"Line End", Line_End_Check'Access), - (+"Input Start", Input_Start_Check'Access), - (+"Input_End", Input_End_Check'Access)); - - - - - 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; - - Util_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)); + package Errors is + + function Valid_Message_Check return Test_Result; + function Valid_Identifier_Check return Test_Result; + function Join_Check return Test_Result; + function Encode_1_Check return Test_Result; + function Encode_2_Check return Test_Result; + function Encode_3_Check return Test_Result; + function Encode_4_Check return Test_Result; + function Decode_Check return Test_Result; + + Tests : Test_Array := + ((+"Valid_Message", Valid_Message_Check'Access), + (+"Valid_Identifier", Valid_Identifier_Check'Access), + (+"Join", Join_Check'Access), + (+"Encode_1", Encode_1_Check'Access), + (+"Encode_2", Encode_2_Check'Access), + (+"Encode_3", Encode_3_Check'Access), + (+"Encode_4", Encode_4_Check'Access), + (+"Decode", Decode_Check'Access)); + + end Errors; + + + + + package Tokens is + + function Adjust_Check return Test_Result; + function Store_Check return Test_Result; + + Tests : Test_Array := + ((+"Adjust", Adjust_Check'Access), + (+"Storage", Store_Check'Access)); + + end Tokens; + + + + + package Lexer is + + 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_Start_Check return Test_Result; + function Line_End_Check return Test_Result; + function Input_Start_Check return Test_Result; + function Input_End_Check return Test_Result; + + Combinator_Tests : Test_Array := + ((+"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 Start", Line_Start_Check'Access), + (+"Line End", Line_End_Check'Access), + (+"Input Start", Input_Start_Check'Access), + (+"Input_End", Input_End_Check'Access)); + + end Lexer; + + + + + package 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 Util; end Ratnest.Tests; diff --git a/test/test_main.adb b/test/test_main.adb index d181b3e..4915a5c 100644 --- a/test/test_main.adb +++ b/test/test_main.adb @@ -14,35 +14,43 @@ use procedure Test_Main is + + type My_Labels is (A, B, C); package My_Tokens is new Packrat.Tokens (My_Labels, Character, String); Err : Packrat.Errors.Error_Message := Packrat.Errors.Encode ("A", 1); Tok : My_Tokens.Token := My_Tokens.Create (A, 1, 3, "abc"); + + begin + + Put_Line ("Running tests for Packrat.Errors..."); - Run_Tests (Error_Tests); + Run_Tests (Errors.Tests); New_Line; Put_Line ("Displaying Error_Message debug string output example:"); Put (Packrat.Errors.Debug_String (Err)); New_Line; Put_Line ("Running tests for Packrat.Tokens..."); - Run_Tests (Token_Tests); + Run_Tests (Tokens.Tests); New_Line; Put_Line ("Displaying Token debug string output example:"); Put (Tok.Debug_String); New_Line; Put_Line ("Running tests for Packrat.Lexer.Combinators..."); - Run_Tests (Lexer_Combinator_Tests); + Run_Tests (Lexer.Combinator_Tests); New_Line; Put_Line ("Running tests for Packrat.Util..."); Put_Line ("Testing set predicates..."); - Run_Tests (Set_Predicate_Tests); + Run_Tests (Util.Set_Predicate_Tests); Put_Line ("Testing ordinary predicates..."); - Run_Tests (Util_Predicate_Tests); + Run_Tests (Util.Predicate_Tests); + + end Test_Main; -- cgit