[multiple changes]
2011-08-03 Yannick Moy <moy@adacore.com> * alfa.ads Update format of ALFA section in ALI file in order to add a mapping from bodies to specs when both are present (ALFA_Scope_Record): add components for spec file/scope * get_alfa.adb (Get_ALFA): read the new file/scope for spec when present * lib-xref-alfa.adb (Collect_ALFA): after all scopes have been collected, fill in the spec information when relevant * put_alfa.adb (Put_ALFA): write the new file/scope for spec when present. 2011-08-03 Eric Botcazou <ebotcazou@adacore.com> * inline.adb (Add_Inlined_Subprogram): Do not consider the enclosing code unit to decide whether to add internally generated subprograms. 2011-08-03 Javier Miranda <miranda@adacore.com> * sem_aux.ads, sem_aux.adb (Is_VM_By_Copy_Actual): New subprogram. * exp_ch9.adb (Build_Simple_Entry_Call): Handle actuals that must be handled by copy in VM targets. 2011-08-03 Emmanuel Briot <briot@adacore.com> * make.adb, makeutl.adb, makeutl.ads (Make.Switches_Of): now shares code with Makeutl.Get_Switches. * prj-tree.adb: Update comment. From-SVN: r177257
This commit is contained in:
Emmanuel Briot
Arnaud Charlet
parent
9466892f26
commit
ab29a348eb
|
|
@ -1,3 +1,9 @@
|
|||
2011-08-03 Emmanuel Briot <briot@adacore.com>
|
||||
|
||||
* prj-proc.adb, prj-ext.adb, prj-ext.ads, prj-env.adb, prj-env.ads,
|
||||
prj-tree.adb, prj-tree.ads (Initialize_And_Copy, Copy): new subprograms
|
||||
(Process_Declarative_Items): new parameter Child_Env.
|
||||
|
||||
2011-08-03 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* alfa.ads Update format of ALFA section in ALI file in order to add a
|
||||
|
|
|
|||
|
|
@ -2197,4 +2197,18 @@ package body Prj.Env is
|
|||
Projects_Paths.Reset (Self.Cache);
|
||||
end Free;
|
||||
|
||||
----------
|
||||
-- Copy --
|
||||
----------
|
||||
|
||||
procedure Copy (From : Project_Search_Path; To : out Project_Search_Path) is
|
||||
begin
|
||||
Free (To);
|
||||
if From.Path /= null then
|
||||
To.Path := new String'(From.Path.all);
|
||||
end if;
|
||||
|
||||
-- No need to copy the Cache, it will be recomputed as needed.
|
||||
end Copy;
|
||||
|
||||
end Prj.Env;
|
||||
|
|
|
|||
|
|
@ -162,6 +162,8 @@ package Prj.Env is
|
|||
-- to search for projects on the path (and caches the results to improve
|
||||
-- efficiency).
|
||||
|
||||
No_Project_Search_Path : constant Project_Search_Path;
|
||||
|
||||
procedure Initialize_Default_Project_Path
|
||||
(Self : in out Project_Search_Path;
|
||||
Target_Name : String);
|
||||
|
|
@ -170,6 +172,9 @@ package Prj.Env is
|
|||
-- variables ADA_PROJECT_PATH and GPR_PROJECT_PATH). This does nothing if
|
||||
-- Self has already been initialized.
|
||||
|
||||
procedure Copy (From : Project_Search_Path; To : out Project_Search_Path);
|
||||
-- Copy From into To
|
||||
|
||||
procedure Initialize_Empty (Self : in out Project_Search_Path);
|
||||
-- Initialize self with an empty list of directories. If Self had already
|
||||
-- been set, it is reset.
|
||||
|
|
@ -234,4 +239,9 @@ private
|
|||
|
||||
Cache : Projects_Paths.Instance;
|
||||
end record;
|
||||
|
||||
No_Project_Search_Path : constant Project_Search_Path :=
|
||||
(Path => null,
|
||||
Cache => Projects_Paths.Nil);
|
||||
|
||||
end Prj.Env;
|
||||
|
|
|
|||
|
|
@ -46,9 +46,11 @@ package body Prj.Ext is
|
|||
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;
|
||||
|
|
@ -63,24 +65,47 @@ package body Prj.Ext is
|
|||
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);
|
||||
|
|
@ -103,7 +128,8 @@ package body Prj.Ext is
|
|||
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;
|
||||
|
|
@ -146,6 +172,7 @@ package body Prj.Ext is
|
|||
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;
|
||||
|
|
@ -162,14 +189,15 @@ package body Prj.Ext is
|
|||
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;
|
||||
|
||||
|
|
@ -178,8 +206,8 @@ package body Prj.Ext is
|
|||
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -54,11 +54,25 @@ package Prj.Ext is
|
|||
procedure Free (Self : in out External_References);
|
||||
-- Free memory used by Self
|
||||
|
||||
type External_Source is
|
||||
(From_Command_Line,
|
||||
From_Environment,
|
||||
From_External_Attribute);
|
||||
-- Where was the value of an external reference defined ?
|
||||
-- They are prioritized in that order, so that a user can always use the
|
||||
-- command line to override a value coming from his environment, or an
|
||||
-- environment variable to override a value defined in an aggregate project
|
||||
-- through the "for External()..." attribute.
|
||||
|
||||
procedure Add
|
||||
(Self : External_References;
|
||||
External_Name : String;
|
||||
Value : String);
|
||||
-- Add an external reference (or modify an existing one)
|
||||
Value : String;
|
||||
Source : External_Source := External_Source'First);
|
||||
-- Add an external reference (or modify an existing one).
|
||||
-- No overriding is done if the Source's priority is less than the one
|
||||
-- used to previously set the value of the variable. The default for Source
|
||||
-- is such that overriding always occurs.
|
||||
|
||||
function Value_Of
|
||||
(Self : External_References;
|
||||
|
|
@ -88,9 +102,10 @@ private
|
|||
type Name_To_Name;
|
||||
type Name_To_Name_Ptr is access all Name_To_Name;
|
||||
type Name_To_Name is record
|
||||
Key : Name_Id;
|
||||
Value : Name_Id;
|
||||
Next : Name_To_Name_Ptr;
|
||||
Key : Name_Id;
|
||||
Value : Name_Id;
|
||||
Source : External_Source;
|
||||
Next : Name_To_Name_Ptr;
|
||||
end record;
|
||||
|
||||
procedure Set_Next (E : Name_To_Name_Ptr; Next : Name_To_Name_Ptr);
|
||||
|
|
|
|||
|
|
@ -131,10 +131,17 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
|
@ -142,13 +149,22 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
|
@ -1392,7 +1408,9 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
|
@ -1597,7 +1615,9 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
|
@ -1949,9 +1969,26 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
||||
|
|
@ -2236,7 +2273,9 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
||||
|
|
@ -2291,6 +2330,7 @@ package body Prj.Proc is
|
|||
Env : in out Prj.Tree.Environment;
|
||||
Reset_Tree : Boolean := True)
|
||||
is
|
||||
Child_Env : Prj.Tree.Environment;
|
||||
begin
|
||||
if Reset_Tree then
|
||||
|
||||
|
|
@ -2306,13 +2346,19 @@ package body Prj.Proc is
|
|||
|
||||
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
|
||||
|
|
@ -2448,7 +2494,9 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
|
@ -2501,7 +2549,9 @@ package body Prj.Proc is
|
|||
(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.
|
||||
|
|
@ -2555,7 +2605,7 @@ package body Prj.Proc is
|
|||
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);
|
||||
|
||||
|
|
@ -2565,8 +2615,10 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
|
@ -2768,7 +2820,9 @@ package body Prj.Proc is
|
|||
(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,
|
||||
|
|
@ -2778,7 +2832,9 @@ package body Prj.Proc is
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1005,7 +1005,8 @@ package body Prj.Tree is
|
|||
----------------
|
||||
|
||||
procedure Initialize
|
||||
(Self : in out Environment; Flags : Processing_Flags) is
|
||||
(Self : out Environment;
|
||||
Flags : Processing_Flags) is
|
||||
begin
|
||||
-- Do not reset the external references, in case we are reloading a
|
||||
-- project, since we want to preserve the current environment. But we
|
||||
|
|
@ -1018,6 +1019,19 @@ package body Prj.Tree is
|
|||
Self.Flags := Flags;
|
||||
end Initialize;
|
||||
|
||||
-------------------------
|
||||
-- Initialize_And_Copy --
|
||||
-------------------------
|
||||
|
||||
procedure Initialize_And_Copy
|
||||
(Self : out Environment;
|
||||
Copy_From : Environment) is
|
||||
begin
|
||||
Self.Flags := Copy_From.Flags;
|
||||
Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External);
|
||||
Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path);
|
||||
end Initialize_And_Copy;
|
||||
|
||||
----------
|
||||
-- Free --
|
||||
----------
|
||||
|
|
|
|||
|
|
@ -60,9 +60,16 @@ package Prj.Tree is
|
|||
-- Configure errors and warnings
|
||||
end record;
|
||||
|
||||
procedure Initialize (Self : in out Environment; Flags : Processing_Flags);
|
||||
procedure Initialize
|
||||
(Self : out Environment;
|
||||
Flags : Processing_Flags);
|
||||
-- Initialize a new environment
|
||||
|
||||
procedure Initialize_And_Copy
|
||||
(Self : out Environment;
|
||||
Copy_From : Environment);
|
||||
-- Initialize a new environment, copying its values from Copy_From
|
||||
|
||||
procedure Free (Self : in out Environment);
|
||||
-- Free the memory used by Self
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue