[Ada] Crash on transient classwide limited view on RHS of short-circuit
Arnaud Charlet
charlet@adacore.com
Wed Jul 16 13:58:00 GMT 2014
This change fixes a compiler crash that would occur in some cases where
an expression involving transient return values of a limited view of a
class-wide interface type occur on the right hand side of a short circuit
operator.
The following compilation must be accepted quietly:
$ gcc -c par-ed.adb
limited with Int2;
package Int1 is
type Int1 is interface;
type Ref_Int1 is access Int1'Class;
type Ref_Int1_List is array (Positive range <>) of Ref_Int1;
function F (This : Int1) return Int2.Int2'Class is abstract;
end Int1;
package Int2 is
type Int2 is interface;
function Fullname (This : Int2) return String is abstract;
end Int2;
with Int1;
with Int2;
package Par is end;
package body Par.Ed is
function Find_Toplevel
(X : Boolean;
Tls : Int1.Ref_Int1_List;
Tl : Int1.Int1'Class)
return Natural
is
Res : Natural := 0;
use type Int2.Int2'Class;
begin
for I in Tls'Range loop
if X
and then Tl.F.Fullname = Tls (I).all.F.Fullname
then
Res := I;
exit;
end if;
end loop;
return Res;
end Find_Toplevel;
end;
package Par.Ed is
function Find_Toplevel
(X : Boolean;
Tls : Int1.Ref_Int1_List;
Tl : Int1.Int1'Class)
return Natural;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
-------------- next part --------------
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 212640)
+++ exp_ch9.adb (working copy)
@@ -29,6 +29,7 @@
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 @@
then
declare
Master_Decl : Node_Id;
-
begin
Set_Has_Master_Entity (Master_Scope);
@@ -1169,7 +1169,7 @@
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
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 212640)
+++ exp_ch4.adb (working copy)
@@ -11390,6 +11390,145 @@
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,9 +12687,20 @@
(Decl : Node_Id;
Rel_Node : Node_Id)
is
- Hook_Context : Node_Id;
- -- Node on which to insert the hook pointer (as an action)
+ Loc : constant Source_Ptr := Sloc (Decl);
+ Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
+ Obj_Typ : constant Node_Id := Etype (Obj_Id);
+ Desig_Typ : Entity_Id;
+ Expr : Node_Id;
+ Fin_Stmts : List_Id;
+ Ptr_Id : Entity_Id;
+ Temp_Id : Entity_Id;
+ Temp_Ins : Node_Id;
+ 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
@@ -12558,216 +12708,56 @@
-- 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.
+ In_Cond_Expr : constant Boolean :=
+ Within_Case_Or_If_Expression (Rel_Node);
- -----------------------------
- -- Find_Enclosing_Contexts --
- -----------------------------
+ begin
+ -- Step 0: determine where to attach finalization actions in the tree
- procedure Find_Enclosing_Contexts (N : Node_Id) is
- Par : Node_Id;
- Top : Node_Id;
+ -- 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.
- 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.
+ if Is_Boolean_Type (Etype (Rel_Node)) then
- In_Cond_Expr : constant Boolean := Within_Case_Or_If_Expression (N);
+ -- 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.
- 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.
+ Finalize_Always :=
+ not (In_Cond_Expr
+ or else
+ Nkind_In (Original_Node (Rel_Node), N_Case_Expression,
+ N_If_Expression));
- 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;
+ declare
+ Loc : constant Source_Ptr := Sloc (Rel_Node);
+ Temp : constant Entity_Id := Make_Temporary (Loc, 'E', Rel_Node);
- -- Prevent the search from going too far
+ 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));
- elsif Is_Body_Or_Package_Declaration (Par) then
- exit;
- end if;
+ Analyze (Last (Actions (Rel_Node)));
- Par := Parent (Par);
- end loop;
+ Set_Expression (Rel_Node, New_Occurrence_Of (Temp, Loc));
+ Analyze (Expression (Rel_Node));
+ end;
- -- 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.
+ else
+ Finalize_Always := False;
+ Finalization_Context := Hook_Context;
+ end if;
- 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);
- Desig_Typ : Entity_Id;
- Expr : Node_Id;
- Fin_Stmts : List_Id;
- Ptr_Id : Entity_Id;
- Temp_Id : Entity_Id;
- Temp_Ins : Node_Id;
-
- -- Start of processing for Process_Transient_Object
-
- begin
- Find_Enclosing_Contexts (Rel_Node);
-
-- Step 1: Create the access type which provides a reference to the
-- transient controlled object.
Index: exp_ch4.ads
===================================================================
--- exp_ch4.ads (revision 212640)
+++ exp_ch4.ads (working copy)
@@ -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 @@
-- 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;
More information about the Gcc-patches
mailing list