?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2015-03-13 Robert Dewar <dewar@adacore.com>
[official-gcc.git] / gcc / ada / prj-proc.adb
blob57b88c651bf6fe326ad3e9c681d62c932af5166d
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-2015, 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
543 if The_Current_Term /= Empty_Node then
544 Current_Term_Kind :=
545 Kind_Of (The_Current_Term, From_Project_Node_Tree);
546
547 case Current_Term_Kind is
548
549 when N_Literal_String =>
550 case Kind is
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 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_Variable_Reference | N_Attribute_Reference =>
697 declare
698 The_Project : Project_Id := Project;
699 The_Package : Package_Id := Pkg;
700 The_Name : Name_Id := No_Name;
701 The_Variable_Id : Variable_Id := No_Variable;
702 The_Variable : Variable_Value;
703 Term_Project : constant Project_Node_Id :=
704 Project_Node_Of
705 (The_Current_Term,
706 From_Project_Node_Tree);
707 Term_Package : constant Project_Node_Id :=
708 Package_Node_Of
709 (The_Current_Term,
710 From_Project_Node_Tree);
711 Index : Name_Id := No_Name;
712
713 begin
714 <<Object_Dir_Restart>>
715 The_Project := Project;
716 The_Package := Pkg;
717 The_Name := No_Name;
718 The_Variable_Id := No_Variable;
719 Index := No_Name;
720
721 if Present (Term_Project)
722 and then Term_Project /= From_Project_Node
723 then
724 -- This variable or attribute comes from another project
725
726 The_Name :=
727 Name_Of (Term_Project, From_Project_Node_Tree);
728 The_Project := Imported_Or_Extended_Project_From
729 (Project => Project,
730 With_Name => The_Name,
731 No_Extending => True);
732 end if;
733
734 if Present (Term_Package) then
735
736 -- This is an attribute of a package
737
738 The_Name :=
739 Name_Of (Term_Package, From_Project_Node_Tree);
740
741 The_Package := The_Project.Decl.Packages;
742 while The_Package /= No_Package
743 and then Shared.Packages.Table (The_Package).Name /=
744 The_Name
745 loop
746 The_Package :=
747 Shared.Packages.Table (The_Package).Next;
748 end loop;
749
750 pragma Assert
751 (The_Package /= No_Package, "package not found.");
752
753 elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
754 N_Attribute_Reference
755 then
756 The_Package := No_Package;
757 end if;
758
759 The_Name :=
760 Name_Of (The_Current_Term, From_Project_Node_Tree);
761
762 if Current_Term_Kind = N_Attribute_Reference then
763 Index :=
764 Associative_Array_Index_Of
765 (The_Current_Term, From_Project_Node_Tree);
766 end if;
767
768 -- If it is not an associative array attribute
769
770 if Index = No_Name then
771
772 -- It is not an associative array attribute
773
774 if The_Package /= No_Package then
775
776 -- First, if there is a package, look into the package
777
778 if Current_Term_Kind = N_Variable_Reference then
779 The_Variable_Id :=
780 Shared.Packages.Table
781 (The_Package).Decl.Variables;
782 else
783 The_Variable_Id :=
784 Shared.Packages.Table
785 (The_Package).Decl.Attributes;
786 end if;
787
788 while The_Variable_Id /= No_Variable
789 and then Shared.Variable_Elements.Table
790 (The_Variable_Id).Name /= The_Name
791 loop
792 The_Variable_Id :=
793 Shared.Variable_Elements.Table
794 (The_Variable_Id).Next;
795 end loop;
796
797 end if;
798
799 if The_Variable_Id = No_Variable then
800
801 -- If we have not found it, look into the project
802
803 if Current_Term_Kind = N_Variable_Reference then
804 The_Variable_Id := The_Project.Decl.Variables;
805 else
806 The_Variable_Id := The_Project.Decl.Attributes;
807 end if;
808
809 while The_Variable_Id /= No_Variable
810 and then Shared.Variable_Elements.Table
811 (The_Variable_Id).Name /= The_Name
812 loop
813 The_Variable_Id :=
814 Shared.Variable_Elements.Table
815 (The_Variable_Id).Next;
816 end loop;
817
818 end if;
819
820 if From_Project_Node_Tree.Incomplete_With then
821 if The_Variable_Id = No_Variable then
822 The_Variable := Nil_Variable_Value;
823 else
824 The_Variable :=
825 Shared.Variable_Elements.Table
826 (The_Variable_Id).Value;
827 end if;
828
829 else
830 pragma Assert (The_Variable_Id /= No_Variable,
831 "variable or attribute not found");
832
833 The_Variable :=
834 Shared.Variable_Elements.Table
835 (The_Variable_Id).Value;
836 end if;
837
838 else
839
840 -- It is an associative array attribute
841
842 declare
843 The_Array : Array_Id := No_Array;
844 The_Element : Array_Element_Id := No_Array_Element;
845 Array_Index : Name_Id := No_Name;
846
847 begin
848 if The_Package /= No_Package then
849 The_Array :=
850 Shared.Packages.Table (The_Package).Decl.Arrays;
851 else
852 The_Array := The_Project.Decl.Arrays;
853 end if;
854
855 while The_Array /= No_Array
856 and then Shared.Arrays.Table (The_Array).Name /=
857 The_Name
858 loop
859 The_Array := Shared.Arrays.Table (The_Array).Next;
860 end loop;
861
862 if The_Array /= No_Array then
863 The_Element :=
864 Shared.Arrays.Table (The_Array).Value;
865 Array_Index :=
866 Get_Attribute_Index
867 (From_Project_Node_Tree,
868 The_Current_Term,
869 Index);
870
871 while The_Element /= No_Array_Element
872 and then Shared.Array_Elements.Table
873 (The_Element).Index /= Array_Index
874 loop
875 The_Element :=
876 Shared.Array_Elements.Table (The_Element).Next;
877 end loop;
878
879 end if;
880
881 if The_Element /= No_Array_Element then
882 The_Variable :=
883 Shared.Array_Elements.Table (The_Element).Value;
884
885 else
886 if Expression_Kind_Of
887 (The_Current_Term, From_Project_Node_Tree) =
888 List
889 then
890 The_Variable :=
891 (Project => Project,
892 Kind => List,
893 Location => No_Location,
894 Default => True,
895 Values => Nil_String);
896 else
897 The_Variable :=
898 (Project => Project,
899 Kind => Single,
900 Location => No_Location,
901 Default => True,
902 Value => Empty_String,
903 Index => 0);
904 end if;
905 end if;
906 end;
907 end if;
908
909 -- Check the defaults
910
911 if Current_Term_Kind = N_Attribute_Reference then
912 declare
913 The_Default : constant Attribute_Default_Value :=
914 Default_Of
915 (The_Current_Term, From_Project_Node_Tree);
916
917 begin
918 -- Check the special value for 'Target when specified
919
920 if The_Default = Target_Value
921 and then Opt.Target_Origin = Specified
922 then
923 Name_Len := 0;
924 Add_Str_To_Name_Buffer (Opt.Target_Value.all);
925 The_Variable.Value := Name_Find;
926
927 -- Check the defaults
928
929 elsif The_Variable.Default then
930 case The_Variable.Kind is
931
932 when Undefined =>
933 null;
934
935 when Single =>
936 case The_Default is
937 when Read_Only_Value =>
938 null;
939
940 when Empty_Value =>
941 The_Variable.Value := Empty_String;
942
943 when Dot_Value =>
944 The_Variable.Value := Dot_String;
945
946 when Object_Dir_Value =>
947 From_Project_Node_Tree.Project_Nodes.Table
948 (The_Current_Term).Name :=
949 Snames.Name_Object_Dir;
950 From_Project_Node_Tree.Project_Nodes.Table
951 (The_Current_Term).Default :=
952 Dot_Value;
953 goto Object_Dir_Restart;
954
955 when Target_Value =>
956 if Opt.Target_Value = null then
957 The_Variable.Value := Empty_String;
958
959 else
960 Name_Len := 0;
961 Add_Str_To_Name_Buffer
962 (Opt.Target_Value.all);
963 The_Variable.Value := Name_Find;
964 end if;
965
966 when Runtime_Value =>
967 Get_Name_String (Index);
968 To_Lower (Name_Buffer (1 .. Name_Len));
969 The_Variable.Value :=
970 Runtime_Defaults.Get (Name_Find);
971 if The_Variable.Value = No_Name then
972 The_Variable.Value := Empty_String;
973 end if;
974
975 end case;
976
977 when List =>
978 case The_Default is
979 when Read_Only_Value =>
980 null;
981
982 when Empty_Value =>
983 The_Variable.Values := Nil_String;
984
985 when Dot_Value =>
986 The_Variable.Values :=
987 Shared.Dot_String_List;
988
989 when Object_Dir_Value |
990 Target_Value |
991 Runtime_Value =>
992 null;
993 end case;
994 end case;
995 end if;
996 end;
997 end if;
998
999 case Kind is
1000 when Undefined =>
1001
1002 -- Should never happen
1003
1004 pragma Assert (False, "undefined expression kind");
1005 null;
1006
1007 when Single =>
1008 case The_Variable.Kind is
1009
1010 when Undefined =>
1011 null;
1012
1013 when Single =>
1014 Add (Result.Value, The_Variable.Value);
1015
1016 when List =>
1017
1018 -- Should never happen
1019
1020 pragma Assert
1021 (False,
1022 "list cannot appear in single " &
1023 "string expression");
1024 null;
1025 end case;
1026
1027 when List =>
1028 case The_Variable.Kind is
1029
1030 when Undefined =>
1031 null;
1032
1033 when Single =>
1034 String_Element_Table.Increment_Last
1035 (Shared.String_Elements);
1036
1037 if Last = Nil_String then
1038
1039 -- This can happen in an expression such as
1040 -- () & Var
1041
1042 Result.Values :=
1043 String_Element_Table.Last
1044 (Shared.String_Elements);
1045
1046 else
1047 Shared.String_Elements.Table (Last).Next :=
1048 String_Element_Table.Last
1049 (Shared.String_Elements);
1050 end if;
1051
1052 Last :=
1053 String_Element_Table.Last
1054 (Shared.String_Elements);
1055
1056 Shared.String_Elements.Table (Last) :=
1057 (Value => The_Variable.Value,
1058 Display_Value => No_Name,
1059 Location => Location_Of
1060 (The_Current_Term,
1061 From_Project_Node_Tree),
1062 Flag => False,
1063 Next => Nil_String,
1064 Index => 0);
1065
1066 when List =>
1067
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
1285 when Undefined =>
1286 null;
1287
1288 when Single =>
1289 if Ext_List then
1290 null; -- error
1291
1292 else
1293 Add (Result.Value, Value);
1294 end if;
1295
1296 when List =>
1297 if not Ext_List or else Str_List /= null then
1298 String_Element_Table.Increment_Last
1299 (Shared.String_Elements);
1300
1301 if Last = Nil_String then
1302 Result.Values :=
1303 String_Element_Table.Last
1304 (Shared.String_Elements);
1305
1306 else
1307 Shared.String_Elements.Table (Last).Next
1308 := String_Element_Table.Last
1309 (Shared.String_Elements);
1310 end if;
1311
1312 Last := String_Element_Table.Last
1313 (Shared.String_Elements);
1314
1315 if Ext_List then
1316 for Ind in Str_List'Range loop
1317 Name_Len := 0;
1318 Add_Str_To_Name_Buffer (Str_List (Ind).all);
1319 Value := Name_Find;
1320 Shared.String_Elements.Table (Last) :=
1321 (Value => Value,
1322 Display_Value => No_Name,
1323 Location =>
1324 Location_Of
1325 (The_Current_Term,
1326 From_Project_Node_Tree),
1327 Flag => False,
1328 Next => Nil_String,
1329 Index => 0);
1330
1331 if Ind /= Str_List'Last then
1332 String_Element_Table.Increment_Last
1333 (Shared.String_Elements);
1334 Shared.String_Elements.Table (Last).Next :=
1335 String_Element_Table.Last
1336 (Shared.String_Elements);
1337 Last := String_Element_Table.Last
1338 (Shared.String_Elements);
1339 end if;
1340 end loop;
1341
1342 else
1343 Shared.String_Elements.Table (Last) :=
1344 (Value => Value,
1345 Display_Value => No_Name,
1346 Location =>
1347 Location_Of
1348 (The_Current_Term,
1349 From_Project_Node_Tree),
1350 Flag => False,
1351 Next => Nil_String,
1352 Index => 0);
1353 end if;
1354 end if;
1355 end case;
1356 end;
1357
1358 when others =>
1359
1360 -- Should never happen
1361
1362 pragma Assert
1363 (False,
1364 "illegal node kind in an expression");
1365 raise Program_Error;
1366
1367 end case;
1368 end if;
1369
1370 The_Term := Next_Term (The_Term, From_Project_Node_Tree);
1371 end loop;
1372
1373 return Result;
1374 end Expression;
1375
1376 ---------------------------------------
1377 -- Imported_Or_Extended_Project_From --
1378 ---------------------------------------
1379
1380 function Imported_Or_Extended_Project_From
1381 (Project : Project_Id;
1382 With_Name : Name_Id;
1383 No_Extending : Boolean := False) return Project_Id
1384 is
1385 List : Project_List;
1386 Result : Project_Id;
1387 Temp_Result : Project_Id;
1388
1389 begin
1390 -- First check if it is the name of an extended project
1391
1392 Result := Project.Extends;
1393 while Result /= No_Project loop
1394 if Result.Name = With_Name then
1395 return Result;
1396 else
1397 Result := Result.Extends;
1398 end if;
1399 end loop;
1400
1401 -- Then check the name of each imported project
1402
1403 Temp_Result := No_Project;
1404 List := Project.Imported_Projects;
1405 while List /= null loop
1406 Result := List.Project;
1407
1408 -- If the project is directly imported, then returns its ID
1409
1410 if Result.Name = With_Name then
1411 return Result;
1412 end if;
1413
1414 -- If a project extending the project is imported, then keep this
1415 -- extending project as a possibility. It will be the returned ID
1416 -- if the project is not imported directly.
1417
1418 declare
1419 Proj : Project_Id;
1420
1421 begin
1422 Proj := Result.Extends;
1423 while Proj /= No_Project loop
1424 if Proj.Name = With_Name then
1425 if No_Extending then
1426 Temp_Result := Proj;
1427 else
1428 Temp_Result := Result;
1429 end if;
1430
1431 exit;
1432 end if;
1433
1434 Proj := Proj.Extends;
1435 end loop;
1436 end;
1437
1438 List := List.Next;
1439 end loop;
1440
1441 pragma Assert (Temp_Result /= No_Project, "project not found");
1442 return Temp_Result;
1443 end Imported_Or_Extended_Project_From;
1444
1445 ------------------
1446 -- Package_From --
1447 ------------------
1448
1449 function Package_From
1450 (Project : Project_Id;
1451 Shared : Shared_Project_Tree_Data_Access;
1452 With_Name : Name_Id) return Package_Id
1453 is
1454 Result : Package_Id := Project.Decl.Packages;
1455
1456 begin
1457 -- Check the name of each existing package of Project
1458
1459 while Result /= No_Package
1460 and then Shared.Packages.Table (Result).Name /= With_Name
1461 loop
1462 Result := Shared.Packages.Table (Result).Next;
1463 end loop;
1464
1465 if Result = No_Package then
1466
1467 -- Should never happen
1468
1469 Write_Line
1470 ("package """ & Get_Name_String (With_Name) & """ not found");
1471 raise Program_Error;
1472
1473 else
1474 return Result;
1475 end if;
1476 end Package_From;
1477
1478 -------------
1479 -- Process --
1480 -------------
1481
1482 procedure Process
1483 (In_Tree : Project_Tree_Ref;
1484 Project : out Project_Id;
1485 Packages_To_Check : String_List_Access;
1486 Success : out Boolean;
1487 From_Project_Node : Project_Node_Id;
1488 From_Project_Node_Tree : Project_Node_Tree_Ref;
1489 Env : in out Prj.Tree.Environment;
1490 Reset_Tree : Boolean := True;
1491 On_New_Tree_Loaded : Tree_Loaded_Callback := null)
1492 is
1493 begin
1494 Process_Project_Tree_Phase_1
1495 (In_Tree => In_Tree,
1496 Project => Project,
1497 Success => Success,
1498 From_Project_Node => From_Project_Node,
1499 From_Project_Node_Tree => From_Project_Node_Tree,
1500 Env => Env,
1501 Packages_To_Check => Packages_To_Check,
1502 Reset_Tree => Reset_Tree,
1503 On_New_Tree_Loaded => On_New_Tree_Loaded);
1504
1505 if Project_Qualifier_Of
1506 (From_Project_Node, From_Project_Node_Tree) /= Configuration
1507 then
1508 Process_Project_Tree_Phase_2
1509 (In_Tree => In_Tree,
1510 Project => Project,
1511 Success => Success,
1512 From_Project_Node => From_Project_Node,
1513 From_Project_Node_Tree => From_Project_Node_Tree,
1514 Env => Env);
1515 end if;
1516 end Process;
1517
1518 -------------------------------
1519 -- Process_Declarative_Items --
1520 -------------------------------
1521
1522 procedure Process_Declarative_Items
1523 (Project : Project_Id;
1524 In_Tree : Project_Tree_Ref;
1525 From_Project_Node : Project_Node_Id;
1526 Node_Tree : Project_Node_Tree_Ref;
1527 Env : Prj.Tree.Environment;
1528 Pkg : Package_Id;
1529 Item : Project_Node_Id;
1530 Child_Env : in out Prj.Tree.Environment)
1531 is
1532 Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
1533
1534 procedure Check_Or_Set_Typed_Variable
1535 (Value : in out Variable_Value;
1536 Declaration : Project_Node_Id);
1537 -- Check whether Value is valid for this typed variable declaration. If
1538 -- it is an error, the behavior depends on the flags: either an error is
1539 -- reported, or a warning, or nothing. In the last two cases, the value
1540 -- of the variable is set to a valid value, replacing Value.
1541
1542 procedure Process_Package_Declaration
1543 (Current_Item : Project_Node_Id);
1544 procedure Process_Attribute_Declaration
1545 (Current : Project_Node_Id);
1546 procedure Process_Case_Construction
1547 (Current_Item : Project_Node_Id);
1548 procedure Process_Associative_Array
1549 (Current_Item : Project_Node_Id);
1550 procedure Process_Expression
1551 (Current : Project_Node_Id);
1552 procedure Process_Expression_For_Associative_Array
1553 (Current : Project_Node_Id;
1554 New_Value : Variable_Value);
1555 procedure Process_Expression_Variable_Decl
1556 (Current_Item : Project_Node_Id;
1557 New_Value : Variable_Value);
1558 -- Process the various declarative items
1559
1560 ---------------------------------
1561 -- Check_Or_Set_Typed_Variable --
1562 ---------------------------------
1563
1564 procedure Check_Or_Set_Typed_Variable
1565 (Value : in out Variable_Value;
1566 Declaration : Project_Node_Id)
1567 is
1568 Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree);
1569
1570 Reset_Value : Boolean := False;
1571 Current_String : Project_Node_Id;
1572
1573 begin
1574 -- Report an error for an empty string
1575
1576 if Value.Value = Empty_String then
1577 Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);
1578
1579 case Env.Flags.Allow_Invalid_External is
1580 when Error =>
1581 Error_Msg
1582 (Env.Flags, "no value defined for %%", Loc, Project);
1583 when Warning =>
1584 Reset_Value := True;
1585 Error_Msg
1586 (Env.Flags, "?no value defined for %%", Loc, Project);
1587 when Silent =>
1588 Reset_Value := True;
1589 end case;
1590
1591 else
1592 -- Loop through all the valid strings for the
1593 -- string type and compare to the string value.
1594
1595 Current_String :=
1596 First_Literal_String
1597 (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1598
1599 while Present (Current_String)
1600 and then
1601 String_Value_Of (Current_String, Node_Tree) /= Value.Value
1602 loop
1603 Current_String :=
1604 Next_Literal_String (Current_String, Node_Tree);
1605 end loop;
1606
1607 -- Report error if string value is not one for the string type
1608
1609 if No (Current_String) then
1610 Error_Msg_Name_1 := Value.Value;
1611 Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);
1612
1613 case Env.Flags.Allow_Invalid_External is
1614 when Error =>
1615 Error_Msg
1616 (Env.Flags, "value %% is illegal for typed string %%",
1617 Loc, Project);
1618
1619 when Warning =>
1620 Error_Msg
1621 (Env.Flags, "?value %% is illegal for typed string %%",
1622 Loc, Project);
1623 Reset_Value := True;
1624
1625 when Silent =>
1626 Reset_Value := True;
1627 end case;
1628 end if;
1629 end if;
1630
1631 if Reset_Value then
1632 Current_String :=
1633 First_Literal_String
1634 (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1635 Value.Value := String_Value_Of (Current_String, Node_Tree);
1636 end if;
1637 end Check_Or_Set_Typed_Variable;
1638
1639 ---------------------------------
1640 -- Process_Package_Declaration --
1641 ---------------------------------
1642
1643 procedure Process_Package_Declaration
1644 (Current_Item : Project_Node_Id)
1645 is
1646 begin
1647 -- Do not process a package declaration that should be ignored
1648
1649 if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then
1650
1651 -- Create the new package
1652
1653 Package_Table.Increment_Last (Shared.Packages);
1654
1655 declare
1656 New_Pkg : constant Package_Id :=
1657 Package_Table.Last (Shared.Packages);
1658 The_New_Package : Package_Element;
1659
1660 Project_Of_Renamed_Package : constant Project_Node_Id :=
1661 Project_Of_Renamed_Package_Of
1662 (Current_Item, Node_Tree);
1663
1664 begin
1665 -- Set the name of the new package
1666
1667 The_New_Package.Name := Name_Of (Current_Item, Node_Tree);
1668
1669 -- Insert the new package in the appropriate list
1670
1671 if Pkg /= No_Package then
1672 The_New_Package.Next :=
1673 Shared.Packages.Table (Pkg).Decl.Packages;
1674 Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg;
1675
1676 else
1677 The_New_Package.Next := Project.Decl.Packages;
1678 Project.Decl.Packages := New_Pkg;
1679 end if;
1680
1681 Shared.Packages.Table (New_Pkg) := The_New_Package;
1682
1683 if Present (Project_Of_Renamed_Package) then
1684
1685 -- Renamed or extending package
1686
1687 declare
1688 Project_Name : constant Name_Id :=
1689 Name_Of (Project_Of_Renamed_Package,
1690 Node_Tree);
1691
1692 Renamed_Project : constant Project_Id :=
1693 Imported_Or_Extended_Project_From
1694 (Project, Project_Name);
1695
1696 Renamed_Package : constant Package_Id :=
1697 Package_From
1698 (Renamed_Project, Shared,
1699 Name_Of (Current_Item, Node_Tree));
1700
1701 begin
1702 -- For a renamed package, copy the declarations of the
1703 -- renamed package, but set all the locations to the
1704 -- location of the package name in the renaming
1705 -- declaration.
1706
1707 Copy_Package_Declarations
1708 (From => Shared.Packages.Table
1709 (Renamed_Package).Decl,
1710 To => Shared.Packages.Table (New_Pkg).Decl,
1711 New_Loc => Location_Of (Current_Item, Node_Tree),
1712 Restricted => False,
1713 Shared => Shared);
1714 end;
1715
1716 else
1717 -- Set the default values of the attributes
1718
1719 Add_Attributes
1720 (Project,
1721 Project.Name,
1722 Name_Id (Project.Directory.Display_Name),
1723 Shared,
1724 Shared.Packages.Table (New_Pkg).Decl,
1725 First_Attribute_Of
1726 (Package_Id_Of (Current_Item, Node_Tree)),
1727 Project_Level => False);
1728 end if;
1729
1730 -- Process declarative items (nothing to do when the package is
1731 -- renaming, as the first declarative item is null).
1732
1733 Process_Declarative_Items
1734 (Project => Project,
1735 In_Tree => In_Tree,
1736 From_Project_Node => From_Project_Node,
1737 Node_Tree => Node_Tree,
1738 Env => Env,
1739 Pkg => New_Pkg,
1740 Item =>
1741 First_Declarative_Item_Of (Current_Item, Node_Tree),
1742 Child_Env => Child_Env);
1743 end;
1744 end if;
1745 end Process_Package_Declaration;
1746
1747 -------------------------------
1748 -- Process_Associative_Array --
1749 -------------------------------
1750
1751 procedure Process_Associative_Array
1752 (Current_Item : Project_Node_Id)
1753 is
1754 Current_Item_Name : constant Name_Id :=
1755 Name_Of (Current_Item, Node_Tree);
1756 -- The name of the attribute
1757
1758 Current_Location : constant Source_Ptr :=
1759 Location_Of (Current_Item, Node_Tree);
1760
1761 New_Array : Array_Id;
1762 -- The new associative array created
1763
1764 Orig_Array : Array_Id;
1765 -- The associative array value
1766
1767 Orig_Project_Name : Name_Id := No_Name;
1768 -- The name of the project where the associative array
1769 -- value is.
1770
1771 Orig_Project : Project_Id := No_Project;
1772 -- The id of the project where the associative array
1773 -- value is.
1774
1775 Orig_Package_Name : Name_Id := No_Name;
1776 -- The name of the package, if any, where the associative array value
1777 -- is located.
1778
1779 Orig_Package : Package_Id := No_Package;
1780 -- The id of the package, if any, where the associative array value
1781 -- is located.
1782
1783 New_Element : Array_Element_Id := No_Array_Element;
1784 -- Id of a new array element created
1785
1786 Prev_Element : Array_Element_Id := No_Array_Element;
1787 -- Last new element id created
1788
1789 Orig_Element : Array_Element_Id := No_Array_Element;
1790 -- Current array element in original associative array
1791
1792 Next_Element : Array_Element_Id := No_Array_Element;
1793 -- Id of the array element that follows the new element. This is not
1794 -- always nil, because values for the associative array attribute may
1795 -- already have been declared, and the array elements declared are
1796 -- reused.
1797
1798 Prj : Project_List;
1799
1800 begin
1801 -- First find if the associative array attribute already has elements
1802 -- declared.
1803
1804 if Pkg /= No_Package then
1805 New_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
1806 else
1807 New_Array := Project.Decl.Arrays;
1808 end if;
1809
1810 while New_Array /= No_Array
1811 and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name
1812 loop
1813 New_Array := Shared.Arrays.Table (New_Array).Next;
1814 end loop;
1815
1816 -- If the attribute has never been declared add new entry in the
1817 -- arrays of the project/package and link it.
1818
1819 if New_Array = No_Array then
1820 Array_Table.Increment_Last (Shared.Arrays);
1821 New_Array := Array_Table.Last (Shared.Arrays);
1822
1823 if Pkg /= No_Package then
1824 Shared.Arrays.Table (New_Array) :=
1825 (Name => Current_Item_Name,
1826 Location => Current_Location,
1827 Value => No_Array_Element,
1828 Next => Shared.Packages.Table (Pkg).Decl.Arrays);
1829
1830 Shared.Packages.Table (Pkg).Decl.Arrays := New_Array;
1831
1832 else
1833 Shared.Arrays.Table (New_Array) :=
1834 (Name => Current_Item_Name,
1835 Location => Current_Location,
1836 Value => No_Array_Element,
1837 Next => Project.Decl.Arrays);
1838
1839 Project.Decl.Arrays := New_Array;
1840 end if;
1841 end if;
1842
1843 -- Find the project where the value is declared
1844
1845 Orig_Project_Name :=
1846 Name_Of
1847 (Associative_Project_Of (Current_Item, Node_Tree), Node_Tree);
1848
1849 Prj := In_Tree.Projects;
1850 while Prj /= null loop
1851 if Prj.Project.Name = Orig_Project_Name then
1852 Orig_Project := Prj.Project;
1853 exit;
1854 end if;
1855 Prj := Prj.Next;
1856 end loop;
1857
1858 pragma Assert (Orig_Project /= No_Project,
1859 "original project not found");
1860
1861 if No (Associative_Package_Of (Current_Item, Node_Tree)) then
1862 Orig_Array := Orig_Project.Decl.Arrays;
1863
1864 else
1865 -- If in a package, find the package where the value is declared
1866
1867 Orig_Package_Name :=
1868 Name_Of
1869 (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree);
1870
1871 Orig_Package := Orig_Project.Decl.Packages;
1872 pragma Assert (Orig_Package /= No_Package,
1873 "original package not found");
1874
1875 while Shared.Packages.Table
1876 (Orig_Package).Name /= Orig_Package_Name
1877 loop
1878 Orig_Package := Shared.Packages.Table (Orig_Package).Next;
1879 pragma Assert (Orig_Package /= No_Package,
1880 "original package not found");
1881 end loop;
1882
1883 Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays;
1884 end if;
1885
1886 -- Now look for the array
1887
1888 while Orig_Array /= No_Array
1889 and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name
1890 loop
1891 Orig_Array := Shared.Arrays.Table (Orig_Array).Next;
1892 end loop;
1893
1894 if Orig_Array = No_Array then
1895 Error_Msg
1896 (Env.Flags,
1897 "associative array value not found",
1898 Location_Of (Current_Item, Node_Tree),
1899 Project);
1900
1901 else
1902 Orig_Element := Shared.Arrays.Table (Orig_Array).Value;
1903
1904 -- Copy each array element
1905
1906 while Orig_Element /= No_Array_Element loop
1907
1908 -- Case of first element
1909
1910 if Prev_Element = No_Array_Element then
1911
1912 -- And there is no array element declared yet, create a new
1913 -- first array element.
1914
1915 if Shared.Arrays.Table (New_Array).Value =
1916 No_Array_Element
1917 then
1918 Array_Element_Table.Increment_Last
1919 (Shared.Array_Elements);
1920 New_Element := Array_Element_Table.Last
1921 (Shared.Array_Elements);
1922 Shared.Arrays.Table (New_Array).Value := New_Element;
1923 Next_Element := No_Array_Element;
1924
1925 -- Otherwise, the new element is the first
1926
1927 else
1928 New_Element := Shared.Arrays.Table (New_Array).Value;
1929 Next_Element :=
1930 Shared.Array_Elements.Table (New_Element).Next;
1931 end if;
1932
1933 -- Otherwise, reuse an existing element, or create
1934 -- one if necessary.
1935
1936 else
1937 Next_Element :=
1938 Shared.Array_Elements.Table (Prev_Element).Next;
1939
1940 if Next_Element = No_Array_Element then
1941 Array_Element_Table.Increment_Last
1942 (Shared.Array_Elements);
1943 New_Element := Array_Element_Table.Last
1944 (Shared.Array_Elements);
1945 Shared.Array_Elements.Table (Prev_Element).Next :=
1946 New_Element;
1947
1948 else
1949 New_Element := Next_Element;
1950 Next_Element :=
1951 Shared.Array_Elements.Table (New_Element).Next;
1952 end if;
1953 end if;
1954
1955 -- Copy the value of the element
1956
1957 Shared.Array_Elements.Table (New_Element) :=
1958 Shared.Array_Elements.Table (Orig_Element);
1959 Shared.Array_Elements.Table (New_Element).Value.Project
1960 := Project;
1961
1962 -- Adjust the Next link
1963
1964 Shared.Array_Elements.Table (New_Element).Next := Next_Element;
1965
1966 -- Adjust the previous id for the next element
1967
1968 Prev_Element := New_Element;
1969
1970 -- Go to the next element in the original array
1971
1972 Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next;
1973 end loop;
1974
1975 -- Make sure that the array ends here, in case there previously a
1976 -- greater number of elements.
1977
1978 Shared.Array_Elements.Table (New_Element).Next := No_Array_Element;
1979 end if;
1980 end Process_Associative_Array;
1981
1982 ----------------------------------------------
1983 -- Process_Expression_For_Associative_Array --
1984 ----------------------------------------------
1985
1986 procedure Process_Expression_For_Associative_Array
1987 (Current : Project_Node_Id;
1988 New_Value : Variable_Value)
1989 is
1990 Name : constant Name_Id := Name_Of (Current, Node_Tree);
1991 Current_Location : constant Source_Ptr :=
1992 Location_Of (Current, Node_Tree);
1993
1994 Index_Name : Name_Id :=
1995 Associative_Array_Index_Of (Current, Node_Tree);
1996
1997 Source_Index : constant Int :=
1998 Source_Index_Of (Current, Node_Tree);
1999
2000 The_Array : Array_Id;
2001 Elem : Array_Element_Id := No_Array_Element;
2002
2003 begin
2004 if Index_Name /= All_Other_Names then
2005 Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name);
2006 end if;
2007
2008 -- Look for the array in the appropriate list
2009
2010 if Pkg /= No_Package then
2011 The_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
2012 else
2013 The_Array := Project.Decl.Arrays;
2014 end if;
2015
2016 while The_Array /= No_Array
2017 and then Shared.Arrays.Table (The_Array).Name /= Name
2018 loop
2019 The_Array := Shared.Arrays.Table (The_Array).Next;
2020 end loop;
2021
2022 -- If the array cannot be found, create a new entry in the list.
2023 -- As The_Array_Element is initialized to No_Array_Element, a new
2024 -- element will be created automatically later
2025
2026 if The_Array = No_Array then
2027 Array_Table.Increment_Last (Shared.Arrays);
2028 The_Array := Array_Table.Last (Shared.Arrays);
2029
2030 if Pkg /= No_Package then
2031 Shared.Arrays.Table (The_Array) :=
2032 (Name => Name,
2033 Location => Current_Location,
2034 Value => No_Array_Element,
2035 Next => Shared.Packages.Table (Pkg).Decl.Arrays);
2036
2037 Shared.Packages.Table (Pkg).Decl.Arrays := The_Array;
2038
2039 else
2040 Shared.Arrays.Table (The_Array) :=
2041 (Name => Name,
2042 Location => Current_Location,
2043 Value => No_Array_Element,
2044 Next => Project.Decl.Arrays);
2045
2046 Project.Decl.Arrays := The_Array;
2047 end if;
2048
2049 else
2050 Elem := Shared.Arrays.Table (The_Array).Value;
2051 end if;
2052
2053 -- Look in the list, if any, to find an element with the same index
2054 -- and same source index.
2055
2056 while Elem /= No_Array_Element
2057 and then
2058 (Shared.Array_Elements.Table (Elem).Index /= Index_Name
2059 or else
2060 Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index)
2061 loop
2062 Elem := Shared.Array_Elements.Table (Elem).Next;
2063 end loop;
2064
2065 -- If no such element were found, create a new one
2066 -- and insert it in the element list, with the
2067 -- proper value.
2068
2069 if Elem = No_Array_Element then
2070 Array_Element_Table.Increment_Last (Shared.Array_Elements);
2071 Elem := Array_Element_Table.Last (Shared.Array_Elements);
2072
2073 Shared.Array_Elements.Table
2074 (Elem) :=
2075 (Index => Index_Name,
2076 Restricted => False,
2077 Src_Index => Source_Index,
2078 Index_Case_Sensitive =>
2079 not Case_Insensitive (Current, Node_Tree),
2080 Value => New_Value,
2081 Next => Shared.Arrays.Table (The_Array).Value);
2082
2083 Shared.Arrays.Table (The_Array).Value := Elem;
2084
2085 else
2086 -- An element with the same index already exists, just replace its
2087 -- value with the new one.
2088
2089 Shared.Array_Elements.Table (Elem).Value := New_Value;
2090 end if;
2091
2092 if Name = Snames.Name_External then
2093 if In_Tree.Is_Root_Tree then
2094 Add (Child_Env.External,
2095 External_Name => Get_Name_String (Index_Name),
2096 Value => Get_Name_String (New_Value.Value),
2097 Source => From_External_Attribute);
2098 Add (Env.External,
2099 External_Name => Get_Name_String (Index_Name),
2100 Value => Get_Name_String (New_Value.Value),
2101 Source => From_External_Attribute,
2102 Silent => True);
2103 else
2104 if Current_Verbosity = High then
2105 Debug_Output
2106 ("'for External' has no effect except in root aggregate ("
2107 & Get_Name_String (Index_Name) & ")", New_Value.Value);
2108 end if;
2109 end if;
2110 end if;
2111 end Process_Expression_For_Associative_Array;
2112
2113 --------------------------------------
2114 -- Process_Expression_Variable_Decl --
2115 --------------------------------------
2116
2117 procedure Process_Expression_Variable_Decl
2118 (Current_Item : Project_Node_Id;
2119 New_Value : Variable_Value)
2120 is
2121 Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);
2122
2123 Is_Attribute : constant Boolean :=
2124 Kind_Of (Current_Item, Node_Tree) =
2125 N_Attribute_Declaration;
2126
2127 Var : Variable_Id := No_Variable;
2128
2129 begin
2130 -- First, find the list where to find the variable or attribute
2131
2132 if Is_Attribute then
2133 if Pkg /= No_Package then
2134 Var := Shared.Packages.Table (Pkg).Decl.Attributes;
2135 else
2136 Var := Project.Decl.Attributes;
2137 end if;
2138
2139 else
2140 if Pkg /= No_Package then
2141 Var := Shared.Packages.Table (Pkg).Decl.Variables;
2142 else
2143 Var := Project.Decl.Variables;
2144 end if;
2145 end if;
2146
2147 -- Loop through the list, to find if it has already been declared
2148
2149 while Var /= No_Variable
2150 and then Shared.Variable_Elements.Table (Var).Name /= Name
2151 loop
2152 Var := Shared.Variable_Elements.Table (Var).Next;
2153 end loop;
2154
2155 -- If it has not been declared, create a new entry in the list
2156
2157 if Var = No_Variable then
2158
2159 -- All single string attribute should already have been declared
2160 -- with a default empty string value.
2161
2162 pragma Assert
2163 (not Is_Attribute,
2164 "illegal attribute declaration for " & Get_Name_String (Name));
2165
2166 Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
2167 Var := Variable_Element_Table.Last (Shared.Variable_Elements);
2168
2169 -- Put the new variable in the appropriate list
2170
2171 if Pkg /= No_Package then
2172 Shared.Variable_Elements.Table (Var) :=
2173 (Next => Shared.Packages.Table (Pkg).Decl.Variables,
2174 Name => Name,
2175 Value => New_Value);
2176 Shared.Packages.Table (Pkg).Decl.Variables := Var;
2177
2178 else
2179 Shared.Variable_Elements.Table (Var) :=
2180 (Next => Project.Decl.Variables,
2181 Name => Name,
2182 Value => New_Value);
2183 Project.Decl.Variables := Var;
2184 end if;
2185
2186 -- If the variable/attribute has already been declared, just
2187 -- change the value.
2188
2189 else
2190 Shared.Variable_Elements.Table (Var).Value := New_Value;
2191 end if;
2192
2193 if Is_Attribute and then Name = Snames.Name_Project_Path then
2194 if In_Tree.Is_Root_Tree then
2195 declare
2196 package Name_Ids is
2197 new Ada.Containers.Vectors (Positive, Name_Id);
2198 Val : String_List_Id := New_Value.Values;
2199 List : Name_Ids.Vector;
2200 begin
2201 -- Get all values
2202
2203 while Val /= Nil_String loop
2204 List.Prepend
2205 (Shared.String_Elements.Table (Val).Value);
2206 Val := Shared.String_Elements.Table (Val).Next;
2207 end loop;
2208
2209 -- Prepend them in the order found in the attribute
2210
2211 for K in Positive range 1 .. Positive (List.Length) loop
2212 Prj.Env.Add_Directories
2213 (Child_Env.Project_Path,
2214 Normalize_Pathname
2215 (Name => Get_Name_String
2216 (List.Element (K)),
2217 Directory => Get_Name_String
2218 (Project.Directory.Display_Name)),
2219 Prepend => True);
2220 end loop;
2221 end;
2222
2223 else
2224 if Current_Verbosity = High then
2225 Debug_Output
2226 ("'for Project_Path' has no effect except in"
2227 & " root aggregate");
2228 end if;
2229 end if;
2230 end if;
2231 end Process_Expression_Variable_Decl;
2232
2233 ------------------------
2234 -- Process_Expression --
2235 ------------------------
2236
2237 procedure Process_Expression (Current : Project_Node_Id) is
2238 New_Value : Variable_Value :=
2239 Expression
2240 (Project => Project,
2241 Shared => Shared,
2242 From_Project_Node => From_Project_Node,
2243 From_Project_Node_Tree => Node_Tree,
2244 Env => Env,
2245 Pkg => Pkg,
2246 First_Term =>
2247 Tree.First_Term
2248 (Expression_Of (Current, Node_Tree), Node_Tree),
2249 Kind =>
2250 Expression_Kind_Of (Current, Node_Tree));
2251
2252 begin
2253 -- Process a typed variable declaration
2254
2255 if Kind_Of (Current, Node_Tree) = N_Typed_Variable_Declaration then
2256 Check_Or_Set_Typed_Variable (New_Value, Current);
2257 end if;
2258
2259 if Kind_Of (Current, Node_Tree) /= N_Attribute_Declaration
2260 or else Associative_Array_Index_Of (Current, Node_Tree) = No_Name
2261 then
2262 Process_Expression_Variable_Decl (Current, New_Value);
2263 else
2264 Process_Expression_For_Associative_Array (Current, New_Value);
2265 end if;
2266 end Process_Expression;
2267
2268 -----------------------------------
2269 -- Process_Attribute_Declaration --
2270 -----------------------------------
2271
2272 procedure Process_Attribute_Declaration (Current : Project_Node_Id) is
2273 begin
2274 if Expression_Of (Current, Node_Tree) = Empty_Node then
2275 Process_Associative_Array (Current);
2276 else
2277 Process_Expression (Current);
2278 end if;
2279 end Process_Attribute_Declaration;
2280
2281 -------------------------------
2282 -- Process_Case_Construction --
2283 -------------------------------
2284
2285 procedure Process_Case_Construction
2286 (Current_Item : Project_Node_Id)
2287 is
2288 The_Project : Project_Id := Project;
2289 -- The id of the project of the case variable
2290
2291 The_Package : Package_Id := Pkg;
2292 -- The id of the package, if any, of the case variable
2293
2294 The_Variable : Variable_Value := Nil_Variable_Value;
2295 -- The case variable
2296
2297 Case_Value : Name_Id := No_Name;
2298 -- The case variable value
2299
2300 Case_Item : Project_Node_Id := Empty_Node;
2301 Choice_String : Project_Node_Id := Empty_Node;
2302 Decl_Item : Project_Node_Id := Empty_Node;
2303
2304 begin
2305 declare
2306 Variable_Node : constant Project_Node_Id :=
2307 Case_Variable_Reference_Of
2308 (Current_Item,
2309 Node_Tree);
2310
2311 Var_Id : Variable_Id := No_Variable;
2312 Name : Name_Id := No_Name;
2313
2314 begin
2315 -- If a project was specified for the case variable, get its id
2316
2317 if Present (Project_Node_Of (Variable_Node, Node_Tree)) then
2318 Name :=
2319 Name_Of
2320 (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2321 The_Project :=
2322 Imported_Or_Extended_Project_From
2323 (Project, Name, No_Extending => True);
2324 The_Package := No_Package;
2325 end if;
2326
2327 -- If a package was specified for the case variable, get its id
2328
2329 if Present (Package_Node_Of (Variable_Node, Node_Tree)) then
2330 Name :=
2331 Name_Of
2332 (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2333 The_Package := Package_From (The_Project, Shared, Name);
2334 end if;
2335
2336 Name := Name_Of (Variable_Node, Node_Tree);
2337
2338 -- First, look for the case variable into the package, if any
2339
2340 if The_Package /= No_Package then
2341 Name := Name_Of (Variable_Node, Node_Tree);
2342
2343 Var_Id := Shared.Packages.Table (The_Package).Decl.Variables;
2344 while Var_Id /= No_Variable
2345 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
2346 loop
2347 Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
2348 end loop;
2349 end if;
2350
2351 -- If not found in the package, or if there is no package, look at
2352 -- the project level.
2353
2354 if Var_Id = No_Variable
2355 and then No (Package_Node_Of (Variable_Node, Node_Tree))
2356 then
2357 Var_Id := The_Project.Decl.Variables;
2358 while Var_Id /= No_Variable
2359 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
2360 loop
2361 Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
2362 end loop;
2363 end if;
2364
2365 if Var_Id = No_Variable then
2366 if Node_Tree.Incomplete_With then
2367 return;
2368
2369 -- Should never happen, because this has already been checked
2370 -- during parsing.
2371
2372 else
2373 Write_Line
2374 ("variable """ & Get_Name_String (Name) & """ not found");
2375 raise Program_Error;
2376 end if;
2377 end if;
2378
2379 -- Get the case variable
2380
2381 The_Variable := Shared.Variable_Elements. Table (Var_Id).Value;
2382
2383 if The_Variable.Kind /= Single then
2384
2385 -- Should never happen, because this has already been checked
2386 -- during parsing.
2387
2388 Write_Line ("variable""" & Get_Name_String (Name) &
2389 """ is not a single string variable");
2390 raise Program_Error;
2391 end if;
2392
2393 -- Get the case variable value
2394
2395 Case_Value := The_Variable.Value;
2396 end;
2397
2398 -- Now look into all the case items of the case construction
2399
2400 Case_Item := First_Case_Item_Of (Current_Item, Node_Tree);
2401
2402 Case_Item_Loop :
2403 while Present (Case_Item) loop
2404 Choice_String := First_Choice_Of (Case_Item, Node_Tree);
2405
2406 -- When Choice_String is nil, it means that it is the
2407 -- "when others =>" alternative.
2408
2409 if No (Choice_String) then
2410 Decl_Item := First_Declarative_Item_Of (Case_Item, Node_Tree);
2411 exit Case_Item_Loop;
2412 end if;
2413
2414 -- Look into all the alternative of this case item
2415
2416 Choice_Loop :
2417 while Present (Choice_String) loop
2418 if Case_Value = String_Value_Of (Choice_String, Node_Tree) then
2419 Decl_Item :=
2420 First_Declarative_Item_Of (Case_Item, Node_Tree);
2421 exit Case_Item_Loop;
2422 end if;
2423
2424 Choice_String := Next_Literal_String (Choice_String, Node_Tree);
2425 end loop Choice_Loop;
2426
2427 Case_Item := Next_Case_Item (Case_Item, Node_Tree);
2428 end loop Case_Item_Loop;
2429
2430 -- If there is an alternative, then we process it
2431
2432 if Present (Decl_Item) then
2433 Process_Declarative_Items
2434 (Project => Project,
2435 In_Tree => In_Tree,
2436 From_Project_Node => From_Project_Node,
2437 Node_Tree => Node_Tree,
2438 Env => Env,
2439 Pkg => Pkg,
2440 Item => Decl_Item,
2441 Child_Env => Child_Env);
2442 end if;
2443 end Process_Case_Construction;
2444
2445 -- Local variables
2446
2447 Current, Decl : Project_Node_Id;
2448 Kind : Project_Node_Kind;
2449
2450 -- Start of processing for Process_Declarative_Items
2451
2452 begin
2453 Decl := Item;
2454 while Present (Decl) loop
2455 Current := Current_Item_Node (Decl, Node_Tree);
2456 Decl := Next_Declarative_Item (Decl, Node_Tree);
2457 Kind := Kind_Of (Current, Node_Tree);
2458
2459 case Kind is
2460 when N_Package_Declaration =>
2461 Process_Package_Declaration (Current);
2462
2463 -- Nothing to process for string type declaration
2464
2465 when N_String_Type_Declaration =>
2466 null;
2467
2468 when N_Attribute_Declaration |
2469 N_Typed_Variable_Declaration |
2470 N_Variable_Declaration =>
2471 Process_Attribute_Declaration (Current);
2472
2473 when N_Case_Construction =>
2474 Process_Case_Construction (Current);
2475
2476 when others =>
2477 Write_Line ("Illegal declarative item: " & Kind'Img);
2478 raise Program_Error;
2479 end case;
2480 end loop;
2481 end Process_Declarative_Items;
2482
2483 ----------------------------------
2484 -- Process_Project_Tree_Phase_1 --
2485 ----------------------------------
2486
2487 procedure Process_Project_Tree_Phase_1
2488 (In_Tree : Project_Tree_Ref;
2489 Project : out Project_Id;
2490 Packages_To_Check : String_List_Access;
2491 Success : out Boolean;
2492 From_Project_Node : Project_Node_Id;
2493 From_Project_Node_Tree : Project_Node_Tree_Ref;
2494 Env : in out Prj.Tree.Environment;
2495 Reset_Tree : Boolean := True;
2496 On_New_Tree_Loaded : Tree_Loaded_Callback := null)
2497 is
2498 begin
2499 if Reset_Tree then
2500
2501 -- Make sure there are no projects in the data structure
2502
2503 Free_List (In_Tree.Projects, Free_Project => True);
2504 end if;
2505
2506 Processed_Projects.Reset;
2507
2508 -- And process the main project and all of the projects it depends on,
2509 -- recursively.
2510
2511 Debug_Increase_Indent ("Process tree, phase 1");
2512
2513 Recursive_Process
2514 (Project => Project,
2515 In_Tree => In_Tree,
2516 Packages_To_Check => Packages_To_Check,
2517 From_Project_Node => From_Project_Node,
2518 From_Project_Node_Tree => From_Project_Node_Tree,
2519 Env => Env,
2520 Extended_By => No_Project,
2521 From_Encapsulated_Lib => False,
2522 On_New_Tree_Loaded => On_New_Tree_Loaded);
2523
2524 Success :=
2525 Total_Errors_Detected = 0
2526 and then
2527 (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2528
2529 if Current_Verbosity = High then
2530 Debug_Decrease_Indent
2531 ("Done Process tree, phase 1, Success=" & Success'Img);
2532 end if;
2533 end Process_Project_Tree_Phase_1;
2534
2535 ----------------------------------
2536 -- Process_Project_Tree_Phase_2 --
2537 ----------------------------------
2538
2539 procedure Process_Project_Tree_Phase_2
2540 (In_Tree : Project_Tree_Ref;
2541 Project : Project_Id;
2542 Success : out Boolean;
2543 From_Project_Node : Project_Node_Id;
2544 From_Project_Node_Tree : Project_Node_Tree_Ref;
2545 Env : Environment)
2546 is
2547 Obj_Dir : Path_Name_Type;
2548 Extending : Project_Id;
2549 Extending2 : Project_Id;
2550 Prj : Project_List;
2551
2552 -- Start of processing for Process_Project_Tree_Phase_2
2553
2554 begin
2555 Success := True;
2556
2557 Debug_Increase_Indent ("Process tree, phase 2", Project.Name);
2558
2559 if Project /= No_Project then
2560 Check (In_Tree, Project, From_Project_Node_Tree, Env.Flags);
2561 end if;
2562
2563 -- If main project is an extending all project, set object directory of
2564 -- all virtual extending projects to object directory of main project.
2565
2566 if Project /= No_Project
2567 and then Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
2568 then
2569 declare
2570 Object_Dir : constant Path_Information := Project.Object_Directory;
2571
2572 begin
2573 Prj := In_Tree.Projects;
2574 while Prj /= null loop
2575 if Prj.Project.Virtual then
2576 Prj.Project.Object_Directory := Object_Dir;
2577 end if;
2578
2579 Prj := Prj.Next;
2580 end loop;
2581 end;
2582 end if;
2583
2584 -- Check that no extending project shares its object directory with
2585 -- the project(s) it extends.
2586
2587 if Project /= No_Project then
2588 Prj := In_Tree.Projects;
2589 while Prj /= null loop
2590 Extending := Prj.Project.Extended_By;
2591
2592 if Extending /= No_Project then
2593 Obj_Dir := Prj.Project.Object_Directory.Name;
2594
2595 -- Check that a project being extended does not share its
2596 -- object directory with any project that extends it, directly
2597 -- or indirectly, including a virtual extending project.
2598
2599 -- Start with the project directly extending it
2600
2601 Extending2 := Extending;
2602 while Extending2 /= No_Project loop
2603 if Has_Ada_Sources (Extending2)
2604 and then Extending2.Object_Directory.Name = Obj_Dir
2605 then
2606 if Extending2.Virtual then
2607 Error_Msg_Name_1 := Prj.Project.Display_Name;
2608 Error_Msg
2609 (Env.Flags,
2610 "project %% cannot be extended by a virtual" &
2611 " project with the same object directory",
2612 Prj.Project.Location, Project);
2613
2614 else
2615 Error_Msg_Name_1 := Extending2.Display_Name;
2616 Error_Msg_Name_2 := Prj.Project.Display_Name;
2617 Error_Msg
2618 (Env.Flags,
2619 "project %% cannot extend project %%",
2620 Extending2.Location, Project);
2621 Error_Msg
2622 (Env.Flags,
2623 "\they share the same object directory",
2624 Extending2.Location, Project);
2625 end if;
2626 end if;
2627
2628 -- Continue with the next extending project, if any
2629
2630 Extending2 := Extending2.Extended_By;
2631 end loop;
2632 end if;
2633
2634 Prj := Prj.Next;
2635 end loop;
2636 end if;
2637
2638 Debug_Decrease_Indent ("Done Process tree, phase 2");
2639
2640 Success := Total_Errors_Detected = 0
2641 and then
2642 (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2643 end Process_Project_Tree_Phase_2;
2644
2645 -----------------------
2646 -- Recursive_Process --
2647 -----------------------
2648
2649 procedure Recursive_Process
2650 (In_Tree : Project_Tree_Ref;
2651 Project : out Project_Id;
2652 Packages_To_Check : String_List_Access;
2653 From_Project_Node : Project_Node_Id;
2654 From_Project_Node_Tree : Project_Node_Tree_Ref;
2655 Env : in out Prj.Tree.Environment;
2656 Extended_By : Project_Id;
2657 From_Encapsulated_Lib : Boolean;
2658 On_New_Tree_Loaded : Tree_Loaded_Callback := null)
2659 is
2660 Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
2661
2662 Child_Env : Prj.Tree.Environment;
2663 -- Only used for the root aggregate project (if any). This is left
2664 -- uninitialized otherwise.
2665
2666 procedure Process_Imported_Projects
2667 (Imported : in out Project_List;
2668 Limited_With : Boolean);
2669 -- Process imported projects. If Limited_With is True, then only
2670 -- projects processed through a "limited with" are processed, otherwise
2671 -- only projects imported through a standard "with" are processed.
2672 -- Imported is the id of the last imported project.
2673
2674 procedure Process_Aggregated_Projects;
2675 -- Process all the projects aggregated in List. This does nothing if the
2676 -- project is not an aggregate project.
2677
2678 procedure Process_Extended_Project;
2679 -- Process the extended project: inherit all packages from the extended
2680 -- project that are not explicitly defined or renamed. Also inherit the
2681 -- languages, if attribute Languages is not explicitly defined.
2682
2683 -------------------------------
2684 -- Process_Imported_Projects --
2685 -------------------------------
2686
2687 procedure Process_Imported_Projects
2688 (Imported : in out Project_List;
2689 Limited_With : Boolean)
2690 is
2691 With_Clause : Project_Node_Id;
2692 New_Project : Project_Id;
2693 Proj_Node : Project_Node_Id;
2694
2695 begin
2696 With_Clause :=
2697 First_With_Clause_Of
2698 (From_Project_Node, From_Project_Node_Tree);
2699
2700 while Present (With_Clause) loop
2701 Proj_Node :=
2702 Non_Limited_Project_Node_Of
2703 (With_Clause, From_Project_Node_Tree);
2704 New_Project := No_Project;
2705
2706 if (Limited_With and then No (Proj_Node))
2707 or else (not Limited_With and then Present (Proj_Node))
2708 then
2709 Recursive_Process
2710 (In_Tree => In_Tree,
2711 Project => New_Project,
2712 Packages_To_Check => Packages_To_Check,
2713 From_Project_Node =>
2714 Project_Node_Of (With_Clause, From_Project_Node_Tree),
2715 From_Project_Node_Tree => From_Project_Node_Tree,
2716 Env => Env,
2717 Extended_By => No_Project,
2718 From_Encapsulated_Lib => From_Encapsulated_Lib,
2719 On_New_Tree_Loaded => On_New_Tree_Loaded);
2720
2721 if Imported = null then
2722 Project.Imported_Projects := new Project_List_Element'
2723 (Project => New_Project,
2724 From_Encapsulated_Lib => False,
2725 Next => null);
2726 Imported := Project.Imported_Projects;
2727 else
2728 Imported.Next := new Project_List_Element'
2729 (Project => New_Project,
2730 From_Encapsulated_Lib => False,
2731 Next => null);
2732 Imported := Imported.Next;
2733 end if;
2734 end if;
2735
2736 With_Clause :=
2737 Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
2738 end loop;
2739 end Process_Imported_Projects;
2740
2741 ---------------------------------
2742 -- Process_Aggregated_Projects --
2743 ---------------------------------
2744
2745 procedure Process_Aggregated_Projects is
2746 List : Aggregated_Project_List;
2747 Loaded_Project : Prj.Tree.Project_Node_Id;
2748 Success : Boolean := True;
2749 Tree : Project_Tree_Ref;
2750 Node_Tree : Project_Node_Tree_Ref;
2751
2752 begin
2753 if Project.Qualifier not in Aggregate_Project then
2754 return;
2755 end if;
2756
2757 Debug_Increase_Indent ("Process_Aggregated_Projects", Project.Name);
2758
2759 Prj.Nmsc.Process_Aggregated_Projects
2760 (Tree => In_Tree,
2761 Project => Project,
2762 Node_Tree => From_Project_Node_Tree,
2763 Flags => Env.Flags);
2764
2765 List := Project.Aggregated_Projects;
2766 while Success and then List /= null loop
2767 Node_Tree := new Project_Node_Tree_Data;
2768 Initialize (Node_Tree);
2769
2770 Prj.Part.Parse
2771 (In_Tree => Node_Tree,
2772 Project => Loaded_Project,
2773 Packages_To_Check => Packages_To_Check,
2774 Project_File_Name => Get_Name_String (List.Path),
2775 Errout_Handling => Prj.Part.Never_Finalize,
2776 Current_Directory => Get_Name_String (Project.Directory.Name),
2777 Is_Config_File => False,
2778 Env => Child_Env);
2779
2780 Success := not Prj.Tree.No (Loaded_Project);
2781
2782 if Success then
2783 if Node_Tree.Incomplete_With then
2784 From_Project_Node_Tree.Incomplete_With := True;
2785 end if;
2786
2787 List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
2788 Prj.Initialize (List.Tree);
2789 List.Tree.Shared := In_Tree.Shared;
2790
2791 -- In aggregate library, aggregated projects are parsed using
2792 -- the aggregate library tree.
2793
2794 if Project.Qualifier = Aggregate_Library then
2795 Tree := In_Tree;
2796 else
2797 Tree := List.Tree;
2798 end if;
2799
2800 -- We can only do the phase 1 of the processing, since we do
2801 -- not have access to the configuration file yet (this is
2802 -- called when doing phase 1 of the processing for the root
2803 -- aggregate project).
2804
2805 if In_Tree.Is_Root_Tree then
2806 Process_Project_Tree_Phase_1
2807 (In_Tree => Tree,
2808 Project => List.Project,
2809 Packages_To_Check => Packages_To_Check,
2810 Success => Success,
2811 From_Project_Node => Loaded_Project,
2812 From_Project_Node_Tree => Node_Tree,
2813 Env => Child_Env,
2814 Reset_Tree => False,
2815 On_New_Tree_Loaded => On_New_Tree_Loaded);
2816 else
2817 -- use the same environment as the rest of the aggregated
2818 -- projects, ie the one that was setup by the root aggregate
2819 Process_Project_Tree_Phase_1
2820 (In_Tree => Tree,
2821 Project => List.Project,
2822 Packages_To_Check => Packages_To_Check,
2823 Success => Success,
2824 From_Project_Node => Loaded_Project,
2825 From_Project_Node_Tree => Node_Tree,
2826 Env => Env,
2827 Reset_Tree => False,
2828 On_New_Tree_Loaded => On_New_Tree_Loaded);
2829 end if;
2830
2831 if On_New_Tree_Loaded /= null then
2832 On_New_Tree_Loaded
2833 (Node_Tree, Tree, Loaded_Project, List.Project);
2834 end if;
2835
2836 else
2837 Debug_Output ("Failed to parse", Name_Id (List.Path));
2838 end if;
2839
2840 List := List.Next;
2841 end loop;
2842
2843 Debug_Decrease_Indent ("Done Process_Aggregated_Projects");
2844 end Process_Aggregated_Projects;
2845
2846 ------------------------------
2847 -- Process_Extended_Project --
2848 ------------------------------
2849
2850 procedure Process_Extended_Project is
2851 Extended_Pkg : Package_Id;
2852 Current_Pkg : Package_Id;
2853 Element : Package_Element;
2854 First : constant Package_Id := Project.Decl.Packages;
2855 Attribute1 : Variable_Id;
2856 Attribute2 : Variable_Id;
2857 Attr_Value1 : Variable;
2858 Attr_Value2 : Variable;
2859
2860 begin
2861 Extended_Pkg := Project.Extends.Decl.Packages;
2862 while Extended_Pkg /= No_Package loop
2863 Element := Shared.Packages.Table (Extended_Pkg);
2864
2865 Current_Pkg := First;
2866 while Current_Pkg /= No_Package
2867 and then
2868 Shared.Packages.Table (Current_Pkg).Name /= Element.Name
2869 loop
2870 Current_Pkg := Shared.Packages.Table (Current_Pkg).Next;
2871 end loop;
2872
2873 if Current_Pkg = No_Package then
2874 Package_Table.Increment_Last (Shared.Packages);
2875 Current_Pkg := Package_Table.Last (Shared.Packages);
2876 Shared.Packages.Table (Current_Pkg) :=
2877 (Name => Element.Name,
2878 Decl => No_Declarations,
2879 Parent => No_Package,
2880 Next => Project.Decl.Packages);
2881 Project.Decl.Packages := Current_Pkg;
2882 Copy_Package_Declarations
2883 (From => Element.Decl,
2884 To => Shared.Packages.Table (Current_Pkg).Decl,
2885 New_Loc => No_Location,
2886 Restricted => True,
2887 Shared => Shared);
2888 end if;
2889
2890 Extended_Pkg := Element.Next;
2891 end loop;
2892
2893 -- Check if attribute Languages is declared in the extending project
2894
2895 Attribute1 := Project.Decl.Attributes;
2896 while Attribute1 /= No_Variable loop
2897 Attr_Value1 := Shared.Variable_Elements. Table (Attribute1);
2898 exit when Attr_Value1.Name = Snames.Name_Languages;
2899 Attribute1 := Attr_Value1.Next;
2900 end loop;
2901
2902 if Attribute1 = No_Variable or else Attr_Value1.Value.Default then
2903
2904 -- Attribute Languages is not declared in the extending project.
2905 -- Check if it is declared in the project being extended.
2906
2907 Attribute2 := Project.Extends.Decl.Attributes;
2908 while Attribute2 /= No_Variable loop
2909 Attr_Value2 := Shared.Variable_Elements.Table (Attribute2);
2910 exit when Attr_Value2.Name = Snames.Name_Languages;
2911 Attribute2 := Attr_Value2.Next;
2912 end loop;
2913
2914 if Attribute2 /= No_Variable
2915 and then not Attr_Value2.Value.Default
2916 then
2917 -- As attribute Languages is declared in the project being
2918 -- extended, copy its value for the extending project.
2919
2920 if Attribute1 = No_Variable then
2921 Variable_Element_Table.Increment_Last
2922 (Shared.Variable_Elements);
2923 Attribute1 := Variable_Element_Table.Last
2924 (Shared.Variable_Elements);
2925 Attr_Value1.Next := Project.Decl.Attributes;
2926 Project.Decl.Attributes := Attribute1;
2927 end if;
2928
2929 Attr_Value1.Name := Snames.Name_Languages;
2930 Attr_Value1.Value := Attr_Value2.Value;
2931 Shared.Variable_Elements.Table (Attribute1) := Attr_Value1;
2932 end if;
2933 end if;
2934 end Process_Extended_Project;
2935
2936 -- Start of processing for Recursive_Process
2937
2938 begin
2939 if No (From_Project_Node) then
2940 Project := No_Project;
2941
2942 else
2943 declare
2944 Imported, Mark : Project_List;
2945 Declaration_Node : Project_Node_Id := Empty_Node;
2946
2947 Name : constant Name_Id :=
2948 Name_Of (From_Project_Node, From_Project_Node_Tree);
2949
2950 Display_Name : constant Name_Id :=
2951 Display_Name_Of
2952 (From_Project_Node, From_Project_Node_Tree);
2953
2954 begin
2955 Project := Processed_Projects.Get (Name);
2956
2957 if Project /= No_Project then
2958
2959 -- Make sure that, when a project is extended, the project id
2960 -- of the project extending it is recorded in its data, even
2961 -- when it has already been processed as an imported project.
2962 -- This is for virtually extended projects.
2963
2964 if Extended_By /= No_Project then
2965 Project.Extended_By := Extended_By;
2966 end if;
2967
2968 return;
2969 end if;
2970
2971 -- Check if the project is already in the tree
2972
2973 Project := No_Project;
2974
2975 declare
2976 List : Project_List := In_Tree.Projects;
2977 Path : constant Path_Name_Type :=
2978 Path_Name_Of (From_Project_Node,
2979 From_Project_Node_Tree);
2980
2981 begin
2982 while List /= null loop
2983 if List.Project.Path.Display_Name = Path then
2984 Project := List.Project;
2985 exit;
2986 end if;
2987
2988 List := List.Next;
2989 end loop;
2990 end;
2991
2992 if Project = No_Project then
2993 Project :=
2994 new Project_Data'
2995 (Empty_Project
2996 (Project_Qualifier_Of
2997 (From_Project_Node, From_Project_Node_Tree)));
2998
2999 -- Note that at this point we do not know yet if the project
3000 -- has been withed from an encapsulated library or not.
3001
3002 In_Tree.Projects :=
3003 new Project_List_Element'
3004 (Project => Project,
3005 From_Encapsulated_Lib => False,
3006 Next => In_Tree.Projects);
3007 end if;
3008
3009 -- Keep track of this point
3010
3011 Mark := In_Tree.Projects;
3012
3013 Processed_Projects.Set (Name, Project);
3014
3015 Project.Name := Name;
3016 Project.Display_Name := Display_Name;
3017
3018 Get_Name_String (Name);
3019
3020 -- If name starts with the virtual prefix, flag the project as
3021 -- being a virtual extending project.
3022
3023 if Name_Len > Virtual_Prefix'Length
3024 and then
3025 Name_Buffer (1 .. Virtual_Prefix'Length) = Virtual_Prefix
3026 then
3027 Project.Virtual := True;
3028 end if;
3029
3030 Project.Path.Display_Name :=
3031 Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
3032 Get_Name_String (Project.Path.Display_Name);
3033 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3034 Project.Path.Name := Name_Find;
3035
3036 Project.Location :=
3037 Location_Of (From_Project_Node, From_Project_Node_Tree);
3038
3039 Project.Directory.Display_Name :=
3040 Directory_Of (From_Project_Node, From_Project_Node_Tree);
3041 Get_Name_String (Project.Directory.Display_Name);
3042 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3043 Project.Directory.Name := Name_Find;
3044
3045 Project.Extended_By := Extended_By;
3046
3047 Add_Attributes
3048 (Project,
3049 Name,
3050 Name_Id (Project.Directory.Display_Name),
3051 In_Tree.Shared,
3052 Project.Decl,
3053 Prj.Attr.Attribute_First,
3054 Project_Level => True);
3055
3056 Process_Imported_Projects (Imported, Limited_With => False);
3057
3058 if Project.Qualifier = Aggregate then
3059 Initialize_And_Copy (Child_Env, Copy_From => Env);
3060
3061 elsif Project.Qualifier = Aggregate_Library then
3062
3063 -- The child environment is the same as the current one
3064
3065 Child_Env := Env;
3066
3067 else
3068 -- No need to initialize Child_Env, since it will not be
3069 -- used anyway by Process_Declarative_Items (only the root
3070 -- aggregate can modify it, and it is never read anyway).
3071
3072 null;
3073 end if;
3074
3075 Declaration_Node :=
3076 Project_Declaration_Of
3077 (From_Project_Node, From_Project_Node_Tree);
3078
3079 Recursive_Process
3080 (In_Tree => In_Tree,
3081 Project => Project.Extends,
3082 Packages_To_Check => Packages_To_Check,
3083 From_Project_Node =>
3084 Extended_Project_Of
3085 (Declaration_Node, From_Project_Node_Tree),
3086 From_Project_Node_Tree => From_Project_Node_Tree,
3087 Env => Env,
3088 Extended_By => Project,
3089 From_Encapsulated_Lib => From_Encapsulated_Lib,
3090 On_New_Tree_Loaded => On_New_Tree_Loaded);
3091
3092 Process_Declarative_Items
3093 (Project => Project,
3094 In_Tree => In_Tree,
3095 From_Project_Node => From_Project_Node,
3096 Node_Tree => From_Project_Node_Tree,
3097 Env => Env,
3098 Pkg => No_Package,
3099 Item => First_Declarative_Item_Of
3100 (Declaration_Node, From_Project_Node_Tree),
3101 Child_Env => Child_Env);
3102
3103 if Project.Extends /= No_Project then
3104 Process_Extended_Project;
3105 end if;
3106
3107 Process_Imported_Projects (Imported, Limited_With => True);
3108
3109 if Total_Errors_Detected = 0 then
3110 Process_Aggregated_Projects;
3111 end if;
3112
3113 -- At this point (after Process_Declarative_Items) we have the
3114 -- attribute values set, we can backtrace In_Tree.Project and
3115 -- set the From_Encapsulated_Library status.
3116
3117 declare
3118 Lib_Standalone : constant Prj.Variable_Value :=
3119 Prj.Util.Value_Of
3120 (Snames.Name_Library_Standalone,
3121 Project.Decl.Attributes,
3122 Shared);
3123 List : Project_List := In_Tree.Projects;
3124 Is_Encapsulated : Boolean;
3125
3126 begin
3127 Get_Name_String (Lib_Standalone.Value);
3128 To_Lower (Name_Buffer (1 .. Name_Len));
3129
3130 Is_Encapsulated := Name_Buffer (1 .. Name_Len) = "encapsulated";
3131
3132 if Is_Encapsulated then
3133 while List /= null and then List /= Mark loop
3134 List.From_Encapsulated_Lib := Is_Encapsulated;
3135 List := List.Next;
3136 end loop;
3137 end if;
3138
3139 if Total_Errors_Detected = 0 then
3140
3141 -- For an aggregate library we add the aggregated projects
3142 -- as imported ones. This is necessary to give visibility
3143 -- to all sources from the aggregates from the aggregated
3144 -- library projects.
3145
3146 if Project.Qualifier = Aggregate_Library then
3147 declare
3148 L : Aggregated_Project_List;
3149 begin
3150 L := Project.Aggregated_Projects;
3151 while L /= null loop
3152 Project.Imported_Projects :=
3153 new Project_List_Element'
3154 (Project => L.Project,
3155 From_Encapsulated_Lib => Is_Encapsulated,
3156 Next =>
3157 Project.Imported_Projects);
3158 L := L.Next;
3159 end loop;
3160 end;
3161 end if;
3162 end if;
3163 end;
3164
3165 if Project.Qualifier = Aggregate and then In_Tree.Is_Root_Tree then
3166 Free (Child_Env);
3167 end if;
3168 end;
3169 end if;
3170 end Recursive_Process;
3171
3172 -----------------------------
3173 -- Set_Default_Runtime_For --
3174 -----------------------------
3175
3176 procedure Set_Default_Runtime_For (Language : Name_Id; Value : String) is
3177 begin
3178 Name_Len := Value'Length;
3179 Name_Buffer (1 .. Name_Len) := Value;
3180 Runtime_Defaults.Set (Language, Name_Find);
3181 end Set_Default_Runtime_For;
3182 end Prj.Proc;
Mirror of the offical gcc git repository hosted at gcc.gnu.org