1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2004 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
42 -- 's' for Single with optional index
44 -- 'l' for List of strings with optional indexes
46 -- The second letter is one of
47 -- 'V' for single variable
48 -- 'A' for associative array
49 -- 'a' for case insensitive associative array
50 -- 'b' for associative array, case insensitive if file names are case
52 -- 'c' same as 'b', with optional index
54 -- End is indicated by two consecutive '#'.
56 Initialization_Data
: constant String :=
64 "LVlocally_removed_files#" &
65 "SVsource_list_file#" &
69 "SVlibrary_version#" &
70 "LVlibrary_interface#" &
71 "SVlibrary_auto_init#" &
72 "LVlibrary_options#" &
73 "SVlibrary_src_dir#" &
75 "SVlibrary_symbol_file#" &
76 "SVlibrary_symbol_policy#" &
77 "SVlibrary_reference_symbol_file#" &
85 "Saspecification_suffix#" &
87 "Saimplementation_suffix#" &
89 "SVseparate_suffix#" &
91 "SVdot_replacement#" &
96 "Laspecification_exceptions#" &
97 "Laimplementation_exceptions#" &
102 "Ladefault_switches#" &
104 "SVlocal_configuration_pragmas#" &
109 "Ladefault_switches#" &
112 "SVexecutable_suffix#" &
113 "SVglobal_configuration_pragmas#" &
123 "Ladefault_switches#" &
129 "Ladefault_switches#" &
131 "LVlinker_options#" &
133 -- package Cross_Reference
135 "Pcross_reference#" &
136 "Ladefault_switches#" &
142 "Ladefault_switches#" &
145 -- package Pretty_Printer
148 "Ladefault_switches#" &
154 "Ladefault_switches#" &
160 "Ladefault_switches#" &
166 "Ladefault_switches#" &
169 "SVcommunication_protocol#" &
170 "Sacompiler_command#" &
171 "SVdebugger_command#" &
174 "SVvcs_file_check#" &
183 procedure Initialize
is
184 Start
: Positive := Initialization_Data
'First;
185 Finish
: Positive := Start
;
186 Current_Package
: Package_Node_Id
:= Empty_Package
;
187 Current_Attribute
: Attribute_Node_Id
:= Empty_Attribute
;
188 Is_An_Attribute
: Boolean := False;
189 Kind_1
: Variable_Kind
:= Undefined
;
190 Optional_Index
: Boolean := False;
191 Kind_2
: Attribute_Kind
:= Single
;
192 Package_Name
: Name_Id
:= No_Name
;
193 Attribute_Name
: Name_Id
:= No_Name
;
194 First_Attribute
: Attribute_Node_Id
:= Attribute_First
;
197 -- Make sure the two tables are empty
200 Package_Attributes
.Init
;
202 while Initialization_Data
(Start
) /= '#' loop
203 Is_An_Attribute
:= True;
204 case Initialization_Data
(Start
) is
207 -- New allowed package
212 while Initialization_Data
(Finish
) /= '#' loop
213 Finish
:= Finish
+ 1;
216 Name_Len
:= Finish
- Start
;
217 Name_Buffer
(1 .. Name_Len
) :=
218 To_Lower
(Initialization_Data
(Start
.. Finish
- 1));
219 Package_Name
:= Name_Find
;
221 for Index
in Package_First
.. Package_Attributes
.Last
loop
222 if Package_Name
= Package_Attributes
.Table
(Index
).Name
then
223 Write_Line
("Duplicate package name """ &
224 Initialization_Data
(Start
.. Finish
- 1) &
225 """ in Prj.Attr body.");
230 Is_An_Attribute
:= False;
231 Current_Attribute
:= Empty_Attribute
;
232 Package_Attributes
.Increment_Last
;
233 Current_Package
:= Package_Attributes
.Last
;
234 Package_Attributes
.Table
(Current_Package
).Name
:=
240 Optional_Index
:= False;
244 Optional_Index
:= True;
248 Optional_Index
:= False;
252 Optional_Index
:= True;
258 if Is_An_Attribute
then
263 case Initialization_Data
(Start
) is
268 Kind_2
:= Associative_Array
;
271 Kind_2
:= Case_Insensitive_Associative_Array
;
274 if File_Names_Case_Sensitive
then
275 Kind_2
:= Associative_Array
;
277 Kind_2
:= Case_Insensitive_Associative_Array
;
281 if File_Names_Case_Sensitive
then
282 Kind_2
:= Optional_Index_Associative_Array
;
285 Optional_Index_Case_Insensitive_Associative_Array
;
295 while Initialization_Data
(Finish
) /= '#' loop
296 Finish
:= Finish
+ 1;
299 Name_Len
:= Finish
- Start
;
300 Name_Buffer
(1 .. Name_Len
) :=
301 To_Lower
(Initialization_Data
(Start
.. Finish
- 1));
302 Attribute_Name
:= Name_Find
;
303 Attributes
.Increment_Last
;
305 if Current_Attribute
= Empty_Attribute
then
306 First_Attribute
:= Attributes
.Last
;
308 if Current_Package
/= Empty_Package
then
309 Package_Attributes
.Table
(Current_Package
).First_Attribute
314 -- Check that there are no duplicate attributes
316 for Index
in First_Attribute
.. Attributes
.Last
- 1 loop
318 Attributes
.Table
(Index
).Name
then
319 Write_Line
("Duplicate attribute name """ &
320 Initialization_Data
(Start
.. Finish
- 1) &
321 """ in Prj.Attr body.");
326 Attributes
.Table
(Current_Attribute
).Next
:=
330 Current_Attribute
:= Attributes
.Last
;
331 Attributes
.Table
(Current_Attribute
) :=
332 (Name
=> Attribute_Name
,
334 Optional_Index
=> Optional_Index
,
336 Next
=> Empty_Attribute
);