diff options
| author | Jed Barber <jjbarber@y7mail.com> | 2020-05-19 15:22:55 +1000 | 
|---|---|---|
| committer | Jed Barber <jjbarber@y7mail.com> | 2020-05-19 15:22:55 +1000 | 
| commit | 196a1a2443b8a66784d293120ee64840ee87f02e (patch) | |
| tree | 98f36e8d72aecd40be8fb5c767f915966d57fd8a | |
Factored out and improved slightly from Packrat project
| -rw-r--r-- | basic_unit_test.gpr | 23 | ||||
| -rw-r--r-- | lib/.gitignore | 4 | ||||
| -rw-r--r-- | obj/.gitignore | 4 | ||||
| -rw-r--r-- | src/unit_tests.adb | 99 | ||||
| -rw-r--r-- | src/unit_tests.ads | 66 | 
5 files changed, 196 insertions, 0 deletions
diff --git a/basic_unit_test.gpr b/basic_unit_test.gpr new file mode 100644 index 0000000..a86644f --- /dev/null +++ b/basic_unit_test.gpr @@ -0,0 +1,23 @@ + + +library project Basic_Unit_Test is + + +    for Languages use ("Ada"); + + +    for Source_Dirs use ("src"); +    for Object_Dir use "obj"; +    for Library_Dir use "lib"; +    for Library_Name use "buntest"; +    for Library_Kind use "dynamic"; + + +    package Compiler is +        for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM100nprt"); +    end Compiler; + + +end Basic_Unit_Test; + + diff --git a/lib/.gitignore b/lib/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/lib/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/obj/.gitignore b/obj/.gitignore new file mode 100644 index 0000000..ea7f887 --- /dev/null +++ b/obj/.gitignore @@ -0,0 +1,4 @@ + + +* +!.gitignore diff --git a/src/unit_tests.adb b/src/unit_tests.adb new file mode 100644 index 0000000..dc57e09 --- /dev/null +++ b/src/unit_tests.adb @@ -0,0 +1,99 @@ + + +with + +    Ada.Text_IO; + +use + +    Ada.Text_IO; + + +package body Unit_Tests is + + +    function Run_Test +           (To_Run  : in Test; +            Verbose : in Verbosity := Weak) +        return Test_Result +    is +        Result : Test_Result; +    begin +        if Verbose = Strong then +            Put ("Running test " & (-To_Run.Name) & "..."); +        end if; +        Result := To_Run.Func.all; +        if Verbose = Strong then +            if Result = Pass then +                Put_Line (" Pass"); +            else +                Put_Line (" Fail"); +            end if; +        elsif Verbose = Weak and Result = Fail then +            Put_Line ("Failed test " & (-To_Run.Name)); +        end if; +        return Result; +    end Run_Test; + + + + +    procedure Run_Test +           (To_Run  : in Test; +            Verbose : in Verbosity := Weak) +    is +        Result : Test_Result; +    begin +        Result := Run_Test (To_Run, Verbose); +    end Run_Test; + + + + +    function Run_Tests +           (To_Run  : in Test_Array; +            Verbose : in Verbosity := Weak) +        return Test_Result_Array +    is +        Total_Count : Natural := To_Run'Length; +        Pass_Count  : Natural := 0; +        Results     : Test_Result_Array (To_Run'Range); +    begin +        for R in To_Run'Range loop +            Results (R) := Run_Test (To_Run (R), Verbose); +            if Results (R) = Pass then +                Pass_Count := Pass_Count + 1; +            end if; +        end loop; +        if Verbose /= None then +            Put_Line ("Test results" & Integer'Image (Pass_Count) & +                " out of" & Integer'Image (Total_Count)); +        end if; +        return Results; +    end Run_Tests; + + + + +    procedure Run_Tests +           (To_Run  : in Test_Array; +            Verbose : in Verbosity := Weak) +    is +        Total_Count : Natural := To_Run'Length; +        Pass_Count  : Natural := 0; +    begin +        for T of To_Run loop +            if Run_Test (T, Verbose) = Pass then +                Pass_Count := Pass_Count + 1; +            end if; +        end loop; +        if Verbose /= None then +            Put_Line ("Test results" & Integer'Image (Pass_Count) & +                " out of" & Integer'Image (Total_Count)); +        end if; +    end Run_Tests; + + +end Unit_Tests; + + diff --git a/src/unit_tests.ads b/src/unit_tests.ads new file mode 100644 index 0000000..473b828 --- /dev/null +++ b/src/unit_tests.ads @@ -0,0 +1,66 @@ + + +with + +    Ada.Strings.Unbounded; + + +package Unit_Tests is + + +    type Verbosity is (None, Weak, Strong); + + + + +    type Test_Result is (Fail, Pass); + +    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; + +    type Test_Result_Array is array (Positive range <>) of Test_Result; + + + + +    function Run_Test +           (To_Run  : in Test; +            Verbose : in Verbosity := Weak) +        return Test_Result; + +    procedure Run_Test +           (To_Run  : in Test; +            Verbose : in Verbosity := Weak); + +    function Run_Tests +           (To_Run  : in Test_Array; +            Verbose : in Verbosity := Weak) +        return Test_Result_Array; + +    procedure Run_Tests +           (To_Run  : in Test_Array; +            Verbose : in Verbosity := Weak); + + + + +    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; + + +end Unit_Tests; + +  | 
