28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
-- --
-- Tests are gathered into sections, which can be nested. What a section --
-- exactly means is left to the implementation of this interface. --
------------------------------------------------------------------------------
with Ada.Exceptions;
package Natools.Tests is
pragma Preelaborate (Tests);
type Reporter is interface;
type Result is (Success, Fail, Error, Skipped);
type Result_Summary is array (Result) of Natural;
|
>
>
>
>
|
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
-- --
-- Tests are gathered into sections, which can be nested. What a section --
-- exactly means is left to the implementation of this interface. --
------------------------------------------------------------------------------
with Ada.Exceptions;
private with Ada.Finalization;
private with Ada.Strings.Unbounded;
private with Ada.Containers.Indefinite_Doubly_Linked_Lists;
package Natools.Tests is
pragma Preelaborate (Tests);
type Reporter is interface;
type Result is (Success, Fail, Error, Skipped);
type Result_Summary is array (Result) of Natural;
|
78
79
80
81
82
83
84
85
|
(Report : in out Reporter'Class;
Test_Name : String;
Ex : Ada.Exceptions.Exception_Occurrence;
Code : Result := Error);
-- Append to Report a new Item, whose result is Code, along with
-- a description of the exception Ex as Info entries.
end Natools.Tests;
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
|
(Report : in out Reporter'Class;
Test_Name : String;
Ex : Ada.Exceptions.Exception_Occurrence;
Code : Result := Error);
-- Append to Report a new Item, whose result is Code, along with
-- a description of the exception Ex as Info entries.
-----------------
-- Test Object --
-----------------
type Test (<>) is tagged limited private;
-- An object of type Test hold information about a single test.
-- It contains a reference to a Reporter object, which is filled with
-- held info when the Test object is finalized.
function Item
(Report : access Reporter'Class;
Name : String;
Default_Outcome : Result := Success)
return Test;
-- Create a new Test object with the given Name
procedure Set_Result (Object : in out Test; Outcome : in Result);
-- Set the test result
procedure Info (Object : in out Test; Text : in String);
-- Append the given text as extra information related to the test
procedure Report_Exception
(Object : in out Test;
Ex : in Ada.Exceptions.Exception_Occurrence;
Code : in Result := Error);
-- Append information about Ex to the test and set its result state
procedure Fail (Object : in out Test; Text : in String := "");
procedure Error (Object : in out Test; Text : in String := "");
procedure Skip (Object : in out Test; Text : in String := "");
-- Set the result state and append Text info in a single call
private
package Info_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists
(String);
type Test (Report : access Reporter'Class) is
new Ada.Finalization.Limited_Controlled with record
Name : Ada.Strings.Unbounded.Unbounded_String;
Info : Info_Lists.List;
Outcome : Result;
Finalized : Boolean := False;
end record;
overriding procedure Finalize (Object : in out Test);
end Natools.Tests;
|