mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-24 18:55:57 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-07-16  Vadim Godunko  <godunko@adacore.com>

	* a-coinho-shared.adb (Adjust): Create
	copy of internal shared object and element when source container
	is locked.
	(Copy): Likewise.
	(Query_Element): Likewise.
	(Update_Element): Likewise.
	(Constant_Reference): Likewise. Raise Constraint_Error on attempt
	to get reference for empty holder.
	(Reference): Likewise.

2014-07-16  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb (Find_Hook_Context): New subprogram, extracted
	from Process_Transient_Oject.
	* exp_ch4.ads: Ditto.
	* exp_ch9.adb (Build_Class_Wide_Master): Insert the _master
	declaration as an action on the topmost enclosing expression,
	not on a possibly conditional subexpreession.

From-SVN: r212645
This commit is contained in:
Arnaud Charlet 2014-07-16 15:57:28 +02:00
parent d6f824bf7f
commit 8942b30c7c
5 changed files with 334 additions and 229 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/ada/ChangeLog
View File

@ -1,3 +1,24 @@
2014-07-16 Vadim Godunko <godunko@adacore.com>
* a-coinho-shared.adb (Adjust): Create
copy of internal shared object and element when source container
is locked.
(Copy): Likewise.
(Query_Element): Likewise.
(Update_Element): Likewise.
(Constant_Reference): Likewise. Raise Constraint_Error on attempt
to get reference for empty holder.
(Reference): Likewise.
2014-07-16 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb (Find_Hook_Context): New subprogram, extracted
from Process_Transient_Oject.
* exp_ch4.ads: Ditto.
* exp_ch9.adb (Build_Class_Wide_Master): Insert the _master
declaration as an action on the topmost enclosing expression,
not on a possibly conditional subexpreession.
2014-07-16 Vadim Godunko <godunko@adacore.com>
* a-coinho.adb, a-coinho-shared.adb, a-coinho.ads, a-coinho-shared.ads:

125
gcc/ada/a-coinho-shared.adb
View File

