OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-10-31  Vincent Celier  <celier@adacore.com>

	* prj-part.adb (Parse_Single_Project): Call Set_Display_Name_Of.
	* prj-proc.adb (Recursive_Process): Call Display_Name_Of to
	get the project Display_Name.
	* prj-tree.adb (Display_Name_Of): New function
	(Set_Display_Name_Of): New procedure.
	(Create_Project): Call Set_Display_Name_Of.
	* prj-tree.ads (Display_Name_Of): New function.
	(Set_Display_Name_Of): New procedure.
	(Project_Node_Record): New component Display_Name.
	(Project_Name_And_Node): Remove component Display_Name.
	* prj-conf.adb (Parse_Project_And_Apply_Config): Use the full
	Config_File_Path as the Config_File_Name, not just its simple
	name.

2014-10-31  Thomas Quinot  <quinot@adacore.com>

	* get_scos.adb: Minor reformatting.

2014-10-31  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Formal_Container_Loop): Create block to
	capture declaration for cursor to prevent spurious errors when
	several formal iterators that use the same cursoe name appear
	in the same context.

From-SVN: r216978
This commit is contained in:
Arnaud Charlet 2014-10-31 15:28:08 +01:00
parent 32dfd2e033
commit 4528392f3b
8 changed files with 131 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -1,3 +1,30 @@
2014-10-31 Vincent Celier <celier@adacore.com>
* prj-part.adb (Parse_Single_Project): Call Set_Display_Name_Of.
* prj-proc.adb (Recursive_Process): Call Display_Name_Of to
get the project Display_Name.
* prj-tree.adb (Display_Name_Of): New function
(Set_Display_Name_Of): New procedure.
(Create_Project): Call Set_Display_Name_Of.
* prj-tree.ads (Display_Name_Of): New function.
(Set_Display_Name_Of): New procedure.
(Project_Node_Record): New component Display_Name.
(Project_Name_And_Node): Remove component Display_Name.
* prj-conf.adb (Parse_Project_And_Apply_Config): Use the full
Config_File_Path as the Config_File_Name, not just its simple
name.
2014-10-31 Thomas Quinot <quinot@adacore.com>
* get_scos.adb: Minor reformatting.
2014-10-31 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_Formal_Container_Loop): Create block to
capture declaration for cursor to prevent spurious errors when
several formal iterators that use the same cursoe name appear
in the same context.
2014-10-31 Vincent Celier <celier@adacore.com>
* prj-proc.adb (Recursive_Process): Make sure that the project

17
gcc/ada/exp_ch5.adb
View File

@ -2776,6 +2776,7 @@ package body Exp_Ch5 is
----------------------------------
procedure Expand_Formal_Container_Loop (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Isc : constant Node_Id := Iteration_Scheme (N);
I_Spec : constant Node_Id := Iterator_Specification (Isc);
Cursor : constant Entity_Id := Defining_Identifier (I_Spec);
@ -2783,6 +2784,7 @@ package body Exp_Ch5 is
Stats : constant List_Id := Statements (N);
Advance : Node_Id;
Blk_Nod : Node_Id;
Init : Node_Id;
New_Loop : Node_Id;
@ -2801,12 +2803,19 @@ package body Exp_Ch5 is
(N, Container, Cursor, Init, Advance, New_Loop);
Set_Ekind (Cursor, E_Variable);
Insert_Action (N, Init);
Append_To (Stats, Advance);
Rewrite (N, New_Loop);
Analyze (New_Loop);
-- Build block to capture declaration of cursor entity.
Blk_Nod :=
Make_Block_Statement (Loc,
Declarations => New_List (Init),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (New_Loop)));
Rewrite (N, Blk_Nod);
Analyze (N);
end Expand_Formal_Container_Loop;
------------------------------------------

4
gcc/ada/get_scos.adb
View File

@ -302,8 +302,8 @@ begin
From => SCO_Table.Last + 1,
To => 0));
when others =>
raise Program_Error;
when others =>
raise Program_Error;
end case;

