From 6f767eb4b27c4e15ca6c3be3b93ca187caf95bd9 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 8 Jan 2019 00:00:09 +1100 Subject: Basic test framework and initial tests for Packrat.Util predicates --- test/ratnest-tests.adb | 396 +++++++++++++++++++++++++++++++++++++++++++++++++ test/ratnest-tests.ads | 40 +++++ test/ratnest.adb | 34 +++++ test/ratnest.ads | 47 ++++++ test/test_main.adb | 21 +++ 5 files changed, 538 insertions(+) create mode 100644 test/ratnest-tests.adb create mode 100644 test/ratnest-tests.ads create mode 100644 test/ratnest.adb create mode 100644 test/ratnest.ads create mode 100644 test/test_main.adb (limited to 'test') diff --git a/test/ratnest-tests.adb b/test/ratnest-tests.adb new file mode 100644 index 0000000..dd2228f --- /dev/null +++ b/test/ratnest-tests.adb @@ -0,0 +1,396 @@ + + +with + + Ada.Characters.Latin_1, + Packrat.Util; + + +package body Ratnest.Tests is + + + package Latin renames Ada.Characters.Latin_1; + package PU renames Packrat.Util; + + + + + 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_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_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; + 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; + + + 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 Ratnest.Tests; + + diff --git a/test/ratnest-tests.ads b/test/ratnest-tests.ads new file mode 100644 index 0000000..c0be0a9 --- /dev/null +++ b/test/ratnest-tests.ads @@ -0,0 +1,40 @@ + + +package Ratnest.Tests is + + + 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)); + + +private + + +end Ratnest.Tests; + + diff --git a/test/ratnest.adb b/test/ratnest.adb new file mode 100644 index 0000000..8d1493c --- /dev/null +++ b/test/ratnest.adb @@ -0,0 +1,34 @@ + + +with + + Ada.Text_IO; + +use + + Ada.Text_IO; + + +package body Ratnest is + + + procedure Run_Tests + (To_Run : in Test_Array) + is + Total_Count : Natural := To_Run'Length; + Failed_Count : Natural := 0; + begin + for T of To_Run loop + if T.Func.all = Failure then + Put_Line ("Failed test " & (-T.Name)); + Failed_Count := Failed_Count + 1; + end if; + end loop; + Put_Line ("Test results" & Integer'Image (Total_Count - Failed_Count) & + " out of" & Integer'Image (Total_Count)); + end Run_Tests; + + +end Ratnest; + + diff --git a/test/ratnest.ads b/test/ratnest.ads new file mode 100644 index 0000000..adf2369 --- /dev/null +++ b/test/ratnest.ads @@ -0,0 +1,47 @@ + + +with + + Ada.Strings.Unbounded; + + +package Ratnest is + + + type Test_Result is (Failure, Success); + + type Test_Function is access function return Test_Result; + + type Test is record + Name : Ada.Strings.Unbounded.Unbounded_String; + Func : Test_Function; + end record; + + type Test_Array is array (Positive range <>) of Test; + + + + + procedure Run_Tests + (To_Run : in Test_Array); + + + + + function "+" + (S : in String) + return Ada.Strings.Unbounded.Unbounded_String + renames Ada.Strings.Unbounded.To_Unbounded_String; + + function "-" + (US : in Ada.Strings.Unbounded.Unbounded_String) + return String + renames Ada.Strings.Unbounded.To_String; + + +private + + +end Ratnest; + + diff --git a/test/test_main.adb b/test/test_main.adb new file mode 100644 index 0000000..417ae7d --- /dev/null +++ b/test/test_main.adb @@ -0,0 +1,21 @@ + + +with + + Ada.Text_IO, + Ratnest.Tests; + +use + + Ada.Text_IO, + Ratnest, + Ratnest.Tests; + + +procedure Test_Main is +begin + Put_Line ("Running tests for Packrat.Util..."); + Run_Tests (Util_Predicate_Tests); +end Test_Main; + + -- cgit