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
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
+
+
gcc/testsuite/ChangeLog:
2016-08-06 Andre Vehreschild <[email protected]>
PR fortran/72698
* gfortran.dg/allocate_with_source_20.f03: New test.
gcc/fortran/ChangeLog:
2016-08-06 Andre Vehreschild <[email protected]>
PR fortran/72698
* trans-stmt.c (gfc_trans_allocate): Prevent generating code for
copy of zero sized string and with it an ICE.
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
+
+
