[Fortran, Patch, PR72698, v1] [5/6/7 Regression] ICE in lhd_incomplete_type_error, at langhooks.c:205

[Fortran, Patch, PR72698, v1] [5/6/7 Regression] ICE in lhd_incomplete_type_error, at langhooks.c:205

[Andre Vehreschild]

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

Hi all,

attached patch fixes the ICE caused by a zero-sized string. Assigning
that string to a temporary variable obviously did not work out. The
patch fixes this by checking for zero-sized strings in SOURCE= and not
producing the code to assign "nothing" to the temporary
variable and later to the allocated memory. The version for gcc-5 had
to be adapted slightly, because the version of the ALLOCATE()
implementation is way behind.

Bootstrapped and regtested on x86_64-linux-gnu/F23. Ok for trunk, gcc-6
and gcc-5?

Regards,
	Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: pr72698_v5_1.patch --]
[-- Type: text/x-patch, Size: 2479 bytes --]

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 1af8732..4891201 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5303,7 +5303,8 @@ gfc_trans_allocate (gfc_code * code)
   stmtblock_t block;
   stmtblock_t post;
   tree nelems;
-  bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set;
+  bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set,
+      do_assign = true;
   gfc_symtree *newsym = NULL;
 
   if (!code->ext.alloc.list)
@@ -5393,6 +5394,14 @@ gfc_trans_allocate (gfc_code * code)
 		  expr3_len = se.string_length;
 		  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))
+		    {
+		      expr3 = expr3_tmp = NULL_TREE;
+		      expr3_len = integer_zero_node;
+		      do_assign = false;
+		    }
 		}
 	      /* else expr3 = NULL_TREE set above.  */
 	    }
@@ -5415,7 +5424,16 @@ gfc_trans_allocate (gfc_code * code)
 	      gfc_add_block_to_block (&block, &se.pre);
 	      gfc_add_block_to_block (&post, &se.post);
 
-	      if (!VAR_P (se.expr))
+	      /* 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);
+		  expr3_len = integer_zero_node;
+		  tmp = NULL_TREE;
+		  do_assign = false;
+		}
+	      else if (!VAR_P (se.expr))
 		{
 		  tree var;
 
@@ -5956,7 +5974,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 && do_assign)
 	{
 	  /* Initialization via SOURCE block
 	     (or static default initializer).  */
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..c145267
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+! 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()))
+   print *, len(z), '  >>' // z // '<<'
+end
+
+

[-- Attachment #3: pr72698_1.clog --]
[-- Type: text/plain, Size: 360 bytes --]

gcc/testsuite/ChangeLog:

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

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


gcc/fortran/ChangeLog:

2016-08-06  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.


[-- Attachment #4: pr72698_1.patch --]
[-- Type: text/x-patch, Size: 2322 bytes --]

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/gfortran.dg/allocate_with_source_20.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
new file mode 100644
index 0000000..c145267
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+! 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()))
+   print *, len(z), '  >>' // z // '<<'
+end
+
+

Re: [Fortran, Patch, PR72698, v1] [5/6/7 Regression] ICE in lhd_incomplete_type_error, at langhooks.c:205

[Andre Vehreschild]

To prevent further confusion: The patch-file

pr72698_1.patch is for trunk and the gcc-6-branch, the

pr72698_v5_1.patch is for gcc-5-branch. 

Sorry for not pointing that out immediately.

- Andre

On Sun, 7 Aug 2016 13:52:34 +0200
Andre Vehreschild <vehre@gmx.de> wrote:

> Hi all,
> 
> attached patch fixes the ICE caused by a zero-sized string. Assigning
> that string to a temporary variable obviously did not work out. The
> patch fixes this by checking for zero-sized strings in SOURCE= and not
> producing the code to assign "nothing" to the temporary
> variable and later to the allocated memory. The version for gcc-5 had
> to be adapted slightly, because the version of the ALLOCATE()
> implementation is way behind.
> 
> Bootstrapped and regtested on x86_64-linux-gnu/F23. Ok for trunk,
> gcc-6 and gcc-5?
> 
> Regards,
> 	Andre


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

Re: [Fortran, Patch, PR72698, v1] [5/6/7 Regression] ICE in lhd_incomplete_type_error, at langhooks.c:205

[Thomas Koenig]

Am 07.08.2016 um 13:52 schrieb Andre Vehreschild:
Hi Andre,

> attached patch fixes the ICE caused by a zero-sized string. Assigning
> that string to a temporary variable obviously did not work out. The
> patch fixes this by checking for zero-sized strings in SOURCE= and not
> producing the code to assign "nothing" to the temporary
> variable and later to the allocated memory. The version for gcc-5 had
> to be adapted slightly, because the version of the ALLOCATE()
> implementation is way behind.
>
> Bootstrapped and regtested on x86_64-linux-gnu/F23. Ok for trunk, gcc-6
> and gcc-5?

Looks good.

With the test case, you might consider changing that into a runtime
test to make sure that the correct result is obtained.

So, OK with that change.

Regards

	Thomas

Re: [Fortran, Patch, PR72698, v1] [5/6/7 Regression] ICE in lhd_incomplete_type_error, at langhooks.c:205

[Andre Vehreschild]

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

Hi Thomas,

thanks for the review. I have changed the test to run and result check
as requested. Committed to trunk as r239236.

Will commit to gcc-6 and -5-branch in one week.

Regards,
	Andre

On Mon, 8 Aug 2016 08:42:08 +0200
Thomas Koenig <tkoenig@netcologne.de> wrote:

