[Patch, fortran] PR61831 side-effect deallocation of variable components

[Patch, fortran] PR61831 side-effect deallocation of variable components

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 1430 bytes --]

Hello,

this is about PR61831 where in code like:
	
	type :: string_t
	   character(LEN=1), dimension(:), allocatable :: chars
	end type string_t
	type(string_t) :: prt_in
	(...)
	tmp = new_prt_spec ([prt_in])
	
the deallocation of the argument's allocatable components after the
procedure call (to new_prt_spec) has the side effect of freeing prt_in's
allocatable components, as the array constructor temporary for [prt_in]
is a shallow copy of prt_in.

This bug is a regression caused by the Dominique's PR41936 memory leak
fix, itself based on a patch originally from me.

The attached patch is basically a revert of that fix.  It avoids the
problem by not deallocating allocatable components in the problematic
case, at the price of a (possible) memory leak.  A new function is
introduced telling whether there is aliasing, so that we don't regress
on PR41936's memory leak when there is no aliasing, and we don't free
components when there is aliasing.
The possible remaining memory leak case is the case of a "mixed" array
constructor with some parts aliasing variables, and some non-aliasing parts.

The patch takes also the opportunity to reassemble the scattered
procedure argument deallocation code into a single place.

The test needs pr65792's fix (thanks Paul), so for the 4.9 branch I
propose commenting the parts that depend on PR65792 in the test.

Regression tested on x86_64-linux. OK for 6/5/4.9 ?

Mikael






[-- Attachment #2: pr61831_v6.CL --]
[-- Type: text/plain, Size: 544 bytes --]

2015-05-16  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/61831
	* trans-array.c (gfc_conv_array_parameter): Remove allocatable
	component deallocation code generation.
	* trans-expr.c (gfc_conv_expr_reference): Ditto.
	(expr_may_alias_variables): New function.
	(gfc_conv_procedure_call): Use it to decide whether generate
	allocatable component deallocation code.
	(gfc_trans_subarray_assign): Set deep copy flag.

2015-05-16  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/61831
	* gfortran.dg/derived_constructor_components_6.f90: New.


[-- Attachment #3: pr61831_v6.diff --]
[-- Type: text/x-patch, Size: 3885 bytes --]

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 8267f6a..210b2ec 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7305,19 +7305,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
 				  expr, size);
     }
 
-  /* Deallocate the allocatable components of structures that are
-     not variable.  */
-  if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
-	&& expr->ts.u.derived->attr.alloc_comp
-	&& expr->expr_type != EXPR_VARIABLE)
-    {
-      tmp = build_fold_indirect_ref_loc (input_location, se->expr);
-      tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
-
-      /* The components shall be deallocated before their containing entity.  */
-      gfc_prepend_expr_to_block (&se->post, tmp);
-    }
-
   if (g77 || (fsym && fsym->attr.contiguous
 	      && !gfc_is_simply_contiguous (expr, false)))
     {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9be8a42..e375453 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4536,6 +4536,36 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
 }
 
 
+/* Temporary arrays generated to represent array constructors are made
+   using simple copies, so that their elements may alias some variable
+   they were copied from.
+   This function tells whether the expression given as input may alias
+   some other variable, under the assumption that only variables and array
+   constructor may alias (in particular structure constructors don't alias),
+   and array constructor elements alias iff they are copied from a variable.
+   This function is used to decide whether freeing an expression's allocatable
+   components is safe or should be avoided.  */
+
+static bool
+expr_may_alias_variables (gfc_expr *e)
+{
+  gfc_constructor *c;
+
+  if (e->expr_type == EXPR_VARIABLE)
+    return true;
+  else if (e->expr_type != EXPR_ARRAY)
+    return false;
+
+  for (c = gfc_constructor_first (e->value.constructor);
+       c; c = gfc_constructor_next (c))
+    if (c->expr
+	&& expr_may_alias_variables (c->expr))
+      return true;
+
+  return false;
+}
+
+
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
    Return nonzero, if the call has alternate specifiers.
