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