if Copy_From.Refs /= null then
N := Name_To_Name_HTable.Get_First (Copy_From.Refs.all);
while N /= null loop
- N2 := new Name_To_Name;
- N2.Key := N.Key;
- N2.Value := N.Value;
+ N2 := new Name_To_Name'
+ (Key => N.Key,
+ Value => N.Value,
+ Source => N.Source,
+ Next => null);
Name_To_Name_HTable.Set (Self.Refs.all, N2);
N := Name_To_Name_HTable.Get_Next (Copy_From.Refs.all);
end loop;
procedure Add
(Self : External_References;
External_Name : String;
- Value : String)
+ Value : String;
+ Source : External_Source := External_Source'First)
is
- N : Name_To_Name_Ptr;
+ Key : Name_Id;
+ N : Name_To_Name_Ptr;
begin
- N := new Name_To_Name;
-
- Name_Len := Value'Length;
- Name_Buffer (1 .. Name_Len) := Value;
- N.Value := Name_Find;
-
Name_Len := External_Name'Length;
Name_Buffer (1 .. Name_Len) := External_Name;
Canonical_Case_Env_Var_Name (Name_Buffer (1 .. Name_Len));
- N.Key := Name_Find;
+ Key := Name_Find;
+
+ -- Check whether the value is already defined, to properly respect the
+ -- overriding order.
+
+ if Source /= External_Source'First then
+ N := Name_To_Name_HTable.Get (Self.Refs.all, Key);
+ if N /= null then
+ if External_Source'Pos (N.Source) <
+ External_Source'Pos (Source)
+ then
+ if Current_Verbosity = High then
+ Debug_Output
+ ("Not overridding existing variable '" & External_Name
+ & "', value was defined in " & N.Source'Img);
+ end if;
+ return;
+ end if;
+ end if;
+ end if;
+
+ Name_Len := Value'Length;
+ Name_Buffer (1 .. Name_Len) := Value;
+ N := new Name_To_Name'
+ (Key => Key,
+ Source => Source,
+ Value => Name_Find,
+ Next => null);
if Current_Verbosity = High then
- Debug_Output ("Add (" & External_Name & ") is", N.Value);
+ Debug_Output ("Add external (" & External_Name & ") is", N.Value);
end if;
Name_To_Name_HTable.Set (Self.Refs.all, N);
External_Name =>
Declaration (Declaration'First .. Equal_Pos - 1),
Value =>
- Declaration (Equal_Pos + 1 .. Declaration'Last));
+ Declaration (Equal_Pos + 1 .. Declaration'Last),
+ Source => From_Command_Line);
return True;
end if;
end loop;
Value := Name_To_Name_HTable.Get (Self.Refs.all, Name_Find);
if Value /= null then
+ Debug_Output ("Value_Of (" & Name & ") is in cache", Value.Value);
return Value.Value;
end if;
end if;
Val := Name_Find;
if Current_Verbosity = High then
- Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
- & ") is", Val);
+ Debug_Output ("Value_Of (" & Name & ") is", Val);
end if;
if Self.Refs /= null then
- Value := new Name_To_Name;
- Value.Key := External_Name;
- Value.Value := Val;
+ Value := new Name_To_Name'
+ (Key => External_Name,
+ Value => Val,
+ Source => From_Environment,
+ Next => null);
Name_To_Name_HTable.Set (Self.Refs.all, Value);
end if;
else
if Current_Verbosity = High then
- Debug_Output ("Value_Of (" & Get_Name_String (External_Name)
- & ") is default", With_Default);
+ Debug_Output
+ ("Value_Of (" & Name & ") is default", With_Default);
end if;
Free (Env_Value);
Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Pkg : Package_Id;
- Item : Project_Node_Id);
+ Item : Project_Node_Id;
+ Child_Env : in out Prj.Tree.Environment;
+ Can_Modify_Child_Env : Boolean);
-- Process declarative items starting with From_Project_Node, and put them
-- in declarations Decl. This is a recursive procedure; it calls itself for
-- a package declaration or a case construction.
+ -- Child_Env is the modified environment after seeing declarations like
+ -- "for External(...) use" or "for Project_Path use" in aggregate projects.
+ -- It should have been initialized first. This environment can only be
+ -- modified if Can_Modify_Child_Env is True, otherwise all the above
+ -- attributes simply have no effect.
procedure Recursive_Process
(In_Tree : Project_Tree_Ref;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Extended_By : Project_Id);
+ Extended_By : Project_Id;
+ Child_Env : in out Prj.Tree.Environment;
+ Is_Root_Project : Boolean);
-- Process project with node From_Project_Node in the tree. Do nothing if
-- From_Project_Node is Empty_Node. If project has already been processed,
-- simply return its project id. Otherwise create a new project id, mark it
-- as processed, call itself recursively for all imported projects and a
-- extended project, if any. Then process the declarative items of the
-- project.
+ -- Child_Env is the environment created from an aggregate project (new
+ -- external values or project path), and should be initialized before the
+ -- call.
+ -- Is_Root_Project should be true only for the project that the user
+ -- explicitly loaded. In the context of aggregate projects, only that
+ -- project is allowed to modify the environment that will be used to load
+ -- projects (Child_Env).
function Get_Attribute_Index
(Tree : Project_Node_Tree_Ref;
Node_Tree : Project_Node_Tree_Ref;
Env : Prj.Tree.Environment;
Pkg : Package_Id;
- Item : Project_Node_Id)
+ Item : Project_Node_Id;
+ Child_Env : in out Prj.Tree.Environment;
+ Can_Modify_Child_Env : Boolean)
is
procedure Check_Or_Set_Typed_Variable
(Value : in out Variable_Value;
Env => Env,
Pkg => New_Pkg,
Item =>
- First_Declarative_Item_Of (Current_Item, Node_Tree));
+ First_Declarative_Item_Of (Current_Item, Node_Tree),
+ Child_Env => Child_Env,
+ Can_Modify_Child_Env => Can_Modify_Child_Env);
end;
end if;
end Process_Package_Declaration;
end if;
if Name = Snames.Name_External then
+ if Can_Modify_Child_Env then
+ Add (Child_Env.External,
+ External_Name => Get_Name_String (Index_Name),
+ Value => Get_Name_String (New_Value.Value),
+ Source => From_External_Attribute);
+ Add (Env.External,
+ External_Name => Get_Name_String (Index_Name),
+ Value => Get_Name_String (New_Value.Value),
+ Source => From_External_Attribute);
+ else
+ if Current_Verbosity = High then
+ Debug_Output
+ ("'for External' has no effect except in root aggregate ("
+ & Get_Name_String (Index_Name) & ")", New_Value.Value);
+ end if;
+ end if;
+
+ elsif Name = Snames.Name_Project_Path then
Debug_Output
- ("Defined external value ("
- & Get_Name_String (Index_Name) & ")", New_Value.Value);
+ ("Defined project path");
end if;
end Process_Expression_For_Associative_Array;
Node_Tree => Node_Tree,
Env => Env,
Pkg => Pkg,
- Item => Decl_Item);
+ Item => Decl_Item,
+ Child_Env => Child_Env,
+ Can_Modify_Child_Env => Can_Modify_Child_Env);
end if;
end Process_Case_Construction;
Env : in out Prj.Tree.Environment;
Reset_Tree : Boolean := True)
is
+ Child_Env : Prj.Tree.Environment;
begin
if Reset_Tree then
Debug_Increase_Indent ("Process tree, phase 1");
+ Initialize_And_Copy (Child_Env, Copy_From => Env);
+
Recursive_Process
(Project => Project,
In_Tree => In_Tree,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
- Extended_By => No_Project);
+ Extended_By => No_Project,
+ Child_Env => Child_Env,
+ Is_Root_Project => True);
+
+ Free (Child_Env);
Success :=
Total_Errors_Detected = 0
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Extended_By : Project_Id)
+ Extended_By : Project_Id;
+ Child_Env : in out Prj.Tree.Environment;
+ Is_Root_Project : Boolean)
is
procedure Process_Imported_Projects
(Imported : in out Project_List;
(With_Clause, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
- Extended_By => No_Project);
+ Extended_By => No_Project,
+ Child_Env => Child_Env,
+ Is_Root_Project => False);
-- Imported is the id of the last imported project. If
-- it is nil, then this imported project is our first.
Errout_Handling => Prj.Part.Never_Finalize,
Current_Directory => Get_Name_String (Project.Directory.Name),
Is_Config_File => False,
- Env => Env);
+ Env => Child_Env);
Success := not Prj.Tree.No (Loaded_Tree);
Project => List.Project,
From_Project_Node => Loaded_Tree,
From_Project_Node_Tree => From_Project_Node_Tree,
- Env => Env,
- Extended_By => No_Project);
+ Env => Child_Env,
+ Extended_By => No_Project,
+ Child_Env => Child_Env,
+ Is_Root_Project => False);
else
Debug_Output ("Failed to parse", Name_Id (List.Path));
end if;
(Declaration_Node, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
- Extended_By => Project);
+ Extended_By => Project,
+ Child_Env => Child_Env,
+ Is_Root_Project => False);
Process_Declarative_Items
(Project => Project,
Env => Env,
Pkg => No_Package,
Item => First_Declarative_Item_Of
- (Declaration_Node, From_Project_Node_Tree));
+ (Declaration_Node, From_Project_Node_Tree),
+ Child_Env => Child_Env,
+ Can_Modify_Child_Env => Is_Root_Project);
if Project.Extends /= No_Project then
Process_Extended_Project;
projects / gcc.git / commitdiff