1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
28 with Namet
; use Namet
;
29 with Osint
; use Osint
;
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
48 -- 'b' for associative array, case insensitive if file names are case
51 -- End is indicated by two consecutive '#'.
53 Initialization_Data
: constant String :=
61 "LVlocally_removed_files#" &
62 "SVsource_list_file#" &
66 "SVlibrary_version#" &
67 "LVlibrary_interface#" &
68 "SVlibrary_auto_init#" &
69 "LVlibrary_options#" &
70 "SVlibrary_src_dir#" &
72 "SVlibrary_symbol_file#" &
73 "SVlibrary_symbol_policy#" &
74 "SVlibrary_reference_symbol_file#" &
82 "Saspecification_suffix#" &
84 "Saimplementation_suffix#" &
86 "SVseparate_suffix#" &
88 "SVdot_replacement#" &
93 "Laspecification_exceptions#" &
94 "Laimplementation_exceptions#" &
99 "Ladefault_switches#" &
101 "SVlocal_configuration_pragmas#" &
106 "Ladefault_switches#" &
109 "SVexecutable_suffix#" &
110 "SVglobal_configuration_pragmas#" &
120 "Ladefault_switches#" &
126 "Ladefault_switches#" &
128 "LVlinker_options#" &
130 -- package Cross_Reference
132 "Pcross_reference#" &
133 "Ladefault_switches#" &
139 "Ladefault_switches#" &
142 -- package Pretty_Printer
145 "Ladefault_switches#" &
151 "Ladefault_switches#" &
157 "Ladefault_switches#" &
163 "Ladefault_switches#" &
166 "SVcommunication_protocol#" &
167 "Sacompiler_command#" &
168 "SVdebugger_command#" &
171 "SVvcs_file_check#" &
180 procedure Initialize
is
181 Start
: Positive := Initialization_Data
'First;
182 Finish
: Positive := Start
;
183 Current_Package
: Package_Node_Id
:= Empty_Package
;
184 Current_Attribute
: Attribute_Node_Id
:= Empty_Attribute
;
185 Is_An_Attribute
: Boolean := False;
186 Kind_1
: Variable_Kind
:= Undefined
;
187 Kind_2
: Attribute_Kind
:= Single
;
188 Package_Name
: Name_Id
:= No_Name
;
189 Attribute_Name
: Name_Id
:= No_Name
;
190 First_Attribute
: Attribute_Node_Id
:= Attribute_First
;
193 -- Make sure the two tables are empty
196 Package_Attributes
.Init
;
198 while Initialization_Data
(Start
) /= '#' loop
199 Is_An_Attribute
:= True;
200 case Initialization_Data
(Start
) is
203 -- New allowed package
208 while Initialization_Data
(Finish
) /= '#' loop
209 Finish
:= Finish
+ 1;
212 Name_Len
:= Finish
- Start
;
213 Name_Buffer
(1 .. Name_Len
) :=
214 To_Lower
(Initialization_Data
(Start
.. Finish
- 1));
215 Package_Name
:= Name_Find
;
217 for Index
in Package_First
.. Package_Attributes
.Last
loop
218 if Package_Name
= Package_Attributes
.Table
(Index
).Name
then
219 Write_Line
("Duplicate package name """ &
220 Initialization_Data
(Start
.. Finish
- 1) &
221 """ in Prj.Attr body.");
226 Is_An_Attribute
:= False;
227 Current_Attribute
:= Empty_Attribute
;
228 Package_Attributes
.Increment_Last
;
229 Current_Package
:= Package_Attributes
.Last
;
230 Package_Attributes
.Table
(Current_Package
).Name
:=
244 if Is_An_Attribute
then
249 case Initialization_Data
(Start
) is
254 Kind_2
:= Associative_Array
;
257 Kind_2
:= Case_Insensitive_Associative_Array
;
260 if File_Names_Case_Sensitive
then
261 Kind_2
:= Case_Insensitive_Associative_Array
;
263 Kind_2
:= Case_Insensitive_Associative_Array
;
273 while Initialization_Data
(Finish
) /= '#' loop
274 Finish
:= Finish
+ 1;
277 Name_Len
:= Finish
- Start
;
278 Name_Buffer
(1 .. Name_Len
) :=
279 To_Lower
(Initialization_Data
(Start
.. Finish
- 1));
280 Attribute_Name
:= Name_Find
;
281 Attributes
.Increment_Last
;
282 if Current_Attribute
= Empty_Attribute
then
283 First_Attribute
:= Attributes
.Last
;
285 if Current_Package
/= Empty_Package
then
286 Package_Attributes
.Table
(Current_Package
).First_Attribute
291 -- Check that there are no duplicate attributes
293 for Index
in First_Attribute
.. Attributes
.Last
- 1 loop
295 Attributes
.Table
(Index
).Name
then
296 Write_Line
("Duplicate attribute name """ &
297 Initialization_Data
(Start
.. Finish
- 1) &
298 """ in Prj.Attr body.");
303 Attributes
.Table
(Current_Attribute
).Next
:=
307 Current_Attribute
:= Attributes
.Last
;
308 Attributes
.Table
(Current_Attribute
) :=
309 (Name
=> Attribute_Name
,
312 Next
=> Empty_Attribute
);