From: Louis Krupp Date: Fri, 2 Oct 2015 04:03:34 +0000 (+0000) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d751beac550156b637116db02867e629715e3dfb;p=gcc.git [multiple changes] 2015-10-01 Louis Krupp PR fortran/62242 PR fortran/52332 * trans-array.c (store_backend_decl): Create new gfc_charlen instance if requested (get_array_ctor_all_strlen): Call store_backend_decl requesting new gfc_charlen (trans_array_constructor): Call store_backend_decl requesting new gfc_charlen if get_array_ctor_strlen was called (gfc_add_loop_ss_code): Don't try to convert non-constant length 2015-10-01 Louis Krupp PR fortran/62242 PR fortran/52332 * gfortran.dg/string_array_constructor_1.f90: New. * gfortran.dg/string_array_constructor_2.f90: New. * gfortran.dg/string_array_constructor_3.f90: New. From-SVN: r228368 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2b6a4b67f6d..1e9435550f5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2015-10-01 Louis Krupp + + PR fortran/62242 + PR fortran/52332 + * trans-array.c + (store_backend_decl): Create new gfc_charlen instance if requested + (get_array_ctor_all_strlen): Call store_backend_decl requesting + new gfc_charlen + (trans_array_constructor): Call store_backend_decl requesting + new gfc_charlen if get_array_ctor_strlen was called + (gfc_add_loop_ss_code): Don't try to convert non-constant length + 2015-10-01 Steven G. Kargl PR fortran.67802 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a6b761baba8..e1d7f78bb6b 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1799,6 +1799,29 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, } +/* The array constructor code can create a string length with an operand + in the form of a temporary variable. This variable will retain its + context (current_function_decl). If we store this length tree in a + gfc_charlen structure which is shared by a variable in another + context, the resulting gfc_charlen structure with a variable in a + different context, we could trip the assertion in expand_expr_real_1 + when it sees that a variable has been created in one context and + referenced in another. + + If this might be the case, we create a new gfc_charlen structure and + link it into the current namespace. */ + +static void +store_backend_decl (gfc_charlen **clp, tree len, bool force_new_cl) +{ + if (force_new_cl) + { + gfc_charlen *new_cl = gfc_new_charlen (gfc_current_ns, *clp); + *clp = new_cl; + } + (*clp)->backend_decl = len; +} + /* A catch-all to obtain the string length for anything that is not a substring of non-constant length, a constant, array or variable. */ @@ -1836,7 +1859,7 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) gfc_add_block_to_block (block, &se.pre); gfc_add_block_to_block (block, &se.post); - e->ts.u.cl->backend_decl = *len; + store_backend_decl (&e->ts.u.cl, *len, true); } } @@ -2226,6 +2249,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) if (expr->ts.type == BT_CHARACTER) { bool const_string; + bool force_new_cl = false; /* get_array_ctor_strlen walks the elements of the constructor, if a typespec was given, we already know the string length and want the one @@ -2244,14 +2268,17 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_add_block_to_block (&outer_loop->post, &length_se.post); } else - const_string = get_array_ctor_strlen (&outer_loop->pre, c, - &ss_info->string_length); + { + const_string = get_array_ctor_strlen (&outer_loop->pre, c, + &ss_info->string_length); + force_new_cl = true; + } /* Complex character array constructors should have been taken care of and not end up here. */ gcc_assert (ss_info->string_length); - expr->ts.u.cl->backend_decl = ss_info->string_length; + store_backend_decl (&expr->ts.u.cl, ss_info->string_length, force_new_cl); type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length); if (const_string) @@ -2589,7 +2616,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, if (expr->ts.type == BT_CHARACTER && ss_info->string_length == NULL && expr->ts.u.cl - && expr->ts.u.cl->length) + && expr->ts.u.cl->length + && expr->ts.u.cl->length->expr_type == EXPR_CONSTANT) { gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, expr->ts.u.cl->length, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3df0caa811f..65a6a9396ff 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2015-10-01 Louis Krupp + + PR fortran/62242 + PR fortran/52332 + * gfortran.dg/string_array_constructor_1.f90: New. + * gfortran.dg/string_array_constructor_2.f90: New. + * gfortran.dg/string_array_constructor_3.f90: New. + 2015-10-01 Segher Boessenkool PR target/67788 diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/string_array_constructor_1.f90 new file mode 100755 index 00000000000..a5968fb37a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/string_array_constructor_1.f90 @@ -0,0 +1,26 @@ +! { dg-do compile } +! PR 62242 +! Array constructor with an array element whose value is a +! character function that is described in an interface block and which +! has an assumed-length result +module gfbug + implicit none + INTERFACE + function UpperCase(string) result(upper) + character(*), intent(IN) :: string + character(LEN(string)) :: upper + end function + function f2(string) result(upper) + character(*), intent(IN) :: string + character(5) :: upper + end function + END INTERFACE +contains + subroutine s1 + character(5) c + character(5), dimension(1) :: ca + ca = (/f2(c)/) ! This compiles + ca = (/Uppercase(c)/) ! This gets an ICE + end subroutine +end module gfbug + diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_2.f90 b/gcc/testsuite/gfortran.dg/string_array_constructor_2.f90 new file mode 100755 index 00000000000..0d352b7f5ca --- /dev/null +++ b/gcc/testsuite/gfortran.dg/string_array_constructor_2.f90 @@ -0,0 +1,48 @@ +! { dg-do run } +! PR 62242 +! Array constructor with an array element whose value is a +! character function that is described in an interface block and which +! has an assumed-length result +module gfbug + implicit none + INTERFACE + function UpperCase(string) result(upper) + character(*), intent(IN) :: string + character(LEN(string)) :: upper + end function + function f2(string) result(upper) + character(*), intent(IN) :: string + character(5) :: upper + end function + END INTERFACE +contains + subroutine s1 + character(5) c + character(5), dimension(1) :: ca + character(5), dimension(1) :: cb + c = "12345" + ca = (/f2(c)/) ! This works + !print *, ca(1) + cb = (/Uppercase(c)/) ! This gets an ICE + if (ca(1) .ne. cb(1)) then + call abort() + end if + !print *, ca(1) + end subroutine +end module gfbug + +function UpperCase(string) result(upper) + character(*), intent(IN) :: string + character(LEN(string)) :: upper + upper = string +end function +function f2(string) result(upper) + character(*), intent(IN) :: string + character(5) :: upper + upper = string +end function + +program main + use gfbug + call s1 +end program diff --git a/gcc/testsuite/gfortran.dg/string_array_constructor_3.f90 b/gcc/testsuite/gfortran.dg/string_array_constructor_3.f90 new file mode 100644 index 00000000000..1ba33e5de90 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/string_array_constructor_3.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! PR 62242 +! A subprogram calling an array constructor with an array element whose +! value is the result of calling a character function with both an +! assumed-length argument and an assumed-length result +module gfbug + implicit none +contains + function inner(inner_str) result(upper) + character(*), intent(IN) :: inner_str + character(LEN(inner_str)) :: upper + + upper = '123' + end function + + subroutine outer(outer_str) + character(*), intent(IN) :: outer_str + character(5) :: z(1) + + z = [inner(outer_str)] + end subroutine +end module gfbug