Hi Tobias,
> 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?
I was assuming that the argument passed to LEN() is already the ultimate
component for the case of substrings, and I was unable to find a case which
requires implementing that iteration. The cases you provided do not seem
to apply here:
- derived type component str1, which is a string of given length, poses no
problem. I added a case to the testcase, see attached updated patch.
- derived type component str2 has deferred length. I do not see that the
simplification can be applied here, as the allocation could lead to str2
being too short, and we do not want to simplify invalid code, such as:
type t
character(len=:), allocatable :: str2
end type
type(t) :: x
allocate(x%str2, source="z")
if (len (x%str2(1:2)) /= 2) stop 1
end
If we want this to be catchable by bounds checking, we need to punt
at simplification of this. The updated patch skips deferred strings.
> * * *
>
> 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!
Good point. I'd rather open a separate PR for this, though.
> > + 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.)
I am not familiar enough with Windows. What is HOST_WIDE_INT
on that system? (As compared to e.g. size_t, ptrdiff_t).
The (slightly) updated patch regtests fine.
Thanks,
Harald
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c27b47aa98f..7f22372afec 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4512,6 +4512,62 @@ 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->ts.deferred
+ || !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 +4577,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..f082cfea795
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100950.f90
@@ -0,0 +1,28 @@
+! { 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)
+ 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 (len (q%s) /= 5) stop 10
+ if (len (r%s) /= 5) stop 11
+end