@ -57,7 +57,20 @@ package body Ada.Containers.Indefinite_Holders is
overriding procedure Adjust (Container : in out Holder) is
begin
if Container.Reference /= null then
Reference (Container.Reference);
if Container.Busy = 0 then
-- Container is not locked, reuse existing internal shared object.
Reference (Container.Reference);
else
-- Otherwise, create copy of both internal shared object and
-- element.
Container.Reference :=
new Shared_Holder'
(Counter => <>,
Element =>
new Element_Type'(Container.Reference.Element.all));
end if;
end if;
Container.Busy := 0;
@ -113,16 +126,34 @@ package body Ada.Containers.Indefinite_Holders is
------------------------
function Constant_Reference
(Container : aliased Holder) return Constant_Reference_Type
is
Ref : constant Constant_Reference_Type :=
(Element => Container.Reference.Element.all'Access,
Control => (Controlled with Container'Unrestricted_Access));
B : Natural renames Ref.Control.Container.Busy;
(Container : aliased Holder) return Constant_Reference_Type is
begin
Reference (Ref.Control.Container.Reference);
B := B + 1;
return Ref;
if Container.Reference = null then
raise Constraint_Error with "container is empty";
elsif Container.Busy = 0
and then not System.Atomic_Counters.Is_One
(Container.Reference.Counter)
then
-- Container is not locked and internal shared object is used by
-- other container, create copy of both internal shared object and
-- element.
Container'Unrestricted_Access.Reference :=
new Shared_Holder'
(Counter => <>,
Element => new Element_Type'(Container.Reference.Element.all));
end if;
declare
Ref : constant Constant_Reference_Type :=
(Element => Container.Reference.Element.all'Access,
Control => (Controlled with Container'Unrestricted_Access));
begin
Reference (Ref.Control.Container.Reference);
Ref.Control.Container.Busy := Ref.Control.Container.Busy + 1;
return Ref;
end;
end Constant_Reference;
----------
@ -133,10 +164,21 @@ package body Ada.Containers.Indefinite_Holders is
begin
if Source.Reference = null then
return (Controlled with null, 0);
else
elsif Source.Busy = 0 then
-- Container is not locked, reuse internal shared object.
Reference (Source.Reference);
return (Controlled with Source.Reference, 0);
else
-- Otherwise, create copy of both internal shared object and elemet.
return
(Controlled with
new Shared_Holder'
(Counter => <>,
Element => new Element_Type'(Source.Reference.Element.all)),
0);
end if;
end Copy;
@ -224,6 +266,19 @@ package body Ada.Containers.Indefinite_Holders is
begin
if Container.Reference = null then
raise Constraint_Error with "container is empty";
elsif Container.Busy = 0
and then not System.Atomic_Counters.Is_One
(Container.Reference.Counter)
then
-- Container is not locked and internal shared object is used by
-- other container, create copy of both internal shared object and
-- element.
Container'Unrestricted_Access.Reference :=
new Shared_Holder'
(Counter => <>,
Element => new Element_Type'(Container.Reference.Element.all));
end if;
B := B + 1;
@ -284,15 +339,34 @@ package body Ada.Containers.Indefinite_Holders is
end Reference;
function Reference
(Container : aliased in out Holder) return Reference_Type
is
Ref : constant Reference_Type :=
(Element => Container.Reference.Element.all'Access,
Control => (Controlled with Container'Unrestricted_Access));
(Container : aliased in out Holder) return Reference_Type is
begin
Reference (Ref.Control.Container.Reference);
Container.Busy := Container.Busy + 1;
return Ref;
if Container.Reference = null then
raise Constraint_Error with "container is empty";
elsif Container.Busy = 0
and then not System.Atomic_Counters.Is_One
(Container.Reference.Counter)
then
-- Container is not locked and internal shared object is used by
-- other container, create copy of both internal shared object and
-- element.
Container.Reference :=
new Shared_Holder'
(Counter => <>,
Element => new Element_Type'(Container.Reference.Element.all));
end if;
declare
Ref : constant Reference_Type :=
(Element => Container.Reference.Element.all'Access,
Control => (Controlled with Container'Unrestricted_Access));
begin
Reference (Ref.Control.Container.Reference);
Ref.Control.Container.Busy := Ref.Control.Container.Busy + 1;
return Ref;
end;
end Reference;
---------------------
@ -387,6 +461,19 @@ package body Ada.Containers.Indefinite_Holders is
begin
if Container.Reference = null then
raise Constraint_Error with "container is empty";
elsif Container.Busy = 0
and then not System.Atomic_Counters.Is_One
(Container.Reference.Counter)
then
-- Container is not locked and internal shared object is used by
-- other container, create copy of both internal shared object and
-- element.
Container'Unrestricted_Access.Reference :=
new Shared_Holder'
(Counter => <>,
Element => new Element_Type'(Container.Reference.Element.all));
end if;
B := B + 1;

404
gcc/ada/exp_ch4.adb
View File

@ -11390,6 +11390,145 @@ package body Exp_Ch4 is
Adjust_Result_Type (N, Typ);
end Expand_Short_Circuit_Operator;
-----------------------
-- Find_Hook_Context --
-----------------------
function Find_Hook_Context (N : Node_Id) return Node_Id is
Par : Node_Id;
Top : Node_Id;
Wrapped_Node : Node_Id;
-- Note: if we are in a transient scope, we want to reuse it as
-- the context for actions insertion, if possible. But if N is itself
-- part of the stored actions for the current transient scope,
-- then we need to insert at the appropriate (inner) location in
-- the not as an action on Node_To_Be_Wrapped.
In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N);
begin
-- When the node is inside a case/if expression, the lifetime of any
-- temporary controlled object is extended. Find a suitable insertion
-- node by locating the topmost case or if expressions.
if In_Cond_Expr then
Par := N;
Top := N;
while Present (Par) loop
if Nkind_In (Original_Node (Par), N_Case_Expression,
N_If_Expression)
then
Top := Par;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
-- The topmost case or if expression is now recovered, but it may
-- still not be the correct place to add generated code. Climb to
-- find a parent that is part of a declarative or statement list,
-- and is not a list of actuals in a call.
Par := Top;
while Present (Par) loop
if Is_List_Member (Par)
and then not Nkind_In (Par, N_Component_Association,
N_Discriminant_Association,
N_Parameter_Association,
N_Pragma_Argument_Association)
and then not Nkind_In
(Parent (Par), N_Function_Call,
N_Procedure_Call_Statement,
N_Entry_Call_Statement)
then
return Par;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
return Par;
else
Par := N;
while Present (Par) loop
-- Keep climbing past various operators
if Nkind (Parent (Par)) in N_Op
or else Nkind_In (Parent (Par), N_And_Then, N_Or_Else)
then
Par := Parent (Par);
else
exit;
end if;
end loop;
Top := Par;
-- The node may be located in a pragma in which case return the
-- pragma itself:
-- pragma Precondition (... and then Ctrl_Func_Call ...);
-- Similar case occurs when the node is related to an object
-- declaration or assignment:
-- Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
-- Another case to consider is when the node is part of a return
-- statement:
-- return ... and then Ctrl_Func_Call ...;
-- Another case is when the node acts as a formal in a procedure
-- call statement:
-- Proc (... and then Ctrl_Func_Call ...);
if Scope_Is_Transient then
Wrapped_Node := Node_To_Be_Wrapped;
else
Wrapped_Node := Empty;
end if;
while Present (Par) loop
if Par = Wrapped_Node
or else Nkind_In (Par, N_Assignment_Statement,
N_Object_Declaration,
N_Pragma,
N_Procedure_Call_Statement,
N_Simple_Return_Statement)
then
return Par;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
-- Return the topmost short circuit operator
return Top;
end if;
end Find_Hook_Context;
-------------------------------------
-- Fixup_Universal_Fixed_Operation --
-------------------------------------
@ -12548,211 +12687,6 @@ package body Exp_Ch4 is
(Decl : Node_Id;
Rel_Node : Node_Id)
is
Hook_Context : Node_Id;
-- Node on which to insert the hook pointer (as an action)
Finalization_Context : Node_Id;
-- Node after which to insert finalization actions
Finalize_Always : Boolean;
-- If False, call to finalizer includes a test of whether the
-- hook pointer is null.
procedure Find_Enclosing_Contexts (N : Node_Id);
-- Find the logical context where N appears, and initialize
-- Hook_Context and Finalization_Context accordingly. Also
-- sets Finalize_Always.
-----------------------------
-- Find_Enclosing_Contexts --
-----------------------------
procedure Find_Enclosing_Contexts (N : Node_Id) is
Par : Node_Id;
Top : Node_Id;
Wrapped_Node : Node_Id;
-- Note: if we are in a transient scope, we want to reuse it as
-- the context for actions insertion, if possible. But if N is itself
-- part of the stored actions for the current transient scope,
-- then we need to insert at the appropriate (inner) location in
-- the not as an action on Node_To_Be_Wrapped.
In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N);
begin
-- When the node is inside a case/if expression, the lifetime of any
-- temporary controlled object is extended. Find a suitable insertion
-- node by locating the topmost case or if expressions.
if In_Cond_Expr then
Par := N;
Top := N;
while Present (Par) loop
if Nkind_In (Original_Node (Par), N_Case_Expression,
N_If_Expression)
then
Top := Par;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
-- The topmost case or if expression is now recovered, but it may
-- still not be the correct place to add generated code. Climb to
-- find a parent that is part of a declarative or statement list,
-- and is not a list of actuals in a call.
Par := Top;
while Present (Par) loop
if Is_List_Member (Par)
and then not Nkind_In (Par, N_Component_Association,
N_Discriminant_Association,
N_Parameter_Association,
N_Pragma_Argument_Association)
and then not Nkind_In
(Parent (Par), N_Function_Call,
N_Procedure_Call_Statement,
N_Entry_Call_Statement)
then
Hook_Context := Par;
goto Hook_Context_Found;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
Hook_Context := Par;
goto Hook_Context_Found;
else
Par := N;
while Present (Par) loop
-- Keep climbing past various operators
if Nkind (Parent (Par)) in N_Op
or else Nkind_In (Parent (Par), N_And_Then, N_Or_Else)
then
Par := Parent (Par);
else
exit;
end if;
end loop;
Top := Par;
-- The node may be located in a pragma in which case return the
-- pragma itself:
-- pragma Precondition (... and then Ctrl_Func_Call ...);
-- Similar case occurs when the node is related to an object
-- declaration or assignment:
-- Obj [: Some_Typ] := ... and then Ctrl_Func_Call ...;
-- Another case to consider is when the node is part of a return
-- statement:
-- return ... and then Ctrl_Func_Call ...;
-- Another case is when the node acts as a formal in a procedure
-- call statement:
-- Proc (... and then Ctrl_Func_Call ...);
if Scope_Is_Transient then
Wrapped_Node := Node_To_Be_Wrapped;
else
Wrapped_Node := Empty;
end if;
while Present (Par) loop
if Par = Wrapped_Node
or else Nkind_In (Par, N_Assignment_Statement,
N_Object_Declaration,
N_Pragma,
N_Procedure_Call_Statement,
N_Simple_Return_Statement)
then
Hook_Context := Par;
goto Hook_Context_Found;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
-- Return the topmost short circuit operator
Hook_Context := Top;
end if;
<<Hook_Context_Found>>
-- Special case for Boolean EWAs: capture expression in a temporary,
-- whose declaration will serve as the context around which to insert
-- finalization code. The finalization thus remains local to the
-- specific condition being evaluated.
if Is_Boolean_Type (Etype (N)) then
-- In this case, the finalization context is chosen so that
-- we know at finalization point that the hook pointer is
-- never null, so no need for a test, we can call the finalizer
-- unconditionally, except in the case where the object is
-- created in a specific branch of a conditional expression.
Finalize_Always :=
not (In_Cond_Expr
or else
Nkind_In (Original_Node (N), N_Case_Expression,
N_If_Expression));
declare
Loc : constant Source_Ptr := Sloc (N);
Temp : constant Entity_Id := Make_Temporary (Loc, 'E', N);
begin
Append_To (Actions (N),
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (Etype (N), Loc),
Expression => Expression (N)));
Finalization_Context := Last (Actions (N));
Analyze (Last (Actions (N)));
Set_Expression (N, New_Occurrence_Of (Temp, Loc));
Analyze (Expression (N));
end;
else
Finalize_Always := False;
Finalization_Context := Hook_Context;
end if;
end Find_Enclosing_Contexts;
-- Local variables
Loc : constant Source_Ptr := Sloc (Decl);
Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Obj_Typ : constant Node_Id := Etype (Obj_Id);
@ -12763,10 +12697,66 @@ package body Exp_Ch4 is
Temp_Id : Entity_Id;
Temp_Ins : Node_Id;
-- Start of processing for Process_Transient_Object
Hook_Context : constant Node_Id := Find_Hook_Context (Rel_Node);
-- Node on which to insert the hook pointer (as an action): the
-- innermost enclosing non-transient scope.
Finalization_Context : Node_Id;
-- Node after which to insert finalization actions
Finalize_Always : Boolean;
-- If False, call to finalizer includes a test of whether the
-- hook pointer is null.
In_Cond_Expr : constant Boolean :=
Within_Case_Or_If_Expression (Rel_Node);
begin
Find_Enclosing_Contexts (Rel_Node);
-- Step 0: determine where to attach finalization actions in the tree
-- Special case for Boolean EWAs: capture expression in a temporary,
-- whose declaration will serve as the context around which to insert
-- finalization code. The finalization thus remains local to the
-- specific condition being evaluated.
if Is_Boolean_Type (Etype (Rel_Node)) then
-- In this case, the finalization context is chosen so that
-- we know at finalization point that the hook pointer is
-- never null, so no need for a test, we can call the finalizer
-- unconditionally, except in the case where the object is
-- created in a specific branch of a conditional expression.
Finalize_Always :=
not (In_Cond_Expr
or else
Nkind_In (Original_Node (Rel_Node), N_Case_Expression,
N_If_Expression));
declare
Loc : constant Source_Ptr := Sloc (Rel_Node);
Temp : constant Entity_Id := Make_Temporary (Loc, 'E', Rel_Node);
begin
Append_To (Actions (Rel_Node),
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (Etype (Rel_Node), Loc),
Expression => Expression (Rel_Node)));
Finalization_Context := Last (Actions (Rel_Node));
Analyze (Last (Actions (Rel_Node)));
Set_Expression (Rel_Node, New_Occurrence_Of (Temp, Loc));
Analyze (Expression (Rel_Node));
end;
else
Finalize_Always := False;
Finalization_Context := Hook_Context;
end if;
-- Step 1: Create the access type which provides a reference to the
-- transient controlled object.

9
gcc/ada/exp_ch4.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -103,4 +103,11 @@ package Exp_Ch4 is
-- have special circuitry in Expand_N_Type_Conversion to promote both of
-- the operands to type Integer.
function Find_Hook_Context (N : Node_Id) return Node_Id;
-- Determine a suitable node on which to attach actions related to N
-- that need to be elaborated unconditionally (i.e. in general the topmost
-- expression of which N is a subexpression, which may or may not be
-- evaluated, for example if N is the right operand of a short circuit
-- operator).
end Exp_Ch4;

4
gcc/ada/exp_ch9.adb
View File

@ -29,6 +29,7 @@ with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch4; use Exp_Ch4;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch11; use Exp_Ch11;
with Exp_Dbug; use Exp_Dbug;
@ -1151,7 +1152,6 @@ package body Exp_Ch9 is
then
declare
Master_Decl : Node_Id;
begin
Set_Has_Master_Entity (Master_Scope);
@ -1169,7 +1169,7 @@ package body Exp_Ch9 is
Make_Explicit_Dereference (Loc,
New_Occurrence_Of (RTE (RE_Current_Master), Loc)));
Insert_Action (Related_Node, Master_Decl);
Insert_Action (Find_Hook_Context (Related_Node), Master_Decl);
Analyze (Master_Decl);
-- Mark the containing scope as a task master. Masters associated