[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