@@ -5328,7 +5358,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
 	    && e->ts.u.derived->attr.alloc_comp
 	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
-	    && (e->expr_type != EXPR_VARIABLE && !e->rank))
+	    && !expr_may_alias_variables (e))
         {
 	  int parm_rank;
 	  tmp = build_fold_indirect_ref_loc (input_location,
@@ -6642,7 +6672,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
 
   gfc_conv_expr (&rse, expr);
 
-  tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, false, true);
+  tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, true, true);
   gfc_add_expr_to_block (&body, tmp);
 
   gcc_assert (rse.ss == gfc_ss_terminator);
@@ -7513,20 +7543,6 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
 
   /* Take the address of that value.  */
   se->expr = gfc_build_addr_expr (NULL_TREE, var);
-  if (expr->ts.type == BT_DERIVED && expr->rank
-      && !gfc_is_finalizable (expr->ts.u.derived, NULL)
-      && expr->ts.u.derived->attr.alloc_comp
-      && expr->expr_type != EXPR_VARIABLE)
-    {
-      tree tmp;
-
-      tmp = build_fold_indirect_ref_loc (input_location, se->expr);
-      tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
-
-      /* The components shall be deallocated before
-         their containing entity.  */
-      gfc_prepend_expr_to_block (&se->post, tmp);
-    }
 }
 
 


[-- Attachment #4: derived_constructor_comps_6.f90 --]
[-- Type: text/x-fortran, Size: 4582 bytes --]

! { dg-do run }
! { dg-additional-options "-fsanitize=address -fdump-tree-original"
!
! PR fortran/61831
! The deallocation of components of array constructor elements
! used to have the side effect of also deallocating some other
! variable's components from which they were copied.

program main
  implicit none

  integer, parameter :: n = 2

  type :: string_t
     character(LEN=1), dimension(:), allocatable :: chars
  end type string_t

  type :: string_container_t
     type(string_t) :: comp
  end type string_container_t

  type :: string_array_container_t
     type(string_t) :: comp(n)
  end type string_array_container_t

  type(string_t) :: prt_in, tmp, tmpa(n)
  type(string_container_t) :: tmpc, tmpca(n)
  type(string_array_container_t) :: tmpac, tmpaca(n)
  integer :: i, j, k

  do i=1,16

     ! Test without intermediary function
     prt_in = string_t(["A"])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "A")) call abort
     deallocate (prt_in%chars)

     ! scalar elemental function
     prt_in = string_t(["B"])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "B")) call abort
     tmp = new_prt_spec (prt_in)
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "B")) call abort
     deallocate (prt_in%chars)
     deallocate (tmp%chars)

     ! array elemental function with array constructor
     prt_in = string_t(["C"])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "C")) call abort
     tmpa = new_prt_spec ([(prt_in, i=1,2)])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "C")) call abort
     deallocate (prt_in%chars)
     do j=1,n
        deallocate (tmpa(j)%chars)
     end do

     ! scalar elemental function with structure constructor
     prt_in = string_t(["D"])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "D")) call abort
     tmpc = new_prt_spec2 (string_container_t(prt_in))
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "D")) call abort
     deallocate (prt_in%chars)
     deallocate(tmpc%comp%chars)

     ! array elemental function of an array constructor of structure constructors
     prt_in = string_t(["E"])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "E")) call abort
     tmpca = new_prt_spec2 ([ (string_container_t(prt_in), i=1,2) ])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "E")) call abort
     deallocate (prt_in%chars)
     do j=1,n
        deallocate (tmpca(j)%comp%chars)
     end do

     ! scalar elemental function with a structure constructor and a nested array constructor
     prt_in = string_t(["F"])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "F")) call abort
     tmpac = new_prt_spec3 (string_array_container_t([ (prt_in, i=1,2) ]))
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "F")) call abort
     deallocate (prt_in%chars)
     do j=1,n
        deallocate (tmpac%comp(j)%chars)
     end do

     ! array elemental function with an array constructor nested inside 
     ! a structure constructor nested inside  an array constructor
     prt_in = string_t(["G"])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "G")) call abort
     tmpaca = new_prt_spec3 ([ (string_array_container_t([ (prt_in, i=1,2) ]), j=1,2) ])
     if (.not. allocated(prt_in%chars)) call abort
     if (any(prt_in%chars .ne. "G")) call abort
     deallocate (prt_in%chars)
     do j=1,n
        do k=1,n
           deallocate (tmpaca(j)%comp(k)%chars)
        end do
     end do

  end do

