1------------------------------------------------------------------------------ 2-- -- 3-- GNATTEST COMPONENTS -- 4-- -- 5-- G N A T T E S T . M A P P I N G -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2015-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 26pragma Ada_2012; 27 28with Ada.Containers.Doubly_Linked_Lists; 29with Ada.Containers.Indefinite_Ordered_Maps; 30 31with GNAT.OS_Lib; use GNAT.OS_Lib; 32 33package GNATtest.Mapping is 34 35 ------------------- 36 -- Tests mapping -- 37 ------------------- 38 39 type TC_Mapping is record 40 TC_Name : String_Access; 41 Line : Natural; 42 Column : Natural; 43 Test : String_Access; 44 Test_Time : String_Access; 45 46 TR_Line : Natural; 47 -- Only used in no separates mode. 48 end record; 49 -- Stores info on individual test cases of subprogram under test. 50 51 package TC_Mapping_List is new 52 Ada.Containers.Doubly_Linked_Lists (TC_Mapping); 53 use TC_Mapping_List; 54 55 type TR_Mapping is record 56 TR_Name : String_Access; 57 -- Name of subprogram under test. 58 Line : Natural; 59 Column : Natural; 60 Test : String_Access := null; 61 Test_Time : String_Access := null; 62 TC_List : TC_Mapping_List.List; 63 64 TR_Line : Natural; 65 -- Only used in no separates mode. 66 end record; 67 -- Stores info on individual subprogram under test and collection of 68 -- corresponding test cases (if any). 69 70 package TR_Mapping_List is new 71 Ada.Containers.Doubly_Linked_Lists (TR_Mapping); 72 use TR_Mapping_List; 73 74 type DT_Mapping is record 75 File : String_Access; 76 Line : Natural; 77 Column : Natural; 78 end record; 79 -- Stores info on individual dangling test. 80 81 package DT_Mapping_List is new 82 Ada.Containers.Doubly_Linked_Lists (DT_Mapping); 83 use DT_Mapping_List; 84 85 type TP_Mapping is record 86 TP_Name : String_Access; 87 SetUp_Name : String_Access; 88 SetUp_Line : Natural; 89 SetUp_Column : Natural; 90 TearDown_Name : String_Access; 91 TearDown_Line : Natural; 92 TearDown_Column : Natural; 93 TR_List : TR_Mapping_List.List; 94 DT_List : DT_Mapping_List.List; 95 end record; 96 -- Stores info on individual test package, all it's test routines and 97 -- dangling tests. 98 99 package TP_Mapping_List is new 100 Ada.Containers.Doubly_Linked_Lists (TP_Mapping); 101 use TP_Mapping_List; 102 103 ------------------- 104 -- Stubs mapping -- 105 ------------------- 106 107 type Entity_Sloc is record 108 Line : Natural; 109 Column : Natural; 110 end record; 111 -- Sloc info 112 113 Nil_Entity_Sloc : constant Entity_Sloc := (0, 0); 114 115 package ES_List is new 116 Ada.Containers.Doubly_Linked_Lists (Entity_Sloc); 117 use ES_List; 118 119 type Entity_Stub_Mapping is record 120 Name : String_Access; 121 Line : Natural; 122 Column : Natural; 123 124-- Original_Body : Entity_Sloc; 125 Stub_Body : Entity_Sloc; 126 Setter : Entity_Sloc; 127 end record; 128 -- Mapping info of entity from stubbed unit. 129 130 function "=" (L, R : Entity_Stub_Mapping) return Boolean is 131 (L.Name.all = R.Name.all and then L.Line = R.Line 132 and then L.Column = R.Column); 133 134 package Entity_Stub_Mapping_List is new 135 Ada.Containers.Doubly_Linked_Lists (Entity_Stub_Mapping); 136 use Entity_Stub_Mapping_List; 137 138 type Stub_Unit_Mapping is record 139 Stub_Data_File_Name : String_Access; 140 Orig_Body_File_Name : String_Access; 141 Stub_Body_File_Name : String_Access; 142 Entities : Entity_Stub_Mapping_List.List; 143 D_Setters : ES_List.List; 144 D_Bodies : ES_List.List; 145 end record; 146 -- Mapping info for a whole stubbed unit. 147 148 Nil_Stub_Unit_Mapping : constant Stub_Unit_Mapping := 149 (null, null, null, 150 Entity_Stub_Mapping_List.Empty_List, 151 ES_List.Empty_List, ES_List.Empty_List); 152 153 procedure Clone (From : Stub_Unit_Mapping; To : in out Stub_Unit_Mapping); 154 155 type Mapping_Type is record 156 Test_Info : TP_Mapping_List.List := TP_Mapping_List.Empty_List; 157 Stub_Info : Stub_Unit_Mapping := Nil_Stub_Unit_Mapping; 158 end record; 159 160 package SP_Mapping is new 161 Ada.Containers.Indefinite_Ordered_Maps (String, Mapping_Type); 162 use SP_Mapping; 163 164 Mapping : SP_Mapping.Map; 165 166 procedure Add_Test_List (Name : String; List : TP_Mapping_List.List); 167 procedure Add_Stub_List (Name : String; Info : Stub_Unit_Mapping); 168 -- Add test/stub mapping info for given unit. 169 170 function New_Line_Counter return Natural; 171 -- Returns current value of the counter 172 173 procedure Reset_Line_Counter; 174 -- Resets the counter to 1. 175 176 procedure New_Line_Count; 177 -- Wrapper that increases the counter of new lines in generated package. 178 179 procedure Generate_Mapping_File; 180 -- Creates a mapping file for tested suprograms and tests. 181 182end GNATtest.Mapping; 183