re PR fortran/72698 (ICE in lhd_incomplete_type_error, at langhooks.c:205)

gcc/testsuite/ChangeLog:

2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/72698
	* gfortran.dg/allocate_with_source_20.f03: New test.


gcc/fortran/ChangeLog:

2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/72698
	* trans-stmt.c (gfc_trans_allocate): Prevent generating code for
	copy of zero sized string and with it an ICE.

From-SVN: r239236

4 files changed, 46 insertions, 7 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bf5ec12..3b54ee3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
 2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>
 
+	PR fortran/72698
+	* trans-stmt.c (gfc_trans_allocate): Prevent generating code for
+	copy of zero sized string and with it an ICE.
+
+2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>
+
 	PR fortran/70524
 	* trans-array.c (gfc_trans_dummy_array_bias): Ensure that the
 	location information is correctly set.
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6e4e2a7..5884e7a 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5448,9 +5448,19 @@ gfc_trans_allocate (gfc_code * code)
 	}
       gfc_add_block_to_block (&block, &se.pre);
       gfc_add_block_to_block (&post, &se.post);
+
+      /* Special case when string in expr3 is zero.  */
+      if (code->expr3->ts.type == BT_CHARACTER
+	  && integer_zerop (se.string_length))
+	{
+	  gfc_init_se (&se, NULL);
+	  temp_var_needed = false;
+	  expr3_len = integer_zero_node;
+	  e3_is = E3_MOLD;
+	}
       /* Prevent aliasing, i.e., se.expr may be already a
 	     variable declaration.  */
-      if (se.expr != NULL_TREE && temp_var_needed)
+      else if (se.expr != NULL_TREE && temp_var_needed)
 	{
 	  tree var, desc;
 	  tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) || is_coarray ?
@@ -5679,11 +5689,8 @@ gfc_trans_allocate (gfc_code * code)
       gcc_assert (expr3_esize);
       expr3_esize = fold_convert (sizetype, expr3_esize);
       if (e3_is == E3_MOLD)
-	{
-	  /* The expr3 is no longer valid after this point.  */
-	  expr3 = NULL_TREE;
-	  e3_is = E3_UNSET;
-	}
+	/* The expr3 is no longer valid after this point.  */
+	expr3 = NULL_TREE;
     }
   else if (code->ext.alloc.ts.type != BT_UNKNOWN)
     {
@@ -6012,7 +6019,7 @@ gfc_trans_allocate (gfc_code * code)
 			    fold_convert (TREE_TYPE (al_len),
 					  integer_zero_node));
 	}
-      if (code->expr3 && !code->expr3->mold)
+      if (code->expr3 && !code->expr3->mold && e3_is != E3_MOLD)
 	{
 	  /* Initialization via SOURCE block (or static default initializer).
 	     Classes need some special handling, so catch them first.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c7a1128..6b7135c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/72698
+	* gfortran.dg/allocate_with_source_20.f03: New test.
+
 2016-08-08  Alan Modra  <amodra@gmail.com>
 
 	* gcc.c-torture/compile/pr72802.c: New.
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_20.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
new file mode 100644
index 0000000..67b50ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+
+! Check that PR72698 is fixed.
+! Contributed by Gerhard Steinmetz
+
+module m
+contains
+   integer function f()
+      f = 4
+   end
+end
+program p
+   use m
+   character(3), parameter :: c = 'abc'
+   character(:), allocatable :: z
+   allocate (z, source=repeat(c(2:1), f()))
+   if (len(z) /= 0) call abort()
+   if (z /= "") call abort()
+end
+
+