[Patch, fortran] PR65792 unitialized structure constructor array subcomponent

[Mikael Morin <mikael dot morin at sfr dot fr>]

Hello,

here is a fix for PR65792 where a structure constructor used as actual
argument was not fully initialized.

The test looks like the following...

  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_t) :: prt_in

  [...]
  tmpc = new_prt_spec2 (string_container_t(prt_in))



The problem is in gfc_trans_subcomponent_assign, when initialising the
component comp with prt_in:

	  if (cm->ts.u.derived->attr.alloc_comp
	      && expr->expr_type == EXPR_VARIABLE)
	    {
	      tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr,
					 dest, expr->rank);
	      gfc_add_expr_to_block (&block, tmp);
	    }
	  else
	    gfc_add_modify (&block, dest,
			    fold_convert (TREE_TYPE (dest), se.expr));

The if branch deep copies allocatable components, but does nothing for
other components, which is the case here (the array elements are copied,
not the array bounds).


The patch proposed here for backport, moves the existing shallow copy
out of the else branch.

For trunk, I wanted to reuse gfc_trans_scalar_assign which has all the
logic for copying stuff around.  And as gfc_trans_scalar_assign is used
as fallback a few lines down, I have tried to use that fallback.
This change of control flow makes the patch a bit more risky, so I
prefer to use the other variant for the branches.

Setting the deep_copy argument of gfc_trans_scalar_assign to true is
necessary so that gfc_copy_alloc_comp is called as before.
Because of the branch the patch removes, I think the fallback code was
unreachable for non-derived types, and for those the deep_copy flag was
irrelevant anyway, so that that change should be rather harmless.


Both patches have been regression tested on trunk on x86_64-linux.
OK for trunk [first patch]?
OK for 4.9 and 5 (after the 5.1 release) [second patch]?

Mikael

PS: Dominiq reported that the variant of this patch posted on the PR was
also fixing PR49324.  I couldn't confirm as what seems to be the
remaining testcase there (comment #6) doesn't fail with trunk here.


2015-04-18  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/65792
	* trans-expr.c (gfc_trans_subcomponent_assign):
	Don't special case non-structure-constructor derived type
	expressions.  Enable deep copying.

2015-04-18  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/65792
	* gfortran.dg/derived_constructor_comps_5.f90: New.

Index: trans-expr.c
===================================================================
--- trans-expr.c	(révision 221972)
+++ trans-expr.c	(copie de travail)
@@ -6908,32 +6908,6 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
 			fold_convert (TREE_TYPE (tmp), se.expr));
       gfc_add_block_to_block (&block, &se.post);
     }
-  else if (expr->ts.type == BT_DERIVED && expr->ts.f90_type != BT_VOID)
-    {
-      if (expr->expr_type != EXPR_STRUCTURE)
-	{
-	  gfc_init_se (&se, NULL);
-	  gfc_conv_expr (&se, expr);
-	  gfc_add_block_to_block (&block, &se.pre);
-	  if (cm->ts.u.derived->attr.alloc_comp
-	      && expr->expr_type == EXPR_VARIABLE)
-	    {
-	      tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr,
-					 dest, expr->rank);
-	      gfc_add_expr_to_block (&block, tmp);
-	    }
-	  else
-	    gfc_add_modify (&block, dest,
-			    fold_convert (TREE_TYPE (dest), se.expr));
-	  gfc_add_block_to_block (&block, &se.post);
-	}
-      else
-	{
-	  /* Nested constructors.  */
-	  tmp = gfc_trans_structure_assign (dest, expr, expr->symtree != NULL);
-	  gfc_add_expr_to_block (&block, tmp);
-	}
-    }
   else if (gfc_deferred_strlen (cm, &tmp))
     {
       tree strlen;
@@ -6967,6 +6941,13 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
 	  gfc_add_expr_to_block (&block, tmp);
 	}
     }
+  else if (expr->expr_type == EXPR_STRUCTURE
+	   && expr->ts.f90_type != BT_VOID)
+    {
+      /* Nested constructors.  */
+      tmp = gfc_trans_structure_assign (dest, expr, expr->symtree != NULL);
+      gfc_add_expr_to_block (&block, tmp);
+    }
   else if (!cm->attr.artificial)
     {
       /* Scalar component (excluding deferred parameters).  */
@@ -6977,7 +6958,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
       if (cm->ts.type == BT_CHARACTER)
 	lse.string_length = cm->ts.u.cl->backend_decl;
       lse.expr = dest;
-      tmp = gfc_trans_scalar_assign (&lse, &se, cm->ts, true, false, true);
+      tmp = gfc_trans_scalar_assign (&lse, &se, cm->ts, true, true, true);
       gfc_add_expr_to_block (&block, tmp);
     }
   return gfc_finish_block (&block);

2015-04-18  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/65792
	* trans-expr.c (gfc_trans_subcomponent_assign):
	Always (shallow) copy the subcomponent.

2015-04-18  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/65792
	* gfortran.dg/derived_constructor_comps_5.f90: New.

Index: trans-expr.c
===================================================================
--- trans-expr.c	(révision 221972)
+++ trans-expr.c	(copie de travail)
@@ -6915,6 +6935,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
 	  gfc_init_se (&se, NULL);
 	  gfc_conv_expr (&se, expr);
 	  gfc_add_block_to_block (&block, &se.pre);
+	  gfc_add_modify (&block, dest,
+			  fold_convert (TREE_TYPE (dest), se.expr));
 	  if (cm->ts.u.derived->attr.alloc_comp
 	      && expr->expr_type == EXPR_VARIABLE)
 	    {
@@ -6922,9 +6944,6 @@ gfc_trans_subcomponent_assign (tree dest, gfc_comp
 					 dest, expr->rank);
 	      gfc_add_expr_to_block (&block, tmp);
 	    }
-	  else
-	    gfc_add_modify (&block, dest,
-			    fold_convert (TREE_TYPE (dest), se.expr));
 	  gfc_add_block_to_block (&block, &se.post);
 	}
       else

! { dg-do run }
!
! PR fortran/65792
! The evaluation of the argument in the call to new_prt_spec2
! failed to properly initialize the comp component.
! While the array contents were properly copied, the array bounds remained
! uninitialized.
!
! Contributed by Dominique D'Humieres <dominiq@lps.ens.fr>

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_t) :: prt_in, tmp, tmpa(n)
  type(string_container_t) :: tmpc, tmpca(n)
  integer :: i, j, k

  do i=1,16

     ! scalar elemental function with structure constructor
     prt_in = string_t(["D"])
     tmpc = new_prt_spec2 (string_container_t(prt_in))
     deallocate (prt_in%chars)
     deallocate(tmpc%comp%chars)

  end do

contains

  impure 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

end program main