+2015-10-01 Louis Krupp <louis.krupp@zoho.com>
+
+ 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 <kargl@gcc.gnu.org>
PR fortran.67802
}
+/* 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. */
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);
}
}
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
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)
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,
+2015-10-01 Louis Krupp <louis.krupp@zoho.com>
+
+ 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 <segher@kernel.crashing.org>
PR target/67788
--- /dev/null
+! { 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
+
--- /dev/null
+! { 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
--- /dev/null
+! { 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
projects / gcc.git / commitdiff