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

Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/65792
	* trans-expr.c (gfc_trans_subcomponent_assign): Always assign
	the expression component to the destination. In addition, if
	the component has allocatable components, copy them and
	deallocate those of the expression, if it is not a variable.
	The expression is fixed if not a variable to prevent multiple
	evaluations.

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

	PR fortran/65792
	* gfortran.dg/derived_constructor_components_5: New test

From-SVN: r223234

gcc/fortran/ChangeLog

@@ -1,3 +1,14 @@
+2015-05-16  Mikael Morin  <mikael@gcc.gnu.org
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/65792
+	* trans-expr.c (gfc_trans_subcomponent_assign): Always assign
+	the expression component to the destination. In addition, if
+	the component has allocatable components, copy them and
+	deallocate those of the expression, if it is not a variable.
+	The expression is fixed if not a variable to prevent multiple
+	evaluations.
+
 2015-05-12  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/66111
@@ -133,12 +144,12 @@
 	to be referenced always.
 	(build_class_array_ref): Adapt retrieval of array descriptor.
 	(build_array_ref): Likewise.
-	(gfc_conv_array_ref): Hand the vptr or the descriptor to 
+	(gfc_conv_array_ref): Hand the vptr or the descriptor to
 	build_array_ref depending whether the sym is class or not.
 	(gfc_trans_array_cobounds):  Select correct gfc_array_spec for
 	regular and class arrays.
 	(gfc_trans_array_bounds): Likewise.
-	(gfc_trans_dummy_array_bias): Likewise. 
+	(gfc_trans_dummy_array_bias): Likewise.
 	(gfc_get_dataptr_offset): Correcting call of build_array_ref.
 	(gfc_conv_expr_descriptor): Set the array's offset to -1 when
 	lbound in inner most dim is 1 and symbol non-pointer/assoc.

gcc/fortran/trans-expr.c

@@ -7050,19 +7050,31 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
     {
       if (expr->expr_type != EXPR_STRUCTURE)
 	{
+	  tree dealloc = NULL_TREE;
 	  gfc_init_se (&se, NULL);
 	  gfc_conv_expr (&se, expr);
 	  gfc_add_block_to_block (&block, &se.pre);
+	  /* Prevent repeat evaluations in gfc_copy_alloc_comp by fixing the
+	     expression in  a temporary variable and deallocate the allocatable
+	     components. Then we can the copy the expression to the result.  */
 	  if (cm->ts.u.derived->attr.alloc_comp
-	      && expr->expr_type == EXPR_VARIABLE)
+	      && expr->expr_type != EXPR_VARIABLE)
+	    {
+	      se.expr = gfc_evaluate_now (se.expr, &block);
+	      dealloc = gfc_deallocate_alloc_comp (cm->ts.u.derived, se.expr,
+						   expr->rank);
+	    }
+	  gfc_add_modify (&block, dest,
+			  fold_convert (TREE_TYPE (dest), se.expr));
+	  if (cm->ts.u.derived->attr.alloc_comp
+	      && expr->expr_type != EXPR_NULL)
 	    {
 	      tmp = gfc_copy_alloc_comp (cm->ts.u.derived, se.expr,
 					 dest, expr->rank);
 	      gfc_add_expr_to_block (&block, tmp);
+	      if (dealloc != NULL_TREE)
+		gfc_add_expr_to_block (&block, dealloc);
 	    }
-	  else
-	    gfc_add_modify (&block, dest,
-			    fold_convert (TREE_TYPE (dest), se.expr));
 	  gfc_add_block_to_block (&block, &se.post);
 	}
       else

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2015-05-16  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/65792
+	* gfortran.dg/derived_constructor_components_5: New test
+
 2015-05-16  Uros Bizjak  <ubizjak@gmail.com>
 
 	PR target/66140

gcc/testsuite/gfortran.dg/derived_constructor_comps_5.f90

@@ -0,0 +1,59 @@
+! { 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,2
+
+! scalar elemental function with structure constructor
+     prt_in = string_t(["D"])
+     tmpc = new_prt_spec2 (string_container_t(prt_in))
+     if (any(tmpc%comp%chars .ne. ["D"])) call abort
+     deallocate (prt_in%chars)
+     deallocate(tmpc%comp%chars)
+! Check that function arguments are OK too
+     tmpc = new_prt_spec2 (string_container_t(new_str_t(["h","e","l","l","o"])))
+     if (any(tmpc%comp%chars .ne. ["h","e","l","l","o"])) call abort
+     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
+
+
+  function new_str_t (name) result (prt_spec)
+    character (*), intent(in), dimension (:) :: name
+    type(string_t) :: prt_spec
+    prt_spec = string_t(name)
+  end function new_str_t
+
+end program main
+