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