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