diff options
Diffstat (limited to 'gcc/ada/exp_ch7.adb')
-rw-r--r-- | gcc/ada/exp_ch7.adb | 80 |
1 files changed, 74 insertions, 6 deletions
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index f9844cd..e9e8053 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1074,6 +1074,76 @@ package body Exp_Ch7 is if No (Wrap_Node) then null; + elsif Nkind (Wrap_Node) = N_Iteration_Scheme then + + -- Create a declaration followed by an assignment, so that + -- the assignment can have its own transient scope. + -- We generate the equivalent of: + + -- type Ptr is access all expr_type; + -- Var : Ptr; + -- begin + -- Var := Expr'reference; + -- end; + + -- This closely resembles what is done in Remove_Side_Effect, + -- but it has to be done here, before the analysis of the call + -- is completed. + + declare + Ptr_Typ : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('A')); + Ptr : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('T')); + + Expr_Type : constant Entity_Id := Etype (N); + New_Expr : constant Node_Id := Relocate_Node (N); + Decl : Node_Id; + Ptr_Typ_Decl : Node_Id; + Stmt : Node_Id; + + begin + Ptr_Typ_Decl := + Make_Full_Type_Declaration (Loc, + Defining_Identifier => Ptr_Typ, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + All_Present => True, + Subtype_Indication => + New_Reference_To (Expr_Type, Loc))); + + Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Ptr, + Object_Definition => New_Occurrence_Of (Ptr_Typ, Loc)); + + Set_Etype (Ptr, Ptr_Typ); + Stmt := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Ptr, Loc), + Expression => Make_Reference (Loc, New_Expr)); + + Set_Analyzed (New_Expr, False); + + Insert_List_Before_And_Analyze + (Parent (Wrap_Node), + New_List ( + Ptr_Typ_Decl, + Decl, + Make_Block_Statement (Loc, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + New_List (Stmt))))); + + Rewrite (N, + Make_Explicit_Dereference (Loc, + Prefix => New_Reference_To (Ptr, Loc))); + Analyze_And_Resolve (N, Expr_Type); + + end; + -- Transient scope is required else @@ -1815,14 +1885,12 @@ package body Exp_Ch7 is return The_Parent; end if; - -- ??? No scheme yet for "for I in Expression'Range loop" - -- ??? the current scheme for Expression wrapping doesn't apply - -- ??? because a RANGE is NOT an expression. Tricky problem... - -- ??? while this problem is not solved we have a potential for - -- ??? leak and unfinalized intermediate objects here. + -- If the expression is within the iteration scheme of a loop, + -- we must create a declaration for it, followed by an assignment + -- in order to have a usable statement to wrap. when N_Loop_Parameter_Specification => - return Empty; + return Parent (The_Parent); -- The following nodes contains "dummy calls" which don't -- need to be wrapped. |