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