> Am 07.08.2016 um 13:52 schrieb Andre Vehreschild:
> Hi Andre,
> 
> > attached patch fixes the ICE caused by a zero-sized string.
> > Assigning that string to a temporary variable obviously did not
> > work out. The patch fixes this by checking for zero-sized strings
> > in SOURCE= and not producing the code to assign "nothing" to the
> > temporary variable and later to the allocated memory. The version
> > for gcc-5 had to be adapted slightly, because the version of the
> > ALLOCATE() implementation is way behind.
> >
> > Bootstrapped and regtested on x86_64-linux-gnu/F23. Ok for trunk,
> > gcc-6 and gcc-5?  
> 
> Looks good.
> 
> With the test case, you might consider changing that into a runtime
> test to make sure that the correct result is obtained.
> 
> So, OK with that change.
> 
> Regards
> 
> 	Thomas
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 3289 bytes --]

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 239235)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -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.
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 239235)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -5448,9 +5448,19 @@
 	}
       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 @@
       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 @@
 			    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.  */
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 239235)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -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.
Index: gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_20.f03	(nicht existent)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_20.f03	(Arbeitskopie)
@@ -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
+
+

Re: [Fortran, Patch, PR72698, v1] [5/6/7 Regression] ICE in lhd_incomplete_type_error, at langhooks.c:205

[Andre Vehreschild]

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

Hi all,

committed to gcc-6-branch as r239352 to catch the next release.

And while on it to gcc-5-branch as r239353.

Regards,
	Andre

On Mon, 8 Aug 2016 11:49:54 +0200
Andre Vehreschild <vehre@gmx.de> wrote:

> Hi Thomas,
> 
> thanks for the review. I have changed the test to run and result check
> as requested. Committed to trunk as r239236.
> 
> Will commit to gcc-6 and -5-branch in one week.
> 
> Regards,
> 	Andre
> 
> On Mon, 8 Aug 2016 08:42:08 +0200
> Thomas Koenig <tkoenig@netcologne.de> wrote:
> 
> > Am 07.08.2016 um 13:52 schrieb Andre Vehreschild:
> > Hi Andre,
> >   
> > > attached patch fixes the ICE caused by a zero-sized string.
> > > Assigning that string to a temporary variable obviously did not
> > > work out. The patch fixes this by checking for zero-sized strings
> > > in SOURCE= and not producing the code to assign "nothing" to the
> > > temporary variable and later to the allocated memory. The version
> > > for gcc-5 had to be adapted slightly, because the version of the
> > > ALLOCATE() implementation is way behind.
> > >
> > > Bootstrapped and regtested on x86_64-linux-gnu/F23. Ok for trunk,
> > > gcc-6 and gcc-5?    
> > 
> > Looks good.
> > 
> > With the test case, you might consider changing that into a runtime
> > test to make sure that the correct result is obtained.
> > 
> > So, OK with that change.
> > 
> > Regards
> > 
> > 	Thomas
> >   
> 
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

[-- Attachment #2: submit_gcc6.diff --]
[-- Type: text/x-patch, Size: 3233 bytes --]

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 239351)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,10 @@
+2016-08-11  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	Backport from trunk
+	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>
 
 	Backport from trunk:
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 239351)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -5439,9 +5439,19 @@
 	}
       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 ?
@@ -5670,11 +5680,8 @@
       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)
     {
@@ -6003,7 +6010,7 @@
 			    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.  */
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 239351)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,9 @@
+2016-08-11  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	Backport from trunk:
+	PR fortran/72698
+	* gfortran.dg/allocate_with_source_20.f03: New test.
+
 2016-08-10  Michael Meissner  <meissner@linux.vnet.ibm.com>
 
 	Backport from mainline
Index: gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_20.f03	(nicht existent)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_20.f03	(Arbeitskopie)
@@ -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
+
+

[-- Attachment #3: submit_gcc-5.diff --]
[-- Type: text/x-patch, Size: 3369 bytes --]

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 239352)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,10 @@
+2016-08-11  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	Backport from trunk:
+	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-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	Backport from trunk
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(Revision 239352)
+++ gcc/fortran/trans-stmt.c	(Arbeitskopie)
@@ -5303,7 +5303,8 @@
   stmtblock_t block;
   stmtblock_t post;
   tree nelems;
-  bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set;
+  bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set,
+      do_assign = true;
   gfc_symtree *newsym = NULL;
 
   if (!code->ext.alloc.list)
@@ -5393,6 +5394,14 @@
 		  expr3_len = se.string_length;
 		  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))
+		    {
+		      expr3 = expr3_tmp = NULL_TREE;
+		      expr3_len = integer_zero_node;
+		      do_assign = false;
+		    }
 		}
 	      /* else expr3 = NULL_TREE set above.  */
 	    }
@@ -5415,8 +5424,17 @@
 	      gfc_add_block_to_block (&block, &se.pre);
 	      gfc_add_block_to_block (&post, &se.post);
 
-	      if (!VAR_P (se.expr))
+	      /* 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);
+		  expr3_len = integer_zero_node;
+		  tmp = NULL_TREE;
+		  do_assign = false;
+		}
+	      else if (!VAR_P (se.expr))
+		{
 		  tree var;
 
 		  tmp = is_coarray ? se.expr
@@ -5956,7 +5974,7 @@
 			    fold_convert (TREE_TYPE (al_len),
 					  integer_zero_node));
 	}
-      if (code->expr3 && !code->expr3->mold)
+      if (code->expr3 && !code->expr3->mold && do_assign)
 	{
 	  /* Initialization via SOURCE block
 	     (or static default initializer).  */
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 239352)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,9 @@
+2016-08-11  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	Backport from trunk:
+	PR fortran/72698
+	* gfortran.dg/allocate_with_source_20.f03: New test.
+
 2016-08-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	Backport from trunk
Index: gcc/testsuite/gfortran.dg/allocate_with_source_20.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_20.f03	(nicht existent)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_20.f03	(Arbeitskopie)
@@ -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
+
+