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 --- packrat.gpr | 23 +++ packrat_parser_lib_notes.txt | 55 ++++-- src/packrat-util.adb | 123 ++++++++++++++ src/packrat-util.ads | 77 +++++++++ src/packrat.ads | 11 ++ test/ratnest-tests.adb | 396 +++++++++++++++++++++++++++++++++++++++++++ test/ratnest-tests.ads | 40 +++++ test/ratnest.adb | 34 ++++ test/ratnest.ads | 47 +++++ test/test_main.adb | 21 +++ tests.gpr | 30 ++++ 11 files changed, 846 insertions(+), 11 deletions(-) create mode 100644 packrat.gpr create mode 100644 src/packrat-util.adb create mode 100644 src/packrat-util.ads create mode 100644 src/packrat.ads 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 create mode 100644 tests.gpr diff --git a/packrat.gpr b/packrat.gpr new file mode 100644 index 0000000..fc0e4b2 --- /dev/null +++ b/packrat.gpr @@ -0,0 +1,23 @@ + + +library project Packrat is + + + for Languages use ("Ada"); + + + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Library_Dir use "lib"; + for Library_Name use "libpackrat"; + for Library_Kind use "dynamic"; + + + package Compiler is + for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM99nprt"); + end Compiler; + + +end Packrat; + + diff --git a/packrat_parser_lib_notes.txt b/packrat_parser_lib_notes.txt index faa423e..a09babf 100644 --- a/packrat_parser_lib_notes.txt +++ b/packrat_parser_lib_notes.txt @@ -95,8 +95,6 @@ Choice (the other that requires passing in an array of function accesses) subtree it produces added as a child of the current position on the output structure Count - -Some -Some_Until Many Many_Until Separate_By @@ -121,11 +119,11 @@ Match Match_With - first uses a transforming function on the next input token then tests against a supplied argument as above, creating a node with the untransformed input if there is a match -Substring +Multimatch - for matching multiple successive items, eg a substring in a string input - checks an array argument against the same length subarray of input tokens for a match, if successful creates a node with that subarray -Substring_With +Multimatch_With - applies a transforming function before the check as above Take - creates a node with the next input token @@ -135,10 +133,6 @@ Take_While Take_Until - takes a predicate and creates a node with the subarray of input tokens corresponding to the next N input where the predicate fails -Take_All - - creates a node with the complete rest of the input token array -End_Of_Line - - a combination of Choice and Match/Substring with "\r\n", "\n", or "\r" (these are recogniser combinators that discard nodes produced by other components) Skip @@ -154,6 +148,8 @@ End_Of_Input Packrat.Lexer - generic over the enum used for labeling lexemes and the input token_list as well as component token elements + - should be possible to place an upper limit on the number of tokens scanned, so as to accommodate a statically + sized output array of tokens (and possibly a statically sized input array) List of funcs: Scan @@ -168,15 +164,25 @@ Packrat.Lexer.Combinators List of funcs: Sequence +Count +Many +Many_Until Satisfy Satisfy_With Match Match_With +Multimatch +Multimatch_With Take Take_While Take_Until +Start_Of_Line +End_Of_Line +Start_Of_Input +End_Of_Input + @@ -191,7 +197,9 @@ Is_Digit Is_Hex Is_Letter Is_Alphanumeric +Is_Punctuation Is_ASCII +Is_Extended_ASCII Is_Space Is_Linespace Is_End_Of_Line @@ -220,17 +228,42 @@ List of datatypes: Error_Info (containing an enum of the symbol expected, and a natural of the position) List of funcs: -New_Message -To_Message -From_Message +Newcode +Encode +Decode +Join + + +Ratnest + +List of funcs: +Run_Tests + + Ratnest.Tests +List of funcs: +Is_Digit_Check +Is_Hex_Check +Is_Letter_Check +Is_Alphanumeric_Check +Is_ASCII_Check +Is_Extended_ASCII_Check +Is_Space_Check +Is_Linespace_Check +Is_End_Of_Line_Check +Is_Whitespace_Check +Is_Not_Whitespace_Check + + + + Ratnest.Examples - some parser examples diff --git a/src/packrat-util.adb b/src/packrat-util.adb new file mode 100644 index 0000000..6ee1d4a --- /dev/null +++ b/src/packrat-util.adb @@ -0,0 +1,123 @@ + + +package body Packrat.Util is + + + function In_Set + (Element : in Character) + return Boolean is + begin + return False; + end In_Set; + + + function Not_In_Set + (Element : in Character) + return Boolean is + begin + return False; + end Not_In_Set; + + + + + + function Is_Digit + (Char : in Character) + return Boolean is + begin + return False; + end Is_Digit; + + + function Is_Hex + (Char : in Character) + return Boolean is + begin + return False; + end Is_Hex; + + + function Is_Letter + (Char : in Character) + return Boolean is + begin + return False; + end Is_Letter; + + + function Is_Alphanumeric + (Char : in Character) + return Boolean is + begin + return False; + end Is_Alphanumeric; + + + function Is_Punctuation + (Char : in Character) + return Boolean is + begin + return False; + end Is_Punctuation; + + + function Is_ASCII + (Char : in Character) + return Boolean is + begin + return False; + end Is_ASCII; + + + function Is_Extended_ASCII + (Char : in Character) + return Boolean is + begin + return False; + end Is_Extended_ASCII; + + + function Is_Space + (Char : in Character) + return Boolean is + begin + return False; + end Is_Space; + + + function Is_Linespace + (Char : in Character) + return Boolean is + begin + return False; + end Is_Linespace; + + + function Is_End_Of_Line + (Char : in Character) + return Boolean is + begin + return False; + end Is_End_Of_Line; + + + function Is_Whitespace + (Char : in Character) + return Boolean is + begin + return False; + end Is_Whitespace; + + + function Not_Whitespace + (Char : in Character) + return Boolean is + begin + return False; + end Not_Whitespace; + + +end Packrat.Util; + + diff --git a/src/packrat-util.ads b/src/packrat-util.ads new file mode 100644 index 0000000..ffc4d66 --- /dev/null +++ b/src/packrat-util.ads @@ -0,0 +1,77 @@ + + +with + + Ada.Strings.Maps; + + +package Packrat.Util is + + + generic + Set : in Ada.Strings.Maps.Character_Set; + function In_Set + (Element : in Character) + return Boolean; + + generic + Set : in Ada.Strings.Maps.Character_Set; + function Not_In_Set + (Element : in Character) + return Boolean; + + function Is_Digit + (Char : in Character) + return Boolean; + + function Is_Hex + (Char : in Character) + return Boolean; + + function Is_Letter + (Char : in Character) + return Boolean; + + function Is_Alphanumeric + (Char : in Character) + return Boolean; + + function Is_Punctuation + (Char : in Character) + return Boolean; + + function Is_ASCII + (Char : in Character) + return Boolean; + + function Is_Extended_ASCII + (Char : in Character) + return Boolean; + + function Is_Space + (Char : in Character) + return Boolean; + + function Is_Linespace + (Char : in Character) + return Boolean; + + function Is_End_Of_Line + (Char : in Character) + return Boolean; + + function Is_Whitespace + (Char : in Character) + return Boolean; + + function Not_Whitespace + (Char : in Character) + return Boolean; + + +private + + +end Packrat.Util; + + diff --git a/src/packrat.ads b/src/packrat.ads new file mode 100644 index 0000000..36410d5 --- /dev/null +++ b/src/packrat.ads @@ -0,0 +1,11 @@ + + +package Packrat is + + +private + + +end Packrat; + + 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; + + diff --git a/tests.gpr b/tests.gpr new file mode 100644 index 0000000..a4f5f93 --- /dev/null +++ b/tests.gpr @@ -0,0 +1,30 @@ + + +with "packrat"; + + +project Tests is + + + for Languages use ("Ada"); + + + for Source_Dirs use ("test/**"); + for Object_Dir use "obj"; + for Exec_Dir use "bin"; + for Main use ("test_main.adb"); + + + package Builder is + for Executable("test_main.adb") use "testrat"; + end Builder; + + + package Compiler is + for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM99nprt"); + end Compiler; + + +end Tests; + + -- cgit