Skip to content

R
riscv-gcc-1
Commit c471e2da by Arnaud Charlet
Options

[multiple changes] 

2009-09-16  Robert Dewar  <dewar@adacore.com>

	* prj-nmsc.adb: Minor reformatting

2009-09-16  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Conditional_Expression): If the type of the
	expression is a by-reference type (tagged or inherently limited)
	introduce an access type to capture references to the values of each
	branch of the conditional.

2009-09-16  Emmanuel Briot  <briot@adacore.com>

	* prj-proc.adb, prj-part.adb, prj-tree.adb, prj-tree.ads
	(Project_Name_And_Node.Display_Name): new field
	The display name of a project (as written in the .gpr file) is now
	computed when the project file itself is parsed, not when it is
	processed.

From-SVN: r151750
parent 75a64833
Showing with 147 additions and 63 deletions
gcc/ada/ChangeLog
2009-09-16 Robert Dewar <dewar@adacore.com>
* prj-nmsc.adb: Minor reformatting
2009-09-16 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Conditional_Expression): If the type of the
expression is a by-reference type (tagged or inherently limited)
introduce an access type to capture references to the values of each
branch of the conditional.
2009-09-16 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj-part.adb, prj-tree.adb, prj-tree.ads
(Project_Name_And_Node.Display_Name): new field
The display name of a project (as written in the .gpr file) is now
computed when the project file itself is parsed, not when it is
processed.
2009-09-16 Thomas Quinot <quinot@adacore.com>
* freeze.adb, exp_intr.adb (Expand_Intrinsic_Call): Leave calls to
......
gcc/ada/exp_ch4.adb
......@@ -4017,8 +4017,12 @@ package body Exp_Ch4 is
Thenx : constant Node_Id := Next (Cond);
Elsex : constant Node_Id := Next (Thenx);
Typ : constant Entity_Id := Etype (N);
Cnn : Entity_Id;
Decl : Node_Id;
New_If : Node_Id;
New_N : Node_Id;
P_Decl : Node_Id;
begin
-- If either then or else actions are present, then given:
......@@ -4038,13 +4042,12 @@ package body Exp_Ch4 is
-- and replace the conditional expression by a reference to Cnn
-- ??? Note: this expansion is wrong for limited types, since it does
-- a copy of a limited value. Similarly it's wrong for unconstrained or
-- class-wide types since in neither case can we have an uninitialized
-- object declaration The proper fix would be to do the following
-- expansion:
-- If the type is limited or unconstrained, the above expansion is
-- not legal, because it involves either an uninitialized object
-- or an illegal assignment. Instead, we generate:
-- Cnn : access typ;
-- type Ptr is access all Typ;
-- Cnn : Ptr;
-- if cond then
-- <<then actions>>
-- Cnn := then-expr'Unrestricted_Access;
......@@ -4053,11 +4056,29 @@ package body Exp_Ch4 is
-- Cnn := else-expr'Unrestricted_Access;
-- end if;
-- and replace the conditional expresion by a reference to Cnn.all ???
-- and replace the conditional expresion by a reference to Cnn.all.
if Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
if Is_By_Reference_Type (Typ) then
Cnn := Make_Temporary (Loc, 'C', N);
P_Decl :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, New_Internal_Name ('A')),
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication =>
New_Reference_To (Typ, Loc)));
Insert_Action (N, P_Decl);
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition =>
New_Occurrence_Of (Defining_Identifier (P_Decl), Loc));
New_If :=
Make_Implicit_If_Statement (N,
Condition => Relocate_Node (Cond),
......@@ -4065,47 +4086,86 @@ package body Exp_Ch4 is
Then_Statements => New_List (
Make_Assignment_Statement (Sloc (Thenx),
Name => New_Occurrence_Of (Cnn, Sloc (Thenx)),
Expression => Relocate_Node (Thenx))),
Expression =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Unrestricted_Access,
Prefix => Relocate_Node (Thenx)))),
Else_Statements => New_List (
Make_Assignment_Statement (Sloc (Elsex),
Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
Expression => Relocate_Node (Elsex))));
Expression =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Unrestricted_Access,
Prefix => Relocate_Node (Elsex)))));
-- Move the SLOC of the parent If statement to the newly created one
-- and change it to the SLOC of the expression which, after
-- expansion, will correspond to what is being evaluated.
New_N :=
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Cnn, Loc));
if Present (Parent (N))
and then Nkind (Parent (N)) = N_If_Statement
then
Set_Sloc (New_If, Sloc (Parent (N)));
Set_Sloc (Parent (N), Loc);
end if;
-- For other types, we only need to expand if there are other actions
-- associated with either branch.
elsif Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
Cnn := Make_Temporary (Loc, 'C', N);
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition => New_Occurrence_Of (Typ, Loc));
New_If :=
Make_Implicit_If_Statement (N,
Condition => Relocate_Node (Cond),
Then_Statements => New_List (
Make_Assignment_Statement (Sloc (Thenx),
Name => New_Occurrence_Of (Cnn, Sloc (Thenx)),
Expression => Relocate_Node (Thenx))),
Else_Statements => New_List (
Make_Assignment_Statement (Sloc (Elsex),
Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
Expression => Relocate_Node (Elsex))));
Set_Assignment_OK (Name (First (Then_Statements (New_If))));
Set_Assignment_OK (Name (First (Else_Statements (New_If))));
if Present (Then_Actions (N)) then
Insert_List_Before
(First (Then_Statements (New_If)), Then_Actions (N));
end if;
New_N := New_Occurrence_Of (Cnn, Loc);
if Present (Else_Actions (N)) then
Insert_List_Before
(First (Else_Statements (New_If)), Else_Actions (N));
end if;
else
Rewrite (N, New_Occurrence_Of (Cnn, Loc));
-- No expansion needed, gigi handles it like a C conditional
-- expression.
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Cnn,
Object_Definition => New_Occurrence_Of (Typ, Loc)));
return;
end if;
Insert_Action (N, New_If);
Analyze_And_Resolve (N, Typ);
-- Move the SLOC of the parent If statement to the newly created one
-- and change it to the SLOC of the expression which, after
-- expansion, will correspond to what is being evaluated.
if Present (Parent (N))
and then Nkind (Parent (N)) = N_If_Statement
then
Set_Sloc (New_If, Sloc (Parent (N)));
Set_Sloc (Parent (N), Loc);
end if;
if Present (Then_Actions (N)) then
Insert_List_Before
(First (Then_Statements (New_If)), Then_Actions (N));
end if;
if Present (Else_Actions (N)) then
Insert_List_Before
(First (Else_Statements (New_If)), Else_Actions (N));
end if;
Insert_Action (N, Decl);
Insert_Action (N, New_If);
Rewrite (N, New_N);
Analyze_And_Resolve (N, Typ);
end Expand_N_Conditional_Expression;
-----------------------------------
......
gcc/ada/prj-nmsc.adb
......@@ -5066,8 +5066,7 @@ package body Prj.Nmsc is
if not Removed then
-- As it is an existing directory, we add it to the
-- list of directories, if it is not already in the
-- list.
-- list of directories, if not already in the list.
if List = Nil_String then
String_Element_Table.Increment_Last
......@@ -6784,6 +6783,15 @@ package body Prj.Nmsc is
Unit => Unit,
Locally_Removed => Locally_Removed,
Path => (Canonical_Path, Path));
-- If it is a source specified in a list, update the entry in
-- the Source_Names table.
if Name_Loc.Found and then Name_Loc.Source = No_Source then
Name_Loc.Source := Source;
Source_Names_Htable.Set
(Project.Source_Names, File_Name, Name_Loc);
end if;
end if;
end if;
end Check_File;
......
gcc/ada/prj-part.adb
......@@ -941,6 +941,7 @@ 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;
......@@ -1298,9 +1299,6 @@ package body Prj.Part is
-- To get expected name of the project file, replace dots by dashes
Name_Len := Buffer_Last;
Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
for Index in 1 .. Name_Len loop
if Name_Buffer (Index) = '.' then
Name_Buffer (Index) := '-';
......@@ -1337,6 +1335,19 @@ package body Prj.Part is
end if;
end;
-- Read the original casing of the project name
declare
Loc : Source_Ptr := Location_Of (Project, In_Tree);
begin
for J in 1 .. Name_Len loop
Name_Buffer (J) := Sinput.Source (Loc);
Loc := Loc + 1;
end loop;
Display_Name_Of_Project := Name_Find;
end;
declare
From_Ext : Extension_Origin := None;
......@@ -1700,6 +1711,7 @@ 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,
Canonical_Path => Canonical_Path_Name,
Extended => Extended,
......
gcc/ada/prj-proc.adb
......@@ -31,7 +31,6 @@ with Prj.Attr; use Prj.Attr;
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
with Sinput; use Sinput;
with Snames;
with GNAT.Case_Util; use GNAT.Case_Util;
......@@ -2425,13 +2424,12 @@ package body Prj.Proc is
declare
Imported : Project_List;
Declaration_Node : Project_Node_Id := Empty_Node;
Tref : Source_Buffer_Ptr;
Name : constant Name_Id :=
Name_Of
(From_Project_Node, From_Project_Node_Tree);
Location : Source_Ptr :=
Location_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);
begin
Project := Processed_Projects.Get (Name);
......@@ -2458,6 +2456,7 @@ package body Prj.Proc is
Processed_Projects.Set (Name, Project);
Project.Name := Name;
Project.Display_Name := Name_Node.Display_Name;
Project.Qualifier :=
Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
......@@ -2471,26 +2470,7 @@ package body Prj.Proc is
Virtual_Prefix
then
Project.Virtual := True;
Project.Display_Name := Name;
-- If there is no file, for example when the project node tree is
-- built in memory by GPS, the Display_Name cannot be found in
-- the source, so its value is the same as Name.
elsif Location = No_Location then
Project.Display_Name := Name;
-- Get the spelling of the project name from the project file
else
Tref := Source_Text (Get_Source_File_Index (Location));
for J in 1 .. Name_Len loop
Name_Buffer (J) := Tref (Location);
Location := Location + 1;
end loop;
Project.Display_Name := Name_Find;
end if;
Project.Path.Display_Name :=
......
gcc/ada/prj-tree.adb
......@@ -2854,6 +2854,7 @@ package body Prj.Tree is
Name,
Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
(Name => Name,
Display_Name => Name,
Canonical_Path => No_Path,
Node => Project,
Extended => False,
......
gcc/ada/prj-tree.ads
......@@ -1332,6 +1332,9 @@ 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
......@@ -1348,6 +1351,7 @@ package Prj.Tree is
No_Project_Name_And_Node : constant Project_Name_And_Node :=
(Name => No_Name,
Display_Name => No_Name,
Node => Empty_Node,
Canonical_Path => No_Path,
Extended => True,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment