Hi all, attached patch fixes the ICE when using a deferred length char array as source= expression in an allocate for complicated source= expressions. Before the patch the compiler was relying on having the string length available in the ts of the expression, but when the expression is sufficiently complicated it is not set there. In trunk the problem does not arise, because the source= expression is evaluated in more cases. In gcc-5 this is not available without doing a major rewrite of the allocate() statement's conv-routine. Therefore this small portion of extra code reliably does the trick and takes the string_length from the se.string_length now.
Bootstrapped and regtested ok on x86_64-linux-gnu/F23. Ok for
gcc-5-branch?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
pr66911_gcc-5_1.clog
Description: Binary data
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index b33bad7..25c2a0c 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5536,14 +5536,23 @@ gfc_trans_allocate (gfc_code * code)
if (expr3_len == NULL_TREE
&& code->expr3->ts.type == BT_CHARACTER)
{
+ gfc_init_se (&se, NULL);
if (code->expr3->ts.u.cl
&& code->expr3->ts.u.cl->length)
{
- gfc_init_se (&se, NULL);
gfc_conv_expr (&se, code->expr3->ts.u.cl->length);
gfc_add_block_to_block (&block, &se.pre);
expr3_len = gfc_evaluate_now (se.expr, &block);
}
+ else
+ {
+ /* The string_length is not set in the symbol, which prevents
+ it being set in the ts. Deduce it by converting expr3. */
+ gfc_conv_expr (&se, code->expr3);
+ gfc_add_block_to_block (&block, &se.pre);
+ gcc_assert (se.string_length);
+ expr3_len = gfc_evaluate_now (se.string_length, &block);
+ }
gcc_assert (expr3_len);
}
/* For character arrays only the kind's size is needed, because
diff --git a/gcc/testsuite/gfortran.dg/deferred_character_16.f90 b/gcc/testsuite/gfortran.dg/deferred_character_16.f90
new file mode 100644
index 0000000..27fb112
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/deferred_character_16.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+program truc
+implicit none
+
+type t_env_table
+ character(len=:), allocatable :: key
+end type
+
+type(t_env_table), dimension(:), allocatable :: environment_table
+
+character(len=:), allocatable :: s
+
+allocate(environment_table(1))
+environment_table(1)%key='tt'
+
+allocate(s, source=environment_table(1)%key)
+
+if ( .not. allocated(s) ) call abort()
+if ( s /= "tt" ) call abort()
+if ( len(s) /= 2 ) call abort()
+!print *, 's:"', s, '" derived:"',environment_table(1)%key,'"'
+
+end program