contains

  elemental function new_prt_spec (name) result (prt_spec)
    type(string_t), intent(in) :: name
    type(string_t) :: prt_spec
    prt_spec = name
  end function new_prt_spec

  elemental function new_prt_spec2 (name) result (prt_spec)
    type(string_container_t), intent(in) :: name
    type(string_container_t) :: prt_spec
    prt_spec = name
  end function new_prt_spec2

  elemental function new_prt_spec3 (name) result (prt_spec)
    type(string_array_container_t), intent(in) :: name
    type(string_array_container_t) :: prt_spec
    prt_spec = name
  end function new_prt_spec3
end program main
! { dg-final { scan-tree-dump-times "__builtin_malloc" 15 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 33 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

Re: [Patch, fortran] PR61831 side-effect deallocation of variable components

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 2921 bytes --]

Le 16/05/2015 18:43, Mikael Morin a écrit :
> Hello,
> 
> this is about PR61831 where in code like:
> 	
> 	type :: string_t
> 	   character(LEN=1), dimension(:), allocatable :: chars
> 	end type string_t
> 	type(string_t) :: prt_in
> 	(...)
> 	tmp = new_prt_spec ([prt_in])
> 	
> the deallocation of the argument's allocatable components after the
> procedure call (to new_prt_spec) has the side effect of freeing prt_in's
> allocatable components, as the array constructor temporary for [prt_in]
> is a shallow copy of prt_in.
> 
> This bug is a regression caused by the Dominique's PR41936 memory leak
> fix, itself based on a patch originally from me.
> 
> The attached patch is basically a revert of that fix.  It avoids the
> problem by not deallocating allocatable components in the problematic
> case, at the price of a (possible) memory leak.  A new function is
> introduced telling whether there is aliasing, so that we don't regress
> on PR41936's memory leak when there is no aliasing, and we don't free
> components when there is aliasing.
> The possible remaining memory leak case is the case of a "mixed" array
> constructor with some parts aliasing variables, and some non-aliasing parts.
> 
> The patch takes also the opportunity to reassemble the scattered
> procedure argument deallocation code into a single place.
> 
> The test needs pr65792's fix (thanks Paul), so for the 4.9 branch I
> propose commenting the parts that depend on PR65792 in the test.
> 
> Regression tested on x86_64-linux. OK for 6/5/4.9 ?

Hello,

I would like to come back to the patch:
https://gcc.gnu.org/ml/gcc-patches/2015-05/msg01491.html

PR66082 made me notice one bug in that patch:
for descriptorless arrays, the patch was deallocating only the first
element's allocatable components.
As gfc_conv_array_parameter returns the array data only, the bounds are
lost and it is not possible to loop through all the elements.

With the attached patch, the deallocation code is kept in
gfc_conv_array_parameter where the bounds of descriptorless arrays are
known.
To test this fixes the bug, I have added a count of while (1) loops in
the dump of pr66082's test.  I'm open to better ideas to properly test this.

For arrays with descriptors, I have decided to not handle them in
gfc_conv_array_parameter, because in some cases gfc_conv_expr_descriptor
is called directly from gfc_conv_procedure_call, without passing through
gfc_conv_array_parameter.
To be able to select everything but descriptorless arrays for
allocatable component deallocation, the flags are moved around somewhat.
The rest is as in the previous patch.

The test provided is basically unchanged, thus not suitable for the
branches without pr65792.
We can decide what to do with it later (backport pr65792 or disable
parts of the test), I would like to have the fix in mainline first.
It has been fortran-tested on x86_64-linux, OK for trunk?

Mikael




[-- Attachment #2: pr61831_v7.CL --]
[-- Type: text/plain, Size: 907 bytes --]

2015-06-20  Mikael Morin  <mikael@gcc.gnu.org>
	    Dominique d'Humieres  <dominiq@lps.ens.fr>

	PR fortran/61831
	* trans-array.c (gfc_conv_array_parameter): Guard allocatable
	component deallocation code generation with descriptorless
	calling convention flag.
	* trans-expr.c (gfc_conv_expr_reference): Remove allocatable
	component deallocation code generation from revision 212329.
	(expr_may_alias_variables): New function.
	(gfc_conv_procedure_call): New boolean elemental_proc to factor
	check for procedure elemental-ness.  Rename boolean f to nodesc_arg
	and declare it in the outer scope.  Use expr_may_alias_variables,
	elemental_proc and nodesc_arg to decide whether generate allocatable
	component deallocation code.
	(gfc_trans_subarray_assign): Set deep copy flag.

2015-06-20  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/61831
	* gfortran.dg/derived_constructor_components_6.f90: New.


[-- Attachment #3: pr61831_v7.diff --]
[-- Type: text/x-patch, Size: 15752 bytes --]

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index fece3ab..bda887c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7386,10 +7386,11 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
     }
 
   /* Deallocate the allocatable components of structures that are
-     not variable.  */
-  if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
-	&& expr->ts.u.derived->attr.alloc_comp
-	&& expr->expr_type != EXPR_VARIABLE)
+     not variable, for descriptorless arguments.
+     Arguments with a descriptor are handled in gfc_conv_procedure_call.  */
+  if (g77 && (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
+	  && expr->ts.u.derived->attr.alloc_comp
+	  && expr->expr_type != EXPR_VARIABLE)
     {
       tmp = build_fold_indirect_ref_loc (input_location, se->expr);
       tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5d6555b..583e692 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4529,6 +4529,62 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
 }
 
 
+/* This function tells whether the middle-end representation of the expression
+   E given as input may point to data otherwise accessible through a variable
+   (sub-)reference.
+   It is assumed that the only expressions that may alias are variables,
+   and array constructors if ARRAY_MAY_ALIAS is true and some of its elements
+   may alias.
+   This function is used to decide whether freeing an expression's allocatable
+   components is safe or should be avoided.
+
+   If ARRAY_MAY_ALIAS is true, an array constructor may alias if some of
+   its elements are copied from a variable.  This ARRAY_MAY_ALIAS trick
+   is necessary because for array constructors, aliasing depends on how
+   the array is used:
+    - If E is an array constructor used as argument to an elemental procedure,
+      the array, which is generated through shallow copy by the scalarizer,
+      is used directly and can alias the expressions it was copied from.
+    - If E is an array constructor used as argument to a non-elemental
+      procedure,the scalarizer is used in gfc_conv_expr_descriptor to generate
+      the array as in the previous case, but then that array is used
+      to initialize a new descriptor through deep copy.  There is no alias
+      possible in that case.
+   Thus, the ARRAY_MAY_ALIAS flag is necessary to distinguish the two cases
+   above.  */
+
+static bool
+expr_may_alias_variables (gfc_expr *e, bool array_may_alias)
+{
+  gfc_constructor *c;
+
+  if (e->expr_type == EXPR_VARIABLE)
+    return true;
+  else if (e->expr_type == EXPR_FUNCTION)
+    {
+      gfc_symbol *proc_ifc = gfc_get_proc_ifc_for_expr (e);
+
+      if ((proc_ifc->result->ts.type == BT_CLASS
+	   && proc_ifc->result->ts.u.derived->attr.is_class
+	   && CLASS_DATA (proc_ifc->result)->attr.class_pointer)
+	  || proc_ifc->result->attr.pointer)
+	return true;
+      else
+	return false;
+    }
+  else if (e->expr_type != EXPR_ARRAY || !array_may_alias)
+    return false;
+
+  for (c = gfc_constructor_first (e->value.constructor);
+       c; c = gfc_constructor_next (c))
+    if (c->expr
+	&& expr_may_alias_variables (c->expr, array_may_alias))
+      return true;
+
+  return false;
+}
+
+
 /* Generate code for a procedure call.  Note can return se->post != NULL.
    If se->direct_byref is set then se->expr contains the return parameter.
    Return nonzero, if the call has alternate specifiers.
@@ -4581,9 +4637,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
   comp = gfc_get_proc_ptr_comp (expr);
 
+  bool elemental_proc = (comp
+			 && comp->ts.interface
+			 && comp->ts.interface->attr.elemental)
+			|| (comp && comp->attr.elemental)
+			|| sym->attr.elemental;
+
   if (se->ss != NULL)
     {
-      if (!sym->attr.elemental && !(comp && comp->attr.elemental))
+      if (!elemental_proc)
 	{
 	  gcc_assert (se->ss->info->type == GFC_SS_FUNCTION);
 	  if (se->ss->info->useflags)
@@ -4640,6 +4702,23 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       fsym = formal ? formal->sym : NULL;
       parm_kind = MISSING;
 
+      /* If the procedure requires an explicit interface, the actual
+	 argument is passed according to the corresponding formal
+	 argument.  If the corresponding formal argument is a POINTER,
+	 ALLOCATABLE or assumed shape, we do not use g77's calling
+	 convention, and pass the address of the array descriptor
+	 instead.  Otherwise we use g77's calling convention, in other words
+	 pass the array data pointer without descriptor.  */
+      bool nodesc_arg = fsym != NULL
+			&& !(fsym->attr.pointer || fsym->attr.allocatable)
+			&& fsym->as
+			&& fsym->as->type != AS_ASSUMED_SHAPE
+			&& fsym->as->type != AS_ASSUMED_RANK;
+      if (comp)
+	nodesc_arg = nodesc_arg || !comp->attr.always_explicit;
+      else
+	nodesc_arg = nodesc_arg || !sym->attr.always_explicit;
+
       /* Class array expressions are sometimes coming completely unadorned
 	 with either arrayspec or _data component.  Correct that here.
 	 OOP-TODO: Move this to the frontend.  */
@@ -5166,22 +5245,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	    }
 	  else
 	    {
-              /* If the procedure requires an explicit interface, the actual
-                 argument is passed according to the corresponding formal
-                 argument.  If the corresponding formal argument is a POINTER,
-                 ALLOCATABLE or assumed shape, we do not use g77's calling
-                 convention, and pass the address of the array descriptor
-                 instead. Otherwise we use g77's calling convention.  */
-	      bool f;
-	      f = (fsym != NULL)
-		  && !(fsym->attr.pointer || fsym->attr.allocatable)
-		  && fsym->as && fsym->as->type != AS_ASSUMED_SHAPE
-		  && fsym->as->type != AS_ASSUMED_RANK;
-	      if (comp)
-		f = f || !comp->attr.always_explicit;
-	      else
-		f = f || !sym->attr.always_explicit;
-
 	      /* If the argument is a function call that may not create
 		 a temporary for the result, we have to check that we
 		 can do it, i.e. that there is no alias between this
@@ -5226,7 +5289,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		   array of derived types.  In this case, the argument
 		   is converted to a temporary, which is passed and then
 		   written back after the procedure call.  */
-		gfc_conv_subref_array_arg (&parmse, e, f,
+		gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
 				fsym ? fsym->attr.intent : INTENT_INOUT,
 				fsym && fsym->attr.pointer);
 	      else if (gfc_is_class_array_ref (e, NULL)
@@ -5238,7 +5301,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		   OOP-TODO: Insert code so that if the dynamic type is
 		   the same as the declared type, copy-in/copy-out does
 		   not occur.  */
-		gfc_conv_subref_array_arg (&parmse, e, f,
+		gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
 				fsym ? fsym->attr.intent : INTENT_INOUT,
 				fsym && fsym->attr.pointer);
 
@@ -5249,12 +5312,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		   intent in.  */
 		{
 		  e->must_finalize = 1;
-		  gfc_conv_subref_array_arg (&parmse, e, f,
+		  gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
 					     INTENT_IN,
 					     fsym && fsym->attr.pointer);
 		}
 	      else
-	        gfc_conv_array_parameter (&parmse, e, f, fsym, sym->name, NULL);
+		gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym,
+					  sym->name, NULL);
 
 	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
 		 allocated on entry, it must be deallocated.  */
@@ -5296,7 +5360,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	     but do not always set fsym.  */
 	  if (e->expr_type == EXPR_VARIABLE
 	      && e->symtree->n.sym->attr.optional
-	      && ((e->rank != 0 && sym->attr.elemental)
+	      && ((e->rank != 0 && elemental_proc)
 		  || e->representation.length || e->ts.type == BT_CHARACTER
 		  || (e->rank != 0
 		      && (fsym == NULL
@@ -5331,13 +5395,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       gfc_add_block_to_block (&post, &parmse.post);
 
       /* Allocated allocatable components of derived types must be
-	 deallocated for non-variable scalars.  Non-variable arrays are
-	 dealt with in trans-array.c(gfc_conv_array_parameter).  */
+	 deallocated for non-variable scalars, array arguments to elemental
+	 procedures, and array arguments with descriptor to non-elemental
+	 procedures.  As bounds information for descriptorless arrays is no
+	 longer available here, they are dealt with in trans-array.c
+	 (gfc_conv_array_parameter).  */
       if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
 	    && e->ts.u.derived->attr.alloc_comp
-	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
-	    && e->expr_type != EXPR_VARIABLE && !e->rank)
-        {
+	    && (e->rank == 0 || elemental_proc || !nodesc_arg)
+	    && !expr_may_alias_variables (e, elemental_proc))
+	{
 	  int parm_rank;
 	  tmp = build_fold_indirect_ref_loc (input_location,
 					 parmse.expr);
@@ -6664,7 +6731,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
 
   gfc_conv_expr (&rse, expr);
 
-  tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, false, true);
+  tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, true, true);
   gfc_add_expr_to_block (&body, tmp);
 
   gcc_assert (rse.ss == gfc_ss_terminator);
@@ -7535,20 +7602,6 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
 
   /* Take the address of that value.  */
   se->expr = gfc_build_addr_expr (NULL_TREE, var);
-  if (expr->ts.type == BT_DERIVED && expr->rank
-      && !gfc_is_finalizable (expr->ts.u.derived, NULL)
-      && expr->ts.u.derived->attr.alloc_comp
-      && expr->expr_type != EXPR_VARIABLE)
-    {
-      tree tmp;
-
-      tmp = build_fold_indirect_ref_loc (input_location, se->expr);
-      tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
-
-      /* The components shall be deallocated before
-         their containing entity.  */
-      gfc_prepend_expr_to_block (&se->post, tmp);
-    }
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
index eaeaf54..b135d3d 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
@@ -27,3 +27,4 @@ contains
 end
 ! { dg-final { scan-tree-dump-times "builtin_malloc" 3 "original" } }
 ! { dg-final { scan-tree-dump-times "builtin_free" 4 "original" } }
+! { dg-final { scan-tree-dump-times "while \\(1\\)" 4 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
new file mode 100644
index 0000000..f9fbcb1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
@@ -0,0 +1,133 @@
+! { dg-do run }
+! { dg-additional-options "-fsanitize=address -fdump-tree-original"
+!
+! PR fortran/61831
+! The deallocation of components of array constructor elements
+! used to have the side effect of also deallocating some other
+! variable's components from which they were copied.
+
+program main
+  implicit none
+
+  integer, parameter :: n = 2
+
+  type :: string_t
+     character(LEN=1), dimension(:), allocatable :: chars
+  end type string_t
+
+  type :: string_container_t
+     type(string_t) :: comp
+  end type string_container_t
+
+  type :: string_array_container_t
+     type(string_t) :: comp(n)
+  end type string_array_container_t
+
+  type(string_t) :: prt_in, tmp, tmpa(n)
+  type(string_container_t) :: tmpc, tmpca(n)
+  type(string_array_container_t) :: tmpac, tmpaca(n)
+  integer :: i, j, k
+
+  do i=1,16
+
+     ! Test without intermediary function
+     prt_in = string_t(["A"])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "A")) call abort
+     deallocate (prt_in%chars)
+
+     ! scalar elemental function
+     prt_in = string_t(["B"])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "B")) call abort
+     tmp = new_prt_spec (prt_in)
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "B")) call abort
+     deallocate (prt_in%chars)
+     deallocate (tmp%chars)
+
+     ! array elemental function with array constructor
+     prt_in = string_t(["C"])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "C")) call abort
+     tmpa = new_prt_spec ([(prt_in, i=1,2)])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "C")) call abort
+     deallocate (prt_in%chars)
+     do j=1,n
+        deallocate (tmpa(j)%chars)
+     end do
+
+     ! scalar elemental function with structure constructor
+     prt_in = string_t(["D"])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "D")) call abort
+     tmpc = new_prt_spec2 (string_container_t(prt_in))
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "D")) call abort
+     deallocate (prt_in%chars)
+     deallocate(tmpc%comp%chars)
+
+     ! array elemental function of an array constructor of structure constructors
+     prt_in = string_t(["E"])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "E")) call abort
+     tmpca = new_prt_spec2 ([ (string_container_t(prt_in), i=1,2) ])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "E")) call abort
+     deallocate (prt_in%chars)
+     do j=1,n
+        deallocate (tmpca(j)%comp%chars)
+     end do
+
+     ! scalar elemental function with a structure constructor and a nested array constructor
+     prt_in = string_t(["F"])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "F")) call abort
+     tmpac = new_prt_spec3 (string_array_container_t([ (prt_in, i=1,2) ]))
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "F")) call abort
+     deallocate (prt_in%chars)
+     do j=1,n
+        deallocate (tmpac%comp(j)%chars)
+     end do
+
+     ! array elemental function with an array constructor nested inside
+     ! a structure constructor nested inside  an array constructor
+     prt_in = string_t(["G"])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "G")) call abort
+     tmpaca = new_prt_spec3 ([ (string_array_container_t([ (prt_in, i=1,2) ]), j=1,2) ])
+     if (.not. allocated(prt_in%chars)) call abort
+     if (any(prt_in%chars .ne. "G")) call abort
+     deallocate (prt_in%chars)
+     do j=1,n
+        do k=1,n
+           deallocate (tmpaca(j)%comp(k)%chars)
+        end do
+     end do
+
+  end do
+
+contains
+
+  elemental function new_prt_spec (name) result (prt_spec)
+    type(string_t), intent(in) :: name
+    type(string_t) :: prt_spec
+    prt_spec = name
+  end function new_prt_spec
+
+  elemental function new_prt_spec2 (name) result (prt_spec)
+    type(string_container_t), intent(in) :: name
+    type(string_container_t) :: prt_spec
+    prt_spec = name
+  end function new_prt_spec2
+
+  elemental function new_prt_spec3 (name) result (prt_spec)
+    type(string_array_container_t), intent(in) :: name
+    type(string_array_container_t) :: prt_spec
+    prt_spec = name
+  end function new_prt_spec3
+end program main
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 15 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_free" 33 "original" } }

