aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorEmmanuel Briot <briot@adacore.com>2011-08-03 10:01:51 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-03 12:01:51 +0200
commitab29a348ebe1345e469cede91ea4b2ef7c72e1fe (patch)
treef598a1cc49cea68a1f0ccdfe4a7e31f9cbdd9664 /gcc
parent9466892f26037f47b9406de56f8ec0f0ed8588a5 (diff)
downloadgcc-ab29a348ebe1345e469cede91ea4b2ef7c72e1fe.zip
gcc-ab29a348ebe1345e469cede91ea4b2ef7c72e1fe.tar.gz
gcc-ab29a348ebe1345e469cede91ea4b2ef7c72e1fe.tar.bz2
[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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog6
-rw-r--r--gcc/ada/prj-env.adb14
-rw-r--r--gcc/ada/prj-env.ads10
-rw-r--r--gcc/ada/prj-ext.adb70
-rw-r--r--gcc/ada/prj-ext.ads25
-rw-r--r--gcc/ada/prj-proc.adb86
-rw-r--r--gcc/ada/prj-tree.adb16
-rw-r--r--gcc/ada/prj-tree.ads9
8 files changed, 193 insertions, 43 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3090c3e..7ce74cf 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 6285222..050660e 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -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;
diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads
index 61c0431..75f014a 100644
--- a/gcc/ada/prj-env.ads
+++ b/gcc/ada/prj-env.ads
@@ -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;
diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb
index b9885c3..a235bde 100644
--- a/gcc/ada/prj-ext.adb
+++ b/gcc/ada/prj-ext.adb
@@ -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);
diff --git a/gcc/ada/prj-ext.ads b/gcc/ada/prj-ext.ads
index 4ea4608..75b0ed2 100644
--- a/gcc/ada/prj-ext.ads
+++ b/gcc/ada/prj-ext.ads
@@ -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);
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index f83a05f..4e3ba1b 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -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;
diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index 3ac6a88..0a1b9a5 100644
--- a/gcc/ada/prj-tree.adb
+++ b/gcc/ada/prj-tree.adb
@@ -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 --
----------
diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index 69372ae..fede1f9 100644
--- a/gcc/ada/prj-tree.ads
+++ b/gcc/ada/prj-tree.ads
@@ -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