mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-13 15:31:15 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2009-04-22  Ed Schonberg  <schonberg@adacore.com>

	* gnat1drv.adb: Fix typo

2009-04-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Make_Build_In_Place_Call_In_Assignment): Code cleanup.
	Add a call to Move_Final_List when the target of the assignment is a
	return object that needs finalization and the expression is a
	controlled build-in-place function.

2009-04-22  Vincent Celier  <celier@adacore.com>

	* make.adb (Gnatmake, Bind_Step): call Set_Ada_Paths with
	Including_Libraries set to True.

From-SVN: r146560
This commit is contained in:
Arnaud Charlet 2009-04-22 12:14:53 +02:00
parent f3a67cfc20
commit 3a69b5ffe6
4 changed files with 118 additions and 36 deletions

12
gcc/ada/ChangeLog

@ -1,3 +1,15 @@
2009-04-22 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Make_Build_In_Place_Call_In_Assignment): Code cleanup.
Add a call to Move_Final_List when the target of the assignment is a
return object that needs finalization and the expression is a
controlled build-in-place function.
2009-04-22 Vincent Celier <celier@adacore.com>
* make.adb (Gnatmake, Bind_Step): call Set_Ada_Paths with
Including_Libraries set to True.
2009-04-22 Ed Schonberg <schonberg@adacore.com>
* lib-load.ads, lib-load.adb (Make_Child_Decl_Unit): New subprogram, to

