1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Err_Vars; use Err_Vars;
28 with Osint; use Osint;
29 with Output; use Output;
30 with Prj.Attr; use Prj.Attr;
31 with Prj.Err; use Prj.Err;
32 with Prj.Ext; use Prj.Ext;
33 with Prj.Nmsc; use Prj.Nmsc;
36 with GNAT.Case_Util; use GNAT.Case_Util;
39 package body Prj.Proc is
41 package Processed_Projects is new GNAT.HTable.Simple_HTable
42 (Header_Num => Header_Num,
43 Element => Project_Id,
44 No_Element => No_Project,
48 -- This hash table contains all processed projects
50 package Unit_Htable is new GNAT.HTable.Simple_HTable
51 (Header_Num => Header_Num,
53 No_Element => No_Source,
57 -- This hash table contains all processed projects
59 procedure Add (To_Exp : in out Name_Id; Str : Name_Id);
60 -- Concatenate two strings and returns another string if both
61 -- arguments are not null string.
63 -- In the following procedures, we are expected to guess the meaning of
64 -- the parameters from their names, this is never a good idea, comments
65 -- should be added precisely defining every formal ???
67 procedure Add_Attributes
68 (Project : Project_Id;
69 Project_Name : Name_Id;
70 Project_Dir : Name_Id;
71 In_Tree : Project_Tree_Ref;
72 Decl : in out Declarations;
73 First : Attribute_Node_Id;
74 Project_Level : Boolean);
75 -- Add all attributes, starting with First, with their default values to
76 -- the package or project with declarations Decl.
79 (In_Tree : Project_Tree_Ref;
81 Flags : Processing_Flags);
82 -- Set all projects to not checked, then call Recursive_Check for the
83 -- main project Project. Project is set to No_Project if errors occurred.
84 -- Current_Dir is for optimization purposes, avoiding extra system calls.
85 -- If Allow_Duplicate_Basenames, then files with the same base names are
86 -- authorized within a project for source-based languages (never for unit
89 procedure Copy_Package_Declarations
91 To : in out Declarations;
93 Naming_Restricted : Boolean;
94 In_Tree : Project_Tree_Ref);
95 -- Copy a package declaration From to To for a renamed package. Change the
96 -- locations of all the attributes to New_Loc. When Naming_Restricted is
97 -- True, do not copy attributes Body, Spec, Implementation and
101 (Project : Project_Id;
102 In_Tree : Project_Tree_Ref;
103 Flags : Processing_Flags;
104 From_Project_Node : Project_Node_Id;
105 From_Project_Node_Tree : Project_Node_Tree_Ref;
107 First_Term : Project_Node_Id;
108 Kind : Variable_Kind) return Variable_Value;
109 -- From N_Expression project node From_Project_Node, compute the value
110 -- of an expression and return it as a Variable_Value.
112 function Imported_Or_Extended_Project_From
113 (Project : Project_Id;
114 With_Name : Name_Id) return Project_Id;
115 -- Find an imported or extended project of Project whose name is With_Name
117 function Package_From
118 (Project : Project_Id;
119 In_Tree : Project_Tree_Ref;
120 With_Name : Name_Id) return Package_Id;
121 -- Find the package of Project whose name is With_Name
123 procedure Process_Declarative_Items
124 (Project : Project_Id;
125 In_Tree : Project_Tree_Ref;
126 Flags : Processing_Flags;
127 From_Project_Node : Project_Node_Id;
128 From_Project_Node_Tree : Project_Node_Tree_Ref;
130 Item : Project_Node_Id);
131 -- Process declarative items starting with From_Project_Node, and put them
132 -- in declarations Decl. This is a recursive procedure; it calls itself for
133 -- a package declaration or a case construction.
135 procedure Recursive_Process
136 (In_Tree : Project_Tree_Ref;
137 Project : out Project_Id;
138 Flags : Processing_Flags;
139 From_Project_Node : Project_Node_Id;
140 From_Project_Node_Tree : Project_Node_Tree_Ref;
141 Extended_By : Project_Id);
142 -- Process project with node From_Project_Node in the tree. Do nothing if
143 -- From_Project_Node is Empty_Node. If project has already been processed,
144 -- simply return its project id. Otherwise create a new project id, mark it
145 -- as processed, call itself recursively for all imported projects and a
146 -- extended project, if any. Then process the declarative items of the
149 function Get_Attribute_Index
150 (Tree : Project_Node_Tree_Ref;
151 Attr : Project_Node_Id;
152 Index : Name_Id) return Name_Id;
153 -- Copy the index of the attribute into Name_Buffer, converting to lower
154 -- case if the attribute is case-insensitive.
160 procedure Add (To_Exp : in out Name_Id; Str : Name_Id) is
162 if To_Exp = No_Name or else To_Exp = Empty_String then
164 -- To_Exp is nil or empty. The result is Str
168 -- If Str is nil, then do not change To_Ext
170 elsif Str /= No_Name and then Str /= Empty_String then
172 S : constant String := Get_Name_String (Str);
174 Get_Name_String (To_Exp);
175 Add_Str_To_Name_Buffer (S);
185 procedure Add_Attributes
186 (Project : Project_Id;
187 Project_Name : Name_Id;
188 Project_Dir : Name_Id;
189 In_Tree : Project_Tree_Ref;
190 Decl : in out Declarations;
191 First : Attribute_Node_Id;
192 Project_Level : Boolean)
194 The_Attribute : Attribute_Node_Id := First;
197 while The_Attribute /= Empty_Attribute loop
198 if Attribute_Kind_Of (The_Attribute) = Single then
200 New_Attribute : Variable_Value;
203 case Variable_Kind_Of (The_Attribute) is
205 -- Undefined should not happen
209 (False, "attribute with an undefined kind");
212 -- Single attributes have a default value of empty string
218 Location => No_Location,
220 Value => Empty_String,
223 -- Special cases of <project>'Name and
224 -- <project>'Project_Dir.
226 if Project_Level then
227 if Attribute_Name_Of (The_Attribute) =
230 New_Attribute.Value := Project_Name;
232 elsif Attribute_Name_Of (The_Attribute) =
233 Snames.Name_Project_Dir
235 New_Attribute.Value := Project_Dir;
239 -- List attributes have a default value of nil list
245 Location => No_Location,
247 Values => Nil_String);
251 Variable_Element_Table.Increment_Last
252 (In_Tree.Variable_Elements);
253 In_Tree.Variable_Elements.Table
254 (Variable_Element_Table.Last
255 (In_Tree.Variable_Elements)) :=
256 (Next => Decl.Attributes,
257 Name => Attribute_Name_Of (The_Attribute),
258 Value => New_Attribute);
259 Decl.Attributes := Variable_Element_Table.Last
260 (In_Tree.Variable_Elements);
264 The_Attribute := Next_Attribute (After => The_Attribute);
273 (In_Tree : Project_Tree_Ref;
274 Project : Project_Id;
275 Flags : Processing_Flags)
278 Process_Naming_Scheme (In_Tree, Project, Flags);
280 -- Set the Other_Part field for the units
286 Iter : Source_Iterator;
291 Iter := For_Each_Source (In_Tree);
293 Source1 := Prj.Element (Iter);
294 exit when Source1 = No_Source;
296 if Source1.Unit /= No_Unit_Index then
297 Name := Source1.Unit.Name;
298 Source2 := Unit_Htable.Get (Name);
300 if Source2 = No_Source then
301 Unit_Htable.Set (K => Name, E => Source1);
303 Unit_Htable.Remove (Name);
312 -------------------------------
313 -- Copy_Package_Declarations --
314 -------------------------------
316 procedure Copy_Package_Declarations
317 (From : Declarations;
318 To : in out Declarations;
319 New_Loc : Source_Ptr;
320 Naming_Restricted : Boolean;
321 In_Tree : Project_Tree_Ref)
324 V2 : Variable_Id := No_Variable;
327 A2 : Array_Id := No_Array;
329 E1 : Array_Element_Id;
330 E2 : Array_Element_Id := No_Array_Element;
334 -- To avoid references in error messages to attribute declarations in
335 -- an original package that has been renamed, copy all the attribute
336 -- declarations of the package and change all locations to New_Loc,
337 -- the location of the renamed package.
339 -- First single attributes
341 V1 := From.Attributes;
342 while V1 /= No_Variable loop
344 -- Copy the attribute
346 Var := In_Tree.Variable_Elements.Table (V1);
349 -- Remove the Next component
351 Var.Next := No_Variable;
353 -- Change the location to New_Loc
355 Var.Value.Location := New_Loc;
356 Variable_Element_Table.Increment_Last (In_Tree.Variable_Elements);
358 -- Put in new declaration
360 if To.Attributes = No_Variable then
362 Variable_Element_Table.Last (In_Tree.Variable_Elements);
364 In_Tree.Variable_Elements.Table (V2).Next :=
365 Variable_Element_Table.Last (In_Tree.Variable_Elements);
368 V2 := Variable_Element_Table.Last (In_Tree.Variable_Elements);
369 In_Tree.Variable_Elements.Table (V2) := Var;
372 -- Then the associated array attributes
375 while A1 /= No_Array loop
376 Arr := In_Tree.Arrays.Table (A1);
379 if not Naming_Restricted or else
380 (Arr.Name /= Snames.Name_Body
381 and then Arr.Name /= Snames.Name_Spec
382 and then Arr.Name /= Snames.Name_Implementation
383 and then Arr.Name /= Snames.Name_Specification)
385 -- Remove the Next component
387 Arr.Next := No_Array;
389 Array_Table.Increment_Last (In_Tree.Arrays);
391 -- Create new Array declaration
393 if To.Arrays = No_Array then
394 To.Arrays := Array_Table.Last (In_Tree.Arrays);
396 In_Tree.Arrays.Table (A2).Next :=
397 Array_Table.Last (In_Tree.Arrays);
400 A2 := Array_Table.Last (In_Tree.Arrays);
402 -- Don't store the array as its first element has not been set yet
404 -- Copy the array elements of the array
407 Arr.Value := No_Array_Element;
408 while E1 /= No_Array_Element loop
410 -- Copy the array element
412 Elm := In_Tree.Array_Elements.Table (E1);
415 -- Remove the Next component
417 Elm.Next := No_Array_Element;
419 -- Change the location
421 Elm.Value.Location := New_Loc;
422 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
424 -- Create new array element
426 if Arr.Value = No_Array_Element then
428 Array_Element_Table.Last (In_Tree.Array_Elements);
430 In_Tree.Array_Elements.Table (E2).Next :=
431 Array_Element_Table.Last (In_Tree.Array_Elements);
434 E2 := Array_Element_Table.Last (In_Tree.Array_Elements);
435 In_Tree.Array_Elements.Table (E2) := Elm;
438 -- Finally, store the new array
440 In_Tree.Arrays.Table (A2) := Arr;
443 end Copy_Package_Declarations;
445 -------------------------
446 -- Get_Attribute_Index --
447 -------------------------
449 function Get_Attribute_Index
450 (Tree : Project_Node_Tree_Ref;
451 Attr : Project_Node_Id;
452 Index : Name_Id) return Name_Id
457 Get_Name_String (Index);
458 Lower := Case_Insensitive (Attr, Tree);
460 -- The index is always case insensitive if it does not include any dot.
461 -- ??? Why not use the properties from prj-attr, simply, maybe because
462 -- we don't know whether we have a file as an index?
467 for J in 1 .. Name_Len loop
468 if Name_Buffer (J) = '.' then
476 To_Lower (Name_Buffer (1 .. Name_Len));
481 end Get_Attribute_Index;
488 (Project : Project_Id;
489 In_Tree : Project_Tree_Ref;
490 Flags : Processing_Flags;
491 From_Project_Node : Project_Node_Id;
492 From_Project_Node_Tree : Project_Node_Tree_Ref;
494 First_Term : Project_Node_Id;
495 Kind : Variable_Kind) return Variable_Value
497 The_Term : Project_Node_Id;
498 -- The term in the expression list
500 The_Current_Term : Project_Node_Id := Empty_Node;
501 -- The current term node id
503 Result : Variable_Value (Kind => Kind);
504 -- The returned result
506 Last : String_List_Id := Nil_String;
507 -- Reference to the last string elements in Result, when Kind is List
510 Result.Project := Project;
511 Result.Location := Location_Of (First_Term, From_Project_Node_Tree);
513 -- Process each term of the expression, starting with First_Term
515 The_Term := First_Term;
516 while Present (The_Term) loop
517 The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
519 case Kind_Of (The_Current_Term, From_Project_Node_Tree) is
521 when N_Literal_String =>
527 -- Should never happen
529 pragma Assert (False, "Undefined expression kind");
535 (The_Current_Term, From_Project_Node_Tree));
538 (The_Current_Term, From_Project_Node_Tree);
542 String_Element_Table.Increment_Last
543 (In_Tree.String_Elements);
545 if Last = Nil_String then
547 -- This can happen in an expression like () & "toto"
549 Result.Values := String_Element_Table.Last
550 (In_Tree.String_Elements);
553 In_Tree.String_Elements.Table
554 (Last).Next := String_Element_Table.Last
555 (In_Tree.String_Elements);
558 Last := String_Element_Table.Last
559 (In_Tree.String_Elements);
561 In_Tree.String_Elements.Table (Last) :=
562 (Value => String_Value_Of
564 From_Project_Node_Tree),
565 Index => Source_Index_Of
567 From_Project_Node_Tree),
568 Display_Value => No_Name,
569 Location => Location_Of
571 From_Project_Node_Tree),
576 when N_Literal_String_List =>
579 String_Node : Project_Node_Id :=
580 First_Expression_In_List
582 From_Project_Node_Tree);
584 Value : Variable_Value;
587 if Present (String_Node) then
589 -- If String_Node is nil, it is an empty list, there is
596 From_Project_Node => From_Project_Node,
597 From_Project_Node_Tree => From_Project_Node_Tree,
601 (String_Node, From_Project_Node_Tree),
603 String_Element_Table.Increment_Last
604 (In_Tree.String_Elements);
606 if Result.Values = Nil_String then
608 -- This literal string list is the first term in a
609 -- string list expression
612 String_Element_Table.Last (In_Tree.String_Elements);
615 In_Tree.String_Elements.Table
617 String_Element_Table.Last (In_Tree.String_Elements);
621 String_Element_Table.Last (In_Tree.String_Elements);
623 In_Tree.String_Elements.Table (Last) :=
624 (Value => Value.Value,
625 Display_Value => No_Name,
626 Location => Value.Location,
629 Index => Value.Index);
632 -- Add the other element of the literal string list
633 -- one after the other
636 Next_Expression_In_List
637 (String_Node, From_Project_Node_Tree);
639 exit when No (String_Node);
646 From_Project_Node => From_Project_Node,
647 From_Project_Node_Tree => From_Project_Node_Tree,
651 (String_Node, From_Project_Node_Tree),
654 String_Element_Table.Increment_Last
655 (In_Tree.String_Elements);
656 In_Tree.String_Elements.Table
657 (Last).Next := String_Element_Table.Last
658 (In_Tree.String_Elements);
659 Last := String_Element_Table.Last
660 (In_Tree.String_Elements);
661 In_Tree.String_Elements.Table (Last) :=
662 (Value => Value.Value,
663 Display_Value => No_Name,
664 Location => Value.Location,
667 Index => Value.Index);
672 when N_Variable_Reference | N_Attribute_Reference =>
675 The_Project : Project_Id := Project;
676 The_Package : Package_Id := Pkg;
677 The_Name : Name_Id := No_Name;
678 The_Variable_Id : Variable_Id := No_Variable;
679 The_Variable : Variable_Value;
680 Term_Project : constant Project_Node_Id :=
683 From_Project_Node_Tree);
684 Term_Package : constant Project_Node_Id :=
687 From_Project_Node_Tree);
688 Index : Name_Id := No_Name;
691 if Present (Term_Project) and then
692 Term_Project /= From_Project_Node
694 -- This variable or attribute comes from another project
697 Name_Of (Term_Project, From_Project_Node_Tree);
698 The_Project := Imported_Or_Extended_Project_From
700 With_Name => The_Name);
703 if Present (Term_Package) then
705 -- This is an attribute of a package
708 Name_Of (Term_Package, From_Project_Node_Tree);
709 The_Package := The_Project.Decl.Packages;
711 while The_Package /= No_Package
712 and then In_Tree.Packages.Table
713 (The_Package).Name /= The_Name
716 In_Tree.Packages.Table
721 (The_Package /= No_Package,
722 "package not found.");
724 elsif Kind_Of (The_Current_Term, From_Project_Node_Tree) =
725 N_Attribute_Reference
727 The_Package := No_Package;
731 Name_Of (The_Current_Term, From_Project_Node_Tree);
733 if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
734 N_Attribute_Reference
737 Associative_Array_Index_Of
738 (The_Current_Term, From_Project_Node_Tree);
741 -- If it is not an associative array attribute
743 if Index = No_Name then
745 -- It is not an associative array attribute
747 if The_Package /= No_Package then
749 -- First, if there is a package, look into the package
751 if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
755 In_Tree.Packages.Table
756 (The_Package).Decl.Variables;
759 In_Tree.Packages.Table
760 (The_Package).Decl.Attributes;
763 while The_Variable_Id /= No_Variable
765 In_Tree.Variable_Elements.Table
766 (The_Variable_Id).Name /= The_Name
769 In_Tree.Variable_Elements.Table
770 (The_Variable_Id).Next;
775 if The_Variable_Id = No_Variable then
777 -- If we have not found it, look into the project
779 if Kind_Of (The_Current_Term, From_Project_Node_Tree) =
782 The_Variable_Id := The_Project.Decl.Variables;
784 The_Variable_Id := The_Project.Decl.Attributes;
787 while The_Variable_Id /= No_Variable
789 In_Tree.Variable_Elements.Table
790 (The_Variable_Id).Name /= The_Name
793 In_Tree.Variable_Elements.Table
794 (The_Variable_Id).Next;
799 pragma Assert (The_Variable_Id /= No_Variable,
800 "variable or attribute not found");
803 In_Tree.Variable_Elements.Table
804 (The_Variable_Id).Value;
808 -- It is an associative array attribute
811 The_Array : Array_Id := No_Array;
812 The_Element : Array_Element_Id := No_Array_Element;
813 Array_Index : Name_Id := No_Name;
816 if The_Package /= No_Package then
818 In_Tree.Packages.Table
819 (The_Package).Decl.Arrays;
821 The_Array := The_Project.Decl.Arrays;
824 while The_Array /= No_Array
825 and then In_Tree.Arrays.Table
826 (The_Array).Name /= The_Name
828 The_Array := In_Tree.Arrays.Table
832 if The_Array /= No_Array then
833 The_Element := In_Tree.Arrays.Table
837 (From_Project_Node_Tree,
841 while The_Element /= No_Array_Element
843 In_Tree.Array_Elements.Table
844 (The_Element).Index /= Array_Index
847 In_Tree.Array_Elements.Table
853 if The_Element /= No_Array_Element then
855 In_Tree.Array_Elements.Table
859 if Expression_Kind_Of
860 (The_Current_Term, From_Project_Node_Tree) =
866 Location => No_Location,
868 Values => Nil_String);
873 Location => No_Location,
875 Value => Empty_String,
886 -- Should never happen
888 pragma Assert (False, "undefined expression kind");
893 case The_Variable.Kind is
899 Add (Result.Value, The_Variable.Value);
903 -- Should never happen
907 "list cannot appear in single " &
908 "string expression");
913 case The_Variable.Kind is
919 String_Element_Table.Increment_Last
920 (In_Tree.String_Elements);
922 if Last = Nil_String then
924 -- This can happen in an expression such as
928 String_Element_Table.Last
929 (In_Tree.String_Elements);
932 In_Tree.String_Elements.Table
934 String_Element_Table.Last
935 (In_Tree.String_Elements);
939 String_Element_Table.Last
940 (In_Tree.String_Elements);
942 In_Tree.String_Elements.Table (Last) :=
943 (Value => The_Variable.Value,
944 Display_Value => No_Name,
945 Location => Location_Of
947 From_Project_Node_Tree),
955 The_List : String_List_Id :=
959 while The_List /= Nil_String loop
960 String_Element_Table.Increment_Last
961 (In_Tree.String_Elements);
963 if Last = Nil_String then
965 String_Element_Table.Last
971 String_Elements.Table (Last).Next :=
972 String_Element_Table.Last
979 String_Element_Table.Last
980 (In_Tree.String_Elements);
982 In_Tree.String_Elements.Table (Last) :=
984 In_Tree.String_Elements.Table
986 Display_Value => No_Name,
990 From_Project_Node_Tree),
996 In_Tree. String_Elements.Table
1004 when N_External_Value =>
1007 (External_Reference_Of
1008 (The_Current_Term, From_Project_Node_Tree),
1009 From_Project_Node_Tree));
1012 Name : constant Name_Id := Name_Find;
1013 Default : Name_Id := No_Name;
1014 Value : Name_Id := No_Name;
1016 Def_Var : Variable_Value;
1018 Default_Node : constant Project_Node_Id :=
1020 (The_Current_Term, From_Project_Node_Tree);
1023 -- If there is a default value for the external reference,
1026 if Present (Default_Node) then
1027 Def_Var := Expression
1028 (Project => Project,
1031 From_Project_Node => From_Project_Node,
1032 From_Project_Node_Tree => From_Project_Node_Tree,
1036 (Default_Node, From_Project_Node_Tree),
1039 if Def_Var /= Nil_Variable_Value then
1040 Default := Def_Var.Value;
1045 Prj.Ext.Value_Of (From_Project_Node_Tree, Name, Default);
1047 if Value = No_Name then
1048 if not Quiet_Output then
1050 (Flags, "?undefined external reference",
1052 (The_Current_Term, From_Project_Node_Tree),
1056 Value := Empty_String;
1065 Add (Result.Value, Value);
1068 String_Element_Table.Increment_Last
1069 (In_Tree.String_Elements);
1071 if Last = Nil_String then
1072 Result.Values := String_Element_Table.Last
1073 (In_Tree.String_Elements);
1076 In_Tree.String_Elements.Table
1077 (Last).Next := String_Element_Table.Last
1078 (In_Tree.String_Elements);
1081 Last := String_Element_Table.Last
1082 (In_Tree.String_Elements);
1083 In_Tree.String_Elements.Table (Last) :=
1085 Display_Value => No_Name,
1088 (The_Current_Term, From_Project_Node_Tree),
1098 -- Should never happen
1102 "illegal node kind in an expression");
1103 raise Program_Error;
1107 The_Term := Next_Term (The_Term, From_Project_Node_Tree);
1113 ---------------------------------------
1114 -- Imported_Or_Extended_Project_From --
1115 ---------------------------------------
1117 function Imported_Or_Extended_Project_From
1118 (Project : Project_Id;
1119 With_Name : Name_Id) return Project_Id
1121 List : Project_List;
1122 Result : Project_Id;
1123 Temp_Result : Project_Id;
1126 -- First check if it is the name of an extended project
1128 Result := Project.Extends;
1129 while Result /= No_Project loop
1130 if Result.Name = With_Name then
1133 Result := Result.Extends;
1137 -- Then check the name of each imported project
1139 Temp_Result := No_Project;
1140 List := Project.Imported_Projects;
1141 while List /= null loop
1142 Result := List.Project;
1144 -- If the project is directly imported, then returns its ID
1146 if Result.Name = With_Name then
1150 -- If a project extending the project is imported, then keep this
1151 -- extending project as a possibility. It will be the returned ID
1152 -- if the project is not imported directly.
1158 Proj := Result.Extends;
1159 while Proj /= No_Project loop
1160 if Proj.Name = With_Name then
1161 Temp_Result := Result;
1165 Proj := Proj.Extends;
1172 pragma Assert (Temp_Result /= No_Project, "project not found");
1174 end Imported_Or_Extended_Project_From;
1180 function Package_From
1181 (Project : Project_Id;
1182 In_Tree : Project_Tree_Ref;
1183 With_Name : Name_Id) return Package_Id
1185 Result : Package_Id := Project.Decl.Packages;
1188 -- Check the name of each existing package of Project
1190 while Result /= No_Package
1191 and then In_Tree.Packages.Table (Result).Name /= With_Name
1193 Result := In_Tree.Packages.Table (Result).Next;
1196 if Result = No_Package then
1198 -- Should never happen
1200 Write_Line ("package """ & Get_Name_String (With_Name) &
1202 raise Program_Error;
1214 (In_Tree : Project_Tree_Ref;
1215 Project : out Project_Id;
1216 Success : out Boolean;
1217 From_Project_Node : Project_Node_Id;
1218 From_Project_Node_Tree : Project_Node_Tree_Ref;
1219 Flags : Processing_Flags;
1220 Reset_Tree : Boolean := True)
1223 Process_Project_Tree_Phase_1
1224 (In_Tree => In_Tree,
1227 From_Project_Node => From_Project_Node,
1228 From_Project_Node_Tree => From_Project_Node_Tree,
1230 Reset_Tree => Reset_Tree);
1232 if Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree) /=
1235 Process_Project_Tree_Phase_2
1236 (In_Tree => In_Tree,
1239 From_Project_Node => From_Project_Node,
1240 From_Project_Node_Tree => From_Project_Node_Tree,
1245 -------------------------------
1246 -- Process_Declarative_Items --
1247 -------------------------------
1249 procedure Process_Declarative_Items
1250 (Project : Project_Id;
1251 In_Tree : Project_Tree_Ref;
1252 Flags : Processing_Flags;
1253 From_Project_Node : Project_Node_Id;
1254 From_Project_Node_Tree : Project_Node_Tree_Ref;
1256 Item : Project_Node_Id)
1258 Current_Declarative_Item : Project_Node_Id;
1259 Current_Item : Project_Node_Id;
1262 -- Loop through declarative items
1264 Current_Item := Empty_Node;
1266 Current_Declarative_Item := Item;
1267 while Present (Current_Declarative_Item) loop
1273 (Current_Declarative_Item, From_Project_Node_Tree);
1275 -- And set Current_Declarative_Item to the next declarative item
1276 -- ready for the next iteration.
1278 Current_Declarative_Item :=
1279 Next_Declarative_Item
1280 (Current_Declarative_Item, From_Project_Node_Tree);
1282 case Kind_Of (Current_Item, From_Project_Node_Tree) is
1284 when N_Package_Declaration =>
1286 -- Do not process a package declaration that should be ignored
1288 if Expression_Kind_Of
1289 (Current_Item, From_Project_Node_Tree) /= Ignored
1291 -- Create the new package
1293 Package_Table.Increment_Last (In_Tree.Packages);
1296 New_Pkg : constant Package_Id :=
1297 Package_Table.Last (In_Tree.Packages);
1298 The_New_Package : Package_Element;
1300 Project_Of_Renamed_Package :
1301 constant Project_Node_Id :=
1302 Project_Of_Renamed_Package_Of
1303 (Current_Item, From_Project_Node_Tree);
1306 -- Set the name of the new package
1308 The_New_Package.Name :=
1309 Name_Of (Current_Item, From_Project_Node_Tree);
1311 -- Insert the new package in the appropriate list
1313 if Pkg /= No_Package then
1314 The_New_Package.Next :=
1315 In_Tree.Packages.Table (Pkg).Decl.Packages;
1316 In_Tree.Packages.Table (Pkg).Decl.Packages :=
1320 The_New_Package.Next := Project.Decl.Packages;
1321 Project.Decl.Packages := New_Pkg;
1324 In_Tree.Packages.Table (New_Pkg) :=
1327 if Present (Project_Of_Renamed_Package) then
1332 Project_Name : constant Name_Id :=
1334 (Project_Of_Renamed_Package,
1335 From_Project_Node_Tree);
1338 constant Project_Id :=
1339 Imported_Or_Extended_Project_From
1340 (Project, Project_Name);
1342 Renamed_Package : constant Package_Id :=
1344 (Renamed_Project, In_Tree,
1347 From_Project_Node_Tree));
1350 -- For a renamed package, copy the declarations of
1351 -- the renamed package, but set all the locations
1352 -- to the location of the package name in the
1353 -- renaming declaration.
1355 Copy_Package_Declarations
1357 In_Tree.Packages.Table (Renamed_Package).Decl,
1359 In_Tree.Packages.Table (New_Pkg).Decl,
1362 (Current_Item, From_Project_Node_Tree),
1363 Naming_Restricted => False,
1364 In_Tree => In_Tree);
1367 -- Standard package declaration, not renaming
1370 -- Set the default values of the attributes
1375 Name_Id (Project.Directory.Name),
1377 In_Tree.Packages.Table (New_Pkg).Decl,
1380 (Current_Item, From_Project_Node_Tree)),
1381 Project_Level => False);
1383 -- And process declarative items of the new package
1385 Process_Declarative_Items
1386 (Project => Project,
1389 From_Project_Node => From_Project_Node,
1390 From_Project_Node_Tree => From_Project_Node_Tree,
1393 First_Declarative_Item_Of
1394 (Current_Item, From_Project_Node_Tree));
1399 when N_String_Type_Declaration =>
1401 -- There is nothing to process
1405 when N_Attribute_Declaration |
1406 N_Typed_Variable_Declaration |
1407 N_Variable_Declaration =>
1409 if Expression_Of (Current_Item, From_Project_Node_Tree) =
1413 -- It must be a full associative array attribute declaration
1416 Current_Item_Name : constant Name_Id :=
1419 From_Project_Node_Tree);
1420 -- The name of the attribute
1422 Current_Location : constant Source_Ptr :=
1425 From_Project_Node_Tree);
1427 New_Array : Array_Id;
1428 -- The new associative array created
1430 Orig_Array : Array_Id;
1431 -- The associative array value
1433 Orig_Project_Name : Name_Id := No_Name;
1434 -- The name of the project where the associative array
1437 Orig_Project : Project_Id := No_Project;
1438 -- The id of the project where the associative array
1441 Orig_Package_Name : Name_Id := No_Name;
1442 -- The name of the package, if any, where the associative
1445 Orig_Package : Package_Id := No_Package;
1446 -- The id of the package, if any, where the associative
1449 New_Element : Array_Element_Id := No_Array_Element;
1450 -- Id of a new array element created
1452 Prev_Element : Array_Element_Id := No_Array_Element;
1453 -- Last new element id created
1455 Orig_Element : Array_Element_Id := No_Array_Element;
1456 -- Current array element in original associative array
1458 Next_Element : Array_Element_Id := No_Array_Element;
1459 -- Id of the array element that follows the new element.
1460 -- This is not always nil, because values for the
1461 -- associative array attribute may already have been
1462 -- declared, and the array elements declared are reused.
1467 -- First find if the associative array attribute already
1468 -- has elements declared.
1470 if Pkg /= No_Package then
1471 New_Array := In_Tree.Packages.Table
1475 New_Array := Project.Decl.Arrays;
1478 while New_Array /= No_Array
1479 and then In_Tree.Arrays.Table (New_Array).Name /=
1482 New_Array := In_Tree.Arrays.Table (New_Array).Next;
1485 -- If the attribute has never been declared add new entry
1486 -- in the arrays of the project/package and link it.
1488 if New_Array = No_Array then
1489 Array_Table.Increment_Last (In_Tree.Arrays);
1490 New_Array := Array_Table.Last (In_Tree.Arrays);
1492 if Pkg /= No_Package then
1493 In_Tree.Arrays.Table (New_Array) :=
1494 (Name => Current_Item_Name,
1495 Location => Current_Location,
1496 Value => No_Array_Element,
1497 Next => In_Tree.Packages.Table
1500 In_Tree.Packages.Table (Pkg).Decl.Arrays :=
1504 In_Tree.Arrays.Table (New_Array) :=
1505 (Name => Current_Item_Name,
1506 Location => Current_Location,
1507 Value => No_Array_Element,
1508 Next => Project.Decl.Arrays);
1510 Project.Decl.Arrays := New_Array;
1514 -- Find the project where the value is declared
1516 Orig_Project_Name :=
1518 (Associative_Project_Of
1519 (Current_Item, From_Project_Node_Tree),
1520 From_Project_Node_Tree);
1522 Prj := In_Tree.Projects;
1523 while Prj /= null loop
1524 if Prj.Project.Name = Orig_Project_Name then
1525 Orig_Project := Prj.Project;
1531 pragma Assert (Orig_Project /= No_Project,
1532 "original project not found");
1534 if No (Associative_Package_Of
1535 (Current_Item, From_Project_Node_Tree))
1537 Orig_Array := Orig_Project.Decl.Arrays;
1540 -- If in a package, find the package where the value
1543 Orig_Package_Name :=
1545 (Associative_Package_Of
1546 (Current_Item, From_Project_Node_Tree),
1547 From_Project_Node_Tree);
1549 Orig_Package := Orig_Project.Decl.Packages;
1550 pragma Assert (Orig_Package /= No_Package,
1551 "original package not found");
1553 while In_Tree.Packages.Table
1554 (Orig_Package).Name /= Orig_Package_Name
1556 Orig_Package := In_Tree.Packages.Table
1557 (Orig_Package).Next;
1558 pragma Assert (Orig_Package /= No_Package,
1559 "original package not found");
1563 In_Tree.Packages.Table (Orig_Package).Decl.Arrays;
1566 -- Now look for the array
1568 while Orig_Array /= No_Array
1569 and then In_Tree.Arrays.Table (Orig_Array).Name /=
1572 Orig_Array := In_Tree.Arrays.Table
1576 if Orig_Array = No_Array then
1579 "associative array value not found",
1580 Location_Of (Current_Item, From_Project_Node_Tree),
1585 In_Tree.Arrays.Table (Orig_Array).Value;
1587 -- Copy each array element
1589 while Orig_Element /= No_Array_Element loop
1591 -- Case of first element
1593 if Prev_Element = No_Array_Element then
1595 -- And there is no array element declared yet,
1596 -- create a new first array element.
1598 if In_Tree.Arrays.Table (New_Array).Value =
1601 Array_Element_Table.Increment_Last
1602 (In_Tree.Array_Elements);
1603 New_Element := Array_Element_Table.Last
1604 (In_Tree.Array_Elements);
1605 In_Tree.Arrays.Table
1606 (New_Array).Value := New_Element;
1607 Next_Element := No_Array_Element;
1609 -- Otherwise, the new element is the first
1612 New_Element := In_Tree.Arrays.
1613 Table (New_Array).Value;
1615 In_Tree.Array_Elements.Table
1619 -- Otherwise, reuse an existing element, or create
1620 -- one if necessary.
1624 In_Tree.Array_Elements.Table
1625 (Prev_Element).Next;
1627 if Next_Element = No_Array_Element then
1628 Array_Element_Table.Increment_Last
1629 (In_Tree.Array_Elements);
1631 Array_Element_Table.Last
1632 (In_Tree.Array_Elements);
1633 In_Tree.Array_Elements.Table
1634 (Prev_Element).Next := New_Element;
1637 New_Element := Next_Element;
1639 In_Tree.Array_Elements.Table
1644 -- Copy the value of the element
1646 In_Tree.Array_Elements.Table
1648 In_Tree.Array_Elements.Table (Orig_Element);
1649 In_Tree.Array_Elements.Table
1650 (New_Element).Value.Project := Project;
1652 -- Adjust the Next link
1654 In_Tree.Array_Elements.Table
1655 (New_Element).Next := Next_Element;
1657 -- Adjust the previous id for the next element
1659 Prev_Element := New_Element;
1661 -- Go to the next element in the original array
1664 In_Tree.Array_Elements.Table
1665 (Orig_Element).Next;
1668 -- Make sure that the array ends here, in case there
1669 -- previously a greater number of elements.
1671 In_Tree.Array_Elements.Table
1672 (New_Element).Next := No_Array_Element;
1676 -- Declarations other that full associative arrays
1680 New_Value : constant Variable_Value :=
1682 (Project => Project,
1685 From_Project_Node => From_Project_Node,
1686 From_Project_Node_Tree => From_Project_Node_Tree,
1691 (Current_Item, From_Project_Node_Tree),
1692 From_Project_Node_Tree),
1695 (Current_Item, From_Project_Node_Tree));
1696 -- The expression value
1698 The_Variable : Variable_Id := No_Variable;
1700 Current_Item_Name : constant Name_Id :=
1703 From_Project_Node_Tree);
1705 Current_Location : constant Source_Ptr :=
1708 From_Project_Node_Tree);
1711 -- Process a typed variable declaration
1713 if Kind_Of (Current_Item, From_Project_Node_Tree) =
1714 N_Typed_Variable_Declaration
1716 -- Report an error for an empty string
1718 if New_Value.Value = Empty_String then
1720 Name_Of (Current_Item, From_Project_Node_Tree);
1723 "no value defined for %%",
1725 (Current_Item, From_Project_Node_Tree),
1730 Current_String : Project_Node_Id;
1733 -- Loop through all the valid strings for the
1734 -- string type and compare to the string value.
1737 First_Literal_String
1738 (String_Type_Of (Current_Item,
1739 From_Project_Node_Tree),
1740 From_Project_Node_Tree);
1741 while Present (Current_String)
1744 (Current_String, From_Project_Node_Tree) /=
1749 (Current_String, From_Project_Node_Tree);
1752 -- Report an error if the string value is not
1753 -- one for the string type.
1755 if No (Current_String) then
1756 Error_Msg_Name_1 := New_Value.Value;
1759 (Current_Item, From_Project_Node_Tree);
1762 "value %% is illegal for typed string %%",
1764 (Current_Item, From_Project_Node_Tree),
1773 if Kind_Of (Current_Item, From_Project_Node_Tree) /=
1774 N_Attribute_Declaration
1776 Associative_Array_Index_Of
1777 (Current_Item, From_Project_Node_Tree) = No_Name
1779 -- Case of a variable declaration or of a not
1780 -- associative array attribute.
1782 -- First, find the list where to find the variable
1785 if Kind_Of (Current_Item, From_Project_Node_Tree) =
1786 N_Attribute_Declaration
1788 if Pkg /= No_Package then
1790 In_Tree.Packages.Table
1791 (Pkg).Decl.Attributes;
1793 The_Variable := Project.Decl.Attributes;
1797 if Pkg /= No_Package then
1799 In_Tree.Packages.Table
1800 (Pkg).Decl.Variables;
1802 The_Variable := Project.Decl.Variables;
1807 -- Loop through the list, to find if it has already
1810 while The_Variable /= No_Variable
1812 In_Tree.Variable_Elements.Table
1813 (The_Variable).Name /= Current_Item_Name
1816 In_Tree.Variable_Elements.Table
1817 (The_Variable).Next;
1820 -- If it has not been declared, create a new entry
1823 if The_Variable = No_Variable then
1825 -- All single string attribute should already have
1826 -- been declared with a default empty string value.
1829 (Kind_Of (Current_Item, From_Project_Node_Tree) /=
1830 N_Attribute_Declaration,
1831 "illegal attribute declaration for "
1832 & Get_Name_String (Current_Item_Name));
1834 Variable_Element_Table.Increment_Last
1835 (In_Tree.Variable_Elements);
1836 The_Variable := Variable_Element_Table.Last
1837 (In_Tree.Variable_Elements);
1839 -- Put the new variable in the appropriate list
1841 if Pkg /= No_Package then
1842 In_Tree.Variable_Elements.Table (The_Variable) :=
1844 In_Tree.Packages.Table
1845 (Pkg).Decl.Variables,
1846 Name => Current_Item_Name,
1847 Value => New_Value);
1848 In_Tree.Packages.Table
1849 (Pkg).Decl.Variables := The_Variable;
1852 In_Tree.Variable_Elements.Table (The_Variable) :=
1853 (Next => Project.Decl.Variables,
1854 Name => Current_Item_Name,
1855 Value => New_Value);
1856 Project.Decl.Variables := The_Variable;
1859 -- If the variable/attribute has already been
1860 -- declared, just change the value.
1863 In_Tree.Variable_Elements.Table
1864 (The_Variable).Value := New_Value;
1867 -- Associative array attribute
1871 Index_Name : Name_Id :=
1872 Associative_Array_Index_Of
1874 From_Project_Node_Tree);
1876 Source_Index : constant Int :=
1879 From_Project_Node_Tree);
1881 The_Array : Array_Id;
1882 The_Array_Element : Array_Element_Id :=
1886 if Index_Name /= All_Other_Names then
1887 Index_Name := Get_Attribute_Index
1888 (From_Project_Node_Tree,
1890 Associative_Array_Index_Of
1891 (Current_Item, From_Project_Node_Tree));
1894 -- Look for the array in the appropriate list
1896 if Pkg /= No_Package then
1898 In_Tree.Packages.Table (Pkg).Decl.Arrays;
1901 Project.Decl.Arrays;
1905 The_Array /= No_Array
1907 In_Tree.Arrays.Table (The_Array).Name /=
1911 In_Tree.Arrays.Table (The_Array).Next;
1914 -- If the array cannot be found, create a new entry
1915 -- in the list. As The_Array_Element is initialized
1916 -- to No_Array_Element, a new element will be
1917 -- created automatically later
1919 if The_Array = No_Array then
1920 Array_Table.Increment_Last (In_Tree.Arrays);
1921 The_Array := Array_Table.Last (In_Tree.Arrays);
1923 if Pkg /= No_Package then
1924 In_Tree.Arrays.Table (The_Array) :=
1925 (Name => Current_Item_Name,
1926 Location => Current_Location,
1927 Value => No_Array_Element,
1928 Next => In_Tree.Packages.Table
1931 In_Tree.Packages.Table (Pkg).Decl.Arrays :=
1935 In_Tree.Arrays.Table (The_Array) :=
1936 (Name => Current_Item_Name,
1937 Location => Current_Location,
1938 Value => No_Array_Element,
1939 Next => Project.Decl.Arrays);
1941 Project.Decl.Arrays := The_Array;
1944 -- Otherwise initialize The_Array_Element as the
1945 -- head of the element list.
1948 The_Array_Element :=
1949 In_Tree.Arrays.Table (The_Array).Value;
1952 -- Look in the list, if any, to find an element
1953 -- with the same index and same source index.
1955 while The_Array_Element /= No_Array_Element
1957 (In_Tree.Array_Elements.Table
1958 (The_Array_Element).Index /= Index_Name
1960 In_Tree.Array_Elements.Table
1961 (The_Array_Element).Src_Index /= Source_Index)
1963 The_Array_Element :=
1964 In_Tree.Array_Elements.Table
1965 (The_Array_Element).Next;
1968 -- If no such element were found, create a new one
1969 -- and insert it in the element list, with the
1972 if The_Array_Element = No_Array_Element then
1973 Array_Element_Table.Increment_Last
1974 (In_Tree.Array_Elements);
1975 The_Array_Element :=
1976 Array_Element_Table.Last
1977 (In_Tree.Array_Elements);
1979 In_Tree.Array_Elements.Table
1980 (The_Array_Element) :=
1981 (Index => Index_Name,
1982 Src_Index => Source_Index,
1983 Index_Case_Sensitive =>
1984 not Case_Insensitive
1985 (Current_Item, From_Project_Node_Tree),
1988 In_Tree.Arrays.Table (The_Array).Value);
1990 In_Tree.Arrays.Table (The_Array).Value :=
1993 -- An element with the same index already exists,
1994 -- just replace its value with the new one.
1997 In_Tree.Array_Elements.Table
1998 (The_Array_Element).Value := New_Value;
2005 when N_Case_Construction =>
2007 The_Project : Project_Id := Project;
2008 -- The id of the project of the case variable
2010 The_Package : Package_Id := Pkg;
2011 -- The id of the package, if any, of the case variable
2013 The_Variable : Variable_Value := Nil_Variable_Value;
2014 -- The case variable
2016 Case_Value : Name_Id := No_Name;
2017 -- The case variable value
2019 Case_Item : Project_Node_Id := Empty_Node;
2020 Choice_String : Project_Node_Id := Empty_Node;
2021 Decl_Item : Project_Node_Id := Empty_Node;
2025 Variable_Node : constant Project_Node_Id :=
2026 Case_Variable_Reference_Of
2028 From_Project_Node_Tree);
2030 Var_Id : Variable_Id := No_Variable;
2031 Name : Name_Id := No_Name;
2034 -- If a project was specified for the case variable,
2037 if Present (Project_Node_Of
2038 (Variable_Node, From_Project_Node_Tree))
2043 (Variable_Node, From_Project_Node_Tree),
2044 From_Project_Node_Tree);
2046 Imported_Or_Extended_Project_From (Project, Name);
2049 -- If a package were specified for the case variable,
2052 if Present (Package_Node_Of
2053 (Variable_Node, From_Project_Node_Tree))
2058 (Variable_Node, From_Project_Node_Tree),
2059 From_Project_Node_Tree);
2061 Package_From (The_Project, In_Tree, Name);
2064 Name := Name_Of (Variable_Node, From_Project_Node_Tree);
2066 -- First, look for the case variable into the package,
2069 if The_Package /= No_Package then
2070 Var_Id := In_Tree.Packages.Table
2071 (The_Package).Decl.Variables;
2073 Name_Of (Variable_Node, From_Project_Node_Tree);
2074 while Var_Id /= No_Variable
2076 In_Tree.Variable_Elements.Table
2077 (Var_Id).Name /= Name
2079 Var_Id := In_Tree.Variable_Elements.
2080 Table (Var_Id).Next;
2084 -- If not found in the package, or if there is no
2085 -- package, look at the project level.
2087 if Var_Id = No_Variable
2090 (Variable_Node, From_Project_Node_Tree))
2092 Var_Id := The_Project.Decl.Variables;
2093 while Var_Id /= No_Variable
2095 In_Tree.Variable_Elements.Table
2096 (Var_Id).Name /= Name
2098 Var_Id := In_Tree.Variable_Elements.
2099 Table (Var_Id).Next;
2103 if Var_Id = No_Variable then
2105 -- Should never happen, because this has already been
2106 -- checked during parsing.
2108 Write_Line ("variable """ &
2109 Get_Name_String (Name) &
2111 raise Program_Error;
2114 -- Get the case variable
2116 The_Variable := In_Tree.Variable_Elements.
2117 Table (Var_Id).Value;
2119 if The_Variable.Kind /= Single then
2121 -- Should never happen, because this has already been
2122 -- checked during parsing.
2124 Write_Line ("variable""" &
2125 Get_Name_String (Name) &
2126 """ is not a single string variable");
2127 raise Program_Error;
2130 -- Get the case variable value
2131 Case_Value := The_Variable.Value;
2134 -- Now look into all the case items of the case construction
2137 First_Case_Item_Of (Current_Item, From_Project_Node_Tree);
2139 while Present (Case_Item) loop
2141 First_Choice_Of (Case_Item, From_Project_Node_Tree);
2143 -- When Choice_String is nil, it means that it is
2144 -- the "when others =>" alternative.
2146 if No (Choice_String) then
2148 First_Declarative_Item_Of
2149 (Case_Item, From_Project_Node_Tree);
2150 exit Case_Item_Loop;
2153 -- Look into all the alternative of this case item
2156 while Present (Choice_String) loop
2159 (Choice_String, From_Project_Node_Tree)
2162 First_Declarative_Item_Of
2163 (Case_Item, From_Project_Node_Tree);
2164 exit Case_Item_Loop;
2169 (Choice_String, From_Project_Node_Tree);
2170 end loop Choice_Loop;
2173 Next_Case_Item (Case_Item, From_Project_Node_Tree);
2174 end loop Case_Item_Loop;
2176 -- If there is an alternative, then we process it
2178 if Present (Decl_Item) then
2179 Process_Declarative_Items
2180 (Project => Project,
2183 From_Project_Node => From_Project_Node,
2184 From_Project_Node_Tree => From_Project_Node_Tree,
2192 -- Should never happen
2194 Write_Line ("Illegal declarative item: " &
2195 Project_Node_Kind'Image
2197 (Current_Item, From_Project_Node_Tree)));
2198 raise Program_Error;
2201 end Process_Declarative_Items;
2203 ----------------------------------
2204 -- Process_Project_Tree_Phase_1 --
2205 ----------------------------------
2207 procedure Process_Project_Tree_Phase_1
2208 (In_Tree : Project_Tree_Ref;
2209 Project : out Project_Id;
2210 Success : out Boolean;
2211 From_Project_Node : Project_Node_Id;
2212 From_Project_Node_Tree : Project_Node_Tree_Ref;
2213 Flags : Processing_Flags;
2214 Reset_Tree : Boolean := True)
2219 -- Make sure there are no projects in the data structure
2221 Free_List (In_Tree.Projects, Free_Project => True);
2224 Processed_Projects.Reset;
2226 -- And process the main project and all of the projects it depends on,
2230 (Project => Project,
2233 From_Project_Node => From_Project_Node,
2234 From_Project_Node_Tree => From_Project_Node_Tree,
2235 Extended_By => No_Project);
2238 Total_Errors_Detected = 0
2240 (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2241 end Process_Project_Tree_Phase_1;
2243 ----------------------------------
2244 -- Process_Project_Tree_Phase_2 --
2245 ----------------------------------
2247 procedure Process_Project_Tree_Phase_2
2248 (In_Tree : Project_Tree_Ref;
2249 Project : Project_Id;
2250 Success : out Boolean;
2251 From_Project_Node : Project_Node_Id;
2252 From_Project_Node_Tree : Project_Node_Tree_Ref;
2253 Flags : Processing_Flags)
2255 Obj_Dir : Path_Name_Type;
2256 Extending : Project_Id;
2257 Extending2 : Project_Id;
2260 -- Start of processing for Process_Project_Tree_Phase_2
2265 if Project /= No_Project then
2266 Check (In_Tree, Project, Flags);
2269 -- If main project is an extending all project, set object directory of
2270 -- all virtual extending projects to object directory of main project.
2272 if Project /= No_Project
2274 Is_Extending_All (From_Project_Node, From_Project_Node_Tree)
2277 Object_Dir : constant Path_Name_Type :=
2278 Project.Object_Directory.Name;
2280 Prj := In_Tree.Projects;
2281 while Prj /= null loop
2282 if Prj.Project.Virtual then
2283 Prj.Project.Object_Directory.Name := Object_Dir;
2290 -- Check that no extending project shares its object directory with
2291 -- the project(s) it extends.
2293 if Project /= No_Project then
2294 Prj := In_Tree.Projects;
2295 while Prj /= null loop
2296 Extending := Prj.Project.Extended_By;
2298 if Extending /= No_Project then
2299 Obj_Dir := Prj.Project.Object_Directory.Name;
2301 -- Check that a project being extended does not share its
2302 -- object directory with any project that extends it, directly
2303 -- or indirectly, including a virtual extending project.
2305 -- Start with the project directly extending it
2307 Extending2 := Extending;
2308 while Extending2 /= No_Project loop
2309 if Has_Ada_Sources (Extending2)
2310 and then Extending2.Object_Directory.Name = Obj_Dir
2312 if Extending2.Virtual then
2313 Error_Msg_Name_1 := Prj.Project.Display_Name;
2316 "project %% cannot be extended by a virtual" &
2317 " project with the same object directory",
2318 Prj.Project.Location, Project);
2321 Error_Msg_Name_1 := Extending2.Display_Name;
2322 Error_Msg_Name_2 := Prj.Project.Display_Name;
2325 "project %% cannot extend project %%",
2326 Extending2.Location, Project);
2329 "\they share the same object directory",
2330 Extending2.Location, Project);
2334 -- Continue with the next extending project, if any
2336 Extending2 := Extending2.Extended_By;
2345 Total_Errors_Detected = 0
2347 (Warning_Mode /= Treat_As_Error or else Warnings_Detected = 0);
2348 end Process_Project_Tree_Phase_2;
2350 -----------------------
2351 -- Recursive_Process --
2352 -----------------------
2354 procedure Recursive_Process
2355 (In_Tree : Project_Tree_Ref;
2356 Project : out Project_Id;
2357 Flags : Processing_Flags;
2358 From_Project_Node : Project_Node_Id;
2359 From_Project_Node_Tree : Project_Node_Tree_Ref;
2360 Extended_By : Project_Id)
2362 procedure Process_Imported_Projects
2363 (Imported : in out Project_List;
2364 Limited_With : Boolean);
2365 -- Process imported projects. If Limited_With is True, then only
2366 -- projects processed through a "limited with" are processed, otherwise
2367 -- only projects imported through a standard "with" are processed.
2368 -- Imported is the id of the last imported project.
2370 -------------------------------
2371 -- Process_Imported_Projects --
2372 -------------------------------
2374 procedure Process_Imported_Projects
2375 (Imported : in out Project_List;
2376 Limited_With : Boolean)
2378 With_Clause : Project_Node_Id;
2379 New_Project : Project_Id;
2380 Proj_Node : Project_Node_Id;
2384 First_With_Clause_Of
2385 (From_Project_Node, From_Project_Node_Tree);
2386 while Present (With_Clause) loop
2388 Non_Limited_Project_Node_Of
2389 (With_Clause, From_Project_Node_Tree);
2390 New_Project := No_Project;
2392 if (Limited_With and then No (Proj_Node))
2393 or else (not Limited_With and then Present (Proj_Node))
2396 (In_Tree => In_Tree,
2397 Project => New_Project,
2399 From_Project_Node =>
2401 (With_Clause, From_Project_Node_Tree),
2402 From_Project_Node_Tree => From_Project_Node_Tree,
2403 Extended_By => No_Project);
2405 -- Imported is the id of the last imported project. If
2406 -- it is nil, then this imported project is our first.
2408 if Imported = null then
2409 Project.Imported_Projects :=
2410 new Project_List_Element'
2411 (Project => New_Project,
2413 Imported := Project.Imported_Projects;
2415 Imported.Next := new Project_List_Element'
2416 (Project => New_Project,
2418 Imported := Imported.Next;
2423 Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
2425 end Process_Imported_Projects;
2427 -- Start of processing for Recursive_Process
2430 if No (From_Project_Node) then
2431 Project := No_Project;
2435 Imported : Project_List;
2436 Declaration_Node : Project_Node_Id := Empty_Node;
2438 Name : constant Name_Id :=
2439 Name_Of (From_Project_Node, From_Project_Node_Tree);
2441 Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
2442 Tree_Private_Part.Projects_Htable.Get
2443 (From_Project_Node_Tree.Projects_HT, Name);
2446 Project := Processed_Projects.Get (Name);
2448 if Project /= No_Project then
2450 -- Make sure that, when a project is extended, the project id
2451 -- of the project extending it is recorded in its data, even
2452 -- when it has already been processed as an imported project.
2453 -- This is for virtually extended projects.
2455 if Extended_By /= No_Project then
2456 Project.Extended_By := Extended_By;
2462 Project := new Project_Data'(Empty_Project);
2463 In_Tree.Projects := new Project_List_Element'
2464 (Project => Project,
2465 Next => In_Tree.Projects);
2467 Processed_Projects.Set (Name, Project);
2469 Project.Name := Name;
2470 Project.Display_Name := Name_Node.Display_Name;
2471 Project.Qualifier :=
2472 Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
2474 Get_Name_String (Name);
2476 -- If name starts with the virtual prefix, flag the project as
2477 -- being a virtual extending project.
2479 if Name_Len > Virtual_Prefix'Length
2480 and then Name_Buffer (1 .. Virtual_Prefix'Length) =
2483 Project.Virtual := True;
2487 Project.Path.Display_Name :=
2488 Path_Name_Of (From_Project_Node, From_Project_Node_Tree);
2489 Get_Name_String (Project.Path.Display_Name);
2490 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2491 Project.Path.Name := Name_Find;
2494 Location_Of (From_Project_Node, From_Project_Node_Tree);
2496 Project.Directory.Display_Name :=
2497 Directory_Of (From_Project_Node, From_Project_Node_Tree);
2498 Get_Name_String (Project.Directory.Display_Name);
2499 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2500 Project.Directory.Name := Name_Find;
2502 Project.Extended_By := Extended_By;
2507 Name_Id (Project.Directory.Name),
2510 Prj.Attr.Attribute_First,
2511 Project_Level => True);
2513 Process_Imported_Projects (Imported, Limited_With => False);
2516 Project_Declaration_Of
2517 (From_Project_Node, From_Project_Node_Tree);
2520 (In_Tree => In_Tree,
2521 Project => Project.Extends,
2523 From_Project_Node => Extended_Project_Of
2525 From_Project_Node_Tree),
2526 From_Project_Node_Tree => From_Project_Node_Tree,
2527 Extended_By => Project);
2529 Process_Declarative_Items
2530 (Project => Project,
2533 From_Project_Node => From_Project_Node,
2534 From_Project_Node_Tree => From_Project_Node_Tree,
2536 Item => First_Declarative_Item_Of
2538 From_Project_Node_Tree));
2540 -- If it is an extending project, inherit all packages
2541 -- from the extended project that are not explicitly defined
2542 -- or renamed. Also inherit the languages, if attribute Languages
2543 -- is not explicitly defined.
2545 if Project.Extends /= No_Project then
2547 Extended_Pkg : Package_Id;
2548 Current_Pkg : Package_Id;
2549 Element : Package_Element;
2550 First : constant Package_Id :=
2551 Project.Decl.Packages;
2552 Attribute1 : Variable_Id;
2553 Attribute2 : Variable_Id;
2554 Attr_Value1 : Variable;
2555 Attr_Value2 : Variable;
2558 Extended_Pkg := Project.Extends.Decl.Packages;
2559 while Extended_Pkg /= No_Package loop
2560 Element := In_Tree.Packages.Table (Extended_Pkg);
2562 Current_Pkg := First;
2563 while Current_Pkg /= No_Package
2564 and then In_Tree.Packages.Table (Current_Pkg).Name /=
2568 In_Tree.Packages.Table (Current_Pkg).Next;
2571 if Current_Pkg = No_Package then
2572 Package_Table.Increment_Last
2574 Current_Pkg := Package_Table.Last (In_Tree.Packages);
2575 In_Tree.Packages.Table (Current_Pkg) :=
2576 (Name => Element.Name,
2577 Decl => No_Declarations,
2578 Parent => No_Package,
2579 Next => Project.Decl.Packages);
2580 Project.Decl.Packages := Current_Pkg;
2581 Copy_Package_Declarations
2582 (From => Element.Decl,
2584 In_Tree.Packages.Table (Current_Pkg).Decl,
2585 New_Loc => No_Location,
2586 Naming_Restricted =>
2587 Element.Name = Snames.Name_Naming,
2588 In_Tree => In_Tree);
2591 Extended_Pkg := Element.Next;
2594 -- Check if attribute Languages is declared in the
2595 -- extending project.
2597 Attribute1 := Project.Decl.Attributes;
2598 while Attribute1 /= No_Variable loop
2599 Attr_Value1 := In_Tree.Variable_Elements.
2601 exit when Attr_Value1.Name = Snames.Name_Languages;
2602 Attribute1 := Attr_Value1.Next;
2605 if Attribute1 = No_Variable or else
2606 Attr_Value1.Value.Default
2608 -- Attribute Languages is not declared in the extending
2609 -- project. Check if it is declared in the project being
2612 Attribute2 := Project.Extends.Decl.Attributes;
2613 while Attribute2 /= No_Variable loop
2614 Attr_Value2 := In_Tree.Variable_Elements.
2616 exit when Attr_Value2.Name = Snames.Name_Languages;
2617 Attribute2 := Attr_Value2.Next;
2620 if Attribute2 /= No_Variable and then
2621 not Attr_Value2.Value.Default
2623 -- As attribute Languages is declared in the project
2624 -- being extended, copy its value for the extending
2627 if Attribute1 = No_Variable then
2628 Variable_Element_Table.Increment_Last
2629 (In_Tree.Variable_Elements);
2630 Attribute1 := Variable_Element_Table.Last
2631 (In_Tree.Variable_Elements);
2632 Attr_Value1.Next := Project.Decl.Attributes;
2633 Project.Decl.Attributes := Attribute1;
2636 Attr_Value1.Name := Snames.Name_Languages;
2637 Attr_Value1.Value := Attr_Value2.Value;
2638 In_Tree.Variable_Elements.Table
2639 (Attribute1) := Attr_Value1;
2645 Process_Imported_Projects (Imported, Limited_With => True);
2648 end Recursive_Process;