*Ping* Re: [Patch, fortran] PR61831 side-effect deallocation of variable components

[Mikael Morin]

Ping: https://gcc.gnu.org/ml/fortran/2015-06/msg00075.html

Le 21/06/2015 11:48, Mikael Morin a écrit :
> Le 16/05/2015 18:43, Mikael Morin a écrit :
>> Hello,
>>
>> this is about PR61831 where in code like:
>> 	
>> 	type :: string_t
>> 	   character(LEN=1), dimension(:), allocatable :: chars
>> 	end type string_t
>> 	type(string_t) :: prt_in
>> 	(...)
>> 	tmp = new_prt_spec ([prt_in])
>> 	
>> the deallocation of the argument's allocatable components after the
>> procedure call (to new_prt_spec) has the side effect of freeing prt_in's
>> allocatable components, as the array constructor temporary for [prt_in]
>> is a shallow copy of prt_in.
>>
>> This bug is a regression caused by the Dominique's PR41936 memory leak
>> fix, itself based on a patch originally from me.
>>
>> The attached patch is basically a revert of that fix.  It avoids the
>> problem by not deallocating allocatable components in the problematic
>> case, at the price of a (possible) memory leak.  A new function is
>> introduced telling whether there is aliasing, so that we don't regress
>> on PR41936's memory leak when there is no aliasing, and we don't free
>> components when there is aliasing.
>> The possible remaining memory leak case is the case of a "mixed" array
>> constructor with some parts aliasing variables, and some non-aliasing parts.
>>
>> The patch takes also the opportunity to reassemble the scattered
>> procedure argument deallocation code into a single place.
>>
>> The test needs pr65792's fix (thanks Paul), so for the 4.9 branch I
>> propose commenting the parts that depend on PR65792 in the test.
>>
>> Regression tested on x86_64-linux. OK for 6/5/4.9 ?
> 
> Hello,
> 
> I would like to come back to the patch:
> https://gcc.gnu.org/ml/gcc-patches/2015-05/msg01491.html
> 
> PR66082 made me notice one bug in that patch:
> for descriptorless arrays, the patch was deallocating only the first
> element's allocatable components.
> As gfc_conv_array_parameter returns the array data only, the bounds are
> lost and it is not possible to loop through all the elements.
> 
> With the attached patch, the deallocation code is kept in
> gfc_conv_array_parameter where the bounds of descriptorless arrays are
> known.
> To test this fixes the bug, I have added a count of while (1) loops in
> the dump of pr66082's test.  I'm open to better ideas to properly test this.
> 
> For arrays with descriptors, I have decided to not handle them in
> gfc_conv_array_parameter, because in some cases gfc_conv_expr_descriptor
> is called directly from gfc_conv_procedure_call, without passing through
> gfc_conv_array_parameter.
> To be able to select everything but descriptorless arrays for
> allocatable component deallocation, the flags are moved around somewhat.
> The rest is as in the previous patch.
> 
> The test provided is basically unchanged, thus not suitable for the
> branches without pr65792.
> We can decide what to do with it later (backport pr65792 or disable
> parts of the test), I would like to have the fix in mainline first.
> It has been fortran-tested on x86_64-linux, OK for trunk?
> 
> Mikael
> 
> 
> 

Re: *Ping* Re: [Patch, fortran] PR61831 side-effect deallocation of variable components

[Steve Kargl]

On Fri, Jul 10, 2015 at 06:35:30PM +0200, Mikael Morin wrote:
> Ping: https://gcc.gnu.org/ml/fortran/2015-06/msg00075.html
> 

Patch looks ok to me.

-- 
Steve