Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514

[Harald Anlauf <anlauf@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 4171 bytes --]

Hi Tobias,

> Gesendet: Mittwoch, 18. August 2021 um 12:22 Uhr
> Von: "Tobias Burnus" <tobias@codesourcery.com>

> > 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.
> 
> Obviously, nonsubstrings cannot be simplified but I do not
> see why  len(str(1:2))  cannot or should not be simplified.
> 
> (Not that I regard substring length inquiries as that common.)

well, here's an example that Intel rejects:

  type u
     character(8)              :: s(4)
     character(:), allocatable :: str
  end type u
  type(u) :: q
  integer, parameter :: k2 = len (q% s(:)(3:4)) ! OK
  integer, parameter :: k3 = len (q% str (3:4)) ! Rejected by Intel
  print *, k2
  if (k2 /= 2) stop 2
  print *, k3
  if (k3 /= 2) stop 3
end

pr100950-ww.f90(7): error #6814: When using this inquiry function, the length of this object cannot be evaluated to a constant.   [LEN]
  integer, parameter :: k3 = len (q% str (3:4)) ! Rejected by Intel
-----------------------------^
pr100950-ww.f90(7): error #7169: Bad initialization expression.   [LEN]
  integer, parameter :: k3 = len (q% str (3:4)) ! Rejected by Intel
-----------------------------^

Of course we could accept it regardless what others do.
I have therefore removed the check for deferred length
in the attached patch (but read on).

> However, there is no reason why the user cannot do:
>    if (allocated(str)) then
>      n = len(str)
>      m = len(str(5:8))
>    end if
> and why the compiler cannot replace the latter by 'm = 4'.

Maybe you can enlighten me here.  I thought one of the
purposes of gfc_simplify_len is to evaluate constant
expressions.  Of course the length is constant, provided
bounds are respected.  Otherwise the result is, well, ...

(It will then eveluate at runtime, which I thought was fine).

> But, IMHO, the latter remark does _not_ imply that we
> shall/must/have to accept code like:
> 
> if (allocated(str)) then
>    block
>       integer, parameter :: n = len(str(:5))
>    end block
> endif

So shall we not simplify here (and thus reject it)?
This is important!  Or silently simplify and accept it?

> With the caveat from above that len(<substring>) is rather special,
> there is no real reason why:  str_array(:)(4:5)  cannot be handled.
> (→ len = 2).

Good point.  This is fixed in the revised patch and tested for.

> > The updated patch regtests fine.  OK?
> Looks good to me except for the caveats.

Regtested again.

>   * * *
> 
> And while the following works
> 
> x = var%str(:)%len  ! ok, yields 5
> y = str2(:)%len     ! ok, yields 5
> 
> the following is wrongly rejected:
> 
> x = var%str(:)(1:1)%len  ! Bogus: 'Invalid character in name'
> y = str2(:)(1:1)%len     ! Bogus: 'Invalid character in name'
> 
> (likewise with '%kind')
> 
> (As "SUBSTRING % LEN", it also appears in the '16.9.99 INDEX',
> but '9.4.5 Type parameter inquiry's 'R916 type-param-inquiry'
> is the official reference.)
> 
> If you don't want to spend time on this subpart - you could
> fill a PR.

Well, there's already

 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=101735

which is a much better suited place for discussion.

>   * * *
> 
> For deferred length, I have no strong opinion; in
> any case, the upper substring bound > stringlen check
> cannot be done in that case (at compile time). I think
> I slightly prefer doing the optimization – but as is
> is a special case and has some caveats (must be allocated,
> upper bound check not possible, ...) I also see reasons
> not to do it. Hence, it also can remain as in your patch.

Actually, this is now an important point.  If we really want
to allow to handle substrings of deferred length strings
in constant expressions, the new patch would be fine,
otherwise I would have to reintroduce the hunk

+  if (e->ts.deferred)
+    return NULL;

and adjust the testcase.

Your choice.  See above.

Of course there may be more corner cases which I did not
think of...

Thanks,
Harald

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr100950-v4.patch --]
[-- Type: text/x-patch, Size: 4376 bytes --]

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c27b47aa98f..cf0a4387788 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 && ref->type != REF_ARRAY)
+      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,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..7de589fe882
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100950.f90
@@ -0,0 +1,39 @@
+! { 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
+     character(len=8)              :: t(4)
+     character(len=:), allocatable :: str
+  end type t_
+  type(t_)                :: q, r(1)
+  integer,      parameter :: lq = len (q%s(3:4)), lr = len (r%s(3:4))
+  integer,      parameter :: l1 = len (q   %t(1)(3:4))
+  integer,      parameter :: l2 = len (q   %t(:)(3:4))
+  integer,      parameter :: l3 = len (q   %str (3:4))
+  integer,      parameter :: l4 = len (r(:)%t(1)(3:4))
+  integer,      parameter :: l5 = len (r(1)%t(:)(3:4))
+  integer,      parameter :: l6 = len (r(1)%str (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
+  if (l1 /= 2 .or. l2 /= 2 .or. l4 /= 2 .or. l5 /= 2) stop 11
+  if (l3 /= 2 .or. l6 /= 2) stop 12
+end