diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index c27b47aa98f..016ec259518 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -4512,6 +4512,60 @@ gfc_simplify_leadz (gfc_expr *e) } +/* Check for constant length of a substring. */ + +static bool +substring_has_constant_len (gfc_expr *e) +{ + ptrdiff_t istart, iend; + size_t length; + bool equal_length = false; + + if (e->ts.type != BT_CHARACTER + || !(e->ref && e->ref->type == REF_SUBSTRING) + || !e->ref->u.ss.start + || e->ref->u.ss.start->expr_type != EXPR_CONSTANT + || !e->ref->u.ss.end + || e->ref->u.ss.end->expr_type != EXPR_CONSTANT + || !e->ref->u.ss.length + || !e->ref->u.ss.length->length + || e->ref->u.ss.length->length->expr_type != EXPR_CONSTANT) + return false; + + /* Basic checks on substring starting and ending indices. */ + if (!gfc_resolve_substring (e->ref, &equal_length)) + return false; + + istart = gfc_mpz_get_hwi (e->ref->u.ss.start->value.integer); + iend = gfc_mpz_get_hwi (e->ref->u.ss.end->value.integer); + length = gfc_mpz_get_hwi (e->ref->u.ss.length->length->value.integer); + + if (istart <= iend) + { + if (istart < 1) + { + gfc_error ("Substring start index (%ld) at %L below 1", + (long) istart, &e->ref->u.ss.start->where); + return false; + } + if (iend > (ssize_t) length) + { + gfc_error ("Substring end index (%ld) at %L exceeds string " + "length", (long) iend, &e->ref->u.ss.end->where); + return false; + } + length = iend - istart + 1; + } + else + length = 0; + + /* Fix substring length. */ + e->value.character.length = length; + + return true; +} + + gfc_expr * gfc_simplify_len (gfc_expr *e, gfc_expr *kind) { @@ -4547,6 +4601,13 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) of the unlimited polymorphic entity. To get the _len component the last _data ref needs to be stripped and a ref to the _len component added. */ return gfc_get_len_component (e->symtree->n.sym->assoc->target, k); + else if (substring_has_constant_len (e)) + { + result = gfc_get_constant_expr (BT_INTEGER, k, &e->where); + mpz_set_si (result->value.integer, + e->value.character.length); + return range_check (result, "LEN"); + } else return NULL; } diff --git a/gcc/testsuite/gfortran.dg/pr100950.f90 b/gcc/testsuite/gfortran.dg/pr100950.f90 new file mode 100644 index 00000000000..f06db45b0b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr100950.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514 + +program p + character(8), parameter :: u = "123" + character(8) :: x = "", s + character(2) :: w(2) = [character(len(x(3:4))) :: 'a','b' ] + character(*), parameter :: y(*) = [character(len(u(3:4))) :: 'a','b' ] + character(*), parameter :: z(*) = [character(len(x(3:4))) :: 'a','b' ] + if (len (y) /= 2) stop 1 + if (len (z) /= 2) stop 2 + if (any (w /= y)) stop 3 + if (len ([character(len(u(3:4))) :: 'a','b' ]) /= 2) stop 4 + if (len ([character(len(x(3:4))) :: 'a','b' ]) /= 2) stop 5 + if (any ([character(len(x(3:4))) :: 'a','b' ] /= y)) stop 6 + write(s,*) [character(len(x(3:4))) :: 'a','b' ] + if (s /= " a b ") stop 7 +end