diff options
Diffstat (limited to 'test/rat_tests-util.adb')
| -rw-r--r-- | test/rat_tests-util.adb | 513 |
1 files changed, 513 insertions, 0 deletions
diff --git a/test/rat_tests-util.adb b/test/rat_tests-util.adb new file mode 100644 index 0000000..fe1f890 --- /dev/null +++ b/test/rat_tests-util.adb @@ -0,0 +1,513 @@ + + +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; + + |