blob: 3c31ef919d3a10c51f30f50cb8cb155748e65a8c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
-- This source is licensed under the Sunset License v1.0
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 ("Testing " & (-To_Run.Name) & "...");
end if;
begin
Result := To_Run.Func.all;
exception
when others => Result := Fail;
end;
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;
|