Here's now my third attempt to fix this PR, taking into account the comments by Tobias and Bernhard.
> > On 10.06.21 20:52, Harald Anlauf via Fortran wrote: > > > +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 > > > > Is there a reason why you do not handle: > > > > type t > > character(len=5) :: str1 > > character(len=:), allocatable :: str2 > > end type > > type(t) :: x > > > > allocate(x%str2, source="abd") > > if (len (x%str)) /= 1) ... > > if (len (x%str2(1:2) /= 2) ... > > etc. > > > > Namely: Search the last_ref = expr->ref->next->next ...? > > and then check that lastref? The mentioned search is now implemented. Note, however, that gfc_simplify_len still won't handle neither deferred strings nor their substrings. I think there is nothing to simplify at compile time here. Otherwise there would be a conflict/inconsistency with type parameter inquiry, see F2018:9.4.5(2): "A deferred type parameter of a pointer that is not associated or of an unallocated allocatable variable shall not be inquired about." > > * * * > > > > Slightly unrelated: I think the following does not violate > > F2018's R916 / C923 – but is rejected, namely: > > R916 type-param-inquiry is designator % type-param-name > > the latter is 'len' or 'kind' for intrinsic types. And: > > R901 designator is ... > > or substring > > But > > > > character(len=5) :: str > > print *, str(1:3)%len > > end > > > > fails with > > > > 2 | print *, str(1:3)%len > > | 1 > > Error: Syntax error in PRINT statement at (1) > > > > > > Assuming you don't want to handle it, can you open a new PR? > > Thanks! I tried to look into this, but there appear to be several unrelated issues requiring a separate treatment. I therefore opened: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=101735 > > > + 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); > > > > As mentioned by Bernhard, you could use HOST_WIDE_INT_PRINT_DEC. > > > > (It probably only matters on Windows which uses long == int = 32bit for > > strings longer than INT_MAX.) Done. The updated patch regtests fine. OK? Thanks, Harald Fortran - simplify length of substring with constant bounds gcc/fortran/ChangeLog: PR fortran/100950 * simplify.c (substring_has_constant_len): New. (gfc_simplify_len): Handle case of substrings with constant bounds. gcc/testsuite/ChangeLog: PR fortran/100950 * gfortran.dg/pr100950.f90: New test.
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index c27b47aa98f..8f7fcec94c8 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -4512,6 +4512,69 @@ gfc_simplify_leadz (gfc_expr *e) } +/* Check for constant length of a substring. */ + +static bool +substring_has_constant_len (gfc_expr *e) +{ + gfc_ref *ref; + HOST_WIDE_INT istart, iend, length; + bool equal_length = false; + + if (e->ts.type != BT_CHARACTER || e->ts.deferred) + return false; + + for (ref = e->ref; ref; ref = ref->next) + if (ref->type != REF_COMPONENT) + break; + + if (!ref + || ref->type != REF_SUBSTRING + || !ref->u.ss.start + || ref->u.ss.start->expr_type != EXPR_CONSTANT + || !ref->u.ss.end + || ref->u.ss.end->expr_type != EXPR_CONSTANT + || !ref->u.ss.length + || !ref->u.ss.length->length + || ref->u.ss.length->length->expr_type != EXPR_CONSTANT) + return false; + + /* Basic checks on substring starting and ending indices. */ + if (!gfc_resolve_substring (ref, &equal_length)) + return false; + + istart = gfc_mpz_get_hwi (ref->u.ss.start->value.integer); + iend = gfc_mpz_get_hwi (ref->u.ss.end->value.integer); + length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer); + + if (istart <= iend) + { + if (istart < 1) + { + gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC + ") at %L below 1", + istart, &ref->u.ss.start->where); + return false; + } + if (iend > length) + { + gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC + ") at %L exceeds string length", + iend, &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) { @@ -4521,7 +4584,11 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) if (k == -1) return &gfc_bad_expr; - if (e->expr_type == EXPR_CONSTANT) + if (e->ts.deferred) + return NULL; + + if (e->expr_type == EXPR_CONSTANT + || 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); diff --git a/gcc/testsuite/gfortran.dg/pr100950.f90 b/gcc/testsuite/gfortran.dg/pr100950.f90 new file mode 100644 index 00000000000..a86c8016e2e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr100950.f90 @@ -0,0 +1,29 @@ +! { 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' ] + character(*), parameter :: t(*) = [character(len(x( :2))) :: 'a','b' ] + character(*), parameter :: v(*) = [character(len(x(7: ))) :: 'a','b' ] + type t_ + character(len=5) :: s + end type t_ + type(t_) :: q, r(1) + integer, parameter :: lq = len (q%s(3:4)), lr = len (r%s(3:4)) + + 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 + if (len (t) /= 2) stop 8 + if (len (v) /= 2) stop 9 + if (lq /= 2 .or. lr /= 2) stop 10 +end