2
gcc/ada/prj-conf.adb
View File

@ -1753,7 +1753,7 @@ package body Prj.Conf is
Update_Ignore_Missing_With (Env.Flags, False);
if Config_File_Path /= null then
Conf_File_Name := new String'(Simple_Name (Config_File_Path.all));
Conf_File_Name := new String'(Config_File_Path.all);
end if;
-- For the second time the project files are parsed, the warning for

8
gcc/ada/prj-part.adb
View File

@ -1298,7 +1298,6 @@ package body Prj.Part is
Name_From_Path : constant Name_Id :=
Project_Name_From (Path_Name, Is_Config_File => Is_Config_File);
Name_Of_Project : Name_Id := No_Name;
Display_Name_Of_Project : Name_Id := No_Name;
Duplicated : Boolean := False;
@ -1634,11 +1633,11 @@ package body Prj.Part is
end if;
end;
-- Read the original casing of the project name
-- Read the original casing of the project name and put it in the
-- project node.
declare
Loc : Source_Ptr;
begin
Loc := Location_Of (Project, In_Tree);
for J in 1 .. Name_Len loop
@ -1646,7 +1645,7 @@ package body Prj.Part is
Loc := Loc + 1;
end loop;
Display_Name_Of_Project := Name_Find;
Set_Display_Name_Of (Project, In_Tree, Name_Find);
end;
declare
@ -2018,7 +2017,6 @@ package body Prj.Part is
(T => In_Tree.Projects_HT,
K => Name_Of_Project,
E => (Name => Name_Of_Project,
Display_Name => Display_Name_Of_Project,
Node => Project,
Resolved_Path => Resolved_Path_Name,
Extended => Extended,

19
gcc/ada/prj-proc.adb
View File

@ -2765,6 +2765,10 @@ package body Prj.Proc is
Success := not Prj.Tree.No (Loaded_Project);
if Success then
if Node_Tree.Incomplete_With then
From_Project_Node_Tree.Incomplete_With := True;
end if;
List.Tree := new Project_Tree_Data (Is_Root_Tree => False);
Prj.Initialize (List.Tree);
List.Tree.Shared := In_Tree.Shared;
@ -2928,9 +2932,9 @@ package body Prj.Proc is
Name : constant Name_Id :=
Name_Of (From_Project_Node, From_Project_Node_Tree);
Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
Tree_Private_Part.Projects_Htable.Get
(From_Project_Node_Tree.Projects_HT, Name);
Display_Name : constant Name_Id :=
Display_Name_Of
(From_Project_Node, From_Project_Node_Tree);
begin
Project := Processed_Projects.Get (Name);
@ -2994,14 +2998,7 @@ package body Prj.Proc is
Processed_Projects.Set (Name, Project);
Project.Name := Name;
-- Make sure that the project display name is never No_Name
if Name_Node.Display_Name = No_Name then
Project.Display_Name := Name;
else
Project.Display_Name := Name_Node.Display_Name;
end if;
Project.Display_Name := Display_Name;
Get_Name_String (Name);

81
gcc/ada/prj-tree.adb
View File

@ -110,26 +110,27 @@ package body Prj.Tree is
Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table
(Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
(Kind => N_Comment_Zones,
Qualifier => Unspecified,
Expr_Kind => Undefined,
Location => No_Location,
Directory => No_Path,
Variables => Empty_Node,
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
Default => Empty_Value,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
(Kind => N_Comment_Zones,
Qualifier => Unspecified,
Expr_Kind => Undefined,
Location => No_Location,
Directory => No_Path,
Variables => Empty_Node,
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Display_Name => No_Name,
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
Default => Empty_Value,
Field1 => Empty_Node,
Field2 => Empty_Node,
Field3 => Empty_Node,
Field4 => Empty_Node,
Flag1 => False,
Flag2 => False,
Comments => Empty_Node);
Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
In_Tree.Project_Nodes.Table (To).Comments := Zone;
@ -170,6 +171,7 @@ package body Prj.Tree is
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Display_Name => No_Name,
Src_Index => 0,
Path_Name => No_Path,
Value => Comments.Table (J).Value,
@ -339,6 +341,7 @@ package body Prj.Tree is
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Display_Name => No_Name,
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
@ -432,6 +435,7 @@ package body Prj.Tree is
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Display_Name => No_Name,
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
@ -469,6 +473,7 @@ package body Prj.Tree is
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Display_Name => No_Name,
Src_Index => 0,
Path_Name => No_Path,
Value => No_Name,
@ -504,6 +509,7 @@ package body Prj.Tree is
Packages => Empty_Node,
Pkg_Id => Empty_Package,
Name => No_Name,
Display_Name => No_Name,
Src_Index => 0,
Path_Name => No_Path,
Value => Comments.Table (J).Value,
@ -1225,6 +1231,22 @@ package body Prj.Tree is
return In_Tree.Project_Nodes.Table (Node).Name;
end Name_Of;
---------------------
-- Display_Name_Of --
---------------------
function Display_Name_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id
is
begin
pragma Assert
(Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
return In_Tree.Project_Nodes.Table (Node).Display_Name;
end Display_Name_Of;
--------------------
-- Next_Case_Item --
--------------------
@ -2424,6 +2446,23 @@ package body Prj.Tree is
In_Tree.Project_Nodes.Table (Node).Name := To;
end Set_Name_Of;
-------------------------
-- Set_Display_Name_Of --
-------------------------
procedure Set_Display_Name_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Name_Id)
is
begin
pragma Assert
(Present (Node)
and then
In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
In_Tree.Project_Nodes.Table (Node).Display_Name := To;
end Set_Display_Name_Of;
-------------------------------
-- Set_Next_Declarative_Item --
-------------------------------
@ -2949,6 +2988,7 @@ package body Prj.Tree is
begin
Project := Default_Project_Node (In_Tree, N_Project);
Set_Name_Of (Project, In_Tree, Name);
Set_Display_Name_Of (Project, In_Tree, Name);
Set_Directory_Of
(Project, In_Tree,
Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
@ -2968,7 +3008,6 @@ package body Prj.Tree is
Name,
Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
(Name => Name,
Display_Name => Name,
Resolved_Path => No_Path,
Node => Project,
Extended => False,

22
gcc/ada/prj-tree.ads
View File

@ -269,6 +269,12 @@ package Prj.Tree is
-- Valid for all non empty nodes. May return No_Name for nodes that have
-- no names.
function Display_Name_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Name_Id;
pragma Inline (Display_Name_Of);
-- Valid only for N_Project node. Returns the display name of the project.
function Kind_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind;
@ -738,7 +744,14 @@ package Prj.Tree is
In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Name_Of);
-- Valid for all non empty nodes.
-- Valid for all non empty nodes
procedure Set_Display_Name_Of
(Node : Project_Node_Id;
In_Tree : Project_Node_Tree_Ref;
To : Name_Id);
pragma Inline (Set_Display_Name_Of);
-- Valid only for N_Project nodes
procedure Set_Kind_Of
(Node : Project_Node_Id;
@ -1159,6 +1172,9 @@ package Prj.Tree is
Directory : Path_Name_Type := No_Path;
-- Only for N_Project
Display_Name : Name_Id := No_Name;
-- Only for N_Project
Expr_Kind : Variable_Kind := Undefined;
-- See below for what Project_Node_Kind it is used
@ -1479,9 +1495,6 @@ package Prj.Tree is
Name : Name_Id;
-- Name of the project
Display_Name : Name_Id;
-- The name of the project as it appears in the .gpr file
Node : Project_Node_Id;
-- Node of the project in table Project_Nodes
@ -1502,7 +1515,6 @@ package Prj.Tree is
No_Project_Name_And_Node : constant Project_Name_And_Node :=
(Name => No_Name,
Display_Name => No_Name,
Node => Empty_Node,
Resolved_Path => No_Path,
Extended => True,