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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147 | private with Ada.Containers.Doubly_Linked_Lists;
private with Ada.Containers.Indefinite_Holders;
private with Ada.Strings.Unbounded;
package WL.Unit is
type Test_Result (<>) is private;
function Test_Success return Test_Result;
-- @return a result which indicates the test was successful
function Test_Failure
(Expected : String;
Found : String)
return Test_Result;
-- Construct and return a test result value indicating
-- a failed test.
-- @param Expected expected result of the test
-- @param Found found result of the test
-- @return a Test_Result which indicates a failed test.
function Test_Error
(Message : String)
return Test_Result;
-- Construct and return a test result value indicating that
-- an error occurred while running the test
-- @param Message an error message, for example the string
-- raise with an exception.
-- @return a test result object indicating an error.
function Is_Success (This : Test_Result) return Boolean;
function Is_Failure (This : Test_Result) return Boolean;
function Is_Error (This : Test_Result) return Boolean;
function Expected (This : Test_Result) return String
with Pre => Is_Failure (This);
function Found (This : Test_Result) return String
with Pre => Is_Failure (This);
function Error_Message (This : Test_Result) return String
with Pre => Is_Error (This);
type Unit_Test is abstract tagged private;
function Name (This : Unit_Test) return String is abstract;
function Try
(This : Unit_Test)
return Test_Result
is abstract;
type Test_Suite is tagged private;
procedure Append
(To : in out Test_Suite;
Test : Unit_Test'Class);
procedure Verbose
(Suite : in out Test_Suite;
Enabled : Boolean := True);
procedure Run_Tests
(Suite : in out Test_Suite;
Success : out Natural;
Failure : out Natural;
Error : out Natural;
Not_Run : out Natural);
private
type Test_Result_Type is (Success, Failure, Error);
type Test_Result (Result : Test_Result_Type) is
record
case Result is
when Success =>
null;
when Failure =>
Expected : Ada.Strings.Unbounded.Unbounded_String;
Found : Ada.Strings.Unbounded.Unbounded_String;
when Error =>
Message : Ada.Strings.Unbounded.Unbounded_String;
end case;
end record;
function Test_Success return Test_Result
is (Result => Success);
function Test_Failure
(Expected : String;
Found : String)
return Test_Result
is (Result => Failure,
Expected => Ada.Strings.Unbounded.To_Unbounded_String (Expected),
Found => Ada.Strings.Unbounded.To_Unbounded_String (Found));
function Test_Error
(Message : String)
return Test_Result
is (Result => Error,
Message => Ada.Strings.Unbounded.To_Unbounded_String (Message));
function Is_Success (This : Test_Result) return Boolean
is (This.Result = Success);
function Is_Failure (This : Test_Result) return Boolean
is (This.Result = Failure);
function Is_Error (This : Test_Result) return Boolean
is (This.Result = Error);
function Expected (This : Test_Result) return String
is (Ada.Strings.Unbounded.To_String (This.Expected));
function Found (This : Test_Result) return String
is (Ada.Strings.Unbounded.To_String (This.Found));
function Error_Message (This : Test_Result) return String
is (Ada.Strings.Unbounded.To_String (This.Message));
type Unit_Test is abstract tagged
record
null;
end record;
package Unit_Test_Holders is
new Ada.Containers.Indefinite_Holders (Unit_Test'Class);
package Test_Result_Holders is
new Ada.Containers.Indefinite_Holders (Test_Result);
type Unit_Test_Record is
record
Test : Unit_Test_Holders.Holder;
Result : Test_Result_Holders.Holder;
end record;
package Unit_Test_Lists is
new Ada.Containers.Doubly_Linked_Lists (Unit_Test_Record);
type Test_Suite is tagged
record
List : Unit_Test_Lists.List;
Is_Verbose : Boolean := False;
end record;
end WL.Unit;
|