1--
2-- Copyright (c) 2007, 2008 Tero Koskinen <tero.koskinen@iki.fi>
3--
4-- Permission to use, copy, modify, and distribute this software for any
5-- purpose with or without fee is hereby granted, provided that the above
6-- copyright notice and this permission notice appear in all copies.
7--
8-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15--
16
17with Ahven.SList;
18with Ahven.AStrings;
19with Ahven.Long_AStrings;
20
21pragma Elaborate_All (Ahven.SList);
22
23-- Like the name implies, the Results package is used for
24-- storing the test results.
25--
26-- Result_Info holds one invidual result and
27-- Result_Collection holds multiple Result_Infos.
28--
29package Ahven.Results is
30   use Ahven.AStrings;
31
32   type Result_Info is private;
33
34   Empty_Result_Info : constant Result_Info;
35   -- Result_Info object which holds no result. It can be used
36   -- to initialize a new Result_Info object.
37
38   procedure Set_Test_Name (Info : in out Result_Info;
39                            Name :        Bounded_String);
40   -- Set a test name for the result.
41
42   procedure Set_Routine_Name (Info : in out Result_Info;
43                               Name :        Bounded_String);
44   -- Set a routine name for the result.
45
46   procedure Set_Message (Info : in out Result_Info;
47                          Message : Bounded_String);
48   -- Set a message for the result.
49
50   procedure Set_Test_Name (Info : in out Result_Info; Name : String);
51   -- A helper function, which calls Set_Test_Name (.. ; Bounded_String)
52
53   procedure Set_Routine_Name (Info : in out Result_Info; Name : String);
54   -- A helper function, which calls Set_Routine_Name (.. ; Bounded_String)
55
56   procedure Set_Message (Info : in out Result_Info; Message : String);
57   -- A helper function, which calls Set_Message (.. ; Bounded_String)
58
59   procedure Set_Long_Message (Info    : in out Result_Info;
60                               Message :        Bounded_String);
61   -- Set a long message for the result
62
63   procedure Set_Long_Message
64     (Info    : in out Result_Info;
65      Message :        Long_AStrings.Bounded_String);
66   -- Set a long message for the result
67
68   procedure Set_Long_Message (Info : in out Result_Info; Message : String);
69   -- A helper function, which calls Set_Long_Message (.. ; Bounded_String)
70
71   procedure Set_Execution_Time (Info         : in out Result_Info;
72                                 Elapsed_Time :        Duration);
73   -- Set the execution time of the result info (test).
74
75   procedure Set_Output_File (Info     : in out Result_Info;
76                              Filename :        Bounded_String);
77   -- Set the name of the test output file.
78
79   procedure Set_Output_File (Info     : in out Result_Info;
80                              Filename :        String);
81   -- Set the name of the test output file.
82
83   function Get_Test_Name (Info : Result_Info) return String;
84   -- Return the test name of the result info.
85
86   function Get_Routine_Name (Info : Result_Info) return String;
87   -- Return the routine name of the result info.
88
89   function Get_Message (Info : Result_Info) return String;
90   -- Return the message of the result info.
91
92   function Get_Long_Message (Info : Result_Info) return String;
93   -- Return the long message of the result info.
94
95   function Get_Execution_Time (Info : Result_Info) return Duration;
96   -- Return the execution time of the result info.
97
98   function Get_Output_File (Info : Result_Info) return Bounded_String;
99   -- Return the name of the output file.
100   -- Empty string is returned in case there is no output file.
101
102   type Result_Collection is limited private;
103   -- A collection of Result_Info objects.
104   -- Contains also child collections.
105
106   type Result_Collection_Access is access Result_Collection;
107
108   procedure Add_Child (Collection : in out Result_Collection;
109                        Child      :        Result_Collection_Access);
110   -- Add a child collection to the collection.
111
112   procedure Add_Error (Collection : in out Result_Collection;
113                        Info       :        Result_Info);
114   -- Add a test error to the collection.
115
116   procedure Add_Skipped (Collection : in out Result_Collection;
117                          Info       :        Result_Info);
118   -- Add a skipped test to the collection.
119
120   procedure Add_Failure (Collection : in out Result_Collection;
121                          Info       :        Result_Info);
122   -- Add a test failure to the collection.
123
124   procedure Add_Pass (Collection : in out Result_Collection;
125                       Info       :        Result_Info);
126   -- Add a passed test to the collection
127
128   procedure Release (Collection : in out Result_Collection);
129   -- Release resourced held by the collection.
130   -- Frees also all children added via Add_Child.
131
132   procedure Set_Name (Collection : in out Result_Collection;
133                       Name       :        Bounded_String);
134   -- Set a test name for the collection.
135
136   procedure Set_Parent (Collection : in out Result_Collection;
137                         Parent     :        Result_Collection_Access);
138   -- Set a parent collection to the collection.
139
140   function Test_Count (Collection : Result_Collection) return Natural;
141   -- Return the amount of tests in the collection.
142   -- Tests in child collections are included.
143
144   function Direct_Test_Count (Collection : Result_Collection) return Natural;
145   -- Return the amount of tests in the collection.
146   -- The tests in the child collections are NOT included.
147
148   function Pass_Count (Collection : Result_Collection) return Natural;
149   -- Return the amount of passed tests in the collection.
150   -- Tests in child collections are included.
151
152   function Error_Count (Collection : Result_Collection) return Natural;
153   -- Return the amount of test errors in the collection.
154   -- Tests in child collections are included.
155
156   function Failure_Count (Collection : Result_Collection) return Natural;
157   -- Return the amount of test errors in the collection.
158   -- Tests in child collections are included.
159
160   function Skipped_Count (Collection : Result_Collection) return Natural;
161   -- Return the amount of skipped tests in the colleciton.
162   -- Tests in child collections are included.
163
164   function Get_Test_Name (Collection : Result_Collection)
165     return Bounded_String;
166   -- Return the name of the collection's test.
167
168   function Get_Parent (Collection : Result_Collection)
169     return Result_Collection_Access;
170   -- Return the parent of the collection.
171
172   function Get_Execution_Time (Collection : Result_Collection)
173     return Duration;
174   -- Return the execution time of the whole collection.
175
176   type Result_Info_Cursor is private;
177   -- A cursor type for Pass, Failure and Error results.
178
179   function First_Pass (Collection : Result_Collection)
180     return Result_Info_Cursor;
181   -- Get the first pass from the collection.
182
183   function First_Failure (Collection : Result_Collection)
184     return Result_Info_Cursor;
185   -- Get the first failure from the collection.
186
187   function First_Skipped (Collection : Result_Collection)
188     return Result_Info_Cursor;
189   -- Get the first skipped test from the collection.
190
191   function First_Error (Collection : Result_Collection)
192     return Result_Info_Cursor;
193   -- Get the first error from the collection.
194
195   function Next (Position : Result_Info_Cursor) return Result_Info_Cursor;
196   -- Get the next pass/failure/error.
197
198   function Data (Position : Result_Info_Cursor) return Result_Info;
199   -- Get the data behind the cursor.
200
201   function Is_Valid (Position : Result_Info_Cursor) return Boolean;
202   -- Is the cursor still valid?
203
204   type Result_Collection_Cursor is private;
205   -- Cursor for iterating over a set of Result_Collection access objects.
206
207   function First_Child (Collection : in Result_Collection)
208     return Result_Collection_Cursor;
209   -- Get the first child of the collection.
210
211   function Next (Position : Result_Collection_Cursor)
212     return Result_Collection_Cursor;
213   -- Get the next child.
214
215   function Is_Valid (Position : Result_Collection_Cursor) return Boolean;
216   -- Is the cursor still valid?
217
218   function Data (Position : Result_Collection_Cursor)
219     return Result_Collection_Access;
220   -- Get the data (Result_Collection_Access) behind the cursor.
221
222   function Child_Depth (Collection : Result_Collection) return Natural;
223   -- Return the maximum depth of children. (a child of a child, etc.)
224   --
225   -- Examples: Child_Depth is 0 for a collection without children.
226   -- Collection with a child containing another child has a depth of 2.
227
228private
229   type Result_Info is record
230      Test_Name      : Bounded_String  := Null_Bounded_String;
231      Output_File    : Bounded_String  := Null_Bounded_String;
232      Routine_Name   : Bounded_String  := Null_Bounded_String;
233      Execution_Time : Duration := 0.0;
234      Message        : Bounded_String  := Null_Bounded_String;
235      Long_Message   : Long_AStrings.Bounded_String
236        := Long_AStrings.Null_Bounded_String;
237   end record;
238
239   Empty_Result_Info : constant Result_Info :=
240     (Test_Name      => Null_Bounded_String,
241      Routine_Name   => Null_Bounded_String,
242      Message        => Null_Bounded_String,
243      Long_Message   => Long_AStrings.Null_Bounded_String,
244      Execution_Time => 0.0,
245      Output_File    => Null_Bounded_String);
246
247   package Result_Info_List is
248     new Ahven.SList (Element_Type => Result_Info);
249
250   type Result_Collection_Wrapper is record
251      Ptr : Result_Collection_Access;
252   end record;
253   -- Work around for Janus/Ada 3.1.1d/3.1.2beta generic bug.
254
255   package Result_List is
256     new Ahven.SList (Element_Type => Result_Collection_Wrapper);
257
258   type Result_Info_Cursor is new Result_Info_List.Cursor;
259
260   type Result_Collection_Cursor is new Result_List.Cursor;
261
262   type Result_Collection is limited record
263      Test_Name : Bounded_String := Null_Bounded_String;
264      Passes    : Result_Info_List.List;
265      Failures  : Result_Info_List.List;
266      Errors    : Result_Info_List.List;
267      Skips     : Result_Info_List.List;
268      Children  : Result_List.List;
269      Parent    : Result_Collection_Access := null;
270   end record;
271end Ahven.Results;
272