1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 with Ada.Characters.Handling; use Ada.Characters.Handling;
30 with Namet; use Namet;
31 with Output; use Output;
33 package body Prj.Attr is
37 -- Package names are preceded by 'P'
39 -- Attribute names are preceded by two letters
41 -- The first letter is one of
45 -- The second letter is one of
46 -- 'V' for single variable
47 -- 'A' for associative array
48 -- 'a' for case insensitive associative array
50 -- End is indicated by two consecutive '#'.
52 Initialization_Data : constant String :=
60 "SVsource_list_file#" &
64 "SVlibrary_elaboration#" &
65 "SVlibrary_version#" &
72 "Saspecification_suffix#" &
73 "Saimplementation_suffix#" &
74 "SVseparate_suffix#" &
76 "SVdot_replacement#" &
79 "LAspecification_exceptions#" &
80 "LAimplementation_exceptions#" &
85 "Ladefault_switches#" &
87 "SVlocal_configuration_pragmas#" &
92 "Ladefault_switches#" &
94 "SVglobal_configuration_pragmas#" &
104 "Ladefault_switches#" &
110 "Ladefault_switches#" &
113 -- package Cross_Reference
115 "Pcross_reference#" &
116 "Ladefault_switches#" &
122 "Ladefault_switches#" &
134 "Sacompiler_command#" &
135 "SVdebugger_command#" &
138 "SVvcs_file_check#" &
147 procedure Initialize is
148 Start : Positive := Initialization_Data'First;
149 Finish : Positive := Start;
150 Current_Package : Package_Node_Id := Empty_Package;
151 Current_Attribute : Attribute_Node_Id := Empty_Attribute;
152 Is_An_Attribute : Boolean := False;
153 Kind_1 : Variable_Kind := Undefined;
154 Kind_2 : Attribute_Kind := Single;
155 Package_Name : Name_Id := No_Name;
156 Attribute_Name : Name_Id := No_Name;
157 First_Attribute : Attribute_Node_Id := Attribute_First;
160 -- Make sure the two tables are empty
162 Attributes.Set_Last (Attributes.First);
163 Package_Attributes.Set_Last (Package_Attributes.First);
165 while Initialization_Data (Start) /= '#' loop
166 Is_An_Attribute := True;
167 case Initialization_Data (Start) is
170 -- New allowed package
175 while Initialization_Data (Finish) /= '#' loop
176 Finish := Finish + 1;
179 Name_Len := Finish - Start;
180 Name_Buffer (1 .. Name_Len) :=
181 To_Lower (Initialization_Data (Start .. Finish - 1));
182 Package_Name := Name_Find;
184 for Index in Package_First .. Package_Attributes.Last loop
185 if Package_Name = Package_Attributes.Table (Index).Name then
186 Write_Line ("Duplicate package name """ &
187 Initialization_Data (Start .. Finish - 1) &
188 """ in Prj.Attr body.");
193 Is_An_Attribute := False;
194 Current_Attribute := Empty_Attribute;
195 Package_Attributes.Increment_Last;
196 Current_Package := Package_Attributes.Last;
197 Package_Attributes.Table (Current_Package).Name :=
211 if Is_An_Attribute then
216 case Initialization_Data (Start) is
220 Kind_2 := Associative_Array;
222 Kind_2 := Case_Insensitive_Associative_Array;
230 while Initialization_Data (Finish) /= '#' loop
231 Finish := Finish + 1;
234 Name_Len := Finish - Start;
235 Name_Buffer (1 .. Name_Len) :=
236 To_Lower (Initialization_Data (Start .. Finish - 1));
237 Attribute_Name := Name_Find;
238 Attributes.Increment_Last;
239 if Current_Attribute = Empty_Attribute then
240 First_Attribute := Attributes.Last;
242 if Current_Package /= Empty_Package then
243 Package_Attributes.Table (Current_Package).First_Attribute
248 -- Check that there are no duplicate attributes
250 for Index in First_Attribute .. Attributes.Last - 1 loop
252 Attributes.Table (Index).Name then
253 Write_Line ("Duplicate attribute name """ &
254 Initialization_Data (Start .. Finish - 1) &
255 """ in Prj.Attr body.");
260 Attributes.Table (Current_Attribute).Next :=
264 Current_Attribute := Attributes.Last;
265 Attributes.Table (Current_Attribute) :=
266 (Name => Attribute_Name,
269 Next => Empty_Attribute);