This patch fixes a crash in the compiler when inlining a function call that returns an unconstrained array in the context of an assignment created for an extended return statement. The patch also optimizes the case where the target of the assignment is a selected component, and avoid the use of an intermediate temporary in the expansion.
The following must compile quietly: with Types; use Types; package body My_Simulink_Model is procedure Compute (Input : Input_Type; Output : out Output_Type) is begin Output.O := Sum (Input.M1, Input.M2); end Compute; procedure Compute_Ext_Return (Input : Input_Type; Output : out Output_Type) is begin Output.O := Sum_Ext_Return (Input.M1, Input.M2); end Compute_Ext_Return; procedure Compute_Inline (Input : Input_Type; Output : out Output_Type) is begin for I in Output.O'Range (1) loop for J in Output.O'Range (2) loop Output.O (I, J) := Input.M1 (I, J) + Input.M2 (I, J); end loop; end loop; end Compute_Inline; end My_Simulink_Model; --- with Types; package My_Simulink_Model is subtype Range_1 is Integer range 1 .. 2; subtype Range_2 is Integer range 1 .. 3; subtype My_Matrix is Types.Integer_Matrix_2D (Range_1, Range_2); type Input_Type is record M1 : My_Matrix; M2 : My_Matrix; end record; type Output_Type is record O : My_Matrix; end record; procedure Compute (Input : Input_Type; Output : out Output_Type); procedure Compute_Ext_Return (Input : Input_Type; Output : out Output_Type); procedure Compute_Inline (Input : Input_Type; Output : out Output_Type); end My_Simulink_Model; --- package Types is type Integer_Matrix_2D is array (Integer range <>, Integer range <>) of Integer; function Sum (Left, Right : Integer_Matrix_2D) return Integer_Matrix_2D; pragma Precondition (Left'Length (1) = Right'Length (1) and Left'Length (2) = Right'Length (2)); pragma Inline_Always (Sum); function Sum_Ext_Return (Left, Right : Integer_Matrix_2D) return Integer_Matrix_2D; pragma Precondition (Left'Length (1) = Right'Length (1) and Left'Length (2) = Right'Length (2)); pragma Inline_Always (Sum_Ext_Return); end Types; --- package body Types is function Sum (Left, Right : Integer_Matrix_2D) return Integer_Matrix_2D is Res : Integer_Matrix_2D (Left'Range (1), Left'Range (2)); begin for I in Res'Range (1) loop for J in Res'Range (2) loop Res (I, J) := Left (I, J) + Right (I, J); end loop; end loop; return Res; end Sum; function Sum_Ext_Return (Left, Right : Integer_Matrix_2D) return Integer_Matrix_2D is begin return Res : Integer_Matrix_2D (Left'Range (1), Left'Range (2)) do for I in Res'Range (1) loop for J in Res'Range (2) loop Res (I, J) := Left (I, J) + Right (I, J); end loop; end loop; end return; end Sum_Ext_Return; end Types; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-06 Ed Schonberg <schonb...@adacore.com> * exp_ch6.adb (Expand_Inlined_Call): Handle properly the case where the return type is an unconstrained array and the context is an assignment. Optimize the case when the target of the assignment is a selected component.
Index: exp_ch6.adb =================================================================== --- exp_ch6.adb (revision 178572) +++ exp_ch6.adb (working copy) @@ -4031,12 +4031,20 @@ Insert_After (Parent (Entity (N)), Blk); + -- If the context is an assignment, and the left-hand side is + -- free of side-effects, the replacement is also safe. + -- Can this be generalized further??? + elsif Nkind (Parent (N)) = N_Assignment_Statement and then (Is_Entity_Name (Name (Parent (N))) or else (Nkind (Name (Parent (N))) = N_Explicit_Dereference - and then Is_Entity_Name (Prefix (Name (Parent (N)))))) + and then Is_Entity_Name (Prefix (Name (Parent (N))))) + + or else + (Nkind (Name (Parent (N))) = N_Selected_Component + and then Is_Entity_Name (Prefix (Name (Parent (N)))))) then -- Replace assignment with the block @@ -4201,14 +4209,19 @@ Set_Declarations (Blk, New_List); end if; - -- For the unconstrained case, capture the name of the local - -- variable that holds the result. This must be the first declaration + -- For the unconstrained case, capture the name of the local variable + -- that holds the result. This must be the first declaration -- in the block, because its bounds cannot depend on local variables. -- Otherwise there is no way to declare the result outside of the -- block. Needless to say, in general the bounds will depend on the -- actuals in the call. + -- If the context is an assignment statement, as is the case for the + -- expansion of an extended return, the left-hand side provides bounds + -- even if the return type is unconstrained. - if Is_Unc then + if Is_Unc + and then Nkind (Parent (N)) /= N_Assignment_Statement + then Targ1 := Defining_Identifier (First (Declarations (Blk))); end if; @@ -4372,6 +4385,12 @@ then Targ := Name (Parent (N)); + elsif Nkind (Parent (N)) = N_Assignment_Statement + and then Nkind (Name (Parent (N))) = N_Selected_Component + and then Is_Entity_Name (Prefix (Name (Parent (N)))) + then + Targ := New_Copy_Tree (Name (Parent (N))); + elsif Nkind (Parent (N)) = N_Object_Declaration and then Is_Limited_Type (Etype (Subp)) then @@ -4388,7 +4407,9 @@ -- eventually be possible to remove that temporary and use the -- result variable directly. - if Is_Unc then + if Is_Unc + and then Nkind (Parent (N)) /= N_Assignment_Statement + then Decl := Make_Object_Declaration (Loc, Defining_Identifier => Temp,