1------------------------------------------------------------------------------
2--                                                                          --
3--                           GNATTEST COMPONENTS                            --
4--                                                                          --
5--           G N A T T E S T . H A R N E S S . G E N E R A T O R            --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--                     Copyright (C) 2011-2016, AdaCore                     --
10--                                                                          --
11-- GNATTEST  is  free  software;  you  can redistribute it and/or modify it --
12-- under terms of the  GNU  General Public License as published by the Free --
13-- Software  Foundation;  either  version  2, or (at your option) any later --
14-- version.  GNATTEST  is  distributed  in the hope that it will be useful, --
15-- but  WITHOUT  ANY  WARRANTY;   without  even  the  implied  warranty  of --
16-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
17-- Public License for more details.  You should have received a copy of the --
18-- GNU  General  Public License distributed with GNAT; see file COPYING. If --
19-- not, write to the  Free  Software  Foundation, 51 Franklin Street, Fifth --
20-- Floor, Boston, MA 02110-1301, USA.,                                      --
21--                                                                          --
22-- GNATTEST is maintained by AdaCore (http://www.adacore.com).              --
23--                                                                          --
24------------------------------------------------------------------------------
25
26--  This package defines different routines for generating test infrastructure.
27
28pragma Ada_2012;
29
30with Asis;                       use Asis;
31
32with GNAT.OS_Lib;                use GNAT.OS_Lib;
33
34with Ada.Containers.Indefinite_Vectors;
35
36with GNATtest.Common;            use GNATtest.Common;
37
38package GNATtest.Harness.Generator is
39
40   procedure Process_Sources;
41   --  Generates tests and gathers information needed to generate harness
42   --  Iterates trough elements of the source table trying to minimize the
43   --  number times the tree file is created.
44
45   --------------------
46   --  Data Storing  --
47   --------------------
48
49   type Test_Type_Info is record
50      Test_Type             : Asis.Declaration := Asis.Nil_Element;
51      Test_Type_Name        : String_Access := null;
52      Good_For_Substitution       : Boolean := False;
53
54      Max_Inheritance_Depth : Natural := 0;
55      --  Inheritance depth of a test routine is a number of packages
56      --  in the hierarchy of the test type between the original
57      --  declaration and the current overriding declaration plus one.
58      --  So if the test routine is overrifen right in the next test
59      --  package, it's inheritance depth will be 1.
60      --  Max_Inheritance_Depth indicates the maximum of all inheritance
61      --  depths of the test routines in the LTR_List that are primitives
62      --  of the given test type..
63
64      Nesting : String_Access;
65
66      --  Following component used only in full mode
67      Tested_Type         : Asis.Element;
68   end record;
69
70   package TT_Info is new
71     Ada.Containers.Indefinite_Vectors (Positive, Test_Type_Info);
72   use TT_Info;
73
74   type Test_Routine_Info is tagged record
75      TR_Declaration : Asis.Declaration;
76      TR_Text_Name   : String_Access;
77      Test_Type_Numb : Positive;
78      Nesting        : String_Access;
79
80      Tested_Sloc    : String_Access := null;
81   end record;
82
83   package TR_Info is new
84     Ada.Containers.Indefinite_Vectors (Positive, Test_Routine_Info);
85
86   use TR_Info;
87
88   type Test_Routine_Info_Enhanced is new Test_Routine_Info with record
89      TR_Parent_Unit_Decl : Asis.Compilation_Unit;
90      TR_Rarent_Unit_Name : String_Access;
91
92      --  Following components used only in full mode
93      Inheritance_Depth   : Natural;
94      Tested_Type         : Asis.Element;
95   end record;
96
97   package TR_Info_Enhanced is new
98     Ada.Containers.Indefinite_Vectors (Positive, Test_Routine_Info_Enhanced);
99
100   use TR_Info_Enhanced;
101
102   type Test_Case_Info is record
103      Name    : String_Access;
104      Nesting : String_Access;
105   end record;
106
107   package TC_Info is new
108     Ada.Containers.Indefinite_Vectors (Positive, Test_Case_Info);
109
110   use TC_Info;
111
112   type Data_Kind_Type is
113     (Declaration_Data,
114      Instantination_Data);
115
116   type Data_Holder (Data_Kind : Data_Kind_Type := Declaration_Data) is record
117
118      Test_Unit : Asis.Compilation_Unit;
119      --  The CU under consideration.
120
121      Test_Unit_Full_Name : String_Access := null;
122      --  Fully expanded Ada name of the CU under consideration.
123
124      Test_Unit_File_Name : String_Access := null;
125      --  Name of file containing the CU under consideration.
126
127      case Data_Kind is
128         --  Indicates which data storing structures are used, determines the
129         --  way of suite generation.
130
131         when Declaration_Data =>
132
133            Test_Types : TT_Info.Vector;
134            --  List of test types.
135
136            TR_List  : TR_Info.Vector;
137            --  List of test routines declared in the test package.
138
139            ITR_List : TR_Info_Enhanced.Vector;
140            --  List of test routines inherited from packages declaring
141            --  predecessing test types.
142
143            LTR_List : TR_Info_Enhanced.Vector;
144            --  List of test routines overriden in current package.
145
146            TC_List : TC_Info.Vector;
147            --  List of test_case types in current package.
148
149            --  Flags:
150            Generic_Kind         : Boolean := False;
151            --  On, when the given package is generic.
152
153            Good_For_Suite       : Boolean := False;
154            --  The suite should be generated.
155
156            Good_For_Substitution       : Boolean := False;
157            --  Substitution suite should be generated.
158
159         when Instantination_Data =>
160
161            Gen_Unit : Asis.Compilation_Unit := Asis.Nil_Compilation_Unit;
162            --  Generic CU that is instatinated into the given one.
163
164            Gen_Unit_Full_Name : String_Access := null;
165            --  Fully expanded Ada name of the generic CU.
166
167            Gen_Unit_File_Name : String_Access := null;
168            --  Name of file containing the generic CU.
169
170      end case;
171
172   end record;
173
174   function Inheritance_Depth
175     (Current_Type_Decl   : Asis.Element;
176      Parent_Type_Decl    : Asis.Element)
177      return Natural;
178   --  Returns the number of packages between the one containing Type_Decl
179   --  and Target_Unit, that contain intermidiate test type extensions.
180   --  See commnets to Data_Holder type.
181
182   procedure Generate_Suite (Data : Data_Holder; Path : String := "");
183   --  Creates a test suites for both the directly declared
184   --  tests and inherited ones.
185
186   procedure Generate_Test_Drivers
187     (Data      : Data_Holder;
188      UUT       : String;
189      Stub_List : Asis_Element_List.List);
190   --  For given UUT generates a set of independant test driver mains, one per
191   --  subprogram under test, inherited or declared.
192
193   procedure Generate_Substitution_Test_Drivers (Data : Data_Holder);
194   --  For given UUT generates a set of independant test driver mains, one per
195   --  overriden subprogram. Each test driver may contain one to several
196   --  tests: one for overriden operation, and if it is an inherited one,
197   --  one for each of the inherited ones for ancestor types right up to the
198   --  original declaration.
199   --  Can only be called for separate drivers mode, not for stub mode.
200
201   procedure Generate_Stub_Test_Driver_Projects;
202   --  Generates all project files necessary for separate test drivers in stub
203   --  mode.
204
205   procedure Generate_Test_Driver_Projects;
206   --  Generates all project files necessary for separate test drivers.
207
208   procedure Generate_Substitution_Suite_From_Tested
209     (Data : Data_Holder; Path : String := "");
210   --  Generates substitution suite from data gathered during skeleton
211   --  generation.
212
213   procedure Test_Runner_Generator;
214   --  Generates Main_Sute and Test_Runner
215
216   procedure Project_Creator;
217   --  Generates a simple project file for the test driver.
218
219end GNATtest.Harness.Generator;
220