]> gcc.gnu.org Git - gcc.git/blob - gcc/ada/prj-proc.adb
git://gcc.gnu.org / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
[multiple changes]
[gcc.git] / gcc / ada / prj-proc.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P R O C --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with Atree; use Atree;
27 with Err_Vars; use Err_Vars;
28 with Opt; use Opt;
29 with Osint; use Osint;
30 with Output; use Output;
31 with Prj.Attr; use Prj.Attr;
32 with Prj.Env;
33 with Prj.Err; use Prj.Err;
34 with Prj.Ext; use Prj.Ext;
35 with Prj.Nmsc; use Prj.Nmsc;
36 with Prj.Part;
37 with Prj.Util;
38 with Snames;
39
40 with Ada.Containers.Vectors;
41 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
42
43 with GNAT.Case_Util; use GNAT.Case_Util;
44 with GNAT.HTable;
45
46 package body Prj.Proc is
47
48 package Processed_Projects is new GNAT.HTable.Simple_HTable
49 (Header_Num => Header_Num,
50 Element => Project_Id,
51 No_Element => No_Project,
52 Key => Name_Id,
53 Hash => Hash,
54 Equal => "=");
55 -- This hash table contains all processed projects
56
57 package Unit_Htable is new GNAT.HTable.Simple_HTable
58 (Header_Num => Header_Num,
59 Element => Source_Id,
60 No_Element => No_Source,
61 Key => Name_Id,
62 Hash => Hash,
63 Equal => "=");
64 -- This hash table contains all processed projects
65
66 package Runtime_Defaults is new GNAT.HTable.Simple_HTable
67 (Header_Num => Prj.Header_Num,
68 Element => Name_Id,
69 No_Element => No_Name,
70 Key => Name_Id,
71 Hash => Prj.Hash,
72 Equal => "=");
73 -- Stores the default values of 'Runtime names for the various languages
74
75 procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
76 -- Concatenate two strings and returns another string if both
77 -- arguments are not null string.
78
79 -- In the following procedures, we are expected to guess the meaning of
80 -- the parameters from their names, this is never a good idea, comments
81 -- should be added precisely defining every formal ???
82
83 procedure Add_Attributes
84 (Project : Project_Id;
85 Project_Name : Name_Id;
86 Project_Dir : Name_Id;
87 Shared : Shared_Project_Tree_Data_Access;
88 Decl : in out Declarations;
89 First : Attribute_Node_Id;
90 Project_Level : Boolean);
91 -- Add all attributes, starting with First, with their default values to
92 -- the package or project with declarations Decl.
93
94 procedure Check
95 (In_Tree : Project_Tree_Ref;
96 Project : Project_Id;
97 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
98 Flags : Processing_Flags);
99 -- Set all projects to not checked, then call Recursive_Check for the
100 -- main project Project. Project is set to No_Project if errors occurred.
101 -- Current_Dir is for optimization purposes, avoiding extra system calls.
102 -- If Allow_Duplicate_Basenames, then files with the same base names are
103 -- authorized within a project for source-based languages (never for unit
104 -- based languages)
105
106 procedure Copy_Package_Declarations
107 (From : Declarations;
108 To : in out Declarations;
109 New_Loc : Source_Ptr;
110 Restricted : Boolean;
111 Shared : Shared_Project_Tree_Data_Access);
112 -- Copy a package declaration From to To for a renamed package. Change the
113 -- locations of all the attributes to New_Loc. When Restricted is
114 -- True, do not copy attributes Body, Spec, Implementation, Specification
115 -- and Linker_Options.
116
117 function Expression
118 (Project : Project_Id;
119 Shared : Shared_Project_Tree_Data_Access;
120 From_Project_Node : Project_Node_Id;
121 From_Project_Node_Tree : Project_Node_Tree_Ref;
122 Env : Prj.Tree.Environment;
123 Pkg : Package_Id;
124 First_Term : Project_Node_Id;
125 Kind : Variable_Kind) return Variable_Value;
126 -- From N_Expression project node From_Project_Node, compute the value
127 -- of an expression and return it as a Variable_Value.
128
129 function Imported_Or_Extended_Project_From
130 (Project : Project_Id;
131 With_Name : Name_Id;
132 No_Extending : Boolean := False) return Project_Id;
133 -- Find an imported or extended project of Project whose name is With_Name.
134 -- When No_Extending is True, do not look for extending projects, returns
135 -- the exact project whose name is With_Name.
136
137 function Package_From
138 (Project : Project_Id;
139 Shared : Shared_Project_Tree_Data_Access;
140 With_Name : Name_Id) return Package_Id;
141 -- Find the package of Project whose name is With_Name
142
143 procedure Process_Declarative_Items
144 (Project : Project_Id;
145 In_Tree : Project_Tree_Ref;
146 From_Project_Node : Project_Node_Id;
147 Node_Tree : Project_Node_Tree_Ref;
148 Env : Prj.Tree.Environment;
149 Pkg : Package_Id;
150 Item : Project_Node_Id;
151 Child_Env : in out Prj.Tree.Environment);
152 -- Process declarative items starting with From_Project_Node, and put them
153 -- in declarations Decl. This is a recursive procedure; it calls itself for
154 -- a package declaration or a case construction.
155 --
156 -- Child_Env is the modified environment after seeing declarations like
157 -- "for External(...) use" or "for Project_Path use" in aggregate projects.
158 -- It should have been initialized first.
159
160 procedure Recursive_Process
161 (In_Tree : Project_Tree_Ref;
162 Project : out Project_Id;
163 Packages_To_Check : String_List_Access;
164 From_Project_Node : Project_Node_Id;
165 From_Project_Node_Tree : Project_Node_Tree_Ref;
166 Env : in out Prj.Tree.Environment;
167 Extended_By : Project_Id;
168 From_Encapsulated_Lib : Boolean;
169 On_New_Tree_Loaded : Tree_Loaded_Callback := null);
170 -- Process project with node From_Project_Node in the tree. Do nothing if
171 -- From_Project_Node is Empty_Node. If project has already been processed,
172 -- simply return its project id. Otherwise create a new project id, mark it
173 -- as processed, call itself recursively for all imported projects and a
174 -- extended project, if any. Then process the declarative items of the
175 -- project.
176 --
177 -- Is_Root_Project should be true only for the project that the user
178 -- explicitly loaded. In the context of aggregate projects, only that
179 -- project is allowed to modify the environment that will be used to load
180 -- projects (Child_Env).
181 --
182 -- From_Encapsulated_Lib is true if we are parsing a project from
183 -- encapsulated library dependencies.
184 --
185 -- If specified, On_New_Tree_Loaded is called after each aggregated project
186 -- has been processed succesfully.
187
188 function Get_Attribute_Index
189 (Tree : Project_Node_Tree_Ref;
190 Attr : Project_Node_Id;
191 Index : Name_Id) return Name_Id;
192 -- Copy the index of the attribute into Name_Buffer, converting to lower
193 -- case if the attribute is case-insensitive.
194
195 ---------
196 -- Add --
197 ---------
198
199 procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
200 begin
201 if To_Exp = No_Name or else To_Exp = Empty_String then
202
203 -- To_Exp is nil or empty. The result is Str
204
205 To_Exp := Str;
206
207 -- If Str is nil, then do not change To_Ext
208
209 elsif Str /= No_Name and then Str /= Empty_String then
210 declare
211 S : constant String := Get_Name_String (Str);
212 begin
213 Get_Name_String (To_Exp);
214 Add_Str_To_Name_Buffer (S);
215 To_Exp := Name_Find;
216 end;
217 end if;
218 end Add;
219
220 --------------------
221 -- Add_Attributes --
222 --------------------
223
224 procedure Add_Attributes
225 (Project : Project_Id;
226 Project_Name : Name_Id;
227 Project_Dir : Name_Id;
228 Shared : Shared_Project_Tree_Data_Access;
229 Decl : in out Declarations;
230 First : Attribute_Node_Id;
231 Project_Level : Boolean)
232 is
233 The_Attribute : Attribute_Node_Id := First;
234
235 begin
236 while The_Attribute /= Empty_Attribute loop
237 if Attribute_Kind_Of (The_Attribute) = Single then
238 declare
239 New_Attribute : Variable_Value;
240
241 begin
242 case Variable_Kind_Of (The_Attribute) is
243
244 -- Undefined should not happen
245
246 when Undefined =>
247 pragma Assert
248 (False, "attribute with an undefined kind");
249 raise Program_Error;
250
251 -- Single attributes have a default value of empty string
252
253 when Single =>
254 New_Attribute :=
255 (Project => Project,
256 Kind => Single,
257 Location => No_Location,
258 Default => True,
259 Value => Empty_String,
260 Index => 0);
261
262 -- Special cases of <project>'Name and
263 -- <project>'Project_Dir.
264
265 if Project_Level then
266 if Attribute_Name_Of (The_Attribute) =
267 Snames.Name_Name
268 then
269 New_Attribute.Value := Project_Name;
270
271 elsif Attribute_Name_Of (The_Attribute) =
272 Snames.Name_Project_Dir
273 then
274 New_Attribute.Value := Project_Dir;
275 end if;
276 end if;
277
278 -- List attributes have a default value of nil list
279
280 when List =>
281 New_Attribute :=
282 (Project => Project,
283 Kind => List,
284 Location => No_Location,
285 Default => True,
286 Values => Nil_String);
287
288 end case;
289
290 Variable_Element_Table.Increment_Last
291 (Shared.Variable_Elements);
292 Shared.Variable_Elements.Table
293 (Variable_Element_Table.Last (Shared.Variable_Elements)) :=
294 (Next => Decl.Attributes,
295 Name => Attribute_Name_Of (The_Attribute),
296 Value => New_Attribute);
297 Decl.Attributes :=
298 Variable_Element_Table.Last
299 (Shared.Variable_Elements);
300 end;
301 end if;
302
303 The_Attribute := Next_Attribute (After => The_Attribute);
304 end loop;
305 end Add_Attributes;
306
307 -----------
308 -- Check --
309 -----------
310
311 procedure Check
312 (In_Tree : Project_Tree_Ref;
313 Project : Project_Id;
314 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
315 Flags : Processing_Flags)
316 is
317 begin
318 Process_Naming_Scheme (In_Tree, Project, Node_Tree, Flags);
319
320 -- Set the Other_Part field for the units
321
322 declare
323 Source1 : Source_Id;
324 Name : Name_Id;
325 Source2 : Source_Id;
326 Iter : Source_Iterator;
327
328 begin
329 Unit_Htable.Reset;
330
331 Iter := For_Each_Source (In_Tree);
332 loop
333 Source1 := Prj.Element (Iter);
334 exit when Source1 = No_Source;
335
336 if Source1.Unit /= No_Unit_Index then
337 Name := Source1.Unit.Name;
338 Source2 := Unit_Htable.Get (Name);
339
340 if Source2 = No_Source then
341 Unit_Htable.Set (K => Name, E => Source1);
342 else
343 Unit_Htable.Remove (Name);
344 end if;
345 end if;
346
347 Next (Iter);
348 end loop;
349 end;
350 end Check;
351
352 -------------------------------
353 -- Copy_Package_Declarations --
354 -------------------------------
355
356 procedure Copy_Package_Declarations
357 (From : Declarations;
358 To : in out Declarations;
359 New_Loc : Source_Ptr;
360 Restricted : Boolean;
361 Shared : Shared_Project_Tree_Data_Access)
362 is
363 V1 : Variable_Id;
364 V2 : Variable_Id := No_Variable;
365 Var : Variable;
366 A1 : Array_Id;
367 A2 : Array_Id := No_Array;
368 Arr : Array_Data;
369 E1 : Array_Element_Id;
370 E2 : Array_Element_Id := No_Array_Element;
371 Elm : Array_Element;
372
373 begin
374 -- To avoid references in error messages to attribute declarations in
375 -- an original package that has been renamed, copy all the attribute
376 -- declarations of the package and change all locations to New_Loc,
377 -- the location of the renamed package.
378
379 -- First single attributes
380
381 V1 := From.Attributes;
382 while V1 /= No_Variable loop
383
384 -- Copy the attribute
385
386 Var := Shared.Variable_Elements.Table (V1);
387 V1 := Var.Next;
388
389 -- Do not copy the value of attribute Linker_Options if Restricted
390
391 if Restricted and then Var.Name = Snames.Name_Linker_Options then
392 Var.Value.Values := Nil_String;
393 end if;
394
395 -- Remove the Next component
396
397 Var.Next := No_Variable;
398
399 -- Change the location to New_Loc
400
401 Var.Value.Location := New_Loc;
402 Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
403
404 -- Put in new declaration
405
406 if To.Attributes = No_Variable then
407 To.Attributes :=
408 Variable_Element_Table.Last (Shared.Variable_Elements);
409 else
410 Shared.Variable_Elements.Table (V2).Next :=
411 Variable_Element_Table.Last (Shared.Variable_Elements);
412 end if;
413
414 V2 := Variable_Element_Table.Last (Shared.Variable_Elements);
415 Shared.Variable_Elements.Table (V2) := Var;
416 end loop;
417
418 -- Then the associated array attributes
419
420 A1 := From.Arrays;
421 while A1 /= No_Array loop
422 Arr := Shared.Arrays.Table (A1);
423 A1 := Arr.Next;
424
425 -- Remove the Next component
426
427 Arr.Next := No_Array;
428 Array_Table.Increment_Last (Shared.Arrays);
429
430 -- Create new Array declaration
431
432 if To.Arrays = No_Array then
433 To.Arrays := Array_Table.Last (Shared.Arrays);
434 else
435 Shared.Arrays.Table (A2).Next :=
436 Array_Table.Last (Shared.Arrays);
437 end if;
438
439 A2 := Array_Table.Last (Shared.Arrays);
440
441 -- Don't store the array as its first element has not been set yet
442
443 -- Copy the array elements of the array
444
445 E1 := Arr.Value;
446 Arr.Value := No_Array_Element;
447 while E1 /= No_Array_Element loop
448
449 -- Copy the array element
450
451 Elm := Shared.Array_Elements.Table (E1);
452 E1 := Elm.Next;
453
454 -- Remove the Next component
455
456 Elm.Next := No_Array_Element;
457
458 Elm.Restricted := Restricted;
459
460 -- Change the location
461
462 Elm.Value.Location := New_Loc;
463 Array_Element_Table.Increment_Last (Shared.Array_Elements);
464
465 -- Create new array element
466
467 if Arr.Value = No_Array_Element then
468 Arr.Value := Array_Element_Table.Last (Shared.Array_Elements);
469 else
470 Shared.Array_Elements.Table (E2).Next :=
471 Array_Element_Table.Last (Shared.Array_Elements);
472 end if;
473
474 E2 := Array_Element_Table.Last (Shared.Array_Elements);
475 Shared.Array_Elements.Table (E2) := Elm;
476 end loop;
477
478 -- Finally, store the new array
479
480 Shared.Arrays.Table (A2) := Arr;
481 end loop;
482 end Copy_Package_Declarations;
483
484 -------------------------
485 -- Get_Attribute_Index --
486 -------------------------
487
488 function Get_Attribute_Index
489 (Tree : Project_Node_Tree_Ref;
490 Attr : Project_Node_Id;
491 Index : Name_Id) return Name_Id
492 is
493 begin
494 if Index = All_Other_Names
495 or else not Case_Insensitive (Attr, Tree)
496 then
497 return Index;
498 end if;
499
500 Get_Name_String (Index);
501 To_Lower (Name_Buffer (1 .. Name_Len));
502 return Name_Find;
503 end Get_Attribute_Index;
504
505 ----------------
506 -- Expression --
507 ----------------
508
509 function Expression
510 (Project : Project_Id;
511 Shared : Shared_Project_Tree_Data_Access;
512 From_Project_Node : Project_Node_Id;
513 From_Project_Node_Tree : Project_Node_Tree_Ref;
514 Env : Prj.Tree.Environment;
515 Pkg : Package_Id;
516 First_Term : Project_Node_Id;
517 Kind : Variable_Kind) return Variable_Value
518 is
519 The_Term : Project_Node_Id;
520 -- The term in the expression list
521
522 The_Current_Term : Project_Node_Id := Empty_Node;
523 -- The current term node id
524
525 Result : Variable_Value (Kind => Kind);
526 -- The returned result
527
528 Last : String_List_Id := Nil_String;
529 -- Reference to the last string elements in Result, when Kind is List
530
531 Current_Term_Kind : Project_Node_Kind;
532
533 begin
534 Result.Project := Project;
535 Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
536
537 -- Process each term of the expression, starting with First_Term
538
539 The_Term := First_Term;
540 while Present (The_Term) loop
541 The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
542 Current_Term_Kind :=
543 Kind_Of (The_Current_Term, From_Project_Node_Tree);
544
545 case Current_Term_Kind is
546
547 when N_Literal_String =>
548
549 case Kind is
550
551 when Undefined =>
552
553 -- Should never happen
554
555 pragma Assert (False, "Undefined expression kind");
556 raise Program_Error;
557
558 when Single =>
559 Add (Result.Value,
560 String_Value_Of
561 (The_Current_Term, From_Project_Node_Tree));
562 Result.Index :=
563 Source_Index_Of
564 (The_Current_Term, From_Project_Node_Tree);
565
566 when List =>
567
568 String_Element_Table.Increment_Last
569 (Shared.String_Elements);
570
571 if Last = Nil_String then
572
573 -- This can happen in an expression like () & "toto"
574
575 Result.Values := String_Element_Table.Last
576 (Shared.String_Elements);
577
578 else
579 Shared.String_Elements.Table
580 (Last).Next := String_Element_Table.Last
581 (Shared.String_Elements);
582 end if;
583
584 Last := String_Element_Table.Last
585 (Shared.String_Elements);
586
587 Shared.String_Elements.Table (Last) :=
588 (Value => String_Value_Of
589 (The_Current_Term,
590 From_Project_Node_Tree),
591 Index => Source_Index_Of
592 (The_Current_Term,
593 From_Project_Node_Tree),
594 Display_Value => No_Name,
595 Location => Location_Of
596 (The_Current_Term,
597 From_Project_Node_Tree),
598 Flag => False,
599 Next => Nil_String);
600 end case;
601
602 when N_Literal_String_List =>
603
604 declare
605 String_Node : Project_Node_Id :=
606 First_Expression_In_List
607 (The_Current_Term,
608 From_Project_Node_Tree);
609
610 Value : Variable_Value;
611
612 begin
613 if Present (String_Node) then
614
615 -- If String_Node is nil, it is an empty list, there is
616 -- nothing to do.
617
618 Value := Expression
619 (Project => Project,
620 Shared => Shared,
621 From_Project_Node => From_Project_Node,
622 From_Project_Node_Tree => From_Project_Node_Tree,
623 Env => Env,
624 Pkg => Pkg,
625 First_Term =>
626 Tree.First_Term
627 (String_Node, From_Project_Node_Tree),
628 Kind => Single);
629 String_Element_Table.Increment_Last
630 (Shared.String_Elements);
631
632 if Result.Values = Nil_String then
633
634 -- This literal string list is the first term in a
635 -- string list expression
636
637 Result.Values :=
638 String_Element_Table.Last
639 (Shared.String_Elements);
640
641 else
642 Shared.String_Elements.Table (Last).Next :=
643 String_Element_Table.Last (Shared.String_Elements);
644 end if;
645
646 Last :=
647 String_Element_Table.Last (Shared.String_Elements);
648
649 Shared.String_Elements.Table (Last) :=
650 (Value => Value.Value,
651 Display_Value => No_Name,
652 Location => Value.Location,
653 Flag => False,
654 Next => Nil_String,
655 Index => Value.Index);
656
657 loop
658 -- Add the other element of the literal string list
659 -- one after the other.
660
661 String_Node :=
662 Next_Expression_In_List
663 (String_Node, From_Project_Node_Tree);
664
665 exit when No (String_Node);
666
667 Value :=
668 Expression
669 (Project => Project,
670 Shared => Shared,
671 From_Project_Node => From_Project_Node,
672 From_Project_Node_Tree => From_Project_Node_Tree,
673 Env => Env,
674 Pkg => Pkg,
675 First_Term =>
676 Tree.First_Term
677 (String_Node, From_Project_Node_Tree),
678 Kind => Single);
679
680 String_Element_Table.Increment_Last
681 (Shared.String_Elements);
682 Shared.String_Elements.Table (Last).Next :=
683 String_Element_Table.Last (Shared.String_Elements);
684 Last := String_Element_Table.Last
685 (Shared.String_Elements);
686 Shared.String_Elements.Table (Last) :=
687 (Value => Value.Value,
688 Display_Value => No_Name,
689 Location => Value.Location,
690 Flag => False,
691 Next => Nil_String,
692 Index => Value.Index);
693 end loop;
694 end if;
695 end;
696
697 when N_Variable_Reference | N_Attribute_Reference =>
698
699 declare
700 The_Project : Project_Id := Project;
701 The_Package : Package_Id := Pkg;
702 The_Name : Name_Id := No_Name;
703 The_Variable_Id : Variable_Id := No_Variable;
704 The_Variable : Variable_Value;
705 Term_Project : constant Project_Node_Id :=
706 Project_Node_Of
707 (The_Current_Term,
708 From_Project_Node_Tree);
709 Term_Package : constant Project_Node_Id :=
710 Package_Node_Of
711 (The_Current_Term,
712 From_Project_Node_Tree);
713 Index : Name_Id := No_Name;
714
715 begin
716 <<Object_Dir_Restart>>
717 The_Project := Project;
718 The_Package := Pkg;
719 The_Name := No_Name;
720 The_Variable_Id := No_Variable;
721 Index := No_Name;
722
723 if Present (Term_Project)
724 and then Term_Project /= From_Project_Node
725 then
726 -- This variable or attribute comes from another project
727
728 The_Name :=
729 Name_Of (Term_Project, From_Project_Node_Tree);
730 The_Project := Imported_Or_Extended_Project_From
731 (Project => Project,
732 With_Name => The_Name,
733 No_Extending => True);
734 end if;
735
736 if Present (Term_Package) then
737
738 -- This is an attribute of a package
739
740 The_Name :=
741 Name_Of (Term_Package, From_Project_Node_Tree);
742
743 The_Package := The_Project.Decl.Packages;
744 while The_Package /= No_Package
745 and then Shared.Packages.Table (The_Package).Name /=
746 The_Name
747 loop
748 The_Package :=
749 Shared.Packages.Table (The_Package).Next;
750 end loop;
751
752 pragma Assert
753 (The_Package /= No_Package, "package not found.");
754
755 elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
756 N_Attribute_Reference
757 then
758 The_Package := No_Package;
759 end if;
760
761 The_Name :=
762 Name_Of (The_Current_Term, From_Project_Node_Tree);
763
764 if Current_Term_Kind = N_Attribute_Reference then
765 Index :=
766 Associative_Array_Index_Of
767 (The_Current_Term, From_Project_Node_Tree);
768 end if;
769
770 -- If it is not an associative array attribute
771
772 if Index = No_Name then
773
774 -- It is not an associative array attribute
775
776 if The_Package /= No_Package then
777
778 -- First, if there is a package, look into the package
779
780 if Current_Term_Kind = N_Variable_Reference then
781 The_Variable_Id :=
782 Shared.Packages.Table
783 (The_Package).Decl.Variables;
784 else
785 The_Variable_Id :=
786 Shared.Packages.Table
787 (The_Package).Decl.Attributes;
788 end if;
789
790 while The_Variable_Id /= No_Variable
791 and then Shared.Variable_Elements.Table
792 (The_Variable_Id).Name /= The_Name
793 loop
794 The_Variable_Id :=
795 Shared.Variable_Elements.Table
796 (The_Variable_Id).Next;
797 end loop;
798
799 end if;
800
801 if The_Variable_Id = No_Variable then
802
803 -- If we have not found it, look into the project
804
805 if Current_Term_Kind = N_Variable_Reference then
806 The_Variable_Id := The_Project.Decl.Variables;
807 else
808 The_Variable_Id := The_Project.Decl.Attributes;
809 end if;
810
811 while The_Variable_Id /= No_Variable
812 and then Shared.Variable_Elements.Table
813 (The_Variable_Id).Name /= The_Name
814 loop
815 The_Variable_Id :=
816 Shared.Variable_Elements.Table
817 (The_Variable_Id).Next;
818 end loop;
819
820 end if;
821
822 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 Target_Value |
993 Runtime_Value =>
994 null;
995 end case;
996 end case;
997 end if;
998 end;
999 end if;
1000
1001 case Kind is
1002 when Undefined =>
1003
1004 -- Should never happen
1005
1006 pragma Assert (False, "undefined expression kind");
1007 null;
1008
1009 when Single =>
1010 case The_Variable.Kind is
1011
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
1032 when Undefined =>
1033 null;
1034
1035 when Single =>
1036 String_Element_Table.Increment_Last
1037 (Shared.String_Elements);
1038
1039 if Last = Nil_String then
1040
1041 -- This can happen in an expression such as
1042 -- () & Var
1043
1044 Result.Values :=
1045 String_Element_Table.Last
1046 (Shared.String_Elements);
1047
1048 else
1049 Shared.String_Elements.Table (Last).Next :=
1050 String_Element_Table.Last
1051 (Shared.String_Elements);
1052 end if;
1053
1054 Last :=
1055 String_Element_Table.Last
1056 (Shared.String_Elements);
1057
1058 Shared.String_Elements.Table (Last) :=
1059 (Value => The_Variable.Value,
1060 Display_Value => No_Name,
1061 Location => Location_Of
1062 (The_Current_Term,
1063 From_Project_Node_Tree),
1064 Flag => False,
1065 Next => Nil_String,
1066 Index => 0);
1067
1068 when List =>
1069
1070 declare
1071 The_List : String_List_Id :=
1072 The_Variable.Values;
1073
1074 begin
1075 while The_List /= Nil_String loop
1076 String_Element_Table.Increment_Last
1077 (Shared.String_Elements);
1078
1079 if Last = Nil_String then
1080 Result.Values :=
1081 String_Element_Table.Last
1082 (Shared.String_Elements);
1083
1084 else
1085 Shared.
1086 String_Elements.Table (Last).Next :=
1087 String_Element_Table.Last
1088 (Shared.String_Elements);
1089
1090 end if;
1091
1092 Last :=
1093 String_Element_Table.Last
1094 (Shared.String_Elements);
1095
1096 Shared.String_Elements.Table
1097 (Last) :=
1098 (Value =>
1099 Shared.String_Elements.Table
1100 (The_List).Value,
1101 Display_Value => No_Name,
1102 Location =>
1103 Location_Of
1104 (The_Current_Term,
1105 From_Project_Node_Tree),
1106 Flag => False,
1107 Next => Nil_String,
1108 Index => 0);
1109
1110 The_List := Shared.String_Elements.Table
1111 (The_List).Next;
1112 end loop;
1113 end;
1114 end case;
1115 end case;
1116 end;
1117
1118 when N_External_Value =>
1119 Get_Name_String
1120 (String_Value_Of
1121 (External_Reference_Of
1122 (The_Current_Term, From_Project_Node_Tree),
1123 From_Project_Node_Tree));
1124
1125 declare
1126 Name : constant Name_Id := Name_Find;
1127 Default : Name_Id := No_Name;
1128 Value : Name_Id := No_Name;
1129 Ext_List : Boolean := False;
1130 Str_List : String_List_Access := null;
1131 Def_Var : Variable_Value;
1132
1133 Default_Node : constant Project_Node_Id :=
1134 External_Default_Of
1135 (The_Current_Term,
1136 From_Project_Node_Tree);
1137
1138 begin
1139 -- If there is a default value for the external reference,
1140 -- get its value.
1141
1142 if Present (Default_Node) then
1143 Def_Var := Expression
1144 (Project => Project,
1145 Shared => Shared,
1146 From_Project_Node => From_Project_Node,
1147 From_Project_Node_Tree => From_Project_Node_Tree,
1148 Env => Env,
1149 Pkg => Pkg,
1150 First_Term =>
1151 Tree.First_Term
1152 (Default_Node, From_Project_Node_Tree),
1153 Kind => Single);
1154
1155 if Def_Var /= Nil_Variable_Value then
1156 Default := Def_Var.Value;
1157 end if;
1158 end if;
1159
1160 Ext_List := Expression_Kind_Of
1161 (The_Current_Term,
1162 From_Project_Node_Tree) = List;
1163
1164 if Ext_List then
1165 Value := Prj.Ext.Value_Of (Env.External, Name, No_Name);
1166
1167 if Value /= No_Name then
1168 declare
1169 Sep : constant String :=
1170 Get_Name_String (Default);
1171 First : Positive := 1;
1172 Lst : Natural;
1173 Done : Boolean := False;
1174 Nmb : Natural;
1175
1176 begin
1177 Get_Name_String (Value);
1178
1179 if Name_Len = 0
1180 or else Sep'Length = 0
1181 or else Name_Buffer (1 .. Name_Len) = Sep
1182 then
1183 Done := True;
1184 end if;
1185
1186 if not Done and then Name_Len < Sep'Length then
1187 Str_List :=
1188 new String_List'
1189 (1 => new String'
1190 (Name_Buffer (1 .. Name_Len)));
1191 Done := True;
1192 end if;
1193
1194 if not Done then
1195 if Name_Buffer (1 .. Sep'Length) = Sep then
1196 First := Sep'Length + 1;
1197 end if;
1198
1199 if Name_Len - First + 1 >= Sep'Length
1200 and then
1201 Name_Buffer (Name_Len - Sep'Length + 1 ..
1202 Name_Len) = Sep
1203 then
1204 Name_Len := Name_Len - Sep'Length;
1205 end if;
1206
1207 if Name_Len = 0 then
1208 Str_List :=
1209 new String_List'(1 => new String'(""));
1210 Done := True;
1211 end if;
1212 end if;
1213
1214 if not Done then
1215
1216 -- Count the number of strings
1217
1218 declare
1219 Saved : constant Positive := First;
1220
1221 begin
1222 Nmb := 1;
1223 loop
1224 Lst :=
1225 Index
1226 (Source =>
1227 Name_Buffer (First .. Name_Len),
1228 Pattern => Sep);
1229 exit when Lst = 0;
1230 Nmb := Nmb + 1;
1231 First := Lst + Sep'Length;
1232 end loop;
1233
1234 First := Saved;
1235 end;
1236
1237 Str_List := new String_List (1 .. Nmb);
1238
1239 -- Populate the string list
1240
1241 Nmb := 1;
1242 loop
1243 Lst :=
1244 Index
1245 (Source =>
1246 Name_Buffer (First .. Name_Len),
1247 Pattern => Sep);
1248
1249 if Lst = 0 then
1250 Str_List (Nmb) :=
1251 new String'
1252 (Name_Buffer (First .. Name_Len));
1253 exit;
1254
1255 else
1256 Str_List (Nmb) :=
1257 new String'
1258 (Name_Buffer (First .. Lst - 1));
1259 Nmb := Nmb + 1;
1260 First := Lst + Sep'Length;
1261 end if;
1262 end loop;
1263 end if;
1264 end;
1265 end if;
1266
1267 else
1268 -- Get the value
1269
1270 Value := Prj.Ext.Value_Of (Env.External, Name, Default);
1271
1272 if Value = No_Name then
1273 if not Quiet_Output then
1274 Error_Msg
1275 (Env.Flags, "?undefined external reference",
1276 Location_Of
1277 (The_Current_Term, From_Project_Node_Tree),
1278 Project);
1279 end if;
1280
1281 Value := Empty_String;
1282 end if;
1283 end if;
1284
1285 case Kind is
1286
1287 when Undefined =>
1288 null;
1289
1290 when Single =>
1291 if Ext_List then
1292 null; -- error
1293
1294 else
1295 Add (Result.Value, Value);
1296 end if;
1297
1298 when List =>
1299 if not Ext_List or else Str_List /= null then
1300 String_Element_Table.Increment_Last
1301 (Shared.String_Elements);
1302
1303 if Last = Nil_String then
1304 Result.Values :=
1305 String_Element_Table.Last
1306 (Shared.String_Elements);
1307
1308 else
1309 Shared.String_Elements.Table (Last).Next
1310 := String_Element_Table.Last
1311 (Shared.String_Elements);
1312 end if;
1313
1314 Last := String_Element_Table.Last
1315 (Shared.String_Elements);
1316
1317 if Ext_List then
1318 for Ind in Str_List'Range loop
1319 Name_Len := 0;
1320 Add_Str_To_Name_Buffer (Str_List (Ind).all);
1321 Value := Name_Find;
1322 Shared.String_Elements.Table (Last) :=
1323 (Value => Value,
1324 Display_Value => No_Name,
1325 Location =>
1326 Location_Of
1327 (The_Current_Term,
1328 From_Project_Node_Tree),
1329 Flag => False,
1330 Next => Nil_String,
1331 Index => 0);
1332
1333 if Ind /= Str_List'Last then
1334 String_Element_Table.Increment_Last
1335 (Shared.String_Elements);
1336 Shared.String_Elements.Table (Last).Next :=
1337 String_Element_Table.Last
1338 (Shared.String_Elements);
1339 Last := String_Element_Table.Last
1340 (Shared.String_Elements);
1341 end if;
1342 end loop;
1343
1344 else
1345 Shared.String_Elements.Table (Last) :=
1346 (Value => Value,
1347 Display_Value => No_Name,
1348 Location =>
1349 Location_Of
1350 (The_Current_Term,
1351 From_Project_Node_Tree),
1352 Flag => False,
1353 Next => Nil_String,
1354 Index => 0);
1355 end if;
1356 end if;
1357 end case;
1358 end;
1359
1360 when others =>
1361
1362 -- Should never happen
1363
1364 pragma Assert
1365 (False,
1366 "illegal node kind in an expression");
1367 raise Program_Error;
1368
1369 end case;
1370
1371 The_Term := Next_Term (The_Term, From_Project_Node_Tree);
1372 end loop;
1373
1374 return Result;
1375 end Expression;
1376
1377 ---------------------------------------
1378 -- Imported_Or_Extended_Project_From --
1379 ---------------------------------------
1380
1381 function Imported_Or_Extended_Project_From
1382 (Project : Project_Id;
1383 With_Name : Name_Id;
1384 No_Extending : Boolean := False) return Project_Id
1385 is
1386 List : Project_List;
1387 Result : Project_Id;
1388 Temp_Result : Project_Id;
1389
1390 begin
1391 -- First check if it is the name of an extended project
1392
1393 Result := Project.Extends;
1394 while Result /= No_Project loop
1395 if Result.Name = With_Name then
1396 return Result;
1397 else
1398 Result := Result.Extends;
1399 end if;
1400 end loop;
1401
1402 -- Then check the name of each imported project
1403
1404 Temp_Result := No_Project;
1405 List := Project.Imported_Projects;
1406 while List /= null loop
1407 Result := List.Project;
1408
1409 -- If the project is directly imported, then returns its ID
1410
1411 if Result.Name = With_Name then
1412 return Result;
1413 end if;
1414
1415 -- If a project extending the project is imported, then keep this
1416 -- extending project as a possibility. It will be the returned ID
1417 -- if the project is not imported directly.
1418
1419 declare
1420 Proj : Project_Id;
1421
1422 begin
1423 Proj := Result.Extends;
1424 while Proj /= No_Project loop
1425 if Proj.Name = With_Name then
1426 if No_Extending then
1427 Temp_Result := Proj;
1428 else
1429 Temp_Result := Result;
1430 end if;
1431
1432 exit;
1433 end if;
1434
1435 Proj := Proj.Extends;
1436 end loop;
1437 end;
1438
1439 List := List.Next;
1440 end loop;
1441
1442 pragma Assert (Temp_Result /= No_Project, "project not found");
1443 return Temp_Result;
1444 end Imported_Or_Extended_Project_From;
1445
1446 ------------------
1447 -- Package_From --
1448 ------------------
1449
1450 function Package_From
1451 (Project : Project_Id;
1452 Shared : Shared_Project_Tree_Data_Access;
1453 With_Name : Name_Id) return Package_Id
1454 is
1455 Result : Package_Id := Project.Decl.Packages;
1456
1457 begin
1458 -- Check the name of each existing package of Project
1459
1460 while Result /= No_Package
1461 and then Shared.Packages.Table (Result).Name /= With_Name
1462 loop
1463 Result := Shared.Packages.Table (Result).Next;
1464 end loop;
1465
1466 if Result = No_Package then
1467
1468 -- Should never happen
1469
1470 Write_Line
1471 ("package """ & Get_Name_String (With_Name) & """ not found");
1472 raise Program_Error;
1473
1474 else
1475 return Result;
1476 end if;
1477 end Package_From;
1478
1479 -------------
1480 -- Process --
1481 -------------
1482
1483 procedure Process
1484 (In_Tree : Project_Tree_Ref;
1485 Project : out Project_Id;
1486 Packages_To_Check : String_List_Access;
1487 Success : out Boolean;
1488 From_Project_Node : Project_Node_Id;
1489 From_Project_Node_Tree : Project_Node_Tree_Ref;
1490 Env : in out Prj.Tree.Environment;
1491 Reset_Tree : Boolean := True;
1492 On_New_Tree_Loaded : Tree_Loaded_Callback := null)
1493 is
1494 begin
1495 Process_Project_Tree_Phase_1
1496 (In_Tree => In_Tree,
1497 Project => Project,
1498 Success => Success,
1499 From_Project_Node => From_Project_Node,
1500 From_Project_Node_Tree => From_Project_Node_Tree,
1501 Env => Env,
1502 Packages_To_Check => Packages_To_Check,
1503 Reset_Tree => Reset_Tree,
1504 On_New_Tree_Loaded => On_New_Tree_Loaded);
1505
1506 if Project_Qualifier_Of
1507 (From_Project_Node, From_Project_Node_Tree) /= Configuration
1508 then
1509 Process_Project_Tree_Phase_2
1510 (In_Tree => In_Tree,
1511 Project => Project,
1512 Success => Success,
1513 From_Project_Node => From_Project_Node,
1514 From_Project_Node_Tree => From_Project_Node_Tree,
1515 Env => Env);
1516 end if;
1517 end Process;
1518
1519 -------------------------------
1520 -- Process_Declarative_Items --
1521 -------------------------------
1522
1523 procedure Process_Declarative_Items
1524 (Project : Project_Id;
1525 In_Tree : Project_Tree_Ref;
1526 From_Project_Node : Project_Node_Id;
1527 Node_Tree : Project_Node_Tree_Ref;
1528 Env : Prj.Tree.Environment;
1529 Pkg : Package_Id;
1530 Item : Project_Node_Id;
1531 Child_Env : in out Prj.Tree.Environment)
1532 is
1533 Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
1534
1535 procedure Check_Or_Set_Typed_Variable
1536 (Value : in out Variable_Value;
1537 Declaration : Project_Node_Id);
1538 -- Check whether Value is valid for this typed variable declaration. If
1539 -- it is an error, the behavior depends on the flags: either an error is
1540 -- reported, or a warning, or nothing. In the last two cases, the value
1541 -- of the variable is set to a valid value, replacing Value.
1542
1543 procedure Process_Package_Declaration
1544 (Current_Item : Project_Node_Id);
1545 procedure Process_Attribute_Declaration
1546 (Current : Project_Node_Id);
1547 procedure Process_Case_Construction
1548 (Current_Item : Project_Node_Id);
1549 procedure Process_Associative_Array
1550 (Current_Item : Project_Node_Id);
1551 procedure Process_Expression
1552 (Current : Project_Node_Id);
1553 procedure Process_Expression_For_Associative_Array
1554 (Current : Project_Node_Id;
1555 New_Value : Variable_Value);
1556 procedure Process_Expression_Variable_Decl
1557 (Current_Item : Project_Node_Id;
1558 New_Value : Variable_Value);
1559 -- Process the various declarative items
1560
1561 ---------------------------------
1562 -- Check_Or_Set_Typed_Variable --
1563 ---------------------------------
1564
1565 procedure Check_Or_Set_Typed_Variable
1566 (Value : in out Variable_Value;
1567 Declaration : Project_Node_Id)
1568 is
1569 Loc : constant Source_Ptr := Location_Of (Declaration, Node_Tree);
1570
1571 Reset_Value : Boolean := False;
1572 Current_String : Project_Node_Id;
1573
1574 begin
1575 -- Report an error for an empty string
1576
1577 if Value.Value = Empty_String then
1578 Error_Msg_Name_1 := Name_Of (Declaration, Node_Tree);
1579
1580 case Env.Flags.Allow_Invalid_External is
1581 when Error =>
1582 Error_Msg
1583 (Env.Flags, "no value defined for %%", Loc, Project);
1584 when Warning =>
1585 Reset_Value := True;
1586 Error_Msg
1587 (Env.Flags, "?no value defined for %%", Loc, Project);
1588 when Silent =>
1589 Reset_Value := True;
1590 end case;
1591
1592 else
1593 -- Loop through all the valid strings for the
1594 -- string type and compare to the string value.
1595
1596 Current_String :=
1597 First_Literal_String
1598 (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1599
1600 while Present (Current_String)
1601 and then
1602 String_Value_Of (Current_String, Node_Tree) /= Value.Value
1603 loop
1604 Current_String :=
1605 Next_Literal_String (Current_String, Node_Tree);
1606 end loop;
1607
1608 -- Report error if string value is not one for the string type
1609
1610 if No (Current_String) then
1611 Error_Msg_Name_1 := Value.Value;
1612 Error_Msg_Name_2 := Name_Of (Declaration, Node_Tree);
1613
1614 case Env.Flags.Allow_Invalid_External is
1615 when Error =>
1616 Error_Msg
1617 (Env.Flags, "value %% is illegal for typed string %%",
1618 Loc, Project);
1619
1620 when Warning =>
1621 Error_Msg
1622 (Env.Flags, "?value %% is illegal for typed string %%",
1623 Loc, Project);
1624 Reset_Value := True;
1625
1626 when Silent =>
1627 Reset_Value := True;
1628 end case;
1629 end if;
1630 end if;
1631
1632 if Reset_Value then
1633 Current_String :=
1634 First_Literal_String
1635 (String_Type_Of (Declaration, Node_Tree), Node_Tree);
1636 Value.Value := String_Value_Of (Current_String, Node_Tree);
1637 end if;
1638 end Check_Or_Set_Typed_Variable;
1639
1640 ---------------------------------
1641 -- Process_Package_Declaration --
1642 ---------------------------------
1643
1644 procedure Process_Package_Declaration
1645 (Current_Item : Project_Node_Id)
1646 is
1647 begin
1648 -- Do not process a package declaration that should be ignored
1649
1650 if Expression_Kind_Of (Current_Item, Node_Tree) /= Ignored then
1651
1652 -- Create the new package
1653
1654 Package_Table.Increment_Last (Shared.Packages);
1655
1656 declare
1657 New_Pkg : constant Package_Id :=
1658 Package_Table.Last (Shared.Packages);
1659 The_New_Package : Package_Element;
1660
1661 Project_Of_Renamed_Package : constant Project_Node_Id :=
1662 Project_Of_Renamed_Package_Of
1663 (Current_Item, Node_Tree);
1664
1665 begin
1666 -- Set the name of the new package
1667
1668 The_New_Package.Name := Name_Of (Current_Item, Node_Tree);
1669
1670 -- Insert the new package in the appropriate list
1671
1672 if Pkg /= No_Package then
1673 The_New_Package.Next :=
1674 Shared.Packages.Table (Pkg).Decl.Packages;
1675 Shared.Packages.Table (Pkg).Decl.Packages := New_Pkg;
1676
1677 else
1678 The_New_Package.Next := Project.Decl.Packages;
1679 Project.Decl.Packages := New_Pkg;
1680 end if;
1681
1682 Shared.Packages.Table (New_Pkg) := The_New_Package;
1683
1684 if Present (Project_Of_Renamed_Package) then
1685
1686 -- Renamed or extending package
1687
1688 declare
1689 Project_Name : constant Name_Id :=
1690 Name_Of (Project_Of_Renamed_Package,
1691 Node_Tree);
1692
1693 Renamed_Project : constant Project_Id :=
1694 Imported_Or_Extended_Project_From
1695 (Project, Project_Name);
1696
1697 Renamed_Package : constant Package_Id :=
1698 Package_From
1699 (Renamed_Project, Shared,
1700 Name_Of (Current_Item, Node_Tree));
1701
1702 begin
1703 -- For a renamed package, copy the declarations of the
1704 -- renamed package, but set all the locations to the
1705 -- location of the package name in the renaming
1706 -- declaration.
1707
1708 Copy_Package_Declarations
1709 (From => Shared.Packages.Table
1710 (Renamed_Package).Decl,
1711 To => Shared.Packages.Table (New_Pkg).Decl,
1712 New_Loc => Location_Of (Current_Item, Node_Tree),
1713 Restricted => False,
1714 Shared => Shared);
1715 end;
1716
1717 else
1718 -- Set the default values of the attributes
1719
1720 Add_Attributes
1721 (Project,
1722 Project.Name,
1723 Name_Id (Project.Directory.Display_Name),
1724 Shared,
1725 Shared.Packages.Table (New_Pkg).Decl,
1726 First_Attribute_Of
1727 (Package_Id_Of (Current_Item, Node_Tree)),
1728 Project_Level => False);
1729 end if;
1730
1731 -- Process declarative items (nothing to do when the package is
1732 -- renaming, as the first declarative item is null).
1733
1734 Process_Declarative_Items
1735 (Project => Project,
1736 In_Tree => In_Tree,
1737 From_Project_Node => From_Project_Node,
1738 Node_Tree => Node_Tree,
1739 Env => Env,
1740 Pkg => New_Pkg,
1741 Item =>
1742 First_Declarative_Item_Of (Current_Item, Node_Tree),
1743 Child_Env => Child_Env);
1744 end;
1745 end if;
1746 end Process_Package_Declaration;
1747
1748 -------------------------------
1749 -- Process_Associative_Array --
1750 -------------------------------
1751
1752 procedure Process_Associative_Array
1753 (Current_Item : Project_Node_Id)
1754 is
1755 Current_Item_Name : constant Name_Id :=
1756 Name_Of (Current_Item, Node_Tree);
1757 -- The name of the attribute
1758
1759 Current_Location : constant Source_Ptr :=
1760 Location_Of (Current_Item, Node_Tree);
1761
1762 New_Array : Array_Id;
1763 -- The new associative array created
1764
1765 Orig_Array : Array_Id;
1766 -- The associative array value
1767
1768 Orig_Project_Name : Name_Id := No_Name;
1769 -- The name of the project where the associative array
1770 -- value is.
1771
1772 Orig_Project : Project_Id := No_Project;
1773 -- The id of the project where the associative array
1774 -- value is.
1775
1776 Orig_Package_Name : Name_Id := No_Name;
1777 -- The name of the package, if any, where the associative array value
1778 -- is located.
1779
1780 Orig_Package : Package_Id := No_Package;
1781 -- The id of the package, if any, where the associative array value
1782 -- is located.
1783
1784 New_Element : Array_Element_Id := No_Array_Element;
1785 -- Id of a new array element created
1786
1787 Prev_Element : Array_Element_Id := No_Array_Element;
1788 -- Last new element id created
1789
1790 Orig_Element : Array_Element_Id := No_Array_Element;
1791 -- Current array element in original associative array
1792
1793 Next_Element : Array_Element_Id := No_Array_Element;
1794 -- Id of the array element that follows the new element. This is not
1795 -- always nil, because values for the associative array attribute may
1796 -- already have been declared, and the array elements declared are
1797 -- reused.
1798
1799 Prj : Project_List;
1800
1801 begin
1802 -- First find if the associative array attribute already has elements
1803 -- declared.
1804
1805 if Pkg /= No_Package then
1806 New_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
1807 else
1808 New_Array := Project.Decl.Arrays;
1809 end if;
1810
1811 while New_Array /= No_Array
1812 and then Shared.Arrays.Table (New_Array).Name /= Current_Item_Name
1813 loop
1814 New_Array := Shared.Arrays.Table (New_Array).Next;
1815 end loop;
1816
1817 -- If the attribute has never been declared add new entry in the
1818 -- arrays of the project/package and link it.
1819
1820 if New_Array = No_Array then
1821 Array_Table.Increment_Last (Shared.Arrays);
1822 New_Array := Array_Table.Last (Shared.Arrays);
1823
1824 if Pkg /= No_Package then
1825 Shared.Arrays.Table (New_Array) :=
1826 (Name => Current_Item_Name,
1827 Location => Current_Location,
1828 Value => No_Array_Element,
1829 Next => Shared.Packages.Table (Pkg).Decl.Arrays);
1830
1831 Shared.Packages.Table (Pkg).Decl.Arrays := New_Array;
1832
1833 else
1834 Shared.Arrays.Table (New_Array) :=
1835 (Name => Current_Item_Name,
1836 Location => Current_Location,
1837 Value => No_Array_Element,
1838 Next => Project.Decl.Arrays);
1839
1840 Project.Decl.Arrays := New_Array;
1841 end if;
1842 end if;
1843
1844 -- Find the project where the value is declared
1845
1846 Orig_Project_Name :=
1847 Name_Of
1848 (Associative_Project_Of (Current_Item, Node_Tree), Node_Tree);
1849
1850 Prj := In_Tree.Projects;
1851 while Prj /= null loop
1852 if Prj.Project.Name = Orig_Project_Name then
1853 Orig_Project := Prj.Project;
1854 exit;
1855 end if;
1856 Prj := Prj.Next;
1857 end loop;
1858
1859 pragma Assert (Orig_Project /= No_Project,
1860 "original project not found");
1861
1862 if No (Associative_Package_Of (Current_Item, Node_Tree)) then
1863 Orig_Array := Orig_Project.Decl.Arrays;
1864
1865 else
1866 -- If in a package, find the package where the value is declared
1867
1868 Orig_Package_Name :=
1869 Name_Of
1870 (Associative_Package_Of (Current_Item, Node_Tree), Node_Tree);
1871
1872 Orig_Package := Orig_Project.Decl.Packages;
1873 pragma Assert (Orig_Package /= No_Package,
1874 "original package not found");
1875
1876 while Shared.Packages.Table
1877 (Orig_Package).Name /= Orig_Package_Name
1878 loop
1879 Orig_Package := Shared.Packages.Table (Orig_Package).Next;
1880 pragma Assert (Orig_Package /= No_Package,
1881 "original package not found");
1882 end loop;
1883
1884 Orig_Array := Shared.Packages.Table (Orig_Package).Decl.Arrays;
1885 end if;
1886
1887 -- Now look for the array
1888
1889 while Orig_Array /= No_Array
1890 and then Shared.Arrays.Table (Orig_Array).Name /= Current_Item_Name
1891 loop
1892 Orig_Array := Shared.Arrays.Table (Orig_Array).Next;
1893 end loop;
1894
1895 if Orig_Array = No_Array then
1896 Error_Msg
1897 (Env.Flags,
1898 "associative array value not found",
1899 Location_Of (Current_Item, Node_Tree),
1900 Project);
1901
1902 else
1903 Orig_Element := Shared.Arrays.Table (Orig_Array).Value;
1904
1905 -- Copy each array element
1906
1907 while Orig_Element /= No_Array_Element loop
1908
1909 -- Case of first element
1910
1911 if Prev_Element = No_Array_Element then
1912
1913 -- And there is no array element declared yet, create a new
1914 -- first array element.
1915
1916 if Shared.Arrays.Table (New_Array).Value =
1917 No_Array_Element
1918 then
1919 Array_Element_Table.Increment_Last
1920 (Shared.Array_Elements);
1921 New_Element := Array_Element_Table.Last
1922 (Shared.Array_Elements);
1923 Shared.Arrays.Table (New_Array).Value := New_Element;
1924 Next_Element := No_Array_Element;
1925
1926 -- Otherwise, the new element is the first
1927
1928 else
1929 New_Element := Shared.Arrays.Table (New_Array).Value;
1930 Next_Element :=
1931 Shared.Array_Elements.Table (New_Element).Next;
1932 end if;
1933
1934 -- Otherwise, reuse an existing element, or create
1935 -- one if necessary.
1936
1937 else
1938 Next_Element :=
1939 Shared.Array_Elements.Table (Prev_Element).Next;
1940
1941 if Next_Element = No_Array_Element then
1942 Array_Element_Table.Increment_Last
1943 (Shared.Array_Elements);
1944 New_Element := Array_Element_Table.Last
1945 (Shared.Array_Elements);
1946 Shared.Array_Elements.Table (Prev_Element).Next :=
1947 New_Element;
1948
1949 else
1950 New_Element := Next_Element;
1951 Next_Element :=
1952 Shared.Array_Elements.Table (New_Element).Next;
1953 end if;
1954 end if;
1955
1956 -- Copy the value of the element
1957
1958 Shared.Array_Elements.Table (New_Element) :=
1959 Shared.Array_Elements.Table (Orig_Element);
1960 Shared.Array_Elements.Table (New_Element).Value.Project
1961 := Project;
1962
1963 -- Adjust the Next link
1964
1965 Shared.Array_Elements.Table (New_Element).Next := Next_Element;
1966
1967 -- Adjust the previous id for the next element
1968
1969 Prev_Element := New_Element;
1970
1971 -- Go to the next element in the original array
1972
1973 Orig_Element := Shared.Array_Elements.Table (Orig_Element).Next;
1974 end loop;
1975
1976 -- Make sure that the array ends here, in case there previously a
1977 -- greater number of elements.
1978
1979 Shared.Array_Elements.Table (New_Element).Next := No_Array_Element;
1980 end if;
1981 end Process_Associative_Array;
1982
1983 ----------------------------------------------
1984 -- Process_Expression_For_Associative_Array --
1985 ----------------------------------------------
1986
1987 procedure Process_Expression_For_Associative_Array
1988 (Current : Project_Node_Id;
1989 New_Value : Variable_Value)
1990 is
1991 Name : constant Name_Id := Name_Of (Current, Node_Tree);
1992 Current_Location : constant Source_Ptr :=
1993 Location_Of (Current, Node_Tree);
1994
1995 Index_Name : Name_Id :=
1996 Associative_Array_Index_Of (Current, Node_Tree);
1997
1998 Source_Index : constant Int :=
1999 Source_Index_Of (Current, Node_Tree);
2000
2001 The_Array : Array_Id;
2002 Elem : Array_Element_Id := No_Array_Element;
2003
2004 begin
2005 if Index_Name /= All_Other_Names then
2006 Index_Name := Get_Attribute_Index (Node_Tree, Current, Index_Name);
2007 end if;
2008
2009 -- Look for the array in the appropriate list
2010
2011 if Pkg /= No_Package then
2012 The_Array := Shared.Packages.Table (Pkg).Decl.Arrays;
2013 else
2014 The_Array := Project.Decl.Arrays;
2015 end if;
2016
2017 while The_Array /= No_Array
2018 and then Shared.Arrays.Table (The_Array).Name /= Name
2019 loop
2020 The_Array := Shared.Arrays.Table (The_Array).Next;
2021 end loop;
2022
2023 -- If the array cannot be found, create a new entry in the list.
2024 -- As The_Array_Element is initialized to No_Array_Element, a new
2025 -- element will be created automatically later
2026
2027 if The_Array = No_Array then
2028 Array_Table.Increment_Last (Shared.Arrays);
2029 The_Array := Array_Table.Last (Shared.Arrays);
2030
2031 if Pkg /= No_Package then
2032 Shared.Arrays.Table (The_Array) :=
2033 (Name => Name,
2034 Location => Current_Location,
2035 Value => No_Array_Element,
2036 Next => Shared.Packages.Table (Pkg).Decl.Arrays);
2037
2038 Shared.Packages.Table (Pkg).Decl.Arrays := The_Array;
2039
2040 else
2041 Shared.Arrays.Table (The_Array) :=
2042 (Name => Name,
2043 Location => Current_Location,
2044 Value => No_Array_Element,
2045 Next => Project.Decl.Arrays);
2046
2047 Project.Decl.Arrays := The_Array;
2048 end if;
2049
2050 else
2051 Elem := Shared.Arrays.Table (The_Array).Value;
2052 end if;
2053
2054 -- Look in the list, if any, to find an element with the same index
2055 -- and same source index.
2056
2057 while Elem /= No_Array_Element
2058 and then
2059 (Shared.Array_Elements.Table (Elem).Index /= Index_Name
2060 or else
2061 Shared.Array_Elements.Table (Elem).Src_Index /= Source_Index)
2062 loop
2063 Elem := Shared.Array_Elements.Table (Elem).Next;
2064 end loop;
2065
2066 -- If no such element were found, create a new one
2067 -- and insert it in the element list, with the
2068 -- proper value.
2069
2070 if Elem = No_Array_Element then
2071 Array_Element_Table.Increment_Last (Shared.Array_Elements);
2072 Elem := Array_Element_Table.Last (Shared.Array_Elements);
2073
2074 Shared.Array_Elements.Table
2075 (Elem) :=
2076 (Index => Index_Name,
2077 Restricted => False,
2078 Src_Index => Source_Index,
2079 Index_Case_Sensitive =>
2080 not Case_Insensitive (Current, Node_Tree),
2081 Value => New_Value,
2082 Next => Shared.Arrays.Table (The_Array).Value);
2083
2084 Shared.Arrays.Table (The_Array).Value := Elem;
2085
2086 else
2087 -- An element with the same index already exists, just replace its
2088 -- value with the new one.
2089
2090 Shared.Array_Elements.Table (Elem).Value := New_Value;
2091 end if;
2092
2093 if Name = Snames.Name_External then
2094 if In_Tree.Is_Root_Tree then
2095 Add (Child_Env.External,
2096 External_Name => Get_Name_String (Index_Name),
2097 Value => Get_Name_String (New_Value.Value),
2098 Source => From_External_Attribute);
2099 Add (Env.External,
2100 External_Name => Get_Name_String (Index_Name),
2101 Value => Get_Name_String (New_Value.Value),
2102 Source => From_External_Attribute,
2103 Silent => True);
2104 else
2105 if Current_Verbosity = High then
2106 Debug_Output
2107 ("'for External' has no effect except in root aggregate ("
2108 & Get_Name_String (Index_Name) & ")", New_Value.Value);
2109 end if;
2110 end if;
2111 end if;
2112 end Process_Expression_For_Associative_Array;
2113
2114 --------------------------------------
2115 -- Process_Expression_Variable_Decl --
2116 --------------------------------------
2117
2118 procedure Process_Expression_Variable_Decl
2119 (Current_Item : Project_Node_Id;
2120 New_Value : Variable_Value)
2121 is
2122 Name : constant Name_Id := Name_Of (Current_Item, Node_Tree);
2123
2124 Is_Attribute : constant Boolean :=
2125 Kind_Of (Current_Item, Node_Tree) =
2126 N_Attribute_Declaration;
2127
2128 Var : Variable_Id := No_Variable;
2129
2130 begin
2131 -- First, find the list where to find the variable or attribute
2132
2133 if Is_Attribute then
2134 if Pkg /= No_Package then
2135 Var := Shared.Packages.Table (Pkg).Decl.Attributes;
2136 else
2137 Var := Project.Decl.Attributes;
2138 end if;
2139
2140 else
2141 if Pkg /= No_Package then
2142 Var := Shared.Packages.Table (Pkg).Decl.Variables;
2143 else
2144 Var := Project.Decl.Variables;
2145 end if;
2146 end if;
2147
2148 -- Loop through the list, to find if it has already been declared
2149
2150 while Var /= No_Variable
2151 and then Shared.Variable_Elements.Table (Var).Name /= Name
2152 loop
2153 Var := Shared.Variable_Elements.Table (Var).Next;
2154 end loop;
2155
2156 -- If it has not been declared, create a new entry in the list
2157
2158 if Var = No_Variable then
2159
2160 -- All single string attribute should already have been declared
2161 -- with a default empty string value.
2162
2163 pragma Assert
2164 (not Is_Attribute,
2165 "illegal attribute declaration for " & Get_Name_String (Name));
2166
2167 Variable_Element_Table.Increment_Last (Shared.Variable_Elements);
2168 Var := Variable_Element_Table.Last (Shared.Variable_Elements);
2169
2170 -- Put the new variable in the appropriate list
2171
2172 if Pkg /= No_Package then
2173 Shared.Variable_Elements.Table (Var) :=
2174 (Next => Shared.Packages.Table (Pkg).Decl.Variables,
2175 Name => Name,
2176 Value => New_Value);
2177 Shared.Packages.Table (Pkg).Decl.Variables := Var;
2178
2179 else
2180 Shared.Variable_Elements.Table (Var) :=
2181 (Next => Project.Decl.Variables,
2182 Name => Name,
2183 Value => New_Value);
2184 Project.Decl.Variables := Var;
2185 end if;
2186
2187 -- If the variable/attribute has already been declared, just
2188 -- change the value.
2189
2190 else
2191 Shared.Variable_Elements.Table (Var).Value := New_Value;
2192 end if;
2193
2194 if Is_Attribute and then Name = Snames.Name_Project_Path then
2195 if In_Tree.Is_Root_Tree then
2196 declare
2197 package Name_Ids is
2198 new Ada.Containers.Vectors (Positive, Name_Id);
2199 Val : String_List_Id := New_Value.Values;
2200 List : Name_Ids.Vector;
2201 begin
2202 -- Get all values
2203
2204 while Val /= Nil_String loop
2205 List.Prepend
2206 (Shared.String_Elements.Table (Val).Value);
2207 Val := Shared.String_Elements.Table (Val).Next;
2208 end loop;
2209
2210 -- Prepend them in the order found in the attribute
2211
2212 for K in Positive range 1 .. Positive (List.Length) loop
2213 Prj.Env.Add_Directories
2214 (Child_Env.Project_Path,
2215 Normalize_Pathname
2216 (Name => Get_Name_String
2217 (List.Element (K)),
2218 Directory => Get_Name_String
2219 (Project.Directory.Display_Name)),
2220 Prepend => True);
2221 end loop;
2222 end;
2223
2224 else
2225 if Current_Verbosity = High then
2226 Debug_Output
2227 ("'for Project_Path' has no effect except in"
2228 & " root aggregate");
2229 end if;
2230 end if;
2231 end if;
2232 end Process_Expression_Variable_Decl;
2233
2234 ------------------------
2235 -- Process_Expression --
2236 ------------------------
2237
2238 procedure Process_Expression (Current : Project_Node_Id) is
2239 New_Value : Variable_Value :=
2240 Expression
2241 (Project => Project,
2242 Shared => Shared,
2243 From_Project_Node => From_Project_Node,
2244 From_Project_Node_Tree => Node_Tree,
2245 Env => Env,
2246 Pkg => Pkg,
2247 First_Term =>
2248 Tree.First_Term
2249 (Expression_Of (Current, Node_Tree), Node_Tree),
2250 Kind =>
2251 Expression_Kind_Of (Current, Node_Tree));
2252
2253 begin
2254 -- Process a typed variable declaration
2255
2256 if Kind_Of (Current, Node_Tree) = N_Typed_Variable_Declaration then
2257 Check_Or_Set_Typed_Variable (New_Value, Current);
2258 end if;
2259
2260 if Kind_Of (Current, Node_Tree) /= N_Attribute_Declaration
2261 or else Associative_Array_Index_Of (Current, Node_Tree) = No_Name
2262 then
2263 Process_Expression_Variable_Decl (Current, New_Value);
2264 else
2265 Process_Expression_For_Associative_Array (Current, New_Value);
2266 end if;
2267 end Process_Expression;
2268
2269 -----------------------------------
2270 -- Process_Attribute_Declaration --
2271 -----------------------------------
2272
2273 procedure Process_Attribute_Declaration (Current : Project_Node_Id) is
2274 begin
2275 if Expression_Of (Current, Node_Tree) = Empty_Node then
2276 Process_Associative_Array (Current);
2277 else
2278 Process_Expression (Current);
2279 end if;
2280 end Process_Attribute_Declaration;
2281
2282 -------------------------------
2283 -- Process_Case_Construction --
2284 -------------------------------
2285
2286 procedure Process_Case_Construction
2287 (Current_Item : Project_Node_Id)
2288 is
2289 The_Project : Project_Id := Project;
2290 -- The id of the project of the case variable
2291
2292 The_Package : Package_Id := Pkg;
2293 -- The id of the package, if any, of the case variable
2294
2295 The_Variable : Variable_Value := Nil_Variable_Value;
2296 -- The case variable
2297
2298 Case_Value : Name_Id := No_Name;
2299 -- The case variable value
2300
2301 Case_Item : Project_Node_Id := Empty_Node;
2302 Choice_String : Project_Node_Id := Empty_Node;
2303 Decl_Item : Project_Node_Id := Empty_Node;
2304
2305 begin
2306 declare
2307 Variable_Node : constant Project_Node_Id :=
2308 Case_Variable_Reference_Of
2309 (Current_Item,
2310 Node_Tree);
2311
2312 Var_Id : Variable_Id := No_Variable;
2313 Name : Name_Id := No_Name;
2314
2315 begin
2316 -- If a project was specified for the case variable, get its id
2317
2318 if Present (Project_Node_Of (Variable_Node, Node_Tree)) then
2319 Name :=
2320 Name_Of
2321 (Project_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2322 The_Project :=
2323 Imported_Or_Extended_Project_From
2324 (Project, Name, No_Extending => True);
2325 The_Package := No_Package;
2326 end if;
2327
2328 -- If a package was specified for the case variable, get its id
2329
2330 if Present (Package_Node_Of (Variable_Node, Node_Tree)) then
2331 Name :=
2332 Name_Of
2333 (Package_Node_Of (Variable_Node, Node_Tree), Node_Tree);
2334 The_Package := Package_From (The_Project, Shared, Name);
2335 end if;
2336
2337 Name := Name_Of (Variable_Node, Node_Tree);
2338
2339 -- First, look for the case variable into the package, if any
2340
2341 if The_Package /= No_Package then
2342 Name := Name_Of (Variable_Node, Node_Tree);
2343
2344 Var_Id := Shared.Packages.Table (The_Package).Decl.Variables;
2345 while Var_Id /= No_Variable
2346 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
2347 loop
2348 Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
2349 end loop;
2350 end if;
2351
2352 -- If not found in the package, or if there is no package, look at
2353 -- the project level.
2354
2355 if Var_Id = No_Variable
2356 and then No (Package_Node_Of (Variable_Node, Node_Tree))
2357 then
2358 Var_Id := The_Project.Decl.Variables;
2359 while Var_Id /= No_Variable
2360 and then Shared.Variable_Elements.Table (Var_Id).Name /= Name
2361 loop
2362 Var_Id := Shared.Variable_Elements.Table (Var_Id).Next;
2363 end loop;
2364 end if;
2365
2366 if Var_Id = No_Variable then
2367
2368 -- Should never happen, because this has already been checked
2369 -- during parsing.
2370
2371 Write_Line
2372 ("variable """ & Get_Name_String (Name) & """ not found");
2373 raise Program_Error;
2374 end if;
2375
2376 -- Get the case variable
2377
2378 The_Variable := Shared.Variable_Elements. Table (Var_Id).Value;
2379
2380 if The_Variable.Kind /= Single then
2381
2382 -- Should never happen, because this has already been checked
2383 -- during parsing.
2384
2385 Write_Line ("variable""" & Get_Name_String (Name) &
2386 """ is not a single string variable");
2387 raise Program_Error;
2388 end if;
2389
2390 -- Get the case variable value
2391
2392 Case_Value := The_Variable.Value;
2393 end;
2394
2395 -- Now look into all the case items of the case construction
2396
2397 Case_Item := First_Case_Item_Of (Current_Item, Node_Tree);
2398
2399 Case_Item_Loop :
2400 while Present (Case_Item) loop
2401 Choice_String := First_Choice_Of (Case_Item, Node_Tree);
2402
2403 -- When Choice_String is nil, it means that it is the
2404 -- "when others =>" alternative.
2405
2406 if No (Choice_String) then
2407 Decl_Item := First_Declarative_Item_Of (Case_Item, Node_Tree);
2408 exit Case_Item_Loop;
2409 end if;
2410
2411 -- Look into all the alternative of this case item
2412
2413 Choice_Loop :
2414 while Present (Choice_String) loop
2415 if Case_Value = String_Value_Of (Choice_String, Node_Tree) then
2416 Decl_Item :=
2417 First_Declarative_Item_Of (Case_Item, Node_Tree);
2418 exit Case_Item_Loop;
2419 end if;
2420
2421 Choice_String := Next_Literal_String (Choice_String, Node_Tree);
2422 end loop Choice_Loop;
2423
2424 Case_Item := Next_Case_Item (Case_Item, Node_Tree);
2425 end loop Case_Item_Loop;
2426
2427 -- If there is an alternative, then we process it
2428
2429 if Present (Decl_Item) then
2430 Process_Declarative_Items
2431 (Project => Project,
2432 In_Tree => In_Tree,
2433 From_Project_Node => From_Project_Node,
2434 Node_Tree => Node_Tree,
2435 Env => Env,
2436 Pkg => Pkg,
2437 Item => Decl_Item,
2438 Child_Env => Child_Env);
2439 end if;
2440 end Process_Case_Construction;
2441
2442 -- Local variables
2443
2444 Current, Decl : Project_Node_Id;
2445 Kind : Project_Node_Kind;
2446
2447 -- Start of processing for Process_Declarative_Items
2448
2449 begin
2450 Decl := Item;
2451 while Present (Decl) loop
2452 Current := Current_Item_Node (Decl, Node_Tree);
2453 Decl := Next_Declarative_Item (Decl, Node_Tree);
2454 Kind := Kind_Of (Current, Node_Tree);
2455
2456 case Kind is
2457 when N_Package_Declaration =>
2458 Process_Package_Declaration (Current);
2459
2460 -- Nothing to process for string type declaration
2461
2462 when N_String_Type_Declaration =>
2463 null;
2464
2465 when N_Attribute_Declaration |
2466 N_Typed_Variable_Declaration |
2467 N_Variable_Declaration =>
2468 Process_Attribute_Declaration (Current);
2469
2470 when N_Case_Construction =>
2471 Process_Case_Construction (Current);
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;
GNU Compiler Collection
This page took 0.176925 seconds and 5 git commands to generate.