From 196a1a2443b8a66784d293120ee64840ee87f02e Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Tue, 19 May 2020 15:22:55 +1000
Subject: Factored out and improved slightly from Packrat project

---
 basic_unit_test.gpr | 23 +++++++++++++
 lib/.gitignore      |  4 +++
 obj/.gitignore      |  4 +++
 src/unit_tests.adb  | 99 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/unit_tests.ads  | 66 +++++++++++++++++++++++++++++++++++
 5 files changed, 196 insertions(+)
 create mode 100644 basic_unit_test.gpr
 create mode 100644 lib/.gitignore
 create mode 100644 obj/.gitignore
 create mode 100644 src/unit_tests.adb
 create mode 100644 src/unit_tests.ads

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;
+
+
-- 
cgit