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

4 files changed, 93 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1b455b5..c06627e 100644
--- a/gcc/fortran/ChangeLog
+++ b/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.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c71037f..9be8a42 100644
--- a/gcc/fortran/trans-expr.c
+++ b/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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 123dadf..7d58a18 100644
--- a/gcc/testsuite/ChangeLog
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_5.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_5.f90
new file mode 100644
index 0000000..083c131
--- /dev/null
+++ b/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

+