Hi Bernhard,
> > +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)
>
> iff we ever can get here with e->ref == NULL then the below will not
> work too well. If so then maybe
> if (e->ts.type != BT_CHARACTER
> || ! e->ref
> || e->ref->type != REF_SUBSTRING
>
> ?
as you already realized, the logic was fine, but probably less
readable than your version. I've changed the code accordingly.
> > + 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);
>
> I think the mpz_set_si args above fit on one line.
That's true.
Since this block is exactly the same as for constant strings,
which is handled in the first condition, I've thought some more
and am convinced now that these two can be fused. Done now.
I've also added two cornercases to the testcase, and regtested again.
> btw.. there's a commentary typo in add_init_expr_to_sym():
> s/skeep/skip/
That is a completely unrelated issue in a different file, right?
Thanks for your constructive comments!
Harald
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c27b47aa98f..42ddc62f3c6 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4512,6 +4512,61 @@ 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)
{
@@ -4521,7 +4576,8 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
if (k == -1)
return &gfc_bad_expr;
- if (e->expr_type == EXPR_CONSTANT)
+ 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..54c459adf99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100950.f90
@@ -0,0 +1,22 @@
+! { 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' ]
+ 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
+end
