]> gcc.gnu.org Git - gcc.git/blame - gcc/ada/prj-proc.adb
git://gcc.gnu.org / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
[multiple changes]
[gcc.git] / gcc / ada / prj-proc.adb
CommitLineData
19235870
RK		 1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
a18e3d62 5-- P R J . P R O C --
19235870
RK		 6-- --
7-- B o d y --
8-- --
422e02cf 9-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
19235870
RK		 10-- --
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- --
b5c84c3c 13-- ware Foundation; either version 3, or (at your option) any later ver- --
19235870
RK		 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 --
b5c84c3c
RD		 18-- Public License distributed with GNAT; see file COPYING3. If not, go to --
19-- http://www.gnu.org/licenses for a complete copy of the license. --
19235870
RK		 20-- --
21-- GNAT was originally developed by the GNAT team at New York University. --
71ff80dc 22-- Extensive contributions were provided by Ada Core Technologies Inc. --
19235870
RK		 23-- --
24------------------------------------------------------------------------------
25
ee2ba856 26with Atree; use Atree;
fbf5a39b 27with Err_Vars; use Err_Vars;
958a816e 28with Opt; use Opt;
fbf5a39b 29with Osint; use Osint;
19235870
RK		 30with Output; use Output;
31with Prj.Attr; use Prj.Attr;
824e9320 32with Prj.Env;
fbf5a39b 33with Prj.Err; use Prj.Err;
19235870
RK		 34with Prj.Ext; use Prj.Ext;
35with Prj.Nmsc; use Prj.Nmsc;
c4d67e2d 36with Prj.Part;
4e3da85a 37with Prj.Util;
b5e792e2 38with Snames;
19235870 39
4e3da85a
PO		 40with Ada.Containers.Vectors;
41with Ada.Strings.Fixed; use Ada.Strings.Fixed;
ef237104 42
07fc65c4 43with GNAT.Case_Util; use GNAT.Case_Util;
19235870
RK		 44with GNAT.HTable;
45
46package body Prj.Proc is
47
19235870
RK		 48 package Processed_Projects is new GNAT.HTable.Simple_HTable
49 (Header_Num => Header_Num,
50 Element => Project_Id,
51 No_Element => No_Project,
52 Key => Name_Id,
53 Hash => Hash,
54 Equal => "=");
55 -- This hash table contains all processed projects
56
ede007da
VC		 57 package Unit_Htable is new GNAT.HTable.Simple_HTable
58 (Header_Num => Header_Num,
59 Element => Source_Id,
60 No_Element => No_Source,
61 Key => Name_Id,
62 Hash => Hash,
63 Equal => "=");
64 -- This hash table contains all processed projects
65
bdafba6f
AC		 66 package Runtime_Defaults is new GNAT.HTable.Simple_HTable
67 (Header_Num => Prj.Header_Num,
68 Element => Name_Id,
69 No_Element => No_Name,
70 Key => Name_Id,
71 Hash => Prj.Hash,
72 Equal => "=");
73 -- Stores the default values of 'Runtime names for the various languages
74
fbf5a39b 75 procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
19235870
RK		 76 -- Concatenate two strings and returns another string if both
77 -- arguments are not null string.
78
b178461a
RD		 79 -- In the following procedures, we are expected to guess the meaning of
80 -- the parameters from their names, this is never a good idea, comments
81 -- should be added precisely defining every formal ???
82
19235870 83 procedure Add_Attributes
ede007da
VC		 84 (Project : Project_Id;
85 Project_Name : Name_Id;
3d5952be 86 Project_Dir : Name_Id;
40ecf2f5 87 Shared : Shared_Project_Tree_Data_Access;
ede007da
VC		 88 Decl : in out Declarations;
89 First : Attribute_Node_Id;
90 Project_Level : Boolean);
b178461a
RD		 91 -- Add all attributes, starting with First, with their default values to
92 -- the package or project with declarations Decl.
19235870 93
0da2c8ac 94 procedure Check
a0a786e3
EB		 95 (In_Tree : Project_Tree_Ref;
96 Project : Project_Id;
97 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
98 Flags : Processing_Flags);
0da2c8ac
AC		 99 -- Set all projects to not checked, then call Recursive_Check for the
100 -- main project Project. Project is set to No_Project if errors occurred.
6c1f47ee 101 -- Current_Dir is for optimization purposes, avoiding extra system calls.
c9287857
EB		 102 -- If Allow_Duplicate_Basenames, then files with the same base names are
103 -- authorized within a project for source-based languages (never for unit
104 -- based languages)
0da2c8ac 105
97b7ca6f 106 procedure Copy_Package_Declarations
b29def53
AC		 107 (From : Declarations;
108 To : in out Declarations;
109 New_Loc : Source_Ptr;
110 Restricted : Boolean;
40ecf2f5 111 Shared : Shared_Project_Tree_Data_Access);
97b7ca6f 112 -- Copy a package declaration From to To for a renamed package. Change the
b29def53
AC		 113 -- locations of all the attributes to New_Loc. When Restricted is
114 -- True, do not copy attributes Body, Spec, Implementation, Specification
115 -- and Linker_Options.
97b7ca6f 116
19235870 117 function Expression
7e98a4c6 118 (Project : Project_Id;
40ecf2f5 119 Shared : Shared_Project_Tree_Data_Access;
7e98a4c6
VC		 120 From_Project_Node : Project_Node_Id;
121 From_Project_Node_Tree : Project_Node_Tree_Ref;
4437a530 122 Env : Prj.Tree.Environment;
7e98a4c6
VC		 123 Pkg : Package_Id;
124 First_Term : Project_Node_Id;
125 Kind : Variable_Kind) return Variable_Value;
19235870
RK		 126 -- From N_Expression project node From_Project_Node, compute the value
127 -- of an expression and return it as a Variable_Value.
128
fbf5a39b 129 function Imported_Or_Extended_Project_From
12e4e81e
AC		 130 (Project : Project_Id;
131 With_Name : Name_Id;
132 No_Extending : Boolean := False) return Project_Id;
66288b9c
RD		 133 -- Find an imported or extended project of Project whose name is With_Name.
134 -- When No_Extending is True, do not look for extending projects, returns
135 -- the exact project whose name is With_Name.
19235870
RK		 136
137 function Package_From
138 (Project : Project_Id;
40ecf2f5 139 Shared : Shared_Project_Tree_Data_Access;
d05ef0ab 140 With_Name : Name_Id) return Package_Id;
07fc65c4 141 -- Find the package of Project whose name is With_Name
19235870
RK		 142
143 procedure Process_Declarative_Items
40ecf2f5
EB		 144 (Project : Project_Id;
145 In_Tree : Project_Tree_Ref;
146 From_Project_Node : Project_Node_Id;
147 Node_Tree : Project_Node_Tree_Ref;
148 Env : Prj.Tree.Environment;
149 Pkg : Package_Id;
150 Item : Project_Node_Id;
151 Child_Env : in out Prj.Tree.Environment);
19235870
RK		 152 -- Process declarative items starting with From_Project_Node, and put them
153 -- in declarations Decl. This is a recursive procedure; it calls itself for
154 -- a package declaration or a case construction.
9fde638d 155 --
ab29a348
EB		 156 -- Child_Env is the modified environment after seeing declarations like
157 -- "for External(...) use" or "for Project_Path use" in aggregate projects.
40ecf2f5 158 -- It should have been initialized first.
19235870
RK		 159
160 procedure Recursive_Process
7e98a4c6
VC		 161 (In_Tree : Project_Tree_Ref;
162 Project : out Project_Id;
3e7302c3 163 Packages_To_Check : String_List_Access;
7e98a4c6
VC		 164 From_Project_Node : Project_Node_Id;
165 From_Project_Node_Tree : Project_Node_Tree_Ref;
4437a530 166 Env : in out Prj.Tree.Environment;
a76b09dc 167 Extended_By : Project_Id;
5216b599
AC		 168 From_Encapsulated_Lib : Boolean;
169 On_New_Tree_Loaded : Tree_Loaded_Callback := null);
b178461a
RD		 170 -- Process project with node From_Project_Node in the tree. Do nothing if
171 -- From_Project_Node is Empty_Node. If project has already been processed,
172 -- simply return its project id. Otherwise create a new project id, mark it
173 -- as processed, call itself recursively for all imported projects and a
174 -- extended project, if any. Then process the declarative items of the
175 -- project.
686d0984 176 --
ab29a348
EB		 177 -- Is_Root_Project should be true only for the project that the user
178 -- explicitly loaded. In the context of aggregate projects, only that
179 -- project is allowed to modify the environment that will be used to load
180 -- projects (Child_Env).
a76b09dc
PO		 181 --
182 -- From_Encapsulated_Lib is true if we are parsing a project from
183 -- encapsulated library dependencies.
5216b599
AC		 184 --
185 -- If specified, On_New_Tree_Loaded is called after each aggregated project
186 -- has been processed succesfully.
19235870 187
7bccff24
EB		 188 function Get_Attribute_Index
189 (Tree : Project_Node_Tree_Ref;
190 Attr : Project_Node_Id;
191 Index : Name_Id) return Name_Id;
192 -- Copy the index of the attribute into Name_Buffer, converting to lower
193 -- case if the attribute is case-insensitive.
194
19235870
RK		 195 ---------
196 -- Add --
197 ---------
198
fbf5a39b 199 procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
19235870 200 begin
39f4e199 201 if To_Exp = No_Name or else To_Exp = Empty_String then
19235870 202
44e1918a 203 -- To_Exp is nil or empty. The result is Str
19235870
RK		 204
205 To_Exp := Str;
206
207 -- If Str is nil, then do not change To_Ext
208
fbf5a39b
AC		 209 elsif Str /= No_Name and then Str /= Empty_String then
210 declare
211 S : constant String := Get_Name_String (Str);
fbf5a39b
AC		 212 begin
213 Get_Name_String (To_Exp);
214 Add_Str_To_Name_Buffer (S);
215 To_Exp := Name_Find;
216 end;
19235870
RK		 217 end if;
218 end Add;
219
220 --------------------
221 -- Add_Attributes --
222 --------------------
223
224 procedure Add_Attributes
ede007da
VC		 225 (Project : Project_Id;
226 Project_Name : Name_Id;
3d5952be 227 Project_Dir : Name_Id;
40ecf2f5 228 Shared : Shared_Project_Tree_Data_Access;
ede007da
VC		 229 Decl : in out Declarations;
230 First : Attribute_Node_Id;
231 Project_Level : Boolean)
fbf5a39b 232 is
19235870 233 The_Attribute : Attribute_Node_Id := First;
19235870
RK		 234
235 begin
236 while The_Attribute /= Empty_Attribute loop
523456db 237 if Attribute_Kind_Of (The_Attribute) = Single then
19235870
RK		 238 declare
239 New_Attribute : Variable_Value;
240
241 begin
523456db 242 case Variable_Kind_Of (The_Attribute) is
19235870
RK		 243
244 -- Undefined should not happen
245
246 when Undefined =>
247 pragma Assert
248 (False, "attribute with an undefined kind");
249 raise Program_Error;
250
251 -- Single attributes have a default value of empty string
252
253 when Single =>
254 New_Attribute :=
d05ef0ab
AC		 255 (Project => Project,
256 Kind => Single,
19235870
RK		 257 Location => No_Location,
258 Default => True,
aa720a54
AC		 259 Value => Empty_String,
260 Index => 0);
19235870 261
3d5952be
AC		 262 -- Special cases of <project>'Name and
263 -- <project>'Project_Dir.
ede007da 264
3d5952be
AC		 265 if Project_Level then
266 if Attribute_Name_Of (The_Attribute) =
267 Snames.Name_Name
268 then
269 New_Attribute.Value := Project_Name;
270
271 elsif Attribute_Name_Of (The_Attribute) =
272 Snames.Name_Project_Dir
273 then
274 New_Attribute.Value := Project_Dir;
275 end if;
ede007da
VC		 276 end if;
277
19235870
RK		 278 -- List attributes have a default value of nil list
279
280 when List =>
281 New_Attribute :=
d05ef0ab
AC		 282 (Project => Project,
283 Kind => List,
19235870
RK		 284 Location => No_Location,
285 Default => True,
286 Values => Nil_String);
287
288 end case;
289
7e98a4c6 290 Variable_Element_Table.Increment_Last
40ecf2f5
EB		 291 (Shared.Variable_Elements);
292 Shared.Variable_Elements.Table
293 (Variable_Element_Table.Last (Shared.Variable_Elements)) :=
19235870 294 (Next => Decl.Attributes,
523456db 295 Name => Attribute_Name_Of (The_Attribute),
19235870 296 Value => New_Attribute);
686d0984
AC		 297 Decl.Attributes :=
298 Variable_Element_Table.Last
299 (Shared.Variable_Elements);
19235870
RK		 300 end;
301 end if;
302
523456db 303 The_Attribute := Next_Attribute (After => The_Attribute);
19235870 304 end loop;
19235870
RK		 305 end Add_Attributes;
306
307 -----------
308 -- Check --
309 -----------
310
7324bf49 311 procedure Check
a0a786e3
EB		 312 (In_Tree : Project_Tree_Ref;
313 Project : Project_Id;
314 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
315 Flags : Processing_Flags)
44e1918a 316 is
8b9890fa 317 begin
a0a786e3 318 Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags);
ede007da
VC		 319
320 -- Set the Other_Part field for the units
321
322 declare
323 Source1 : Source_Id;
324 Name : Name_Id;
325 Source2 : Source_Id;
5eed512d 326 Iter : Source_Iterator;
ede007da
VC		 327
328 begin
329 Unit_Htable.Reset;
330
5eed512d
EB		 331 Iter := For_Each_Source (In_Tree);
332 loop
333 Source1 := Prj.Element (Iter);
334 exit when Source1 = No_Source;
335
5a66a766
EB		 336 if Source1.Unit /= No_Unit_Index then
337 Name := Source1.Unit.Name;
ede007da
VC		 338 Source2 := Unit_Htable.Get (Name);
339
340 if Source2 = No_Source then
341 Unit_Htable.Set (K => Name, E => Source1);
ede007da
VC		 342 else
343 Unit_Htable.Remove (Name);
ede007da
VC		 344 end if;
345 end if;
346
5eed512d 347 Next (Iter);
ede007da
VC		 348 end loop;
349 end;
19235870
RK		 350 end Check;
351
97b7ca6f
VC		 352 -------------------------------
353 -- Copy_Package_Declarations --
354 -------------------------------
355
356 procedure Copy_Package_Declarations
b29def53
AC		 357 (From : Declarations;
358 To : in out Declarations;
359 New_Loc : Source_Ptr;
360 Restricted : Boolean;
40ecf2f5 361 Shared : Shared_Project_Tree_Data_Access)
97b7ca6f 362 is
8eaf1723
RD		 363 V1 : Variable_Id;
364 V2 : Variable_Id := No_Variable;
97b7ca6f 365 Var : Variable;
8eaf1723
RD		 366 A1 : Array_Id;
367 A2 : Array_Id := No_Array;
97b7ca6f
VC		 368 Arr : Array_Data;
369 E1 : Array_Element_Id;
370 E2 : Array_Element_Id := No_Array_Element;
371 Elm : Array_Element;
372
373 begin
374 -- To avoid references in error messages to attribute declarations in
375 -- an original package that has been renamed, copy all the attribute
376 -- declarations of the package and change all locations to New_Loc,
377 -- the location of the renamed package.
378
379 -- First single attributes
380
8eaf1723 381 V1 := From.Attributes;
97b7ca6f
VC		 382 while V1 /= No_Variable loop
383
384 -- Copy the attribute
385
40ecf2f5 386 Var := Shared.Variable_Elements.Table (V1);
97b7ca6f
VC		 387 V1 := Var.Next;
388
a8930b80 389 -- Do not copy the value of attribute Linker_Options if Restricted
b29def53
AC		 390
391 if Restricted and then Var.Name = Snames.Name_Linker_Options then
392 Var.Value.Values := Nil_String;
393 end if;
394
97b7ca6f
VC		 395 -- Remove the Next component
396
397 Var.Next := No_Variable;
398
399 -- Change the location to New_Loc
400
401 Var.Value.Location := New_Loc;
40ecf2f5 402 Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
97b7ca6f
VC		 403
404 -- Put in new declaration
405
406 if To.Attributes = No_Variable then
407 To.Attributes :=
40ecf2f5 408 Variable_Element_Table.Last (Shared.Variable_Elements);
97b7ca6f 409 else
40ecf2f5
EB		 410 Shared.Variable_Elements.Table (V2).Next :=
411 Variable_Element_Table.Last (Shared.Variable_Elements);
97b7ca6f
VC		 412 end if;
413
40ecf2f5
EB		 414 V2 := Variable_Element_Table.Last (Shared.Variable_Elements);
415 Shared.Variable_Elements.Table (V2) := Var;
97b7ca6f
VC		 416 end loop;
417
418 -- Then the associated array attributes
419
8eaf1723 420 A1 := From.Arrays;
97b7ca6f 421 while A1 /= No_Array loop
40ecf2f5 422 Arr := Shared.Arrays.Table (A1);
97b7ca6f
VC		 423 A1 := Arr.Next;
424
9f55bc62 425 -- Remove the Next component
97b7ca6f 426
9f55bc62
AC		 427 Arr.Next := No_Array;
428 Array_Table.Increment_Last (Shared.Arrays);
97b7ca6f 429
9f55bc62 430 -- Create new Array declaration
97b7ca6f 431
9f55bc62
AC		 432 if To.Arrays = No_Array then
433 To.Arrays := Array_Table.Last (Shared.Arrays);
434 else
435 Shared.Arrays.Table (A2).Next :=
436 Array_Table.Last (Shared.Arrays);
437 end if;
97b7ca6f 438
9f55bc62 439 A2 := Array_Table.Last (Shared.Arrays);
97b7ca6f 440
9f55bc62 441 -- Don't store the array as its first element has not been set yet
97b7ca6f 442
9f55bc62 443 -- Copy the array elements of the array
97b7ca6f 444
9f55bc62
AC		 445 E1 := Arr.Value;
446 Arr.Value := No_Array_Element;
447 while E1 /= No_Array_Element loop
97b7ca6f 448
9f55bc62 449 -- Copy the array element
97b7ca6f 450
9f55bc62
AC		 451 Elm := Shared.Array_Elements.Table (E1);
452 E1 := Elm.Next;
97b7ca6f 453
9f55bc62 454 -- Remove the Next component
97b7ca6f 455
9f55bc62 456 Elm.Next := No_Array_Element;
97b7ca6f 457
9f55bc62 458 Elm.Restricted := Restricted;
9fdb5d21 459
9f55bc62 460 -- Change the location
97b7ca6f 461
9f55bc62
AC		 462 Elm.Value.Location := New_Loc;
463 Array_Element_Table.Increment_Last (Shared.Array_Elements);
97b7ca6f 464
9f55bc62 465 -- Create new array element
97b7ca6f 466
9f55bc62 467 if Arr.Value = No_Array_Element then
9fdb5d21 468 Arr.Value := Array_Element_Table.Last (Shared.Array_Elements);
9f55bc62
AC		 469 else
470 Shared.Array_Elements.Table (E2).Next :=
471 Array_Element_Table.Last (Shared.Array_Elements);
472 end if;
97b7ca6f 473
9f55bc62
AC		 474 E2 := Array_Element_Table.Last (Shared.Array_Elements);
475 Shared.Array_Elements.Table (E2) := Elm;
476 end loop;
97b7ca6f 477
9f55bc62 478 -- Finally, store the new array
97b7ca6f 479
9f55bc62 480 Shared.Arrays.Table (A2) := Arr;
97b7ca6f
VC		 481 end loop;
482 end Copy_Package_Declarations;
483
7bccff24
EB		 484 -------------------------
485 -- Get_Attribute_Index --
486 -------------------------
487
488 function Get_Attribute_Index
86828d40
AC		 489 (Tree : Project_Node_Tree_Ref;
490 Attr : Project_Node_Id;
491 Index : Name_Id) return Name_Id
e917aec2 492 is
7bccff24 493 begin
34798441
EB		 494 if Index = All_Other_Names
495 or else not Case_Insensitive (Attr, Tree)
496 then
d606f1df
AC		 497 return Index;
498 end if;
499
7bccff24 500 Get_Name_String (Index);
34798441
EB		 501 To_Lower (Name_Buffer (1 .. Name_Len));
502 return Name_Find;
7bccff24
EB		 503 end Get_Attribute_Index;
504
19235870
RK		 505 ----------------
506 -- Expression --
507 ----------------
508
509 function Expression
7e98a4c6 510 (Project : Project_Id;
40ecf2f5 511 Shared : Shared_Project_Tree_Data_Access;
7e98a4c6
VC		 512 From_Project_Node : Project_Node_Id;
513 From_Project_Node_Tree : Project_Node_Tree_Ref;
4437a530 514 Env : Prj.Tree.Environment;
7e98a4c6
VC		 515 Pkg : Package_Id;
516 First_Term : Project_Node_Id;
517 Kind : Variable_Kind) return Variable_Value
19235870 518 is
2c011ce1 519 The_Term : Project_Node_Id;
19235870
RK		 520 -- The term in the expression list
521
522 The_Current_Term : Project_Node_Id := Empty_Node;
523 -- The current term node id
524
19235870
RK		 525 Result : Variable_Value (Kind => Kind);
526 -- The returned result
527
528 Last : String_List_Id := Nil_String;
44e1918a 529 -- Reference to the last string elements in Result, when Kind is List
19235870 530
af6478c8
AC		 531 Current_Term_Kind : Project_Node_Kind;
532
19235870 533 begin
d05ef0ab 534 Result.Project := Project;
7e98a4c6 535 Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
19235870
RK		 536
537 -- Process each term of the expression, starting with First_Term
538
2c011ce1 539 The_Term := First_Term;
4f469be3 540 while Present (The_Term) loop
7e98a4c6 541 The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
af6478c8
AC		 542 Current_Term_Kind :=
543 Kind_Of (The_Current_Term, From_Project_Node_Tree);
19235870 544
af6478c8 545 case Current_Term_Kind is
19235870
RK		 546
547 when N_Literal_String =>
548
549 case Kind is
550
551 when Undefined =>
552
553 -- Should never happen
554
555 pragma Assert (False, "Undefined expression kind");
556 raise Program_Error;
557
558 when Single =>
7e98a4c6
VC		 559 Add (Result.Value,
560 String_Value_Of
561 (The_Current_Term, From_Project_Node_Tree));
562 Result.Index :=
563 Source_Index_Of
564 (The_Current_Term, From_Project_Node_Tree);
19235870
RK		 565
566 when List =>
567
7e98a4c6 568 String_Element_Table.Increment_Last
40ecf2f5 569 (Shared.String_Elements);
19235870
RK		 570
571 if Last = Nil_String then
572
44e1918a 573 -- This can happen in an expression like () & "toto"
19235870 574
7e98a4c6 575 Result.Values := String_Element_Table.Last
40ecf2f5 576 (Shared.String_Elements);
19235870
RK		 577
578 else
40ecf2f5 579 Shared.String_Elements.Table
7e98a4c6 580 (Last).Next := String_Element_Table.Last
40ecf2f5 581 (Shared.String_Elements);
19235870
RK		 582 end if;
583
7e98a4c6 584 Last := String_Element_Table.Last
40ecf2f5 585 (Shared.String_Elements);
8eaf1723 586
40ecf2f5 587 Shared.String_Elements.Table (Last) :=
8eaf1723
RD		 588 (Value => String_Value_Of
589 (The_Current_Term,
590 From_Project_Node_Tree),
591 Index => Source_Index_Of
592 (The_Current_Term,
593 From_Project_Node_Tree),
fbf5a39b 594 Display_Value => No_Name,
8eaf1723
RD		 595 Location => Location_Of
596 (The_Current_Term,
597 From_Project_Node_Tree),
598 Flag => False,
599 Next => Nil_String);
19235870
RK		 600 end case;
601
602 when N_Literal_String_List =>
603
604 declare
605 String_Node : Project_Node_Id :=
7e98a4c6
VC		 606 First_Expression_In_List
607 (The_Current_Term,
608 From_Project_Node_Tree);
19235870
RK		 609
610 Value : Variable_Value;
611
612 begin
4f469be3 613 if Present (String_Node) then
19235870 614
8eaf1723 615 -- If String_Node is nil, it is an empty list, there is
e917aec2 616 -- nothing to do.
19235870
RK		 617
618 Value := Expression
7e98a4c6 619 (Project => Project,
40ecf2f5 620 Shared => Shared,
7e98a4c6
VC		 621 From_Project_Node => From_Project_Node,
622 From_Project_Node_Tree => From_Project_Node_Tree,
4437a530 623 Env => Env,
7e98a4c6
VC		 624 Pkg => Pkg,
625 First_Term =>
626 Tree.First_Term
627 (String_Node, From_Project_Node_Tree),
628 Kind => Single);
629 String_Element_Table.Increment_Last
40ecf2f5 630 (Shared.String_Elements);
19235870
RK		 631
632 if Result.Values = Nil_String then
633
8eaf1723
RD		 634 -- This literal string list is the first term in a
635 -- string list expression
19235870 636
686d0984
AC		 637 Result.Values :=
638 String_Element_Table.Last
639 (Shared.String_Elements);
19235870
RK		 640
641 else
40ecf2f5
EB		 642 Shared.String_Elements.Table (Last).Next :=
643 String_Element_Table.Last (Shared.String_Elements);
19235870
RK		 644 end if;
645
686d0984
AC		 646 Last :=
647 String_Element_Table.Last (Shared.String_Elements);
7e98a4c6 648
40ecf2f5 649 Shared.String_Elements.Table (Last) :=
19235870 650 (Value => Value.Value,
fbf5a39b 651 Display_Value => No_Name,
19235870 652 Location => Value.Location,
fbf5a39b 653 Flag => False,
aa720a54
AC		 654 Next => Nil_String,
655 Index => Value.Index);
19235870
RK		 656
657 loop
658 -- Add the other element of the literal string list
e917aec2 659 -- one after the other.
19235870
RK		 660
661 String_Node :=
7e98a4c6
VC		 662 Next_Expression_In_List
663 (String_Node, From_Project_Node_Tree);
19235870 664
4f469be3 665 exit when No (String_Node);
19235870
RK		 666
667 Value :=
668 Expression
7e98a4c6 669 (Project => Project,
40ecf2f5 670 Shared => Shared,
7e98a4c6
VC		 671 From_Project_Node => From_Project_Node,
672 From_Project_Node_Tree => From_Project_Node_Tree,
4437a530 673 Env => Env,
7e98a4c6
VC		 674 Pkg => Pkg,
675 First_Term =>
676 Tree.First_Term
677 (String_Node, From_Project_Node_Tree),
678 Kind => Single);
679
680 String_Element_Table.Increment_Last
40ecf2f5
EB		 681 (Shared.String_Elements);
682 Shared.String_Elements.Table (Last).Next :=
683 String_Element_Table.Last (Shared.String_Elements);
684 Last := String_Element_Table.Last
685 (Shared.String_Elements);
686 Shared.String_Elements.Table (Last) :=
19235870 687 (Value => Value.Value,
fbf5a39b 688 Display_Value => No_Name,
19235870 689 Location => Value.Location,
fbf5a39b 690 Flag => False,
aa720a54
AC		 691 Next => Nil_String,
692 Index => Value.Index);
19235870 693 end loop;
19235870 694 end if;
19235870
RK		 695 end;
696
697 when N_Variable_Reference | N_Attribute_Reference =>
698
699 declare
ede007da
VC		 700 The_Project : Project_Id := Project;
701 The_Package : Package_Id := Pkg;
702 The_Name : Name_Id := No_Name;
703 The_Variable_Id : Variable_Id := No_Variable;
07fc65c4 704 The_Variable : Variable_Value;
19235870 705 Term_Project : constant Project_Node_Id :=
39f4e199
VC		 706 Project_Node_Of
707 (The_Current_Term,
708 From_Project_Node_Tree);
19235870 709 Term_Package : constant Project_Node_Id :=
39f4e199
VC		 710 Package_Node_Of
711 (The_Current_Term,
712 From_Project_Node_Tree);
ede007da 713 Index : Name_Id := No_Name;
19235870
RK		 714
715 begin
af6478c8
AC		 716 <<Object_Dir_Restart>>
717 The_Project := Project;
718 The_Package := Pkg;
719 The_Name := No_Name;
720 The_Variable_Id := No_Variable;
721 Index := No_Name;
722
86828d40
AC		 723 if Present (Term_Project)
724 and then Term_Project /= From_Project_Node
19235870
RK		 725 then
726 -- This variable or attribute comes from another project
727
7e98a4c6
VC		 728 The_Name :=
729 Name_Of (Term_Project, From_Project_Node_Tree);
fbf5a39b 730 The_Project := Imported_Or_Extended_Project_From
12e4e81e
AC		 731 (Project => Project,
732 With_Name => The_Name,
733 No_Extending => True);
19235870
RK		 734 end if;
735
4f469be3 736 if Present (Term_Package) then
19235870
RK		 737
738 -- This is an attribute of a package
739
7e98a4c6
VC		 740 The_Name :=
741 Name_Of (Term_Package, From_Project_Node_Tree);
19235870 742
686d0984 743 The_Package := The_Project.Decl.Packages;
19235870 744 while The_Package /= No_Package
40ecf2f5
EB		 745 and then Shared.Packages.Table (The_Package).Name /=
746 The_Name
19235870 747 loop
7e98a4c6 748 The_Package :=
40ecf2f5 749 Shared.Packages.Table (The_Package).Next;
19235870
RK		 750 end loop;
751
752 pragma Assert
e917aec2 753 (The_Package /= No_Package, "package not found.");
19235870 754
7e98a4c6 755 elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
e917aec2 756 N_Attribute_Reference
7e98a4c6 757 then
19235870
RK		 758 The_Package := No_Package;
759 end if;
760
7e98a4c6
VC		 761 The_Name :=
762 Name_Of (The_Current_Term, From_Project_Node_Tree);
19235870 763
af6478c8 764 if Current_Term_Kind = N_Attribute_Reference then
7e98a4c6
VC		 765 Index :=
766 Associative_Array_Index_Of
767 (The_Current_Term, From_Project_Node_Tree);
07fc65c4 768 end if;
19235870 769
07fc65c4 770 -- If it is not an associative array attribute
19235870 771
fbf5a39b 772 if Index = No_Name then
07fc65c4
GB		 773
774 -- It is not an associative array attribute
775
776 if The_Package /= No_Package then
777
778 -- First, if there is a package, look into the package
779
af6478c8 780 if Current_Term_Kind = N_Variable_Reference then
07fc65c4 781 The_Variable_Id :=
40ecf2f5 782 Shared.Packages.Table
7e98a4c6 783 (The_Package).Decl.Variables;
07fc65c4
GB		 784 else
785 The_Variable_Id :=
40ecf2f5 786 Shared.Packages.Table
7e98a4c6 787 (The_Package).Decl.Attributes;
07fc65c4
GB		 788 end if;
789
790 while The_Variable_Id /= No_Variable
40ecf2f5 791 and then Shared.Variable_Elements.Table
686d0984 792 (The_Variable_Id).Name /= The_Name
07fc65c4 793 loop
686d0984
AC		 794 The_Variable_Id :=
795 Shared.Variable_Elements.Table
796 (The_Variable_Id).Next;
07fc65c4 797 end loop;
19235870 798
19235870
RK		 799 end if;
800
07fc65c4 801 if The_Variable_Id = No_Variable then
19235870 802
07fc65c4 803 -- If we have not found it, look into the project
19235870 804
af6478c8 805 if Current_Term_Kind = N_Variable_Reference then
66713d62 806 The_Variable_Id := The_Project.Decl.Variables;
07fc65c4 807 else
66713d62 808 The_Variable_Id := The_Project.Decl.Attributes;
07fc65c4 809 end if;
19235870 810
07fc65c4 811 while The_Variable_Id /= No_Variable
40ecf2f5 812 and then Shared.Variable_Elements.Table
7e98a4c6 813 (The_Variable_Id).Name /= The_Name
07fc65c4
GB		 814 loop
815 The_Variable_Id :=
40ecf2f5 816 Shared.Variable_Elements.Table
7e98a4c6 817 (The_Variable_Id).Next;
07fc65c4 818 end loop;
19235870 819
19235870
RK		 820 end if;
821
3dfe4883
AC		 822 if From_Project_Node_Tree.Incomplete_With then
823 if The_Variable_Id = No_Variable then
824 The_Variable := Nil_Variable_Value;
825 else
826 The_Variable :=
827 Shared.Variable_Elements.Table
828 (The_Variable_Id).Value;
829 end if;
19235870 830
3dfe4883
AC		 831 else
832 pragma Assert (The_Variable_Id /= No_Variable,
833 "variable or attribute not found");
834
835 The_Variable :=
836 Shared.Variable_Elements.Table
837 (The_Variable_Id).Value;
838 end if;
07fc65c4
GB		 839
840 else
19235870 841
07fc65c4 842 -- It is an associative array attribute
19235870 843
07fc65c4
GB		 844 declare
845 The_Array : Array_Id := No_Array;
846 The_Element : Array_Element_Id := No_Array_Element;
847 Array_Index : Name_Id := No_Name;
7e98a4c6 848
07fc65c4
GB		 849 begin
850 if The_Package /= No_Package then
686d0984
AC		 851 The_Array :=
852 Shared.Packages.Table (The_Package).Decl.Arrays;
07fc65c4 853 else
66713d62 854 The_Array := The_Project.Decl.Arrays;
07fc65c4
GB		 855 end if;
856
857 while The_Array /= No_Array
40ecf2f5 858 and then Shared.Arrays.Table (The_Array).Name /=
686d0984 859 The_Name
07fc65c4 860 loop
40ecf2f5 861 The_Array := Shared.Arrays.Table (The_Array).Next;
07fc65c4
GB		 862 end loop;
863
864 if The_Array /= No_Array then
e917aec2 865 The_Element :=
40ecf2f5 866 Shared.Arrays.Table (The_Array).Value;
7bccff24
EB		 867 Array_Index :=
868 Get_Attribute_Index
869 (From_Project_Node_Tree,
870 The_Current_Term,
871 Index);
07fc65c4
GB		 872
873 while The_Element /= No_Array_Element
40ecf2f5 874 and then Shared.Array_Elements.Table
e917aec2 875 (The_Element).Index /= Array_Index
07fc65c4
GB		 876 loop
877 The_Element :=
686d0984 878 Shared.Array_Elements.Table (The_Element).Next;
07fc65c4
GB		 879 end loop;
880
881 end if;
882
883 if The_Element /= No_Array_Element then
686d0984
AC		 884 The_Variable :=
885 Shared.Array_Elements.Table (The_Element).Value;
07fc65c4
GB		 886
887 else
7e98a4c6 888 if Expression_Kind_Of
686d0984 889 (The_Current_Term, From_Project_Node_Tree) =
7e98a4c6 890 List
07fc65c4
GB		 891 then
892 The_Variable :=
d05ef0ab
AC		 893 (Project => Project,
894 Kind => List,
07fc65c4
GB		 895 Location => No_Location,
896 Default => True,
897 Values => Nil_String);
07fc65c4
GB		 898 else
899 The_Variable :=
d05ef0ab
AC		 900 (Project => Project,
901 Kind => Single,
07fc65c4
GB		 902 Location => No_Location,
903 Default => True,
aa720a54
AC		 904 Value => Empty_String,
905 Index => 0);
07fc65c4 906 end if;
07fc65c4 907 end if;
07fc65c4 908 end;
07fc65c4 909 end if;
19235870 910
af6478c8
AC		 911 -- Check the defaults
912
1725676d 913 if Current_Term_Kind = N_Attribute_Reference then
af6478c8
AC		 914 declare
915 The_Default : constant Attribute_Default_Value :=
916 Default_Of
917 (The_Current_Term, From_Project_Node_Tree);
7ed57189 918
af6478c8 919 begin
1725676d
AC		 920 -- Check the special value for 'Target when specified
921
922 if The_Default = Target_Value
923 and then Opt.Target_Origin = Specified
924 then
925 Name_Len := 0;
926 Add_Str_To_Name_Buffer (Opt.Target_Value.all);
927 The_Variable.Value := Name_Find;
928
929 -- Check the defaults
930
931 elsif The_Variable.Default then
932 case The_Variable.Kind is
adc876a8 933
7ed57189
AC		 934 when Undefined =>
935 null;
936
937 when Single =>
938 case The_Default is
939 when Read_Only_Value =>
940 null;
941
942 when Empty_Value =>
943 The_Variable.Value := Empty_String;
944
945 when Dot_Value =>
946 The_Variable.Value := Dot_String;
947
948 when Object_Dir_Value =>
949 From_Project_Node_Tree.Project_Nodes.Table
950 (The_Current_Term).Name :=
951 Snames.Name_Object_Dir;
952 From_Project_Node_Tree.Project_Nodes.Table
953 (The_Current_Term).Default :=
954 Dot_Value;
955 goto Object_Dir_Restart;
956
957 when Target_Value =>
1725676d
AC		 958 if Opt.Target_Value = null then
959 The_Variable.Value := Empty_String;
960
961 else
962 Name_Len := 0;
963 Add_Str_To_Name_Buffer
964 (Opt.Target_Value.all);
965 The_Variable.Value := Name_Find;
966 end if;
bdafba6f
AC		 967
968 when Runtime_Value =>
969 Get_Name_String (Index);
970 To_Lower (Name_Buffer (1 .. Name_Len));
971 The_Variable.Value :=
972 Runtime_Defaults.Get (Name_Find);
973 if The_Variable.Value = No_Name then
974 The_Variable.Value := Empty_String;
975 end if;
976
7ed57189
AC		 977 end case;
978
979 when List =>
980 case The_Default is
dbb4cfef 981 when Read_Only_Value =>
7ed57189
AC		 982 null;
983
dbb4cfef 984 when Empty_Value =>
7ed57189
AC		 985 The_Variable.Values := Nil_String;
986
dbb4cfef 987 when Dot_Value =>
7ed57189
AC		 988 The_Variable.Values :=
989 Shared.Dot_String_List;
990
bdafba6f 991 when Object_Dir_Value |
dbb4cfef
AC		 992 Target_Value |
993 Runtime_Value =>
7ed57189
AC		 994 null;
995 end case;
1725676d
AC		 996 end case;
997 end if;
af6478c8
AC		 998 end;
999 end if;
1000
19235870 1001 case Kind is
19235870
RK		 1002 when Undefined =>
1003
1004 -- Should never happen
1005
1006 pragma Assert (False, "undefined expression kind");
1007 null;
1008
1009 when Single =>
07fc65c4 1010 case The_Variable.Kind is
19235870
RK		 1011
1012 when Undefined =>
1013 null;
1014
1015 when Single =>
07fc65c4 1016 Add (Result.Value, The_Variable.Value);
19235870
RK		 1017
1018 when List =>
1019
1020 -- Should never happen
1021
1022 pragma Assert
1023 (False,
1024 "list cannot appear in single " &
1025 "string expression");
1026 null;
19235870
RK		 1027 end case;
1028
1029 when List =>
07fc65c4 1030 case The_Variable.Kind is
19235870
RK		 1031
1032 when Undefined =>
1033 null;
1034
1035 when Single =>
7e98a4c6 1036 String_Element_Table.Increment_Last
40ecf2f5 1037 (Shared.String_Elements);
19235870
RK		 1038
1039 if Last = Nil_String then
1040
1041 -- This can happen in an expression such as
1042 -- () & Var
1043
7e98a4c6
VC		 1044 Result.Values :=
1045 String_Element_Table.Last
40ecf2f5 1046 (Shared.String_Elements);
19235870
RK		 1047
1048 else
40ecf2f5 1049 Shared.String_Elements.Table (Last).Next :=
7e98a4c6 1050 String_Element_Table.Last
40ecf2f5 1051 (Shared.String_Elements);
19235870
RK		 1052 end if;
1053
7e98a4c6
VC		 1054 Last :=
1055 String_Element_Table.Last
40ecf2f5 1056 (Shared.String_Elements);
7e98a4c6 1057
40ecf2f5 1058 Shared.String_Elements.Table (Last) :=
7e98a4c6 1059 (Value => The_Variable.Value,
fbf5a39b 1060 Display_Value => No_Name,
7e98a4c6
VC		 1061 Location => Location_Of
1062 (The_Current_Term,
1063 From_Project_Node_Tree),
1064 Flag => False,
1065 Next => Nil_String,
1066 Index => 0);
19235870
RK		 1067
1068 when List =>
1069
1070 declare
1071 The_List : String_List_Id :=
07fc65c4 1072 The_Variable.Values;
19235870
RK		 1073
1074 begin
1075 while The_List /= Nil_String loop
7e98a4c6 1076 String_Element_Table.Increment_Last
40ecf2f5 1077 (Shared.String_Elements);
19235870
RK		 1078
1079 if Last = Nil_String then
7e98a4c6
VC		 1080 Result.Values :=
1081 String_Element_Table.Last
40ecf2f5 1082 (Shared.String_Elements);
19235870
RK		 1083
1084 else
40ecf2f5 1085 Shared.
7e98a4c6
VC		 1086 String_Elements.Table (Last).Next :=
1087 String_Element_Table.Last
40ecf2f5 1088 (Shared.String_Elements);
19235870
RK		 1089
1090 end if;
1091
7e98a4c6
VC		 1092 Last :=
1093 String_Element_Table.Last
40ecf2f5 1094 (Shared.String_Elements);
7e98a4c6 1095
40ecf2f5
EB		 1096 Shared.String_Elements.Table
1097 (Last) :=
7e98a4c6 1098 (Value =>
40ecf2f5 1099 Shared.String_Elements.Table
7e98a4c6 1100 (The_List).Value,
fbf5a39b 1101 Display_Value => No_Name,
7e98a4c6
VC		 1102 Location =>
1103 Location_Of
1104 (The_Current_Term,
1105 From_Project_Node_Tree),
1106 Flag => False,
1107 Next => Nil_String,
1108 Index => 0);
1109
40ecf2f5 1110 The_List := Shared.String_Elements.Table
7e98a4c6 1111 (The_List).Next;
19235870
RK		 1112 end loop;
1113 end;
1114 end case;
1115 end case;
1116 end;
1117
1118 when N_External_Value =>
fbf5a39b 1119 Get_Name_String
7e98a4c6
VC		 1120 (String_Value_Of
1121 (External_Reference_Of
1122 (The_Current_Term, From_Project_Node_Tree),
1123 From_Project_Node_Tree));
19235870
RK		 1124
1125 declare
ef237104
AC		 1126 Name : constant Name_Id := Name_Find;
1127 Default : Name_Id := No_Name;
1128 Value : Name_Id := No_Name;
1129 Ext_List : Boolean := False;
1130 Str_List : String_List_Access := null;
1131 Def_Var : Variable_Value;
c8b0c260 1132
19235870 1133 Default_Node : constant Project_Node_Id :=
ef237104
AC		 1134 External_Default_Of
1135 (The_Current_Term,
1136 From_Project_Node_Tree);
19235870
RK		 1137
1138 begin
c8b0c260
VC		 1139 -- If there is a default value for the external reference,
1140 -- get its value.
1141
4f469be3 1142 if Present (Default_Node) then
c8b0c260
VC		 1143 Def_Var := Expression
1144 (Project => Project,
40ecf2f5 1145 Shared => Shared,
4f469be3 1146 From_Project_Node => From_Project_Node,
c8b0c260 1147 From_Project_Node_Tree => From_Project_Node_Tree,
4437a530 1148 Env => Env,
c8b0c260
VC		 1149 Pkg => Pkg,
1150 First_Term =>
1151 Tree.First_Term
1152 (Default_Node, From_Project_Node_Tree),
1153 Kind => Single);
1154
1155 if Def_Var /= Nil_Variable_Value then
1156 Default := Def_Var.Value;
1157 end if;
19235870
RK		 1158 end if;
1159
ef237104 1160 Ext_List := Expression_Kind_Of
e917aec2
RD		 1161 (The_Current_Term,
1162 From_Project_Node_Tree) = List;
ef237104
AC		 1163
1164 if Ext_List then
4437a530 1165 Value := Prj.Ext.Value_Of (Env.External, Name, No_Name);
ef237104
AC		 1166
1167 if Value /= No_Name then
1168 declare
1169 Sep : constant String :=
1170 Get_Name_String (Default);
1171 First : Positive := 1;
1172 Lst : Natural;
1173 Done : Boolean := False;
1174 Nmb : Natural;
1175
1176 begin
1177 Get_Name_String (Value);
1178
1179 if Name_Len = 0
1180 or else Sep'Length = 0
1181 or else Name_Buffer (1 .. Name_Len) = Sep
1182 then
1183 Done := True;
1184 end if;
1185
1186 if not Done and then Name_Len < Sep'Length then
1187 Str_List :=
1188 new String_List'
1189 (1 => new String'
1190 (Name_Buffer (1 .. Name_Len)));
1191 Done := True;
1192 end if;
1193
1194 if not Done then
1195 if Name_Buffer (1 .. Sep'Length) = Sep then
1196 First := Sep'Length + 1;
1197 end if;
1198
1199 if Name_Len - First + 1 >= Sep'Length
1200 and then
1201 Name_Buffer (Name_Len - Sep'Length + 1 ..
1202 Name_Len) = Sep
1203 then
1204 Name_Len := Name_Len - Sep'Length;
1205 end if;
1206
1207 if Name_Len = 0 then
1208 Str_List :=
1209 new String_List'(1 => new String'(""));
1210 Done := True;
1211 end if;
1212 end if;
1213
1214 if not Done then
686d0984
AC		 1215
1216 -- Count the number of strings
ef237104
AC		 1217
1218 declare
1219 Saved : constant Positive := First;
ef237104 1220
686d0984 1221 begin
ef237104
AC		 1222 Nmb := 1;
1223 loop
1224 Lst :=
1225 Index
1226 (Source =>
1227 Name_Buffer (First .. Name_Len),
1228 Pattern => Sep);
1229 exit when Lst = 0;
1230 Nmb := Nmb + 1;
1231 First := Lst + Sep'Length;
1232 end loop;
1233
1234 First := Saved;
1235 end;
19235870 1236
ef237104
AC		 1237 Str_List := new String_List (1 .. Nmb);
1238
1239 -- Populate the string list
1240
1241 Nmb := 1;
1242 loop
1243 Lst :=
1244 Index
1245 (Source =>
1246 Name_Buffer (First .. Name_Len),
1247 Pattern => Sep);
1248
1249 if Lst = 0 then
1250 Str_List (Nmb) :=
1251 new String'
1252 (Name_Buffer (First .. Name_Len));
1253 exit;
1254
1255 else
1256 Str_List (Nmb) :=
1257 new String'
1258 (Name_Buffer (First .. Lst - 1));
1259 Nmb := Nmb + 1;
1260 First := Lst + Sep'Length;
1261 end if;
1262 end loop;
1263 end if;
1264 end;
19235870
RK		 1265 end if;
1266
ef237104
AC		 1267 else
1268 -- Get the value
1269
4437a530 1270 Value := Prj.Ext.Value_Of (Env.External, Name, Default);
ef237104
AC		 1271
1272 if Value = No_Name then
1273 if not Quiet_Output then
1274 Error_Msg
4437a530 1275 (Env.Flags, "?undefined external reference",
ef237104
AC		 1276 Location_Of
1277 (The_Current_Term, From_Project_Node_Tree),
1278 Project);
1279 end if;
1280
1281 Value := Empty_String;
1282 end if;
19235870
RK		 1283 end if;
1284
1285 case Kind is
1286
1287 when Undefined =>
1288 null;
1289
1290 when Single =>
ef237104
AC		 1291 if Ext_List then
1292 null; -- error
19235870 1293
ef237104
AC		 1294 else
1295 Add (Result.Value, Value);
1296 end if;
19235870 1297
ef237104
AC		 1298 when List =>
1299 if not Ext_List or else Str_List /= null then
1300 String_Element_Table.Increment_Last
40ecf2f5 1301 (Shared.String_Elements);
19235870 1302
ef237104
AC		 1303 if Last = Nil_String then
1304 Result.Values :=
1305 String_Element_Table.Last
40ecf2f5 1306 (Shared.String_Elements);
19235870 1307
ef237104 1308 else
40ecf2f5
EB		 1309 Shared.String_Elements.Table (Last).Next
1310 := String_Element_Table.Last
1311 (Shared.String_Elements);
ef237104
AC		 1312 end if;
1313
40ecf2f5
EB		 1314 Last := String_Element_Table.Last
1315 (Shared.String_Elements);
19235870 1316
ef237104
AC		 1317 if Ext_List then
1318 for Ind in Str_List'Range loop
1319 Name_Len := 0;
1320 Add_Str_To_Name_Buffer (Str_List (Ind).all);
1321 Value := Name_Find;
40ecf2f5 1322 Shared.String_Elements.Table (Last) :=
ef237104
AC		 1323 (Value => Value,
1324 Display_Value => No_Name,
1325 Location =>
1326 Location_Of
1327 (The_Current_Term,
1328 From_Project_Node_Tree),
1329 Flag => False,
1330 Next => Nil_String,
1331 Index => 0);
1332
1333 if Ind /= Str_List'Last then
1334 String_Element_Table.Increment_Last
40ecf2f5
EB		 1335 (Shared.String_Elements);
1336 Shared.String_Elements.Table (Last).Next :=
ef237104 1337 String_Element_Table.Last
40ecf2f5
EB		 1338 (Shared.String_Elements);
1339 Last := String_Element_Table.Last
1340 (Shared.String_Elements);
ef237104
AC		 1341 end if;
1342 end loop;
1343
1344 else
40ecf2f5 1345 Shared.String_Elements.Table (Last) :=
ef237104
AC		 1346 (Value => Value,
1347 Display_Value => No_Name,
1348 Location =>
1349 Location_Of
1350 (The_Current_Term,
1351 From_Project_Node_Tree),
1352 Flag => False,
1353 Next => Nil_String,
1354 Index => 0);
1355 end if;
1356 end if;
19235870 1357 end case;
19235870
RK		 1358 end;
1359
1360 when others =>
1361
1362 -- Should never happen
1363
1364 pragma Assert
1365 (False,
1366 "illegal node kind in an expression");
1367 raise Program_Error;
1368
1369 end case;
1370
7e98a4c6 1371 The_Term := Next_Term (The_Term, From_Project_Node_Tree);
19235870 1372 end loop;
767b404e 1373
19235870
RK		 1374 return Result;
1375 end Expression;
1376
1377 ---------------------------------------
fbf5a39b 1378 -- Imported_Or_Extended_Project_From --
19235870
RK		 1379 ---------------------------------------
1380
fbf5a39b 1381 function Imported_Or_Extended_Project_From
12e4e81e
AC		 1382 (Project : Project_Id;
1383 With_Name : Name_Id;
1384 No_Extending : Boolean := False) return Project_Id
19235870 1385 is
1a5d715a
VC		 1386 List : Project_List;
1387 Result : Project_Id;
1388 Temp_Result : Project_Id;
19235870
RK		 1389
1390 begin
1ae44ba2 1391 -- First check if it is the name of an extended project
19235870 1392
66713d62 1393 Result := Project.Extends;
1a5d715a 1394 while Result /= No_Project loop
66713d62 1395 if Result.Name = With_Name then
1a5d715a
VC		 1396 return Result;
1397 else
66713d62 1398 Result := Result.Extends;
1a5d715a
VC		 1399 end if;
1400 end loop;
19235870 1401
1a5d715a 1402 -- Then check the name of each imported project
19235870 1403
1a5d715a 1404 Temp_Result := No_Project;
66713d62 1405 List := Project.Imported_Projects;
3563739b
AC		 1406 while List /= null loop
1407 Result := List.Project;
1ae44ba2 1408
1a5d715a 1409 -- If the project is directly imported, then returns its ID
1ae44ba2 1410
66713d62 1411 if Result.Name = With_Name then
1a5d715a
VC		 1412 return Result;
1413 end if;
1ae44ba2 1414
1a5d715a
VC		 1415 -- If a project extending the project is imported, then keep this
1416 -- extending project as a possibility. It will be the returned ID
1417 -- if the project is not imported directly.
1ae44ba2 1418
1a5d715a 1419 declare
132410cb 1420 Proj : Project_Id;
1ae44ba2 1421
1a5d715a 1422 begin
132410cb 1423 Proj := Result.Extends;
1a5d715a 1424 while Proj /= No_Project loop
66713d62 1425 if Proj.Name = With_Name then
12e4e81e
AC		 1426 if No_Extending then
1427 Temp_Result := Proj;
1428 else
1429 Temp_Result := Result;
1430 end if;
1431
1a5d715a
VC		 1432 exit;
1433 end if;
19235870 1434
66713d62 1435 Proj := Proj.Extends;
1a5d715a
VC		 1436 end loop;
1437 end;
19235870 1438
3563739b 1439 List := List.Next;
1a5d715a 1440 end loop;
19235870 1441
1a5d715a
VC		 1442 pragma Assert (Temp_Result /= No_Project, "project not found");
1443 return Temp_Result;
fbf5a39b 1444 end Imported_Or_Extended_Project_From;
19235870
RK		 1445
1446 ------------------
1447 -- Package_From --
1448 ------------------
1449
1450 function Package_From
1451 (Project : Project_Id;
40ecf2f5 1452 Shared : Shared_Project_Tree_Data_Access;
d05ef0ab 1453 With_Name : Name_Id) return Package_Id
19235870 1454 is
66713d62 1455 Result : Package_Id := Project.Decl.Packages;
19235870
RK		 1456
1457 begin
1458 -- Check the name of each existing package of Project
1459
1460 while Result /= No_Package
40ecf2f5 1461 and then Shared.Packages.Table (Result).Name /= With_Name
19235870 1462 loop
40ecf2f5 1463 Result := Shared.Packages.Table (Result).Next;
19235870
RK		 1464 end loop;
1465
1466 if Result = No_Package then
7e98a4c6 1467
19235870 1468 -- Should never happen
7e98a4c6 1469
86828d40
AC		 1470 Write_Line
1471 ("package """ & Get_Name_String (With_Name) & """ not found");
19235870
RK		 1472 raise Program_Error;
1473
1474 else
1475 return Result;
1476 end if;
1477 end Package_From;
1478
1479 -------------
1480 -- Process --
1481 -------------
1482
1483 procedure Process
7e98a4c6
VC		 1484 (In_Tree : Project_Tree_Ref;
1485 Project : out Project_Id;
3e7302c3 1486 Packages_To_Check : String_List_Access;
7e98a4c6
VC		 1487 Success : out Boolean;
1488 From_Project_Node : Project_Node_Id;
1489 From_Project_Node_Tree : Project_Node_Tree_Ref;
4437a530 1490 Env : in out Prj.Tree.Environment;
5216b599
AC		 1491 Reset_Tree : Boolean := True;
1492 On_New_Tree_Loaded : Tree_Loaded_Callback := null)
19235870
RK		 1493 is
1494 begin
a70f5d82
VC		 1495 Process_Project_Tree_Phase_1
1496 (In_Tree => In_Tree,
1497 Project => Project,
1498 Success => Success,
7e98a4c6
VC		 1499 From_Project_Node => From_Project_Node,
1500 From_Project_Node_Tree => From_Project_Node_Tree,
4437a530 1501 Env => Env,
3e7302c3 1502 Packages_To_Check => Packages_To_Check,
5216b599
AC		 1503 Reset_Tree => Reset_Tree,
1504 On_New_Tree_Loaded => On_New_Tree_Loaded);
19235870 1505
86828d40 1506 if Project_Qualifier_Of
67c86178 1507 (From_Project_Node, From_Project_Node_Tree) /= Configuration
fdd7e7bb 1508 then
a70f5d82 1509 Process_Project_Tree_Phase_2
2c011ce1
RD		 1510 (In_Tree => In_Tree,
1511 Project => Project,
1512 Success => Success,
1513 From_Project_Node => From_Project_Node,
1514 From_Project_Node_Tree => From_Project_Node_Tree,
4437a530 1515 Env => Env);
19235870 1516 end if;
19235870
RK		 1517 end Process;
1518
1519 -------------------------------
1520 -- Process_Declarative_Items --
1521 -------------------------------
1522
1523 procedure Process_Declarative_Items
86828d40
AC		 1524 (Project : Project_Id;
1525 In_Tree : Project_Tree_Ref;
1526 From_Project_Node : Project_Node_Id;
1527 Node_Tree : Project_Node_Tree_Ref;
1528 Env : Prj.Tree.Environment;
1529 Pkg : Package_Id;
1530 Item : Project_Node_Id;
1531 Child_Env : in out Prj.Tree.Environment)
fbf5a39b 1532 is
86828d40 1533 Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
40ecf2f5 1534
82923c66
AC		 1535 procedure Check_Or_Set_Typed_Variable
1536 (Value : in out Variable_Value;
1537 Declaration : Project_Node_Id);
1538 -- Check whether Value is valid for this typed variable declaration. If
1539 -- it is an error, the behavior depends on the flags: either an error is
1540 -- reported, or a warning, or nothing. In the last two cases, the value
1541 -- of the variable is set to a valid value, replacing Value.
1542
c4d67e2d
AC		 1543 procedure Process_Package_Declaration
1544 (Current_Item : Project_Node_Id);
e917aec2
RD		 1545 procedure Process_Attribute_Declaration
1546 (Current : Project_Node_Id);
c4d67e2d
AC		 1547 procedure Process_Case_Construction
1548 (Current_Item : Project_Node_Id);
1549 procedure Process_Associative_Array
1550 (Current_Item : Project_Node_Id);
1551 procedure Process_Expression
1552 (Current : Project_Node_Id);
1553 procedure Process_Expression_For_Associative_Array
34798441 1554 (Current : Project_Node_Id;
c4d67e2d
AC		 1555 New_Value : Variable_Value);
1556 procedure Process_Expression_Variable_Decl
1557 (Current_Item : Project_Node_Id;
1558 New_Value : Variable_Value);
1559 -- Process the various declarative items
1560
82923c66
AC		 1561 ---------------------------------
1562 -- Check_Or_Set_Typed_Variable --
1563 ---------------------------------
1564
1565 procedure Check_Or_Set_Typed_Variable
1566 (Value : in out Variable_Value;
1567 Declaration : Project_Node_Id)
1568 is
c4d67e2d 1569 Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree);
82923c66
AC		 1570
1571 Reset_Value : Boolean := False;
1572 Current_String : Project_Node_Id;
1573
1574 begin
1575 -- Report an error for an empty string
1576
1577 if Value.Value = Empty_String then
c4d67e2d 1578 Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);
82923c66 1579
4437a530 1580 case Env.Flags.Allow_Invalid_External is
82923c66 1581 when Error =>
4437a530
EB		 1582 Error_Msg
1583 (Env.Flags, "no value defined for %%", Loc, Project);
82923c66
AC		 1584 when Warning =>
1585 Reset_Value := True;
4437a530
EB		 1586 Error_Msg
1587 (Env.Flags, "?no value defined for %%", Loc, Project);
82923c66
AC		 1588 when Silent =>
1589 Reset_Value := True;
1590 end case;
1591
1592 else
1593 -- Loop through all the valid strings for the
1594 -- string type and compare to the string value.
1595
e917aec2
RD		 1596 Current_String :=
1597 First_Literal_String
1598 (String_Type_Of (Declaration, Node_Tree), Node_Tree);
c4d67e2d 1599
82923c66 1600 while Present (Current_String)
86828d40
AC		 1601 and then
1602 String_Value_Of (Current_String, Node_Tree) /= Value.Value
82923c66
AC		 1603 loop
1604 Current_String :=
c4d67e2d 1605 Next_Literal_String (Current_String, Node_Tree);
82923c66
AC		 1606 end loop;
1607
1608 -- Report error if string value is not one for the string type
1609
1610 if No (Current_String) then
1611 Error_Msg_Name_1 := Value.Value;
c4d67e2d 1612 Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);
82923c66 1613
4437a530 1614 case Env.Flags.Allow_Invalid_External is
82923c66
AC		 1615 when Error =>
1616 Error_Msg
4437a530 1617 (Env.Flags, "value %% is illegal for typed string %%",
82923c66 1618 Loc, Project);
686d0984 1619
82923c66
AC		 1620 when Warning =>
1621 Error_Msg
4437a530 1622 (Env.Flags, "?value %% is illegal for typed string %%",
82923c66
AC		 1623 Loc, Project);
1624 Reset_Value := True;
686d0984 1625
82923c66
AC		 1626 when Silent =>
1627 Reset_Value := True;
1628 end case;
1629 end if;
1630 end if;
1631
1632 if Reset_Value then
1633 Current_String :=
1634 First_Literal_String
c4d67e2d
AC		 1635 (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1636 Value.Value := String_Value_Of (Current_String, Node_Tree);
82923c66
AC		 1637 end if;
1638 end Check_Or_Set_Typed_Variable;
1639
c4d67e2d
AC		 1640 ---------------------------------
1641 -- Process_Package_Declaration --
1642 ---------------------------------
19235870 1643
c4d67e2d 1644 procedure Process_Package_Declaration
e917aec2
RD		 1645 (Current_Item : Project_Node_Id)
1646 is
c4d67e2d
AC		 1647 begin
1648 -- Do not process a package declaration that should be ignored
82923c66 1649
c4d67e2d 1650 if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then
e917aec2 1651
c4d67e2d 1652 -- Create the new package
ede007da 1653
40ecf2f5 1654 Package_Table.Increment_Last (Shared.Packages);
19235870 1655
c4d67e2d
AC		 1656 declare
1657 New_Pkg : constant Package_Id :=
40ecf2f5 1658 Package_Table.Last (Shared.Packages);
c4d67e2d 1659 The_New_Package : Package_Element;
19235870 1660
c4d67e2d 1661 Project_Of_Renamed_Package : constant Project_Node_Id :=
e917aec2
RD		 1662 Project_Of_Renamed_Package_Of
1663 (Current_Item, Node_Tree);
19235870 1664
c4d67e2d
AC		 1665 begin
1666 -- Set the name of the new package
19235870 1667
c4d67e2d 1668 The_New_Package.Name := Name_Of (Current_Item, Node_Tree);
19235870 1669
c4d67e2d 1670 -- Insert the new package in the appropriate list
19235870 1671
c4d67e2d
AC		 1672 if Pkg /= No_Package then
1673 The_New_Package.Next :=
40ecf2f5
EB		 1674 Shared.Packages.Table (Pkg).Decl.Packages;
1675 Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg;
19235870 1676
c4d67e2d
AC		 1677 else
1678 The_New_Package.Next := Project.Decl.Packages;
1679 Project.Decl.Packages := New_Pkg;
1680 end if;
ede007da 1681
40ecf2f5 1682 Shared.Packages.Table (New_Pkg) := The_New_Package;
19235870 1683
c4d67e2d 1684 if Present (Project_Of_Renamed_Package) then
19235870 1685
c4d67e2d 1686 -- Renamed or extending package
19235870 1687
fbf5a39b 1688 declare
c4d67e2d 1689 Project_Name : constant Name_Id :=
86828d40
AC		 1690 Name_Of (Project_Of_Renamed_Package,
1691 Node_Tree);
c4d67e2d
AC		 1692
1693 Renamed_Project : constant Project_Id :=
86828d40
AC		 1694 Imported_Or_Extended_Project_From
1695 (Project, Project_Name);
19235870 1696
c4d67e2d 1697 Renamed_Package : constant Package_Id :=
86828d40
AC		 1698 Package_From
1699 (Renamed_Project, Shared,
1700 Name_Of (Current_Item, Node_Tree));
19235870 1701
fbf5a39b 1702 begin
e917aec2
RD		 1703 -- For a renamed package, copy the declarations of the
1704 -- renamed package, but set all the locations to the
1705 -- location of the package name in the renaming
1706 -- declaration.
c4d67e2d
AC		 1707
1708 Copy_Package_Declarations
67c86178
AC		 1709 (From => Shared.Packages.Table
1710 (Renamed_Package).Decl,
86828d40 1711 To => Shared.Packages.Table (New_Pkg).Decl,
c4d67e2d
AC		 1712 New_Loc => Location_Of (Current_Item, Node_Tree),
1713 Restricted => False,
40ecf2f5 1714 Shared => Shared);
c4d67e2d 1715 end;
19235870 1716
c4d67e2d
AC		 1717 else
1718 -- Set the default values of the attributes
1719
1720 Add_Attributes
1721 (Project,
1722 Project.Name,
4bb43ffb 1723 Name_Id (Project.Directory.Display_Name),
40ecf2f5
EB		 1724 Shared,
1725 Shared.Packages.Table (New_Pkg).Decl,
c4d67e2d
AC		 1726 First_Attribute_Of
1727 (Package_Id_Of (Current_Item, Node_Tree)),
1728 Project_Level => False);
1729 end if;
19235870 1730
e917aec2
RD		 1731 -- Process declarative items (nothing to do when the package is
1732 -- renaming, as the first declarative item is null).
19235870 1733
c4d67e2d
AC		 1734 Process_Declarative_Items
1735 (Project => Project,
1736 In_Tree => In_Tree,
c4d67e2d 1737 From_Project_Node => From_Project_Node,
4437a530
EB		 1738 Node_Tree => Node_Tree,
1739 Env => Env,
c4d67e2d
AC		 1740 Pkg => New_Pkg,
1741 Item =>
ab29a348 1742 First_Declarative_Item_Of (Current_Item, Node_Tree),
40ecf2f5 1743 Child_Env => Child_Env);
c4d67e2d
AC		 1744 end;
1745 end if;
1746 end Process_Package_Declaration;
a70f5d82 1747
c4d67e2d
AC		 1748 -------------------------------
1749 -- Process_Associative_Array --
1750 -------------------------------
19235870 1751
c4d67e2d
AC		 1752 procedure Process_Associative_Array
1753 (Current_Item : Project_Node_Id)
1754 is
1755 Current_Item_Name : constant Name_Id :=
e917aec2 1756 Name_Of (Current_Item, Node_Tree);
c4d67e2d 1757 -- The name of the attribute
19235870 1758
c4d67e2d 1759 Current_Location : constant Source_Ptr :=
e917aec2 1760 Location_Of (Current_Item, Node_Tree);
19235870 1761
c4d67e2d
AC		 1762 New_Array : Array_Id;
1763 -- The new associative array created
19235870 1764
c4d67e2d
AC		 1765 Orig_Array : Array_Id;
1766 -- The associative array value
19235870 1767
c4d67e2d
AC		 1768 Orig_Project_Name : Name_Id := No_Name;
1769 -- The name of the project where the associative array
1770 -- value is.
fbf5a39b 1771
c4d67e2d
AC		 1772 Orig_Project : Project_Id := No_Project;
1773 -- The id of the project where the associative array
1774 -- value is.
fbf5a39b 1775
c4d67e2d 1776 Orig_Package_Name : Name_Id := No_Name;
e917aec2
RD		 1777 -- The name of the package, if any, where the associative array value
1778 -- is located.
b3f48fd4 1779
c4d67e2d 1780 Orig_Package : Package_Id := No_Package;
e917aec2
RD		 1781 -- The id of the package, if any, where the associative array value
1782 -- is located.
b3f48fd4 1783
c4d67e2d
AC		 1784 New_Element : Array_Element_Id := No_Array_Element;
1785 -- Id of a new array element created
19235870 1786
c4d67e2d
AC		 1787 Prev_Element : Array_Element_Id := No_Array_Element;
1788 -- Last new element id created
19235870 1789
c4d67e2d
AC		 1790 Orig_Element : Array_Element_Id := No_Array_Element;
1791 -- Current array element in original associative array
19235870 1792
c4d67e2d 1793 Next_Element : Array_Element_Id := No_Array_Element;
e917aec2
RD		 1794 -- Id of the array element that follows the new element. This is not
1795 -- always nil, because values for the associative array attribute may
1796 -- already have been declared, and the array elements declared are
1797 -- reused.
19235870 1798
c4d67e2d 1799 Prj : Project_List;
19235870 1800
c4d67e2d 1801 begin
e917aec2
RD		 1802 -- First find if the associative array attribute already has elements
1803 -- declared.
19235870 1804
c4d67e2d 1805 if Pkg /= No_Package then
40ecf2f5 1806 New_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
c4d67e2d
AC		 1807 else
1808 New_Array := Project.Decl.Arrays;
1809 end if;
19235870 1810
c4d67e2d 1811 while New_Array /= No_Array
40ecf2f5 1812 and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name
c4d67e2d 1813 loop
40ecf2f5 1814 New_Array := Shared.Arrays.Table (New_Array).Next;
c4d67e2d 1815 end loop;
19235870 1816
e917aec2
RD		 1817 -- If the attribute has never been declared add new entry in the
1818 -- arrays of the project/package and link it.
d42ec90c 1819
c4d67e2d 1820 if New_Array = No_Array then
40ecf2f5
EB		 1821 Array_Table.Increment_Last (Shared.Arrays);
1822 New_Array := Array_Table.Last (Shared.Arrays);
19235870 1823
c4d67e2d 1824 if Pkg /= No_Package then
40ecf2f5 1825 Shared.Arrays.Table (New_Array) :=
c4d67e2d
AC		 1826 (Name => Current_Item_Name,
1827 Location => Current_Location,
1828 Value => No_Array_Element,
40ecf2f5 1829 Next => Shared.Packages.Table (Pkg).Decl.Arrays);
19235870 1830
40ecf2f5 1831 Shared.Packages.Table (Pkg).Decl.Arrays := New_Array;
19235870 1832
c4d67e2d 1833 else
40ecf2f5 1834 Shared.Arrays.Table (New_Array) :=
c4d67e2d
AC		 1835 (Name => Current_Item_Name,
1836 Location => Current_Location,
1837 Value => No_Array_Element,
1838 Next => Project.Decl.Arrays);
19235870 1839
c4d67e2d
AC		 1840 Project.Decl.Arrays := New_Array;
1841 end if;
1842 end if;
19235870 1843
c4d67e2d 1844 -- Find the project where the value is declared
19235870 1845
c4d67e2d
AC		 1846 Orig_Project_Name :=
1847 Name_Of
1848 (Associative_Project_Of (Current_Item, Node_Tree), Node_Tree);
19235870 1849
c4d67e2d
AC		 1850 Prj := In_Tree.Projects;
1851 while Prj /= null loop
1852 if Prj.Project.Name = Orig_Project_Name then
1853 Orig_Project := Prj.Project;
1854 exit;
1855 end if;
1856 Prj := Prj.Next;
1857 end loop;
fbf5a39b 1858
c4d67e2d
AC		 1859 pragma Assert (Orig_Project /= No_Project,
1860 "original project not found");
fbf5a39b 1861
c4d67e2d
AC		 1862 if No (Associative_Package_Of (Current_Item, Node_Tree)) then
1863 Orig_Array := Orig_Project.Decl.Arrays;
fbf5a39b 1864
c4d67e2d 1865 else
e917aec2 1866 -- If in a package, find the package where the value is declared
66713d62 1867
c4d67e2d
AC		 1868 Orig_Package_Name :=
1869 Name_Of
1870 (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree);
fbf5a39b 1871
c4d67e2d
AC		 1872 Orig_Package := Orig_Project.Decl.Packages;
1873 pragma Assert (Orig_Package /= No_Package,
1874 "original package not found");
fbf5a39b 1875
40ecf2f5
EB		 1876 while Shared.Packages.Table
1877 (Orig_Package).Name /= Orig_Package_Name
c4d67e2d 1878 loop
40ecf2f5 1879 Orig_Package := Shared.Packages.Table (Orig_Package).Next;
c4d67e2d
AC		 1880 pragma Assert (Orig_Package /= No_Package,
1881 "original package not found");
1882 end loop;
19235870 1883
40ecf2f5 1884 Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays;
c4d67e2d 1885 end if;
fbf5a39b 1886
c4d67e2d 1887 -- Now look for the array
19235870 1888
c4d67e2d 1889 while Orig_Array /= No_Array
40ecf2f5 1890 and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name
c4d67e2d 1891 loop
40ecf2f5 1892 Orig_Array := Shared.Arrays.Table (Orig_Array).Next;
c4d67e2d 1893 end loop;
19235870 1894
c4d67e2d
AC		 1895 if Orig_Array = No_Array then
1896 Error_Msg
4437a530 1897 (Env.Flags,
c4d67e2d
AC		 1898 "associative array value not found",
1899 Location_Of (Current_Item, Node_Tree),
1900 Project);
7e98a4c6 1901
c4d67e2d 1902 else
40ecf2f5 1903 Orig_Element := Shared.Arrays.Table (Orig_Array).Value;
19235870 1904
c4d67e2d 1905 -- Copy each array element
7e98a4c6 1906
c4d67e2d 1907 while Orig_Element /= No_Array_Element loop
19235870 1908
c4d67e2d 1909 -- Case of first element
19235870 1910
c4d67e2d 1911 if Prev_Element = No_Array_Element then
7e98a4c6 1912
e917aec2
RD		 1913 -- And there is no array element declared yet, create a new
1914 -- first array element.
fbf5a39b 1915
40ecf2f5 1916 if Shared.Arrays.Table (New_Array).Value =
c4d67e2d
AC		 1917 No_Array_Element
1918 then
1919 Array_Element_Table.Increment_Last
40ecf2f5 1920 (Shared.Array_Elements);
c4d67e2d 1921 New_Element := Array_Element_Table.Last
40ecf2f5
EB		 1922 (Shared.Array_Elements);
1923 Shared.Arrays.Table (New_Array).Value := New_Element;
c4d67e2d 1924 Next_Element := No_Array_Element;
fbf5a39b 1925
c4d67e2d 1926 -- Otherwise, the new element is the first
fbf5a39b 1927
c4d67e2d 1928 else
40ecf2f5 1929 New_Element := Shared.Arrays.Table (New_Array).Value;
c4d67e2d 1930 Next_Element :=
40ecf2f5 1931 Shared.Array_Elements.Table (New_Element).Next;
c4d67e2d 1932 end if;
fbf5a39b 1933
c4d67e2d
AC		 1934 -- Otherwise, reuse an existing element, or create
1935 -- one if necessary.
7e98a4c6 1936
c4d67e2d
AC		 1937 else
1938 Next_Element :=
40ecf2f5 1939 Shared.Array_Elements.Table (Prev_Element).Next;
fbf5a39b 1940
c4d67e2d
AC		 1941 if Next_Element = No_Array_Element then
1942 Array_Element_Table.Increment_Last
40ecf2f5
EB		 1943 (Shared.Array_Elements);
1944 New_Element := Array_Element_Table.Last
1945 (Shared.Array_Elements);
1946 Shared.Array_Elements.Table (Prev_Element).Next :=
c4d67e2d 1947 New_Element;
19235870 1948
c4d67e2d
AC		 1949 else
1950 New_Element := Next_Element;
1951 Next_Element :=
40ecf2f5 1952 Shared.Array_Elements.Table (New_Element).Next;
c4d67e2d
AC		 1953 end if;
1954 end if;
19235870 1955
c4d67e2d 1956 -- Copy the value of the element
fbf5a39b 1957
40ecf2f5
EB		 1958 Shared.Array_Elements.Table (New_Element) :=
1959 Shared.Array_Elements.Table (Orig_Element);
1960 Shared.Array_Elements.Table (New_Element).Value.Project
1961 := Project;
19235870 1962
c4d67e2d 1963 -- Adjust the Next link
19235870 1964
40ecf2f5 1965 Shared.Array_Elements.Table (New_Element).Next := Next_Element;
19235870 1966
c4d67e2d 1967 -- Adjust the previous id for the next element
19235870 1968
c4d67e2d 1969 Prev_Element := New_Element;
44e1918a 1970
c4d67e2d 1971 -- Go to the next element in the original array
fbf5a39b 1972
40ecf2f5 1973 Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next;
c4d67e2d 1974 end loop;
44e1918a 1975
e917aec2
RD		 1976 -- Make sure that the array ends here, in case there previously a
1977 -- greater number of elements.
19235870 1978
40ecf2f5 1979 Shared.Array_Elements.Table (New_Element).Next := No_Array_Element;
c4d67e2d
AC		 1980 end if;
1981 end Process_Associative_Array;
fbf5a39b 1982
c4d67e2d
AC		 1983 ----------------------------------------------
1984 -- Process_Expression_For_Associative_Array --
1985 ----------------------------------------------
fbf5a39b 1986
c4d67e2d 1987 procedure Process_Expression_For_Associative_Array
34798441
EB		 1988 (Current : Project_Node_Id;
1989 New_Value : Variable_Value)
c4d67e2d 1990 is
e917aec2 1991 Name : constant Name_Id := Name_Of (Current, Node_Tree);
c4d67e2d 1992 Current_Location : constant Source_Ptr :=
e917aec2 1993 Location_Of (Current, Node_Tree);
fbf5a39b 1994
c4d67e2d 1995 Index_Name : Name_Id :=
e917aec2 1996 Associative_Array_Index_Of (Current, Node_Tree);
fbf5a39b 1997
c4d67e2d 1998 Source_Index : constant Int :=
e917aec2 1999 Source_Index_Of (Current, Node_Tree);
fbf5a39b 2000
34798441
EB		 2001 The_Array : Array_Id;
2002 Elem : Array_Element_Id := No_Array_Element;
fbf5a39b 2003
c4d67e2d
AC		 2004 begin
2005 if Index_Name /= All_Other_Names then
34798441 2006 Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name);
c4d67e2d 2007 end if;
fbf5a39b 2008
c4d67e2d 2009 -- Look for the array in the appropriate list
fbf5a39b 2010
c4d67e2d 2011 if Pkg /= No_Package then
40ecf2f5 2012 The_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
c4d67e2d
AC		 2013 else
2014 The_Array := Project.Decl.Arrays;
2015 end if;
19235870 2016
c4d67e2d 2017 while The_Array /= No_Array
40ecf2f5 2018 and then Shared.Arrays.Table (The_Array).Name /= Name
c4d67e2d 2019 loop
40ecf2f5 2020 The_Array := Shared.Arrays.Table (The_Array).Next;
c4d67e2d 2021 end loop;
fbf5a39b 2022
e917aec2
RD		 2023 -- If the array cannot be found, create a new entry in the list.
2024 -- As The_Array_Element is initialized to No_Array_Element, a new
2025 -- element will be created automatically later
fbf5a39b 2026
c4d67e2d 2027 if The_Array = No_Array then
40ecf2f5
EB		 2028 Array_Table.Increment_Last (Shared.Arrays);
2029 The_Array := Array_Table.Last (Shared.Arrays);
fbf5a39b 2030
c4d67e2d 2031 if Pkg /= No_Package then
40ecf2f5 2032 Shared.Arrays.Table (The_Array) :=
34798441 2033 (Name => Name,
c4d67e2d
AC		 2034 Location => Current_Location,
2035 Value => No_Array_Element,
40ecf2f5 2036 Next => Shared.Packages.Table (Pkg).Decl.Arrays);
fbf5a39b 2037
40ecf2f5 2038 Shared.Packages.Table (Pkg).Decl.Arrays := The_Array;
44e1918a 2039
c4d67e2d 2040 else
40ecf2f5 2041 Shared.Arrays.Table (The_Array) :=
34798441 2042 (Name => Name,
c4d67e2d
AC		 2043 Location => Current_Location,
2044 Value => No_Array_Element,
2045 Next => Project.Decl.Arrays);
fbf5a39b 2046
c4d67e2d
AC		 2047 Project.Decl.Arrays := The_Array;
2048 end if;
fbf5a39b 2049
c4d67e2d 2050 else
40ecf2f5 2051 Elem := Shared.Arrays.Table (The_Array).Value;
c4d67e2d 2052 end if;
fbf5a39b 2053
e917aec2
RD		 2054 -- Look in the list, if any, to find an element with the same index
2055 -- and same source index.
d42ec90c 2056
34798441 2057 while Elem /= No_Array_Element
c4d67e2d 2058 and then
40ecf2f5 2059 (Shared.Array_Elements.Table (Elem).Index /= Index_Name
e917aec2 2060 or else
40ecf2f5 2061 Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index)
c4d67e2d 2062 loop
40ecf2f5 2063 Elem := Shared.Array_Elements.Table (Elem).Next;
c4d67e2d 2064 end loop;
19235870 2065
c4d67e2d
AC		 2066 -- If no such element were found, create a new one
2067 -- and insert it in the element list, with the
2068 -- proper value.
a70f5d82 2069
34798441 2070 if Elem = No_Array_Element then
40ecf2f5
EB		 2071 Array_Element_Table.Increment_Last (Shared.Array_Elements);
2072 Elem := Array_Element_Table.Last (Shared.Array_Elements);
19235870 2073
40ecf2f5 2074 Shared.Array_Elements.Table
34798441 2075 (Elem) :=
c4d67e2d 2076 (Index => Index_Name,
9f55bc62 2077 Restricted => False,
c4d67e2d
AC		 2078 Src_Index => Source_Index,
2079 Index_Case_Sensitive =>
34798441 2080 not Case_Insensitive (Current, Node_Tree),
c4d67e2d 2081 Value => New_Value,
40ecf2f5 2082 Next => Shared.Arrays.Table (The_Array).Value);
19235870 2083
40ecf2f5 2084 Shared.Arrays.Table (The_Array).Value := Elem;
19235870 2085
34798441 2086 else
e917aec2
RD		 2087 -- An element with the same index already exists, just replace its
2088 -- value with the new one.
fbf5a39b 2089
40ecf2f5 2090 Shared.Array_Elements.Table (Elem).Value := New_Value;
34798441
EB		 2091 end if;
2092
2093 if Name = Snames.Name_External then
40ecf2f5 2094 if In_Tree.Is_Root_Tree then
ab29a348
EB		 2095 Add (Child_Env.External,
2096 External_Name => Get_Name_String (Index_Name),
2097 Value => Get_Name_String (New_Value.Value),
2098 Source => From_External_Attribute);
2099 Add (Env.External,
2100 External_Name => Get_Name_String (Index_Name),
2101 Value => Get_Name_String (New_Value.Value),
08cd7c2f
AC		 2102 Source => From_External_Attribute,
2103 Silent => True);
ab29a348
EB		 2104 else
2105 if Current_Verbosity = High then
2106 Debug_Output
2107 ("'for External' has no effect except in root aggregate ("
2108 & Get_Name_String (Index_Name) & ")", New_Value.Value);
2109 end if;
2110 end if;
c4d67e2d
AC		 2111 end if;
2112 end Process_Expression_For_Associative_Array;
19235870 2113
c4d67e2d
AC		 2114 --------------------------------------
2115 -- Process_Expression_Variable_Decl --
2116 --------------------------------------
fbf5a39b 2117
c4d67e2d
AC		 2118 procedure Process_Expression_Variable_Decl
2119 (Current_Item : Project_Node_Id;
2120 New_Value : Variable_Value)
2121 is
34798441 2122 Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);
2c1b72d7 2123
34798441 2124 Is_Attribute : constant Boolean :=
e917aec2
RD		 2125 Kind_Of (Current_Item, Node_Tree) =
2126 N_Attribute_Declaration;
2c1b72d7 2127
824e9320 2128 Var : Variable_Id := No_Variable;
19235870 2129
c4d67e2d 2130 begin
dbe36d67 2131 -- First, find the list where to find the variable or attribute
fbf5a39b 2132
34798441 2133 if Is_Attribute then
c4d67e2d 2134 if Pkg /= No_Package then
40ecf2f5 2135 Var := Shared.Packages.Table (Pkg).Decl.Attributes;
c4d67e2d 2136 else
34798441 2137 Var := Project.Decl.Attributes;
c4d67e2d 2138 end if;
7e98a4c6 2139
c4d67e2d
AC		 2140 else
2141 if Pkg /= No_Package then
40ecf2f5 2142 Var := Shared.Packages.Table (Pkg).Decl.Variables;
c4d67e2d 2143 else
34798441 2144 Var := Project.Decl.Variables;
c4d67e2d
AC		 2145 end if;
2146 end if;
fbf5a39b 2147
dbe36d67 2148 -- Loop through the list, to find if it has already been declared
fbf5a39b 2149
34798441 2150 while Var /= No_Variable
40ecf2f5 2151 and then Shared.Variable_Elements.Table (Var).Name /= Name
c4d67e2d 2152 loop
40ecf2f5 2153 Var := Shared.Variable_Elements.Table (Var).Next;
c4d67e2d 2154 end loop;
fbf5a39b 2155
e917aec2 2156 -- If it has not been declared, create a new entry in the list
fbf5a39b 2157
34798441 2158 if Var = No_Variable then
fbf5a39b 2159
e917aec2
RD		 2160 -- All single string attribute should already have been declared
2161 -- with a default empty string value.
fbf5a39b 2162
c4d67e2d 2163 pragma Assert
34798441
EB		 2164 (not Is_Attribute,
2165 "illegal attribute declaration for " & Get_Name_String (Name));
19235870 2166
40ecf2f5
EB		 2167 Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
2168 Var := Variable_Element_Table.Last (Shared.Variable_Elements);
fbf5a39b 2169
c4d67e2d 2170 -- Put the new variable in the appropriate list
fbf5a39b 2171
c4d67e2d 2172 if Pkg /= No_Package then
40ecf2f5
EB		 2173 Shared.Variable_Elements.Table (Var) :=
2174 (Next => Shared.Packages.Table (Pkg).Decl.Variables,
34798441 2175 Name => Name,
c4d67e2d 2176 Value => New_Value);
40ecf2f5 2177 Shared.Packages.Table (Pkg).Decl.Variables := Var;
c8c41617 2178
c4d67e2d 2179 else
40ecf2f5 2180 Shared.Variable_Elements.Table (Var) :=
c4d67e2d 2181 (Next => Project.Decl.Variables,
34798441 2182 Name => Name,
c4d67e2d 2183 Value => New_Value);
34798441 2184 Project.Decl.Variables := Var;
c4d67e2d 2185 end if;
c8c41617 2186
e917aec2
RD		 2187 -- If the variable/attribute has already been declared, just
2188 -- change the value.
1b685674 2189
c4d67e2d 2190 else
40ecf2f5 2191 Shared.Variable_Elements.Table (Var).Value := New_Value;
c4d67e2d 2192 end if;
824e9320 2193
292689c2 2194 if Is_Attribute and then Name = Snames.Name_Project_Path then
824e9320
AC		 2195 if In_Tree.Is_Root_Tree then
2196 declare
4e3da85a
PO		 2197 package Name_Ids is
2198 new Ada.Containers.Vectors (Positive, Name_Id);
2199 Val : String_List_Id := New_Value.Values;
2200 List : Name_Ids.Vector;
824e9320 2201 begin
4e3da85a
PO		 2202 -- Get all values
2203
824e9320 2204 while Val /= Nil_String loop
4e3da85a
PO		 2205 List.Prepend
2206 (Shared.String_Elements.Table (Val).Value);
2207 Val := Shared.String_Elements.Table (Val).Next;
2208 end loop;
2209
7e856112 2210 -- Prepend them in the order found in the attribute
4e3da85a
PO		 2211
2212 for K in Positive range 1 .. Positive (List.Length) loop
824e9320
AC		 2213 Prj.Env.Add_Directories
2214 (Child_Env.Project_Path,
54bb89ca 2215 Normalize_Pathname
4e3da85a
PO		 2216 (Name => Get_Name_String
2217 (List.Element (K)),
2218 Directory => Get_Name_String
2219 (Project.Directory.Display_Name)),
2220 Prepend => True);
824e9320
AC		 2221 end loop;
2222 end;
2223
2224 else
2225 if Current_Verbosity = High then
2226 Debug_Output
2227 ("'for Project_Path' has no effect except in"
2228 & " root aggregate");
2229 end if;
2230 end if;
2231 end if;
c4d67e2d 2232 end Process_Expression_Variable_Decl;
fbf5a39b 2233
c4d67e2d
AC		 2234 ------------------------
2235 -- Process_Expression --
2236 ------------------------
fbf5a39b 2237
e917aec2 2238 procedure Process_Expression (Current : Project_Node_Id) is
c4d67e2d 2239 New_Value : Variable_Value :=
e917aec2
RD		 2240 Expression
2241 (Project => Project,
40ecf2f5 2242 Shared => Shared,
e917aec2
RD		 2243 From_Project_Node => From_Project_Node,
2244 From_Project_Node_Tree => Node_Tree,
2245 Env => Env,
2246 Pkg => Pkg,
2247 First_Term =>
2248 Tree.First_Term
2249 (Expression_Of (Current, Node_Tree), Node_Tree),
2250 Kind =>
2251 Expression_Kind_Of (Current, Node_Tree));
fbf5a39b 2252
c4d67e2d
AC		 2253 begin
2254 -- Process a typed variable declaration
fbf5a39b 2255
e917aec2 2256 if Kind_Of (Current, Node_Tree) = N_Typed_Variable_Declaration then
c4d67e2d
AC		 2257 Check_Or_Set_Typed_Variable (New_Value, Current);
2258 end if;
fbf5a39b 2259
c4d67e2d
AC		 2260 if Kind_Of (Current, Node_Tree) /= N_Attribute_Declaration
2261 or else Associative_Array_Index_Of (Current, Node_Tree) = No_Name
2262 then
2263 Process_Expression_Variable_Decl (Current, New_Value);
2264 else
2265 Process_Expression_For_Associative_Array (Current, New_Value);
2266 end if;
2267 end Process_Expression;
fbf5a39b 2268
c4d67e2d
AC		 2269 -----------------------------------
2270 -- Process_Attribute_Declaration --
2271 -----------------------------------
7e98a4c6 2272
c4d67e2d
AC		 2273 procedure Process_Attribute_Declaration (Current : Project_Node_Id) is
2274 begin
2275 if Expression_Of (Current, Node_Tree) = Empty_Node then
2276 Process_Associative_Array (Current);
2277 else
2278 Process_Expression (Current);
2279 end if;
2280 end Process_Attribute_Declaration;
fbf5a39b 2281
c4d67e2d
AC		 2282 -------------------------------
2283 -- Process_Case_Construction --
2284 -------------------------------
7e98a4c6 2285
c4d67e2d 2286 procedure Process_Case_Construction
e917aec2 2287 (Current_Item : Project_Node_Id)
c4d67e2d
AC		 2288 is
2289 The_Project : Project_Id := Project;
2290 -- The id of the project of the case variable
fbf5a39b 2291
c4d67e2d
AC		 2292 The_Package : Package_Id := Pkg;
2293 -- The id of the package, if any, of the case variable
fbf5a39b 2294
c4d67e2d
AC		 2295 The_Variable : Variable_Value := Nil_Variable_Value;
2296 -- The case variable
fbf5a39b 2297
c4d67e2d
AC		 2298 Case_Value : Name_Id := No_Name;
2299 -- The case variable value
fbf5a39b 2300
c4d67e2d
AC		 2301 Case_Item : Project_Node_Id := Empty_Node;
2302 Choice_String : Project_Node_Id := Empty_Node;
2303 Decl_Item : Project_Node_Id := Empty_Node;
fbf5a39b 2304
c4d67e2d
AC		 2305 begin
2306 declare
2307 Variable_Node : constant Project_Node_Id :=
2308 Case_Variable_Reference_Of
2309 (Current_Item,
2310 Node_Tree);
fbf5a39b 2311
c4d67e2d
AC		 2312 Var_Id : Variable_Id := No_Variable;
2313 Name : Name_Id := No_Name;
19235870 2314
c4d67e2d 2315 begin
e917aec2 2316 -- If a project was specified for the case variable, get its id
c4d67e2d
AC		 2317
2318 if Present (Project_Node_Of (Variable_Node, Node_Tree)) then
2319 Name :=
2320 Name_Of
2321 (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2322 The_Project :=
f11ac8e7
AC		 2323 Imported_Or_Extended_Project_From
2324 (Project, Name, No_Extending => True);
2325 The_Package := No_Package;
c4d67e2d 2326 end if;
fbf5a39b 2327
e917aec2 2328 -- If a package was specified for the case variable, get its id
fbf5a39b 2329
c4d67e2d
AC		 2330 if Present (Package_Node_Of (Variable_Node, Node_Tree)) then
2331 Name :=
2332 Name_Of
2333 (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree);
40ecf2f5 2334 The_Package := Package_From (The_Project, Shared, Name);
c4d67e2d 2335 end if;
fbf5a39b 2336
c4d67e2d 2337 Name := Name_Of (Variable_Node, Node_Tree);
fbf5a39b 2338
e917aec2 2339 -- First, look for the case variable into the package, if any
19235870 2340
c4d67e2d 2341 if The_Package /= No_Package then
c4d67e2d 2342 Name := Name_Of (Variable_Node, Node_Tree);
e917aec2 2343
40ecf2f5 2344 Var_Id := Shared.Packages.Table (The_Package).Decl.Variables;
c4d67e2d 2345 while Var_Id /= No_Variable
40ecf2f5 2346 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
c4d67e2d 2347 loop
40ecf2f5 2348 Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
c4d67e2d
AC		 2349 end loop;
2350 end if;
19235870 2351
e917aec2
RD		 2352 -- If not found in the package, or if there is no package, look at
2353 -- the project level.
19235870 2354
c4d67e2d
AC		 2355 if Var_Id = No_Variable
2356 and then No (Package_Node_Of (Variable_Node, Node_Tree))
2357 then
2358 Var_Id := The_Project.Decl.Variables;
2359 while Var_Id /= No_Variable
40ecf2f5 2360 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
c4d67e2d 2361 loop
40ecf2f5 2362 Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
c4d67e2d
AC		 2363 end loop;
2364 end if;
19235870 2365
c4d67e2d 2366 if Var_Id = No_Variable then
19235870 2367
e917aec2
RD		 2368 -- Should never happen, because this has already been checked
2369 -- during parsing.
19235870 2370
c4d67e2d
AC		 2371 Write_Line
2372 ("variable """ & Get_Name_String (Name) & """ not found");
2373 raise Program_Error;
2374 end if;
fbf5a39b 2375
c4d67e2d 2376 -- Get the case variable
19235870 2377
40ecf2f5 2378 The_Variable := Shared.Variable_Elements. Table (Var_Id).Value;
fbf5a39b 2379
c4d67e2d 2380 if The_Variable.Kind /= Single then
19235870 2381
e917aec2
RD		 2382 -- Should never happen, because this has already been checked
2383 -- during parsing.
19235870 2384
c4d67e2d
AC		 2385 Write_Line ("variable""" & Get_Name_String (Name) &
2386 """ is not a single string variable");
2387 raise Program_Error;
2388 end if;
19235870 2389
c4d67e2d 2390 -- Get the case variable value
e917aec2 2391
c4d67e2d
AC		 2392 Case_Value := The_Variable.Value;
2393 end;
19235870 2394
c4d67e2d 2395 -- Now look into all the case items of the case construction
fbf5a39b 2396
c4d67e2d 2397 Case_Item := First_Case_Item_Of (Current_Item, Node_Tree);
19235870 2398
c4d67e2d
AC		 2399 Case_Item_Loop :
2400 while Present (Case_Item) loop
2401 Choice_String := First_Choice_Of (Case_Item, Node_Tree);
19235870 2402
e917aec2
RD		 2403 -- When Choice_String is nil, it means that it is the
2404 -- "when others =>" alternative.
19235870 2405
c4d67e2d
AC		 2406 if No (Choice_String) then
2407 Decl_Item := First_Declarative_Item_Of (Case_Item, Node_Tree);
2408 exit Case_Item_Loop;
2409 end if;
19235870 2410
c4d67e2d 2411 -- Look into all the alternative of this case item
19235870 2412
c4d67e2d
AC		 2413 Choice_Loop :
2414 while Present (Choice_String) loop
2415 if Case_Value = String_Value_Of (Choice_String, Node_Tree) then
2416 Decl_Item :=
2417 First_Declarative_Item_Of (Case_Item, Node_Tree);
2418 exit Case_Item_Loop;
2419 end if;
fbf5a39b 2420
c4d67e2d
AC		 2421 Choice_String := Next_Literal_String (Choice_String, Node_Tree);
2422 end loop Choice_Loop;
19235870 2423
c4d67e2d
AC		 2424 Case_Item := Next_Case_Item (Case_Item, Node_Tree);
2425 end loop Case_Item_Loop;
fbf5a39b 2426
c4d67e2d 2427 -- If there is an alternative, then we process it
19235870 2428
c4d67e2d
AC		 2429 if Present (Decl_Item) then
2430 Process_Declarative_Items
40ecf2f5
EB		 2431 (Project => Project,
2432 In_Tree => In_Tree,
2433 From_Project_Node => From_Project_Node,
2434 Node_Tree => Node_Tree,
2435 Env => Env,
2436 Pkg => Pkg,
2437 Item => Decl_Item,
2438 Child_Env => Child_Env);
c4d67e2d
AC		 2439 end if;
2440 end Process_Case_Construction;
fbf5a39b 2441
c4d67e2d 2442 -- Local variables
19235870 2443
c4d67e2d
AC		 2444 Current, Decl : Project_Node_Id;
2445 Kind : Project_Node_Kind;
7e98a4c6 2446
c4d67e2d 2447 -- Start of processing for Process_Declarative_Items
19235870 2448
c4d67e2d
AC		 2449 begin
2450 Decl := Item;
2451 while Present (Decl) loop
2452 Current := Current_Item_Node (Decl, Node_Tree);
2453 Decl := Next_Declarative_Item (Decl, Node_Tree);
2454 Kind := Kind_Of (Current, Node_Tree);
fbf5a39b 2455
c4d67e2d
AC		 2456 case Kind is
2457 when N_Package_Declaration =>
2458 Process_Package_Declaration (Current);
19235870 2459
e917aec2
RD		 2460 -- Nothing to process for string type declaration
2461
c4d67e2d 2462 when N_String_Type_Declaration =>
c4d67e2d 2463 null;
19235870 2464
c4d67e2d
AC		 2465 when N_Attribute_Declaration |
2466 N_Typed_Variable_Declaration |
2467 N_Variable_Declaration =>
2468 Process_Attribute_Declaration (Current);
2469
2470 when N_Case_Construction =>
2471 Process_Case_Construction (Current);
19235870 2472
c4d67e2d
AC		 2473 when others =>
2474 Write_Line ("Illegal declarative item: " & Kind'Img);
19235870
RK		 2475 raise Program_Error;
2476 end case;
2477 end loop;
2478 end Process_Declarative_Items;
2479
a70f5d82
VC		 2480 ----------------------------------
2481 -- Process_Project_Tree_Phase_1 --
2482 ----------------------------------
2483
2484 procedure Process_Project_Tree_Phase_1
2485 (In_Tree : Project_Tree_Ref;
2486 Project : out Project_Id;
3e7302c3 2487 Packages_To_Check : String_List_Access;
a70f5d82
VC		 2488 Success : out Boolean;
2489 From_Project_Node : Project_Node_Id;
2490 From_Project_Node_Tree : Project_Node_Tree_Ref;
4437a530 2491 Env : in out Prj.Tree.Environment;
5216b599
AC		 2492 Reset_Tree : Boolean := True;
2493 On_New_Tree_Loaded : Tree_Loaded_Callback := null)
a70f5d82
VC		 2494 is
2495 begin
a70f5d82
VC		 2496 if Reset_Tree then
2497
2498 -- Make sure there are no projects in the data structure
2499
66713d62 2500 Free_List (In_Tree.Projects, Free_Project => True);
a70f5d82
VC		 2501 end if;
2502
2503 Processed_Projects.Reset;
2504
2505 -- And process the main project and all of the projects it depends on,
2506 -- recursively.
2507
c4d67e2d
AC		 2508 Debug_Increase_Indent ("Process tree, phase 1");
2509
a70f5d82
VC		 2510 Recursive_Process
2511 (Project => Project,
2512 In_Tree => In_Tree,
3e7302c3 2513 Packages_To_Check => Packages_To_Check,
a70f5d82
VC		 2514 From_Project_Node => From_Project_Node,
2515 From_Project_Node_Tree => From_Project_Node_Tree,
4437a530 2516 Env => Env,
a76b09dc 2517 Extended_By => No_Project,
5216b599
AC		 2518 From_Encapsulated_Lib => False,
2519 On_New_Tree_Loaded => On_New_Tree_Loaded);
a70f5d82 2520
1b685674
VC		 2521 Success :=
2522 Total_Errors_Detected = 0
2523 and then
c4d67e2d
AC		 2524 (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2525
2526 if Current_Verbosity = High then
86828d40
AC		 2527 Debug_Decrease_Indent
2528 ("Done Process tree, phase 1, Success=" & Success'Img);
c4d67e2d 2529 end if;
a70f5d82
VC		 2530 end Process_Project_Tree_Phase_1;
2531
2532 ----------------------------------
2533 -- Process_Project_Tree_Phase_2 --
2534 ----------------------------------
2535
2536 procedure Process_Project_Tree_Phase_2
2c011ce1
RD		 2537 (In_Tree : Project_Tree_Ref;
2538 Project : Project_Id;
2539 Success : out Boolean;
2540 From_Project_Node : Project_Node_Id;
2541 From_Project_Node_Tree : Project_Node_Tree_Ref;
4437a530 2542 Env : Environment)
a70f5d82
VC		 2543 is
2544 Obj_Dir : Path_Name_Type;
2545 Extending : Project_Id;
2546 Extending2 : Project_Id;
66713d62 2547 Prj : Project_List;
a70f5d82
VC		 2548
2549 -- Start of processing for Process_Project_Tree_Phase_2
2550
2551 begin
a70f5d82
VC		 2552 Success := True;
2553
40ecf2f5 2554 Debug_Increase_Indent ("Process tree, phase 2", Project.Name);
c4d67e2d 2555
a70f5d82 2556 if Project /= No_Project then
4437a530 2557 Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags);
a70f5d82
VC		 2558 end if;
2559
67efd80a
AC		 2560 -- If main project is an extending all project, set object directory of
2561 -- all virtual extending projects to object directory of main project.
a70f5d82
VC		 2562
2563 if Project /= No_Project
86828d40 2564 and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
a70f5d82
VC		 2565 then
2566 declare
86828d40 2567 Object_Dir : constant Path_Information := Project.Object_Directory;
e917aec2 2568
a70f5d82 2569 begin
66713d62
AC		 2570 Prj := In_Tree.Projects;
2571 while Prj /= null loop
2572 if Prj.Project.Virtual then
71158d7e 2573 Prj.Project.Object_Directory := Object_Dir;
a70f5d82 2574 end if;
e917aec2 2575
66713d62 2576 Prj := Prj.Next;
a70f5d82
VC		 2577 end loop;
2578 end;
2579 end if;
2580
2581 -- Check that no extending project shares its object directory with
2582 -- the project(s) it extends.
2583
2584 if Project /= No_Project then
66713d62
AC		 2585 Prj := In_Tree.Projects;
2586 while Prj /= null loop
2587 Extending := Prj.Project.Extended_By;
a70f5d82
VC		 2588
2589 if Extending /= No_Project then
66713d62 2590 Obj_Dir := Prj.Project.Object_Directory.Name;
a70f5d82
VC		 2591
2592 -- Check that a project being extended does not share its
2593 -- object directory with any project that extends it, directly
2594 -- or indirectly, including a virtual extending project.
2595
2596 -- Start with the project directly extending it
2597
2598 Extending2 := Extending;
2599 while Extending2 /= No_Project loop
66713d62
AC		 2600 if Has_Ada_Sources (Extending2)
2601 and then Extending2.Object_Directory.Name = Obj_Dir
a70f5d82 2602 then
66713d62
AC		 2603 if Extending2.Virtual then
2604 Error_Msg_Name_1 := Prj.Project.Display_Name;
e2d9085b 2605 Error_Msg
4437a530 2606 (Env.Flags,
e2d9085b
EB		 2607 "project %% cannot be extended by a virtual" &
2608 " project with the same object directory",
2609 Prj.Project.Location, Project);
a70f5d82
VC		 2610
2611 else
66713d62
AC		 2612 Error_Msg_Name_1 := Extending2.Display_Name;
2613 Error_Msg_Name_2 := Prj.Project.Display_Name;
e2d9085b 2614 Error_Msg
4437a530 2615 (Env.Flags,
e2d9085b
EB		 2616 "project %% cannot extend project %%",
2617 Extending2.Location, Project);
2618 Error_Msg
4437a530 2619 (Env.Flags,
e2d9085b
EB		 2620 "\they share the same object directory",
2621 Extending2.Location, Project);
a70f5d82
VC		 2622 end if;
2623 end if;
2624
2625 -- Continue with the next extending project, if any
2626
66713d62 2627 Extending2 := Extending2.Extended_By;
a70f5d82
VC		 2628 end loop;
2629 end if;
66713d62
AC		 2630
2631 Prj := Prj.Next;
a70f5d82
VC		 2632 end loop;
2633 end if;
2634
c4d67e2d
AC		 2635 Debug_Decrease_Indent ("Done Process tree, phase 2");
2636
86828d40
AC		 2637 Success := Total_Errors_Detected = 0
2638 and then
2639 (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
a70f5d82
VC		 2640 end Process_Project_Tree_Phase_2;
2641
19235870
RK		 2642 -----------------------
2643 -- Recursive_Process --
2644 -----------------------
2645
2646 procedure Recursive_Process
7e98a4c6
VC		 2647 (In_Tree : Project_Tree_Ref;
2648 Project : out Project_Id;
3e7302c3 2649 Packages_To_Check : String_List_Access;
7e98a4c6
VC		 2650 From_Project_Node : Project_Node_Id;
2651 From_Project_Node_Tree : Project_Node_Tree_Ref;
4437a530 2652 Env : in out Prj.Tree.Environment;
a76b09dc 2653 Extended_By : Project_Id;
5216b599
AC		 2654 From_Encapsulated_Lib : Boolean;
2655 On_New_Tree_Loaded : Tree_Loaded_Callback := null)
19235870 2656 is
86828d40 2657 Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
40ecf2f5
EB		 2658
2659 Child_Env : Prj.Tree.Environment;
2660 -- Only used for the root aggregate project (if any). This is left
2661 -- uninitialized otherwise.
2662
347ab254
EB		 2663 procedure Process_Imported_Projects
2664 (Imported : in out Project_List;
2665 Limited_With : Boolean);
2666 -- Process imported projects. If Limited_With is True, then only
2667 -- projects processed through a "limited with" are processed, otherwise
2668 -- only projects imported through a standard "with" are processed.
2669 -- Imported is the id of the last imported project.
2670
c4d67e2d 2671 procedure Process_Aggregated_Projects;
e917aec2
RD		 2672 -- Process all the projects aggregated in List. This does nothing if the
2673 -- project is not an aggregate project.
c4d67e2d
AC		 2674
2675 procedure Process_Extended_Project;
e917aec2
RD		 2676 -- Process the extended project: inherit all packages from the extended
2677 -- project that are not explicitly defined or renamed. Also inherit the
2678 -- languages, if attribute Languages is not explicitly defined.
c4d67e2d 2679
ce30eccb
EB		 2680 -------------------------------
2681 -- Process_Imported_Projects --
2682 -------------------------------
2683
347ab254
EB		 2684 procedure Process_Imported_Projects
2685 (Imported : in out Project_List;
2686 Limited_With : Boolean)
2687 is
d9c0e057 2688 With_Clause : Project_Node_Id;
347ab254
EB		 2689 New_Project : Project_Id;
2690 Proj_Node : Project_Node_Id;
d9c0e057 2691
347ab254 2692 begin
d9c0e057
AC		 2693 With_Clause :=
2694 First_With_Clause_Of
2695 (From_Project_Node, From_Project_Node_Tree);
c4d67e2d 2696
347ab254
EB		 2697 while Present (With_Clause) loop
2698 Proj_Node :=
2699 Non_Limited_Project_Node_Of
2700 (With_Clause, From_Project_Node_Tree);
2701 New_Project := No_Project;
2702
d1ced162
RD		 2703 if (Limited_With and then No (Proj_Node))
2704 or else (not Limited_With and then Present (Proj_Node))
347ab254
EB		 2705 then
2706 Recursive_Process
2707 (In_Tree => In_Tree,
2708 Project => New_Project,
3e7302c3 2709 Packages_To_Check => Packages_To_Check,
347ab254 2710 From_Project_Node =>
3e7302c3 2711 Project_Node_Of (With_Clause, From_Project_Node_Tree),
347ab254 2712 From_Project_Node_Tree => From_Project_Node_Tree,
4437a530 2713 Env => Env,
a76b09dc 2714 Extended_By => No_Project,
5216b599
AC		 2715 From_Encapsulated_Lib => From_Encapsulated_Lib,
2716 On_New_Tree_Loaded => On_New_Tree_Loaded);
347ab254 2717
3563739b 2718 if Imported = null then
a76b09dc
PO		 2719 Project.Imported_Projects := new Project_List_Element'
2720 (Project => New_Project,
2721 From_Encapsulated_Lib => False,
2722 Next => null);
66713d62 2723 Imported := Project.Imported_Projects;
347ab254 2724 else
3563739b 2725 Imported.Next := new Project_List_Element'
a76b09dc
PO		 2726 (Project => New_Project,
2727 From_Encapsulated_Lib => False,
2728 Next => null);
3563739b 2729 Imported := Imported.Next;
347ab254 2730 end if;
347ab254
EB		 2731 end if;
2732
2733 With_Clause :=
2734 Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
2735 end loop;
2736 end Process_Imported_Projects;
19235870 2737
c4d67e2d
AC		 2738 ---------------------------------
2739 -- Process_Aggregated_Projects --
2740 ---------------------------------
2741
2742 procedure Process_Aggregated_Projects is
86828d40 2743 List : Aggregated_Project_List;
40ecf2f5 2744 Loaded_Project : Prj.Tree.Project_Node_Id;
86828d40 2745 Success : Boolean := True;
5415acbd 2746 Tree : Project_Tree_Ref;
42ae3870 2747 Node_Tree : Project_Node_Tree_Ref;
67c86178 2748
c4d67e2d 2749 begin
5415acbd 2750 if Project.Qualifier not in Aggregate_Project then
c4d67e2d
AC		 2751 return;
2752 end if;
2753
2754 Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name);
2755
2756 Prj.Nmsc.Process_Aggregated_Projects
86828d40
AC		 2757 (Tree => In_Tree,
2758 Project => Project,
2759 Node_Tree => From_Project_Node_Tree,
2760 Flags => Env.Flags);
c4d67e2d
AC		 2761
2762 List := Project.Aggregated_Projects;
2763 while Success and then List /= null loop
42ae3870
AC		 2764 Node_Tree := new Project_Node_Tree_Data;
2765 Initialize (Node_Tree);
2766
c4d67e2d 2767 Prj.Part.Parse
42ae3870 2768 (In_Tree => Node_Tree,
40ecf2f5 2769 Project => Loaded_Project,
3e7302c3 2770 Packages_To_Check => Packages_To_Check,
c4d67e2d
AC		 2771 Project_File_Name => Get_Name_String (List.Path),
2772 Errout_Handling => Prj.Part.Never_Finalize,
2773 Current_Directory => Get_Name_String (Project.Directory.Name),
2774 Is_Config_File => False,
ab29a348 2775 Env => Child_Env);
c4d67e2d 2776
40ecf2f5 2777 Success := not Prj.Tree.No (Loaded_Project);
c4d67e2d
AC		 2778
2779 if Success then
4528392f
AC		 2780 if Node_Tree.Incomplete_With then
2781 From_Project_Node_Tree.Incomplete_With := True;
2782 end if;
2783
40ecf2f5
EB		 2784 List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
2785 Prj.Initialize (List.Tree);
2786 List.Tree.Shared := In_Tree.Shared;
2787
5415acbd
AC		 2788 -- In aggregate library, aggregated projects are parsed using
2789 -- the aggregate library tree.
2790
2791 if Project.Qualifier = Aggregate_Library then
2792 Tree := In_Tree;
2793 else
2794 Tree := List.Tree;
2795 end if;
2796
40ecf2f5
EB		 2797 -- We can only do the phase 1 of the processing, since we do
2798 -- not have access to the configuration file yet (this is
2799 -- called when doing phase 1 of the processing for the root
2800 -- aggregate project).
2801
2802 if In_Tree.Is_Root_Tree then
2803 Process_Project_Tree_Phase_1
5415acbd 2804 (In_Tree => Tree,
40ecf2f5 2805 Project => List.Project,
3e7302c3 2806 Packages_To_Check => Packages_To_Check,
40ecf2f5
EB		 2807 Success => Success,
2808 From_Project_Node => Loaded_Project,
42ae3870 2809 From_Project_Node_Tree => Node_Tree,
40ecf2f5 2810 Env => Child_Env,
5216b599
AC		 2811 Reset_Tree => False,
2812 On_New_Tree_Loaded => On_New_Tree_Loaded);
40ecf2f5
EB		 2813 else
2814 -- use the same environment as the rest of the aggregated
2815 -- projects, ie the one that was setup by the root aggregate
2816 Process_Project_Tree_Phase_1
5415acbd 2817 (In_Tree => Tree,
40ecf2f5 2818 Project => List.Project,
3e7302c3 2819 Packages_To_Check => Packages_To_Check,
40ecf2f5
EB		 2820 Success => Success,
2821 From_Project_Node => Loaded_Project,
42ae3870 2822 From_Project_Node_Tree => Node_Tree,
40ecf2f5 2823 Env => Env,
5216b599
AC		 2824 Reset_Tree => False,
2825 On_New_Tree_Loaded => On_New_Tree_Loaded);
2826 end if;
2827
2828 if On_New_Tree_Loaded /= null then
2829 On_New_Tree_Loaded
2830 (Node_Tree, Tree, Loaded_Project, List.Project);
40ecf2f5 2831 end if;
86828d40 2832
c4d67e2d
AC		 2833 else
2834 Debug_Output ("Failed to parse", Name_Id (List.Path));
2835 end if;
2836
2837 List := List.Next;
2838 end loop;
2839
2840 Debug_Decrease_Indent ("Done Process_Aggregated_Projects");
2841 end Process_Aggregated_Projects;
2842
2843 ------------------------------
2844 -- Process_Extended_Project --
2845 ------------------------------
2846
2847 procedure Process_Extended_Project is
2848 Extended_Pkg : Package_Id;
2849 Current_Pkg : Package_Id;
2850 Element : Package_Element;
2851 First : constant Package_Id := Project.Decl.Packages;
2852 Attribute1 : Variable_Id;
2853 Attribute2 : Variable_Id;
2854 Attr_Value1 : Variable;
2855 Attr_Value2 : Variable;
2856
2857 begin
2858 Extended_Pkg := Project.Extends.Decl.Packages;
2859 while Extended_Pkg /= No_Package loop
40ecf2f5 2860 Element := Shared.Packages.Table (Extended_Pkg);
c4d67e2d
AC		 2861
2862 Current_Pkg := First;
2863 while Current_Pkg /= No_Package
86828d40
AC		 2864 and then
2865 Shared.Packages.Table (Current_Pkg).Name /= Element.Name
c4d67e2d 2866 loop
40ecf2f5 2867 Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
c4d67e2d
AC		 2868 end loop;
2869
2870 if Current_Pkg = No_Package then
40ecf2f5
EB		 2871 Package_Table.Increment_Last (Shared.Packages);
2872 Current_Pkg := Package_Table.Last (Shared.Packages);
2873 Shared.Packages.Table (Current_Pkg) :=
c4d67e2d
AC		 2874 (Name => Element.Name,
2875 Decl => No_Declarations,
2876 Parent => No_Package,
2877 Next => Project.Decl.Packages);
2878 Project.Decl.Packages := Current_Pkg;
2879 Copy_Package_Declarations
2880 (From => Element.Decl,
40ecf2f5 2881 To => Shared.Packages.Table (Current_Pkg).Decl,
c4d67e2d
AC		 2882 New_Loc => No_Location,
2883 Restricted => True,
40ecf2f5 2884 Shared => Shared);
c4d67e2d
AC		 2885 end if;
2886
2887 Extended_Pkg := Element.Next;
2888 end loop;
2889
e917aec2 2890 -- Check if attribute Languages is declared in the extending project
c4d67e2d
AC		 2891
2892 Attribute1 := Project.Decl.Attributes;
2893 while Attribute1 /= No_Variable loop
40ecf2f5 2894 Attr_Value1 := Shared.Variable_Elements. Table (Attribute1);
c4d67e2d
AC		 2895 exit when Attr_Value1.Name = Snames.Name_Languages;
2896 Attribute1 := Attr_Value1.Next;
2897 end loop;
2898
86828d40 2899 if Attribute1 = No_Variable or else Attr_Value1.Value.Default then
67c86178 2900
e917aec2
RD		 2901 -- Attribute Languages is not declared in the extending project.
2902 -- Check if it is declared in the project being extended.
c4d67e2d
AC		 2903
2904 Attribute2 := Project.Extends.Decl.Attributes;
2905 while Attribute2 /= No_Variable loop
40ecf2f5 2906 Attr_Value2 := Shared.Variable_Elements.Table (Attribute2);
c4d67e2d
AC		 2907 exit when Attr_Value2.Name = Snames.Name_Languages;
2908 Attribute2 := Attr_Value2.Next;
2909 end loop;
2910
86828d40
AC		 2911 if Attribute2 /= No_Variable
2912 and then not Attr_Value2.Value.Default
c4d67e2d 2913 then
e917aec2
RD		 2914 -- As attribute Languages is declared in the project being
2915 -- extended, copy its value for the extending project.
c4d67e2d
AC		 2916
2917 if Attribute1 = No_Variable then
2918 Variable_Element_Table.Increment_Last
40ecf2f5 2919 (Shared.Variable_Elements);
c4d67e2d 2920 Attribute1 := Variable_Element_Table.Last
40ecf2f5 2921 (Shared.Variable_Elements);
c4d67e2d
AC		 2922 Attr_Value1.Next := Project.Decl.Attributes;
2923 Project.Decl.Attributes := Attribute1;
2924 end if;
2925
2926 Attr_Value1.Name := Snames.Name_Languages;
2927 Attr_Value1.Value := Attr_Value2.Value;
40ecf2f5 2928 Shared.Variable_Elements.Table (Attribute1) := Attr_Value1;
c4d67e2d
AC		 2929 end if;
2930 end if;
2931 end Process_Extended_Project;
2932
d9c0e057
AC		 2933 -- Start of processing for Recursive_Process
2934
19235870 2935 begin
4f469be3 2936 if No (From_Project_Node) then
19235870
RK		 2937 Project := No_Project;
2938
2939 else
2940 declare
a76b09dc 2941 Imported, Mark : Project_List;
b5e792e2 2942 Declaration_Node : Project_Node_Id := Empty_Node;
67efd80a 2943
67c86178
AC		 2944 Name : constant Name_Id :=
2945 Name_Of (From_Project_Node, From_Project_Node_Tree);
67efd80a 2946
4528392f
AC		 2947 Display_Name : constant Name_Id :=
2948 Display_Name_Of
2949 (From_Project_Node, From_Project_Node_Tree);
c8b0c260 2950
19235870
RK		 2951 begin
2952 Project := Processed_Projects.Get (Name);
2953
2954 if Project /= No_Project then
d1c5f424 2955
ddd6e5ae
VC		 2956 -- Make sure that, when a project is extended, the project id
2957 -- of the project extending it is recorded in its data, even
2958 -- when it has already been processed as an imported project.
2959 -- This is for virtually extended projects.
2960
2961 if Extended_By /= No_Project then
66713d62 2962 Project.Extended_By := Extended_By;
ddd6e5ae
VC		 2963 end if;
2964
19235870
RK		 2965 return;
2966 end if;
2967
1ebc2612
AC		 2968 -- Check if the project is already in the tree
2969
2970 Project := No_Project;
a18e3d62 2971
1ebc2612
AC		 2972 declare
2973 List : Project_List := In_Tree.Projects;
2974 Path : constant Path_Name_Type :=
2975 Path_Name_Of (From_Project_Node,
2976 From_Project_Node_Tree);
2977
2978 begin
2979 while List /= null loop
2980 if List.Project.Path.Display_Name = Path then
2981 Project := List.Project;
2982 exit;
2983 end if;
2984
2985 List := List.Next;
2986 end loop;
2987 end;
2988
2989 if Project = No_Project then
2990 Project :=
2991 new Project_Data'
2992 (Empty_Project
2993 (Project_Qualifier_Of
2994 (From_Project_Node, From_Project_Node_Tree)));
2995
2996 -- Note that at this point we do not know yet if the project
2997 -- has been withed from an encapsulated library or not.
2998
2999 In_Tree.Projects :=
3000 new Project_List_Element'
3001 (Project => Project,
3002 From_Encapsulated_Lib => False,
3003 Next => In_Tree.Projects);
3004 end if;
a76b09dc
PO		 3005
3006 -- Keep track of this point
3007
3008 Mark := In_Tree.Projects;
66713d62 3009
19235870 3010 Processed_Projects.Set (Name, Project);
07fc65c4 3011
66713d62 3012 Project.Name := Name;
4528392f 3013 Project.Display_Name := Display_Name;
aed24d9d 3014
9596236a
AC		 3015 Get_Name_String (Name);
3016
3017 -- If name starts with the virtual prefix, flag the project as
3018 -- being a virtual extending project.
3019
3020 if Name_Len > Virtual_Prefix'Length
86828d40
AC		 3021 and then
3022 Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix
9596236a 3023 then
66713d62 3024 Project.Virtual := True;
9596236a
AC		 3025 end if;
3026
66713d62 3027 Project.Path.Display_Name :=
7e98a4c6 3028 Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
66713d62 3029 Get_Name_String (Project.Path.Display_Name);
fbf5a39b 3030 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
66713d62 3031 Project.Path.Name := Name_Find;
fbf5a39b 3032
66713d62 3033 Project.Location :=
7e98a4c6 3034 Location_Of (From_Project_Node, From_Project_Node_Tree);
fbf5a39b 3035
66713d62 3036 Project.Directory.Display_Name :=
ede007da 3037 Directory_Of (From_Project_Node, From_Project_Node_Tree);
66713d62 3038 Get_Name_String (Project.Directory.Display_Name);
fbf5a39b 3039 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
66713d62 3040 Project.Directory.Name := Name_Find;
fbf5a39b 3041
66713d62 3042 Project.Extended_By := Extended_By;
07fc65c4 3043
7e98a4c6 3044 Add_Attributes
ede007da
VC		 3045 (Project,
3046 Name,
65f7ed64 3047 Name_Id (Project.Directory.Display_Name),
40ecf2f5 3048 In_Tree.Shared,
66713d62 3049 Project.Decl,
ede007da
VC		 3050 Prj.Attr.Attribute_First,
3051 Project_Level => True);
3052
347ab254 3053 Process_Imported_Projects (Imported, Limited_With => False);
19235870 3054
422e02cf 3055 if Project.Qualifier = Aggregate then
40ecf2f5 3056 Initialize_And_Copy (Child_Env, Copy_From => Env);
d1c5f424 3057
5415acbd 3058 elsif Project.Qualifier = Aggregate_Library then
67c86178 3059
5415acbd 3060 -- The child environment is the same as the current one
67c86178 3061
5415acbd
AC		 3062 Child_Env := Env;
3063
40ecf2f5
EB		 3064 else
3065 -- No need to initialize Child_Env, since it will not be
3066 -- used anyway by Process_Declarative_Items (only the root
3067 -- aggregate can modify it, and it is never read anyway).
d1c5f424 3068
40ecf2f5
EB		 3069 null;
3070 end if;
3071
7e98a4c6
VC		 3072 Declaration_Node :=
3073 Project_Declaration_Of
3074 (From_Project_Node, From_Project_Node_Tree);
19235870
RK		 3075
3076 Recursive_Process
7e98a4c6 3077 (In_Tree => In_Tree,
66713d62 3078 Project => Project.Extends,
3e7302c3
AC		 3079 Packages_To_Check => Packages_To_Check,
3080 From_Project_Node =>
3081 Extended_Project_Of
3082 (Declaration_Node, From_Project_Node_Tree),
7e98a4c6 3083 From_Project_Node_Tree => From_Project_Node_Tree,
4437a530 3084 Env => Env,
a76b09dc 3085 Extended_By => Project,
5216b599
AC		 3086 From_Encapsulated_Lib => From_Encapsulated_Lib,
3087 On_New_Tree_Loaded => On_New_Tree_Loaded);
19235870 3088
19235870 3089 Process_Declarative_Items
7e98a4c6
VC		 3090 (Project => Project,
3091 In_Tree => In_Tree,
3092 From_Project_Node => From_Project_Node,
804fe3c4 3093 Node_Tree => From_Project_Node_Tree,
4437a530 3094 Env => Env,
7e98a4c6 3095 Pkg => No_Package,
a70f5d82 3096 Item => First_Declarative_Item_Of
ab29a348 3097 (Declaration_Node, From_Project_Node_Tree),
40ecf2f5 3098 Child_Env => Child_Env);
19235870 3099
66713d62 3100 if Project.Extends /= No_Project then
c4d67e2d 3101 Process_Extended_Project;
fbf5a39b 3102 end if;
1a5d715a 3103
347ab254 3104 Process_Imported_Projects (Imported, Limited_With => True);
c4d67e2d 3105
ee2ba856 3106 if Total_Errors_Detected = 0 then
75685ef7
PO		 3107 Process_Aggregated_Projects;
3108 end if;
3109
a76b09dc
PO		 3110 -- At this point (after Process_Declarative_Items) we have the
3111 -- attribute values set, we can backtrace In_Tree.Project and
3112 -- set the From_Encapsulated_Library status.
5415acbd 3113
a76b09dc
PO		 3114 declare
3115 Lib_Standalone : constant Prj.Variable_Value :=
3116 Prj.Util.Value_Of
3117 (Snames.Name_Library_Standalone,
3118 Project.Decl.Attributes,
3119 Shared);
3120 List : Project_List := In_Tree.Projects;
3121 Is_Encapsulated : Boolean;
37da997b 3122
a76b09dc
PO		 3123 begin
3124 Get_Name_String (Lib_Standalone.Value);
3125 To_Lower (Name_Buffer (1 .. Name_Len));
5415acbd 3126
a76b09dc
PO		 3127 Is_Encapsulated := Name_Buffer (1 .. Name_Len) = "encapsulated";
3128
3129 if Is_Encapsulated then
3130 while List /= null and then List /= Mark loop
3131 List.From_Encapsulated_Lib := Is_Encapsulated;
3132 List := List.Next;
3133 end loop;
5415acbd 3134 end if;
a76b09dc 3135
ee2ba856 3136 if Total_Errors_Detected = 0 then
a76b09dc
PO		 3137
3138 -- For an aggregate library we add the aggregated projects
3139 -- as imported ones. This is necessary to give visibility
3140 -- to all sources from the aggregates from the aggregated
3141 -- library projects.
3142
3143 if Project.Qualifier = Aggregate_Library then
3144 declare
3145 L : Aggregated_Project_List;
3146 begin
3147 L := Project.Aggregated_Projects;
3148 while L /= null loop
3149 Project.Imported_Projects :=
3150 new Project_List_Element'
3151 (Project => L.Project,
3152 From_Encapsulated_Lib => Is_Encapsulated,
3153 Next =>
3154 Project.Imported_Projects);
3155 L := L.Next;
3156 end loop;
3157 end;
3158 end if;
3159 end if;
3160 end;
40ecf2f5 3161
86828d40 3162 if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
40ecf2f5
EB		 3163 Free (Child_Env);
3164 end if;
19235870
RK		 3165 end;
3166 end if;
3167 end Recursive_Process;
3168
bdafba6f
AC		 3169 -----------------------------
3170 -- Set_Default_Runtime_For --
3171 -----------------------------
3172
3173 procedure Set_Default_Runtime_For (Language : Name_Id; Value : String) is
3174 begin
3175 Name_Len := Value'Length;
3176 Name_Buffer (1 .. Name_Len) := Value;
3177 Runtime_Defaults.Set (Language, Name_Find);
3178 end Set_Default_Runtime_For;
19235870 3179end Prj.Proc;
GNU Compiler Collection
This page took 4.374227 seconds and 5 git commands to generate.