1------------------------------------------------------------------------------
2--                                                                          --
3--                           GNATTEST COMPONENTS                            --
4--                                                                          --
5--                      G N A T T E S T . C O M M O N                       --
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 contains some general-purpose entities that are used by many
27--  GNATtest components
28
29pragma Ada_2012;
30
31with Asis;
32with Asis.Text;                   use Asis.Text;
33with Asis.Elements;               use Asis.Elements;
34
35with Ada.Exceptions;              use Ada.Exceptions;
36with GNAT.OS_Lib;                 use GNAT.OS_Lib;
37with Ada.Sequential_IO;
38
39with GNATCOLL.Projects;
40with GNATCOLL.VFS;                use GNATCOLL.VFS;
41
42with Ada.Containers.Indefinite_Doubly_Linked_Lists;
43with Ada.Containers.Doubly_Linked_Lists;
44with Ada.Containers.Indefinite_Ordered_Sets;
45with Ada.Containers.Indefinite_Ordered_Maps;
46
47package GNATtest.Common is
48
49   procedure Report_Err (Message : String);
50   --  Prints it's argument to the standard error output
51
52   procedure Report_AUnit_Usage;
53   --  Shows a message about AUnit being among the source files
54
55   procedure Report_Std (Message : String; Offset : Integer := 0);
56   --  Prints it's argument to the standard output with Offset spaces before.
57
58   procedure Report_Unhandled_ASIS_Exception (Ex : Exception_Occurrence);
59   --  Reports an unhandled ASIS exception
60
61   procedure Report_Unhandled_Exception (Ex : Exception_Occurrence);
62   --  Reports an unhandled non-ASIS exception
63
64   procedure Generate_Common_File;
65   --  Creates a file with package gnattest_generated which denotes the default
66   --  skeletons behavior and declares renamins necessary to avoid name
67   --  conflicts with tested sources.
68
69   function Get_Subp_Name (Subp : Asis.Element) return String;
70   --  if Subp is a subprigram declaration it will return subprogram's name;
71   --  if Subp is an overloaded operator - it's text name
72
73   Source_Project_Tree : GNATCOLL.Projects.Project_Tree;
74   --  Source project file name. Used for extraction of source files and
75   --  paths for compiler.
76
77   The_Context : Asis.Context;
78   --  The Context for all the processing. May be associated, opened, closed
79   --  and dissociated several times during one tool run.
80
81   Fatal_Error : exception;
82
83   Tmp_Test_Prj : String_Access := null;
84
85   package Char_Sequential_IO is new Ada.Sequential_IO (Character);
86   Output_File : Char_Sequential_IO.File_Type;
87
88   procedure Create_Dirs (Target_Dirs : File_Array_Access);
89   --  Creates given directories.
90
91   procedure S_Put (Span : Natural; Text : String);
92   --  Adds Span number spaces before the Text and prints it to Output_File
93
94   procedure Create (Name : String);
95   procedure Close_File;
96   --  Wrappers for creating and closing output files.
97
98   procedure Put_New_Line;
99   --  Puts a unix-style terminator to the Output_File disregard from the
100   --  current actual platform.
101
102   function Unit_To_File_Name (Old : String) return String;
103   --  Replaces dots with "-" and lowers the case of the letters.
104
105   package List_Of_Strings is new
106     Ada.Containers.Indefinite_Doubly_Linked_Lists (String);
107   use List_Of_Strings;
108
109   package Asis_Element_List is new
110     Ada.Containers.Doubly_Linked_Lists (Asis.Element, Is_Equal);
111   use Asis_Element_List;
112
113   package String_Set is new
114     Ada.Containers.Indefinite_Ordered_Sets (String);
115   use String_Set;
116
117   package String_To_String_Map is new
118     Ada.Containers.Indefinite_Ordered_Maps (String, String);
119   use String_To_String_Map;
120
121   --------------------
122   -- Stub exclusion --
123   --------------------
124
125   Default_Stub_Exclusion_List : String_Set.Set :=
126     String_Set.Empty_Set;
127   package String_To_String_Set is new
128     Ada.Containers.Indefinite_Ordered_Maps (String, String_Set.Set);
129   use String_To_String_Set;
130   Stub_Exclusion_Lists : String_To_String_Set.Map    :=
131     String_To_String_Set.Empty_Map;
132
133   procedure Store_Default_Excluded_Stub (Excluded : String);
134   --  Store data on units that should not be stubbed for all UUTs.
135   procedure Store_Excluded_Stub (Source : String; Excluded : String);
136   --  Store data on units that should not be stubbed for given UUT.
137
138   function Get_Next_Infix return String;
139   --  Returns a numbered infix ("1_", "2_",..), increasing the number for
140   --  each call.
141
142   Inherited_Switches : List_Of_Strings.List;
143
144   Excluded_Test_Package_Bodies : String_Set.Set;
145   Excluded_Test_Data_Files     : String_Set.Set;
146
147   function Get_Nesting (Elem : Asis.Element) return String;
148   --  Returns the full package & protected prefix if the element.
149
150   function Parent_Type_Declaration
151     (Type_Dec : Asis.Element) return Asis.Element;
152   --  Returns a corresponding parent type declaration for a given tagged type
153   --  extension declaration.
154
155   function First_Column_Number (Element : Asis.Element) return Line_Number;
156   --  Returns the number on the first column of the first line of the element.
157
158   procedure Put_Harness_Header;
159
160   function Mangle_Hash_Full
161     (Subp           : Asis.Declaration;
162      Case_Sensitive : Boolean := False;
163      N_Controlling  : Boolean := False;
164      For_Stubs      : Boolean := False)
165      return String;
166   --  Returns full hash for given subprogram.
167
168   function To_String_First_Name (Elem : Asis.Element) return String;
169
170   function Substring_16 (S : String) return String is
171     (S (S'First .. S'First + 15));
172   function Substring_6 (S : String) return String is
173     (S (S'First .. S'First + 5));
174
175   function "<" (Left, Right : Asis.Element) return Boolean;
176
177   ------------------------
178   --  String constants  --
179   ------------------------
180
181   Test_Routine_Prefix      : constant String := "Test_";
182   --  Prefix to each test routine
183
184   Wrapper_Prefix           : constant String := "Wrap_";
185
186   Stub_Type_Prefix         : constant String := "Stub_Data_Type_";
187
188   Stub_Object_Prefix       : constant String := "Stub_Data_";
189
190   Setter_Prefix            : constant String := "Set_Stub_";
191
192   Stub_Result_Suffix       : constant String := "_Result";
193
194   Stub_Counter_Var         : constant String := "Stub_Counter";
195
196   Test_Unit_Name           : constant String := "Tests";
197   --  Name of test child package for non-primitive tests.
198
199   Test_Unit_Name_Suff      : constant String := "_Tests";
200   --  Suffix for test packages that correspond to tagged record types.
201
202   Gen_Test_Unit_Name       : constant String := "Gen_Tests";
203   --  Name of generic test child package for non-primitive tests.
204
205   Gen_Test_Unit_Name_Suff  : constant String := "_Gen_Tests";
206   --  Suffix for generic test packages that correspond to tagged record types.
207
208   Inst_Test_Unit_Name      : constant String := "Inst_Tests";
209   --  Name of instatiation test child package.
210
211   Test_Prj_Prefix          : constant String := "test_";
212   --  Prefix of the output project file name.
213
214   Test_Data_Unit_Name      : constant String := "Test_Data";
215
216   Test_Data_Unit_Name_Suff : constant String := "_Test_Data";
217
218   Stub_Data_Unit_Name      : constant String := "Stub_Data";
219
220   Stub_Project_Prefix      : constant String := "Stub_";
221
222   TD_Prefix                : constant String := "Driver_";
223   TD_Prefix_Overriden      : constant String := "VTE_Driver_";
224
225   Hash_Version             : constant String := "2.2";
226
227   GT_Marker_Begin   : constant String := "--  begin read only";
228   GT_Marker_End     : constant String := "--  end read only";
229
230end GNATtest.Common;
231