1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Ada.Characters.Handling; use Ada.Characters.Handling;
29 with Namet; use Namet;
30 with Output; use Output;
32 package body Prj.Attr is
36 -- Package names are preceded by 'P'
38 -- Attribute names are preceded by two letters
40 -- The first letter is one of
44 -- The second letter is one of
45 -- 'V' for single variable
46 -- 'A' for associative array
47 -- 'a' for case insensitive associative array
49 -- End is indicated by two consecutive '#'.
51 Initialization_Data : constant String :=
59 "SVsource_list_file#" &
63 "SVlibrary_elaboration#" &
64 "SVlibrary_version#" &
71 "Saspecification_suffix#" &
72 "Saimplementation_suffix#" &
73 "SVseparate_suffix#" &
75 "SVdot_replacement#" &
78 "LAspecification_exceptions#" &
79 "LAimplementation_exceptions#" &
84 "Ladefault_switches#" &
86 "SVlocal_configuration_pragmas#" &
91 "Ladefault_switches#" &
93 "SVglobal_configuration_pragmas#" &
103 "Ladefault_switches#" &
109 "Ladefault_switches#" &
112 -- package Cross_Reference
114 "Pcross_reference#" &
115 "Ladefault_switches#" &
121 "Ladefault_switches#" &
133 "Sacompiler_command#" &
134 "SVdebugger_command#" &
137 "SVvcs_file_check#" &
146 procedure Initialize is
147 Start : Positive := Initialization_Data'First;
148 Finish : Positive := Start;
149 Current_Package : Package_Node_Id := Empty_Package;
150 Current_Attribute : Attribute_Node_Id := Empty_Attribute;
151 Is_An_Attribute : Boolean := False;
152 Kind_1 : Variable_Kind := Undefined;
153 Kind_2 : Attribute_Kind := Single;
154 Package_Name : Name_Id := No_Name;
155 Attribute_Name : Name_Id := No_Name;
156 First_Attribute : Attribute_Node_Id := Attribute_First;
159 -- Make sure the two tables are empty
161 Attributes.Set_Last (Attributes.First);
162 Package_Attributes.Set_Last (Package_Attributes.First);
164 while Initialization_Data (Start) /= '#' loop
165 Is_An_Attribute := True;
166 case Initialization_Data (Start) is
169 -- New allowed package
174 while Initialization_Data (Finish) /= '#' loop
175 Finish := Finish + 1;
178 Name_Len := Finish - Start;
179 Name_Buffer (1 .. Name_Len) :=
180 To_Lower (Initialization_Data (Start .. Finish - 1));
181 Package_Name := Name_Find;
183 for Index in Package_First .. Package_Attributes.Last loop
184 if Package_Name = Package_Attributes.Table (Index).Name then
185 Write_Line ("Duplicate package name """ &
186 Initialization_Data (Start .. Finish - 1) &
187 """ in Prj.Attr body.");
192 Is_An_Attribute := False;
193 Current_Attribute := Empty_Attribute;
194 Package_Attributes.Increment_Last;
195 Current_Package := Package_Attributes.Last;
196 Package_Attributes.Table (Current_Package).Name :=
210 if Is_An_Attribute then
215 case Initialization_Data (Start) is
219 Kind_2 := Associative_Array;
221 Kind_2 := Case_Insensitive_Associative_Array;
229 while Initialization_Data (Finish) /= '#' loop
230 Finish := Finish + 1;
233 Name_Len := Finish - Start;
234 Name_Buffer (1 .. Name_Len) :=
235 To_Lower (Initialization_Data (Start .. Finish - 1));
236 Attribute_Name := Name_Find;
237 Attributes.Increment_Last;
238 if Current_Attribute = Empty_Attribute then
239 First_Attribute := Attributes.Last;
241 if Current_Package /= Empty_Package then
242 Package_Attributes.Table (Current_Package).First_Attribute
247 -- Check that there are no duplicate attributes
249 for Index in First_Attribute .. Attributes.Last - 1 loop
251 Attributes.Table (Index).Name then
252 Write_Line ("Duplicate attribute name """ &
253 Initialization_Data (Start .. Finish - 1) &
254 """ in Prj.Attr body.");
259 Attributes.Table (Current_Attribute).Next :=
263 Current_Attribute := Attributes.Last;
264 Attributes.Table (Current_Attribute) :=
265 (Name => Attribute_Name,
268 Next => Empty_Attribute);