136
gcc/ada/exp_ch6.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -5243,15 +5243,16 @@ package body Exp_Ch6 is
(Assign : Node_Id;
Function_Call : Node_Id)
is
Lhs : constant Node_Id := Name (Assign);
Loc : Source_Ptr;
Func_Call : Node_Id := Function_Call;
Function_Id : Entity_Id;
Result_Subt : Entity_Id;
Ref_Type : Entity_Id;
Ptr_Typ_Decl : Node_Id;
Def_Id : Entity_Id;
New_Expr : Node_Id;
Lhs : constant Node_Id := Name (Assign);
Func_Call : Node_Id := Function_Call;
Func_Id : Entity_Id;
Loc : Source_Ptr;
Obj_Decl : Node_Id;
Obj_Id : Entity_Id;
Ptr_Typ : Entity_Id;
Ptr_Typ_Decl : Node_Id;
Result_Subt : Entity_Id;
Target : Node_Id;
begin
-- Step past qualification or unchecked conversion (the latter can occur
@ -5278,16 +5279,16 @@ package body Exp_Ch6 is
Loc := Sloc (Function_Call);
if Is_Entity_Name (Name (Func_Call)) then
Function_Id := Entity (Name (Func_Call));
Func_Id := Entity (Name (Func_Call));
elsif Nkind (Name (Func_Call)) = N_Explicit_Dereference then
Function_Id := Etype (Name (Func_Call));
Func_Id := Etype (Name (Func_Call));
else
raise Program_Error;
end if;
Result_Subt := Etype (Function_Id);
Result_Subt := Etype (Func_Id);
-- When the result subtype is unconstrained, an additional actual must
-- be passed to indicate that the caller is providing the return object.
@ -5296,67 +5297,136 @@ package body Exp_Ch6 is
-- to be treated effectively the same as calls to class-wide functions.
Add_Alloc_Form_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Alloc_Form => Caller_Allocation);
(Func_Call, Func_Id, Alloc_Form => Caller_Allocation);
-- If Lhs is a selected component, then pass it along so that its prefix
-- object will be used as the source of the finalization list.
if Nkind (Lhs) = N_Selected_Component then
Add_Final_List_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Acc_Type => Empty, Sel_Comp => Lhs);
(Func_Call, Func_Id, Acc_Type => Empty, Sel_Comp => Lhs);
else
Add_Final_List_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Acc_Type => Empty);
(Func_Call, Func_Id, Acc_Type => Empty);
end if;
Add_Task_Actuals_To_Build_In_Place_Call
(Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster));
(Func_Call, Func_Id, Make_Identifier (Loc, Name_uMaster));
-- Add an implicit actual to the function call that provides access to
-- the caller's return object.
Add_Access_Actual_To_Build_In_Place_Call
(Func_Call,
Function_Id,
Func_Id,
Make_Unchecked_Type_Conversion (Loc,
Subtype_Mark => New_Reference_To (Result_Subt, Loc),
Expression => Relocate_Node (Lhs)));
-- Create an access type designating the function's result subtype
Ref_Type :=
Ptr_Typ :=
Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
Ptr_Typ_Decl :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Ref_Type,
Defining_Identifier => Ptr_Typ,
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
All_Present => True,
Subtype_Indication =>
New_Reference_To (Result_Subt, Loc)));
Insert_After_And_Analyze (Assign, Ptr_Typ_Decl);
-- Finally, create an access object initialized to a reference to the
-- function call.
Def_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('R'));
Set_Etype (Def_Id, Ref_Type);
Obj_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
Set_Etype (Obj_Id, Ptr_Typ);
New_Expr :=
Make_Reference (Loc,
Prefix => Relocate_Node (Func_Call));
Insert_After_And_Analyze (Ptr_Typ_Decl,
Obj_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Def_Id,
Object_Definition => New_Reference_To (Ref_Type, Loc),
Expression => New_Expr));
Defining_Identifier => Obj_Id,
Object_Definition =>
New_Reference_To (Ptr_Typ, Loc),
Expression =>
Make_Reference (Loc,
Prefix => Relocate_Node (Func_Call)));
Insert_After_And_Analyze (Ptr_Typ_Decl, Obj_Decl);
Rewrite (Assign, Make_Null_Statement (Loc));
-- Retrieve the target of the assignment
if Nkind (Lhs) = N_Selected_Component then
Target := Selector_Name (Lhs);
elsif Nkind (Lhs) = N_Type_Conversion then
Target := Expression (Lhs);
else
Target := Lhs;
end if;
-- If we are assigning to a return object or this is an expression of
-- an extension aggregate, the target should either be an identifier
-- or a simple expression. All other cases imply a different scenario.
if Nkind (Target) in N_Has_Entity then
Target := Entity (Target);
else
return;
end if;
-- When the target of the assignment is a return object of an enclosing
-- build-in-place function and also requires finalization, the list
-- generated for the assignment must be moved to that of the enclosing
-- function.
-- function Enclosing_BIP_Function return Ctrl_Typ is
-- begin
-- return (Ctrl_Parent_Part => BIP_Function with ...);
-- end Enclosing_BIP_Function;
if Is_Return_Object (Target)
and then Needs_Finalization (Etype (Target))
and then Needs_Finalization (Result_Subt)
then
declare
Obj_List : constant Node_Id := Find_Final_List (Obj_Id);
Encl_List : Node_Id;
Encl_Scop : Entity_Id;
begin
Encl_Scop := Scope (Target);
-- Locate the scope of the extended return statement
while Present (Encl_Scop)
and then Ekind (Encl_Scop) /= E_Return_Statement
loop
Encl_Scop := Scope (Encl_Scop);
end loop;
-- A return object should always be enclosed by a return statement
-- scope at some level.
pragma Assert (Present (Encl_Scop));
Encl_List :=
Make_Attribute_Reference (Loc,
Prefix =>
New_Reference_To (
Finalization_Chain_Entity (Encl_Scop), Loc),
Attribute_Name => Name_Unrestricted_Access);
-- Generate a call to move final list
Insert_After_And_Analyze (Obj_Decl,
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (RTE (RE_Move_Final_List), Loc),
Parameter_Associations => New_List (Obj_List, Encl_List)));
end;
end if;
end Make_Build_In_Place_Call_In_Assignment;
----------------------------------------------------

2
gcc/ada/gnat1drv.adb

@ -517,7 +517,7 @@ begin
if Nkind (Unit (Main_Unit_Node)) in N_Unit_Body
and then not Acts_As_Spec (Main_Unit_Node)
then
if Nkind (Main_Unit_Node) = N_Subprogram_Body
if Nkind (Unit (Main_Unit_Node)) = N_Subprogram_Body
and then not Comes_From_Source (Library_Unit (Main_Unit_Node))
then
null;

4
gcc/ada/make.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -6213,7 +6213,7 @@ package body Make is
-- Put all the source directories in ADA_INCLUDE_PATH,
-- and all the object directories in ADA_OBJECTS_PATH.
Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, False);
Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, True);
-- If switch -C was specified, create a binder mapping file