===================================================================
@@ -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
===================================================================
@@ -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). */
===================================================================
@@ -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
===================================================================
@@ -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
+
+