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

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

[Harald Anlauf]

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

Dear Fortranners,

we should be able to simplify the length of a substring with known
constant bounds.  The attached patch adds this.

Regtested on x86_64-pc-linux-gnu.

OK for mainline?  Since this should be rather safe, to at least 11-branch?

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.


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

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

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

[Bernhard Reutner-Fischer]

On Wed, 9 Jun 2021 23:39:45 +0200
Harald Anlauf via Gcc-patches <gcc-patches@gcc.gnu.org> wrote:

> 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)

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

?

> +      || !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);

I think the mpz_set_si args above fit on one line.

btw.. there's a commentary typo in add_init_expr_to_sym():
s/skeep/skip/

thanks,

> +      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

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

[Bernhard Reutner-Fischer]

On Thu, 10 Jun 2021 12:24:35 +0200
Bernhard Reutner-Fischer <rep.dot.nop@gmail.com> wrote:

> On Wed, 9 Jun 2021 23:39:45 +0200
> Harald Anlauf via Gcc-patches <gcc-patches@gcc.gnu.org> wrote:

> > +/* 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)  
> 
> 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
> 
> ?

Not sure what i was reading, maybe i read || instead of && in the
braced condition. Your initial version works equally well of course
although it's obviously harder to parse for at least some :)
thanks,

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

[Harald Anlauf]

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

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


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

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

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

[Bernhard Reutner-Fischer]

On 10 June 2021 20:52:12 CEST, Harald Anlauf <anlauf@gmx.de> wrote:

>> 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.

Thanks.
Btw.. I know that we cast hwi to long int often and use %ld but think there is a HOST_WIDE_INT_PRINT_DEC format macro to print a hwi.

>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?

Completely unrelated, yes.
>
>Thanks for your constructive comments!

thanks for the patch!

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

[Tobias Burnus]

Hi Harald,

sorry for being way behind my review duties :-(

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?

   * * *

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!

  * * *

That's in so far related to your patch as last_ref would
then be the last ref before ref->next == NULL or
before ref->next->type == REF_INQUIRY

> +  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.)

Thanks,

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

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

[Harald Anlauf]

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

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

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

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

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

[Harald Anlauf]

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

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.


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

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

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

[Harald Anlauf]

*Ping*

> Gesendet: Dienstag, 03. August 2021 um 23:17 Uhr
> Von: "Harald Anlauf" <anlauf@gmx.de>
> An: "Harald Anlauf" <anlauf@gmx.de>
> Cc: "Tobias Burnus" <Tobias_Burnus@mentor.com>, "Bernhard Reutner-Fischer" <rep.dot.nop@gmail.com>, "Harald Anlauf via Gcc-patches" <gcc-patches@gcc.gnu.org>, "fortran" <fortran@gcc.gnu.org>
> Betreff: Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514
>
> 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.
> 
>

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

[Tobias Burnus]

Hi Harald,

sorry for the belated review.

On 03.08.21 23:17, Harald Anlauf wrote:
>>> 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.

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.)

Regarding:

> 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."

That's a requirement for the user not to do:
   character(len=:), allocatable :: str
   n = len(str)  ! unallocated 'str'

which makes sense as 'len(str)' is not meaningful in this case and
the compiler might even access invalid memory in this case
and definitely undefined memory.

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'.

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


> +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;
cf. above.
> +
> +  for (ref = e->ref; ref; ref = ref->next)
> +    if (ref->type != REF_COMPONENT)
> +      break;
> +
> +  if (!ref
> +      || ref->type != REF_SUBSTRING
> +      || !ref->u.ss.start

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).

[I do note that "len(str(:5))" appears in your examples, hence,
I assume that ss.start is set in that case to '1'.]

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

In particular:

  * * *

I think at least the array case should be handled.
On current mainline (i.e. without your patch),
I get (-fdump-tree-original)

   x = 5;  // Wrong - should be 1
   y = 1;  // OK

for

character(len=5) :: str2(4)
type t
    character(len=5) :: str(4)
end type t
type(t) :: var
integer :: x, y
x = len(var%str(:)(1:1))
y = len(str2(:)(1:1))
end

I don't know what's the result with your patch - but if
it is 'x = 5', it must be fixed.

  * * *

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.

  * * *

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.

Thanks,

Tobias

> 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.

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

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

[Harald Anlauf]

[-- 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

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

[Tobias Burnus]

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

Hi Harald,

On 18.08.21 23:01, Harald Anlauf wrote:
>> Von: "Tobias Burnus"<tobias@codesourcery.com>
>>> Note, however, that gfc_simplify_len still won't handle neither
>>> deferred strings nor their substrings.
>> Obviously, nonsubstrings cannot be simplified but I do not
>> see why  len(str(1:2))  cannot or should not be simplified.
> well, here's an example that Intel rejects:
> ...
>       character(:), allocatable :: str
>    end type u
>    type(u) :: q
> ...
>    integer, parameter :: k3 = len (q% str (3:4)) ! Rejected by Intel
>
> pr100950-ww.f90(7): error #6814: When using this inquiry function, the length of this object cannot be evaluated to a constant.   [LEN]

I think the question is really how to interpret "10.1.12 Constant expression"

"(4) a specification inquiry where each designator or argument is
    ...
  (b) a variable whose properties inquired about are not
     (i) assumed,
     (ii) deferred, or
     (iii) defined by an expression that is not a constant expression,"

And as the substring bounds are constant expressions,
one can argue that (4)(b) is fulfilled as (i)–(iii) do not apply.

I am inclined to say that the Intel compiler has a bug by not
accepting it – but as written before, I regard sub-string length
(esp. with const expr) inquiries as an odd corner case which
is unlikely to occur in real-world code.

>> However, there is no reason why the user cannot do [...]
> Maybe you can enlighten me here.  [...]
I can't as I did not understand your question. However ...
>> 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?

I tried to draw the line between simplification – to generate better code –
and 'constant expression' handling (accept where permitted, diagnose
non-standard-conforming code). — However, nearly but not quite always:
if it can be simplified to a constant the standard also regards it as
constant expression.

I think in for the purpose of the examples in this email thread,
we do not need to distinguish the two. — And can always simplify
deferred-length substrings where the substring bounds are const
expressions (or the lower-bound is absent and, hence, 1).

>> 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.

Still does not work – or rather: ...%t(:)(3:4) [i.e. substring with array section]
and ...%str(3:4) [i.e. substring of deferred-length scalar] both do work
but if one combines the two (→ ...%str2(:)(3:4), i.e. substring of deferred-length
array section), it does not:

Array ‘r’ at (1) is a variable, which does not reduce to a constant expression

for:

--- a/gcc/testsuite/gfortran.dg/pr100950.f90
+++ b/gcc/testsuite/gfortran.dg/pr100950.f90
@@ -15,2 +15,3 @@ program p
       character(len=:), allocatable :: str
+     character(len=:), allocatable :: str2(:)
    end type t_
@@ -24,2 +25,4 @@ program p
    integer,      parameter :: l6 = len (r(1)%str (3:4))
+  integer,      parameter :: l7 = len (r(1)%str2(1)(3:4))
+  integer,      parameter :: l8 = len (r(1)%str2(:)(3:4))


which feels odd.

>>> The updated patch regtests fine.  OK?
>> Looks good to me except for the caveats.
> Regtested again.
[...]
> Well, there's already
>   https://gcc.gnu.org/bugzilla/show_bug.cgi?id=101735

I have added the example to the PR.

>> For deferred length, I have no strong opinion; [...]
> 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,
I think handling len=: substrings is fine.

In principle, LGTM – except I wonder what we do about the
len(r(1)%str(1)(3:4));
I think we really do handle most code available and I would like to
close this
topic – but still it feels a bit odd to leave this bit out.

I was also wondering whether we should check that the
compile-time simplification works – i.e. use -fdump-tree-original for this;
I attached a patch for this.

Thanks,

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: patch.diff --]
[-- Type: text/x-patch, Size: 867 bytes --]

diff --git a/gcc/testsuite/gfortran.dg/pr100950.f90 b/gcc/testsuite/gfortran.dg/pr100950.f90
index 7de589fe882..b9dcef0a7af 100644
--- a/gcc/testsuite/gfortran.dg/pr100950.f90
+++ b/gcc/testsuite/gfortran.dg/pr100950.f90
@@ -1,0 +2 @@
+! { dg-additional-options "-fdump-tree-original" }
@@ -15,0 +17 @@ program p
+     character(len=:), allocatable :: str2(:)
@@ -24,0 +27,2 @@ program p
+!  integer,      parameter :: l7 = len (r(1)%str2(1)(3:4))
+!  integer,      parameter :: l8 = len (r(1)%str2(:)(3:4))
@@ -37,0 +42 @@ program p
+!  if (l3 /= 2 .or. l6 /= 2 .or. l7 /= 2 .or. l8 /= 2) stop 12
@@ -39,0 +45,4 @@ end
+
+! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 2 "original" } }
+! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(3, 0\\);" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(7, 0\\);" "original" } }

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

[Harald Anlauf]

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

Hi Tobias,

> I am inclined to say that the Intel compiler has a bug by not
> accepting it – but as written before, I regard sub-string length
> (esp. with const expr) inquiries as an odd corner case which
> is unlikely to occur in real-world code.

ok.

> Still does not work – or rather: ...%t(:)(3:4) [i.e. substring with array section]
> and ...%str(3:4) [i.e. substring of deferred-length scalar] both do work
> but if one combines the two (→ ...%str2(:)(3:4), i.e. substring of deferred-length
> array section), it does not:
> 
> Array ‘r’ at (1) is a variable, which does not reduce to a constant expression
> 
> for:
> 
> --- a/gcc/testsuite/gfortran.dg/pr100950.f90
> +++ b/gcc/testsuite/gfortran.dg/pr100950.f90
> @@ -15,2 +15,3 @@ program p
>        character(len=:), allocatable :: str
> +     character(len=:), allocatable :: str2(:)
>     end type t_
> @@ -24,2 +25,4 @@ program p
>     integer,      parameter :: l6 = len (r(1)%str (3:4))
> +  integer,      parameter :: l7 = len (r(1)%str2(1)(3:4))
> +  integer,      parameter :: l8 = len (r(1)%str2(:)(3:4))
> 
> 
> which feels odd.

I agree.  I have revised the code slightly to accept substrings
of deferred-length.  Your suggested variants now work correctly.

> In principle, LGTM – except I wonder what we do about the
> len(r(1)%str(1)(3:4));
> I think we really do handle most code available and I would like to
> close this
> topic – but still it feels a bit odd to leave this bit out.

That is handle now as discussed, see attached final patch.
Regtested again.

> I was also wondering whether we should check that the
> compile-time simplification works – i.e. use -fdump-tree-original for this;
> I attached a patch for this.

I added this to the final patch and taken the liberty to push the result
to master as d881460deb1f0bdfc3e8fa2d391a03a9763cbff4.

Thanks for your patience, given the rather extensive review...

Harald

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

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c27b47aa98f..492867e12cb 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4512,6 +4512,78 @@ 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)
+    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)
+    return false;
+
+  /* For non-deferred strings the given length shall be constant.  */
+  if (!e->ts.deferred
+      && (!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);
+
+  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;
+	}
+
+      /* For deferred strings use end index as proxy for length.  */
+      if (e->ts.deferred)
+	length = iend;
+      else
+	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
+      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 +4593,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..cb9d126bc18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr100950.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+! 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=8), pointer     :: u(:)
+     character(len=:), allocatable :: str
+     character(len=:), allocatable :: str2(:)
+  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))
+  integer,      parameter :: l7 = len (r(1)%str2(1)(3:4))
+  integer,      parameter :: l8 = len (r(1)%str2(:)(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 .or. l7 /= 2 .or. l8 /= 2) stop 12
+
+  block
+    integer, parameter :: l9 = len (r(1)%u(:)(3:4))
+    if (l9 /= 2) stop 13
+  end block
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 2 "original" } }
+! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(3, 0\\);" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(7, 0\\);" "original" } }

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

[H.J. Lu]

On Thu, Aug 19, 2021 at 12:12 PM Harald Anlauf via Gcc-patches
<gcc-patches@gcc.gnu.org> wrote:
>
> Hi Tobias,
>
> > I am inclined to say that the Intel compiler has a bug by not
> > accepting it – but as written before, I regard sub-string length
> > (esp. with const expr) inquiries as an odd corner case which
> > is unlikely to occur in real-world code.
>
> ok.
>
> > Still does not work – or rather: ...%t(:)(3:4) [i.e. substring with array section]
> > and ...%str(3:4) [i.e. substring of deferred-length scalar] both do work
> > but if one combines the two (→ ...%str2(:)(3:4), i.e. substring of deferred-length
> > array section), it does not:
> >
> > Array ‘r’ at (1) is a variable, which does not reduce to a constant expression
> >
> > for:
> >
> > --- a/gcc/testsuite/gfortran.dg/pr100950.f90
> > +++ b/gcc/testsuite/gfortran.dg/pr100950.f90
> > @@ -15,2 +15,3 @@ program p
> >        character(len=:), allocatable :: str
> > +     character(len=:), allocatable :: str2(:)
> >     end type t_
> > @@ -24,2 +25,4 @@ program p
> >     integer,      parameter :: l6 = len (r(1)%str (3:4))
> > +  integer,      parameter :: l7 = len (r(1)%str2(1)(3:4))
> > +  integer,      parameter :: l8 = len (r(1)%str2(:)(3:4))
> >
> >
> > which feels odd.
>
> I agree.  I have revised the code slightly to accept substrings
> of deferred-length.  Your suggested variants now work correctly.
>
> > In principle, LGTM – except I wonder what we do about the
> > len(r(1)%str(1)(3:4));
> > I think we really do handle most code available and I would like to
> > close this
> > topic – but still it feels a bit odd to leave this bit out.
>
> That is handle now as discussed, see attached final patch.
> Regtested again.
>
> > I was also wondering whether we should check that the
> > compile-time simplification works – i.e. use -fdump-tree-original for this;
> > I attached a patch for this.
>
> I added this to the final patch and taken the liberty to push the result
> to master as d881460deb1f0bdfc3e8fa2d391a03a9763cbff4.
>
> Thanks for your patience, given the rather extensive review...
>
> Harald

This may have broken bootstrap on 32-bit hosts:

https://gcc.gnu.org/pipermail/gcc-regression/2021-August/075209.html

-- 
H.J.

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

[Harald Anlauf]

Hi!

> Gesendet: Freitag, 20. August 2021 um 02:21 Uhr
> Von: "H.J. Lu" <hjl.tools@gmail.com>

> This may have broken bootstrap on 32-bit hosts:
> 
> https://gcc.gnu.org/pipermail/gcc-regression/2021-August/075209.html

I do not understand the error message:

../../src-master/gcc/fortran/simplify.c: In function ‘bool substring_has_constant_len(gfc_expr*)’:
../../src-master/gcc/fortran/simplify.c:4557:22: error: unknown conversion type character ‘l’ in format [-Werror=format=]
 4557 |           gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
      |                      ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 4558 |                      ") at %L below 1",
      |                      ~~~~~~~~~~~~~~~~~
../../src-master/gcc/fortran/simplify.c:4557:22: error: format ‘%L’ expects argument of type ‘locus*’, but argument 2 has type ‘long long int’ [-Werror=format=]
 4557 |           gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
      |                      ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 4558 |                      ") at %L below 1",
      |                      ~~~~~~~~~~~~~~~~~
 4559 |                      istart, &ref->u.ss.start->where);
      |                      ~~~~~~
      |                      |
      |                      long long int
../../src-master/gcc/fortran/simplify.c:4557:22: error: too many arguments for format [-Werror=format-extra-args]

Is there an issue with HOST_WIDE_INT_PRINT_DEC on 32-bit hosts?
What is the right way to print a HOST_WIDE_INT?

It works on 64-bit without any warning.

Harald

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

[Jakub Jelinek]

On Fri, Aug 20, 2021 at 08:48:57AM +0200, Harald Anlauf via Gcc-patches wrote:
> Hi!
> 
> > Gesendet: Freitag, 20. August 2021 um 02:21 Uhr
> > Von: "H.J. Lu" <hjl.tools@gmail.com>
> 
> > This may have broken bootstrap on 32-bit hosts:
> > 
> > https://gcc.gnu.org/pipermail/gcc-regression/2021-August/075209.html
> 
> I do not understand the error message:
> 
> ../../src-master/gcc/fortran/simplify.c: In function ‘bool substring_has_constant_len(gfc_expr*)’:
> ../../src-master/gcc/fortran/simplify.c:4557:22: error: unknown conversion type character ‘l’ in format [-Werror=format=]
>  4557 |           gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
>       |                      ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
>  4558 |                      ") at %L below 1",
>       |                      ~~~~~~~~~~~~~~~~~
> ../../src-master/gcc/fortran/simplify.c:4557:22: error: format ‘%L’ expects argument of type ‘locus*’, but argument 2 has type ‘long long int’ [-Werror=format=]
>  4557 |           gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
>       |                      ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
>  4558 |                      ") at %L below 1",
>       |                      ~~~~~~~~~~~~~~~~~
>  4559 |                      istart, &ref->u.ss.start->where);
>       |                      ~~~~~~
>       |                      |
>       |                      long long int
> ../../src-master/gcc/fortran/simplify.c:4557:22: error: too many arguments for format [-Werror=format-extra-args]
> 
> Is there an issue with HOST_WIDE_INT_PRINT_DEC on 32-bit hosts?
> What is the right way to print a HOST_WIDE_INT?
> 
> It works on 64-bit without any warning.

gfc_error etc. aren't *printf family, it has its own format specifier
handling (e.g. it handles %L and %C), and it is even different
from the error/warning handling in middle-end/c-family FEs/backends.

HOST_WIDE_INT_PRINT_DEC is wrong in the above spot for 2 reasons:
1) gfc_error etc. argument is automatically marked for translation
   and translated, having a macro in there that expands to various things
   depending on host makes it impossible to mark for translation and
   a lottery for translation.
2) hwint.h defines:
#define HOST_LONG_FORMAT "l"
#define HOST_LONG_LONG_FORMAT "ll"
#if INT64_T_IS_LONG
# define GCC_PRI64 HOST_LONG_FORMAT
#else
# define GCC_PRI64 HOST_LONG_LONG_FORMAT
#endif
#define PRId64 GCC_PRI64 "d"
#define HOST_WIDE_INT_PRINT_DEC "%" PRId64
   but xm-mingw32.h overrides
#define HOST_LONG_LONG_FORMAT "I64"
   so effectively HOST_WIDE_INT_PRINT_DEC is "%ld", "%lld" or "%I64d"
   Now, gfc_error does handle %d or %ld, but doesn't handle %lld nor
   %I64d, so even if the 1) issue didn't exist, this explains why
   it works only on some hosts (e.g. x86_64-linux where %ld is used).
   But e.g. on i686-linux or many other hosts it is %lld which
   gfc_error doesn't handle and on Windows that %I64d.

Now, the non-Fortran FE diagnostic code actually has %wd for this (w
modifier like l modifier), which takes HOST_WIDE_INT/unsigned HOST_WIDE_INT
argument and prints it.

So, either you get through the hops to support that, unfortunately it isn't
just adding support for that in fortran/error.c (error_print) and some
helper functions, which wouldn't be that hard, just add 'w' next to 'l'
handling, TYPE_* for that and union member etc., but one needs to modify
c-family/c-format.c too to register the modifier so that gcc doesn't warn
about it and knows the proper argument type etc.

The other much easier but uglier option is to use a temporary buffer:
  char buffer[21];
  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, hwint_val);
  gfc_error ("... %s ...", ... buffer ...);
This works, as it uses the host sprintf i.e. *printf family for which
HOST_WIDE_INT_PRINT_DEC macro is designed.

	Jakub

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

[Harald Anlauf]

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

Hi Jakob,

thanks for the detailed explanation!

> The other much easier but uglier option is to use a temporary buffer:
>   char buffer[21];
>   sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, hwint_val);
>   gfc_error ("... %s ...", ... buffer ...);
> This works, as it uses the host sprintf i.e. *printf family for which
> HOST_WIDE_INT_PRINT_DEC macro is designed.

The attached followup patch implements this.

Can anybody affected by current HEAD confirm that this fixes bootstrap?

Thanks,
Harald

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

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 492867e12cb..eaabbffca4d 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4552,11 +4552,12 @@ substring_has_constant_len (gfc_expr *e)

   if (istart <= iend)
     {
+      char buffer[21];
       if (istart < 1)
 	{
-	  gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
-		     ") at %L below 1",
-		     istart, &ref->u.ss.start->where);
+	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
+	  gfc_error ("Substring start index (%s) at %L below 1",
+		     buffer, &ref->u.ss.start->where);
 	  return false;
 	}

@@ -4567,9 +4568,9 @@ substring_has_constant_len (gfc_expr *e)
 	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
       if (iend > length)
 	{
-	  gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
-		     ") at %L exceeds string length",
-		     iend, &ref->u.ss.end->where);
+	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
+	  gfc_error ("Substring end index (%s) at %L exceeds string length",
+		     buffer, &ref->u.ss.end->where);
 	  return false;
 	}
       length = iend - istart + 1;

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

[Jakub Jelinek]

On Fri, Aug 20, 2021 at 11:45:33AM +0200, Harald Anlauf wrote:
> Hi Jakob,
> 
> thanks for the detailed explanation!
> 
> > The other much easier but uglier option is to use a temporary buffer:
> >   char buffer[21];
> >   sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, hwint_val);
> >   gfc_error ("... %s ...", ... buffer ...);
> > This works, as it uses the host sprintf i.e. *printf family for which
> > HOST_WIDE_INT_PRINT_DEC macro is designed.
> 
> The attached followup patch implements this.
> 
> Can anybody affected by current HEAD confirm that this fixes bootstrap?

I have verified it fixes i686-linux bootstrap.
But the new testcase doesn't trigger any of those new errors, is something
else in the testsuite covering those or do you have some short snippet that
could verify the errors work properly?

> diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
> index 492867e12cb..eaabbffca4d 100644
> --- a/gcc/fortran/simplify.c
> +++ b/gcc/fortran/simplify.c
> @@ -4552,11 +4552,12 @@ substring_has_constant_len (gfc_expr *e)
> 
>    if (istart <= iend)
>      {
> +      char buffer[21];
>        if (istart < 1)
>  	{
> -	  gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
> -		     ") at %L below 1",
> -		     istart, &ref->u.ss.start->where);
> +	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
> +	  gfc_error ("Substring start index (%s) at %L below 1",
> +		     buffer, &ref->u.ss.start->where);
>  	  return false;
>  	}
> 
> @@ -4567,9 +4568,9 @@ substring_has_constant_len (gfc_expr *e)
>  	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
>        if (iend > length)
>  	{
> -	  gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
> -		     ") at %L exceeds string length",
> -		     iend, &ref->u.ss.end->where);
> +	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
> +	  gfc_error ("Substring end index (%s) at %L exceeds string length",
> +		     buffer, &ref->u.ss.end->where);
>  	  return false;
>  	}
>        length = iend - istart + 1;


	Jakub

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

[Harald Anlauf]

> Gesendet: Freitag, 20. August 2021 um 12:12 Uhr
> Von: "Jakub Jelinek" <jakub@redhat.com>

> I have verified it fixes i686-linux bootstrap.
> But the new testcase doesn't trigger any of those new errors, is something
> else in the testsuite covering those or do you have some short snippet that
> could verify the errors work properly?

The testcase was designed to verify correct simplification of
substring length for a variety of cases.

I played with variations of the testcase by specifying illegal
substring bounds, but all these cases were caught in a different
spot with similar error messages.

I put those checks into substring_has_constant_len as sanity checks.
Do you want me to remove them?

Or are you trying to say that it is important to exercise them?

Thanks,
Harald

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

[Jakub Jelinek]

On Fri, Aug 20, 2021 at 12:53:33PM +0200, Harald Anlauf wrote:
> > Gesendet: Freitag, 20. August 2021 um 12:12 Uhr
> > Von: "Jakub Jelinek" <jakub@redhat.com>
> 
> > I have verified it fixes i686-linux bootstrap.
> > But the new testcase doesn't trigger any of those new errors, is something
> > else in the testsuite covering those or do you have some short snippet that
> > could verify the errors work properly?
> 
> The testcase was designed to verify correct simplification of
> substring length for a variety of cases.
> 
> I played with variations of the testcase by specifying illegal
> substring bounds, but all these cases were caught in a different
> spot with similar error messages.
> 
> I put those checks into substring_has_constant_len as sanity checks.
> Do you want me to remove them?
> 
> Or are you trying to say that it is important to exercise them?

Not a big deal, just wanted to verify that it actually works on i686-linux.
Please just go ahead and commit the patch to avoid the bootstrap failures.

Thanks.

	Jakub

[PATCH, committed] Fix bootstrap breakage caused by r12-3033 (PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514)

[Harald Anlauf]

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

Dear all,

I've just pushed the fix for the bootstrap breakage as confirmed by Jakub.


commit r12-3043-g12f22906d3c025e7edb60e3264dc9cd27a49e3e1
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Fri Aug 20 13:38:00 2021 +0200

    Fortran - use temporary char buffer for passing HOST_WIDE_INT to gfc_error

    gcc/fortran/ChangeLog:

            PR fortran/100950
            * simplify.c (substring_has_constant_len): Fix format string of
            gfc_error, pass HOST_WIDE_INT bounds values via char buffer.


Sorry for the inconvenience.

Harald


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

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 492867e12cb..eaabbffca4d 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4552,11 +4552,12 @@ substring_has_constant_len (gfc_expr *e)

   if (istart <= iend)
     {
+      char buffer[21];
       if (istart < 1)
 	{
-	  gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
-		     ") at %L below 1",
-		     istart, &ref->u.ss.start->where);
+	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
+	  gfc_error ("Substring start index (%s) at %L below 1",
+		     buffer, &ref->u.ss.start->where);
 	  return false;
 	}

@@ -4567,9 +4568,9 @@ substring_has_constant_len (gfc_expr *e)
 	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
       if (iend > length)
 	{
-	  gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
-		     ") at %L exceeds string length",
-		     iend, &ref->u.ss.end->where);
+	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
+	  gfc_error ("Substring end index (%s) at %L exceeds string length",
+		     buffer, &ref->u.ss.end->where);
 	  return false;
 	}
       length = iend - istart + 1;

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

[Tobias Burnus]

On 20.08.21 12:53, Harald Anlauf wrote:

>> I have verified it fixes i686-linux bootstrap.
>> But the new testcase doesn't trigger any of those new errors, is something
>> else in the testsuite covering those or do you have some short snippet that
>> could verify the errors work properly?
> The testcase was designed to verify correct simplification of
> substring length for a variety of cases.
>
> I played with variations of the testcase by specifying illegal
> substring bounds, but all these cases were caught in a different
> spot with similar error messages.

I can confirm this. – I think in order to reduce the clutter, the
diagnostic probably should be removed.

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

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

[Harald Anlauf]

> Gesendet: Freitag, 20. August 2021 um 14:01 Uhr
> Von: "Tobias Burnus" <tobias@codesourcery.com>
> On 20.08.21 12:53, Harald Anlauf wrote:
> 
> > I played with variations of the testcase by specifying illegal
> > substring bounds, but all these cases were caught in a different
> > spot with similar error messages.
> 
> I can confirm this. – I think in order to reduce the clutter, the
> diagnostic probably should be removed.

I am unable to prove that we will never that check.  So how about:

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index eaabbffca4d..04722a8640c 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4552,27 +4552,13 @@ substring_has_constant_len (gfc_expr *e)
 
   if (istart <= iend)
     {
-      char buffer[21];
-      if (istart < 1)
-       {
-         sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
-         gfc_error ("Substring start index (%s) at %L below 1",
-                    buffer, &ref->u.ss.start->where);
-         return false;
-       }
-
       /* For deferred strings use end index as proxy for length.  */
       if (e->ts.deferred)
        length = iend;
       else
        length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
-      if (iend > length)
-       {
-         sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
-         gfc_error ("Substring end index (%s) at %L exceeds string length",
-                    buffer, &ref->u.ss.end->where);
-         return false;
-       }
+
+      gcc_assert (istart >= 1 && iend <= length);
       length = iend - istart + 1;
     }
   else

Or skip the gcc_assert and cross fingers... (we then would not even need to
verify ref->u.ss.length in that depth).

Harald

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

[Tobias Burnus]

Hi Harald,

On 20.08.21 14:17, Harald Anlauf wrote:
>> I can confirm this. – I think in order to reduce the clutter, the
>> diagnostic probably should be removed.
> I am unable to prove that we will never that check.  So how about:
> diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
> index eaabbffca4d..04722a8640c 100644
> --- a/gcc/fortran/simplify.c
> +++ b/gcc/fortran/simplify.c
> @@ -4552,27 +4552,13 @@ substring_has_constant_len (gfc_expr *e)
>
>     if (istart <= iend)
>       {
> -      char buffer[21];
> -      if (istart < 1)
> -       {
> -         sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
> -         gfc_error ("Substring start index (%s) at %L below 1",
> -                    buffer, &ref->u.ss.start->where);
> -         return false;
> -       }
> -
>         /* For deferred strings use end index as proxy for length.  */
>         if (e->ts.deferred)
>          length = iend;
>         else
>          length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
> -      if (iend > length)
> -       {
> -         sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
> -         gfc_error ("Substring end index (%s) at %L exceeds string length",
> -                    buffer, &ref->u.ss.end->where);
> -         return false;
> -       }
> +
> +      gcc_assert (istart >= 1 && iend <= length);
>         length = iend - istart + 1;
>       }
>     else
>
> Or skip the gcc_assert and cross fingers... (we then would not even need to
> verify ref->u.ss.length in that depth).

LGTM – I am fine with either variant, but I am slightly inclined to
removing the gcc_assert*
– as I believe that the existing checks come early enough and do seem to
work well.

Can you check ('grep') whether we already have sufficient coverage of
substring out of bounds?
We presumably have, but if you spot something, I think it makes sense to
add those to the testsuite.

Tobias
*I think GCC won't complain but if ENABLE_ASSERT_CHECKING is not defined,
there is then a pointless 'length =' assignment, overridden before it is
ever used.

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

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

[Harald Anlauf]

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

Hi Tobias,

> LGTM – I am fine with either variant, but I am slightly inclined to
> removing the gcc_assert*
> – as I believe that the existing checks come early enough and do seem to
> work well.

I played some more and found additional cases that we hadn't discussed
before.  (At least I hadn't thought of them because of the focus on
deferred length strings.)

- automatic string variables / arrays
- assumed length strings
- PDTs with character components.

The last one actually turned out sort of "hopeless" for now, so I opened

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

to track this.

I added the other cases to testcase pr100950.f90 and reduced the checks
and code within "substring_has_constant_len" to the bare minimum.
See the attached follow-up patch.

> Can you check ('grep') whether we already have sufficient coverage of
> substring out of bounds?
> We presumably have, but if you spot something, I think it makes sense to
> add those to the testsuite.

We do have some checks on substring indices (e.g. substr_10.f90),
but not really extensive coverage.

> Tobias
> *I think GCC won't complain but if ENABLE_ASSERT_CHECKING is not defined,
> there is then a pointless 'length =' assignment, overridden before it is
> ever used.

Yes.  This is fixed below.

I guess I have to apologize for things getting a bit out of control for
this PR, but the results are on the other hand way beyond my initial
expectations...

Re-regtested on x86_64-pc-linux-gnu.  Should be safe elsewhere...

OK?

Thanks,
Harald


Fortran - extend set of substring expressions handled in length simplification

gcc/fortran/ChangeLog:

	PR fortran/100950
	* simplify.c (substring_has_constant_len): Minimize checks for
	substring expressions being allowed.

gcc/testsuite/ChangeLog:

	PR fortran/100950
	* gfortran.dg/pr100950.f90: Extend coverage.


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

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 4cb73e836c7..b46cbfa90ab 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4533,14 +4533,7 @@ substring_has_constant_len (gfc_expr *e)
       || !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)
-    return false;
-
-  /* For non-deferred strings the given length shall be constant.  */
-  if (!e->ts.deferred
-      && (!ref->u.ss.length->length
-	  || ref->u.ss.length->length->expr_type != EXPR_CONSTANT))
+      || ref->u.ss.end->expr_type != EXPR_CONSTANT)
     return false;

   /* Basic checks on substring starting and ending indices.  */
@@ -4551,27 +4544,7 @@ substring_has_constant_len (gfc_expr *e)
   iend = gfc_mpz_get_hwi (ref->u.ss.end->value.integer);

   if (istart <= iend)
-    {
-      if (istart < 1)
-	{
-	  gfc_error ("Substring start index (%wd) at %L below 1",
-		     istart, &ref->u.ss.start->where);
-	  return false;
-	}
-
-      /* For deferred strings use end index as proxy for length.  */
-      if (e->ts.deferred)
-	length = iend;
-      else
-	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
-      if (iend > length)
-	{
-	  gfc_error ("Substring end index (%wd) at %L exceeds string length",
-		     iend, &ref->u.ss.end->where);
-	  return false;
-	}
-      length = iend - istart + 1;
-    }
+    length = iend - istart + 1;
   else
     length = 0;

diff --git a/gcc/testsuite/gfortran.dg/pr100950.f90 b/gcc/testsuite/gfortran.dg/pr100950.f90
index cb9d126bc18..a19409c2507 100644
--- a/gcc/testsuite/gfortran.dg/pr100950.f90
+++ b/gcc/testsuite/gfortran.dg/pr100950.f90
@@ -46,6 +46,18 @@ program p
     integer, parameter :: l9 = len (r(1)%u(:)(3:4))
     if (l9 /= 2) stop 13
   end block
+
+  call sub (42, "abcde")
+contains
+  subroutine sub (m, c)
+    integer,          intent(in) :: m
+    character(len=*), intent(in) :: c
+    character(len=m)    :: p, o(3)
+    integer, parameter  :: l10 = len (p(6:7))
+    integer, parameter  :: l11 = len (o(:)(6:7))
+    integer, parameter  :: l12 = len (c(2:3))
+    if (l10 /= 2 .or. l11 /= 2 .or. l12 /= 2) stop 14
+  end subroutine sub
 end

 ! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 2 "original" } }

[Patch] c-format.c/Fortran: Support %wd / host-wide integer in gfc_error (Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514)

[Tobias Burnus]

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

On 20.08.21 11:16, Jakub Jelinek wrote:

> Now, the non-Fortran FE diagnostic code actually has %wd for this (w
> modifier like l modifier), which takes HOST_WIDE_INT/unsigned HOST_WIDE_INT
> argument and prints it.
>
> So, either you get through the hops to support that, unfortunately it isn't
> just adding support for that in fortran/error.c (error_print) and some
> helper functions, which wouldn't be that hard, just add 'w' next to 'l'
> handling, TYPE_* for that and union member etc., but one needs to modify
> c-family/c-format.c too to register the modifier so that gcc doesn't warn
> about it and knows the proper argument type etc.

That's what the attached patch does.

Build on x86-64 GNU Linux; I tried to build it with -m32 (cf. my
previous email) but as I did not run into the original issue, this does
not proof much.

Comments? OK?

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: omp-fortran-hwi.diff --]
[-- Type: text/x-patch, Size: 12585 bytes --]

c-format.c/Fortran: Support %wd / host-wide integer in gfc_error

This patch adds support for the 'll' (long double)
and 'w' (HOST_WIDE_INT) length modifiers to the
Fortran FE diagnostic function (gfc_error, gfc_warning, ...)

gcc/c-family/ChangeLog:

	* c-format.c (gcc_gfc_length_specs): Add 'll' and 'w'.
	(gcc_gfc_char_table): Add T9L_LL and T9L_ULL to
	"di" and "u", respecitively; fill with BADLEN to match
	size of 'types'.
	(get_init_dynamic_hwi): Split off from ...
	(init_dynamic_diag_info): ... here. Call it.
	(init_dynamic_gfc_info): Call it.

gcc/fortran/ChangeLog:

	* error.c
	(error_uinteger): Take 'long long unsigned' instead
	of 'long unsigned' as argumpent.
	(error_integer): Take 'long long' instead of 'long'.
	(error_hwuint, error_hwint): New.
	(error_print): Update to handle 'll' and 'w'
	length modifiers.
	* simplify.c (substring_has_constant_len): Replace
	HOST_WIDE_INT_PRINT_DEC by '%wd'.

diff --git a/gcc/c-family/c-format.c b/gcc/c-family/c-format.c
index 6fd0bb33d21..b4cb765a9d3 100644
--- a/gcc/c-family/c-format.c
+++ b/gcc/c-family/c-format.c
@@ -546,10 +546,11 @@ static const format_length_info strfmon_length_specs[] =
 };
 
 
-/* For now, the Fortran front-end routines only use l as length modifier.  */
+/* Length modifiers used by the fortran/error.c routines.  */
 static const format_length_info gcc_gfc_length_specs[] =
 {
-  { "l", FMT_LEN_l, STD_C89, NO_FMT, 0 },
+  { "l", FMT_LEN_l, STD_C89, "ll", FMT_LEN_ll, STD_C89, 0 },
+  { "w", FMT_LEN_w, STD_C89, NO_FMT, 0 },
   { NO_FMT, NO_FMT, 0 }
 };
 
@@ -821,10 +822,10 @@ static const format_char_info gcc_cxxdiag_char_table[] =
 static const format_char_info gcc_gfc_char_table[] =
 {
   /* C89 conversion specifiers.  */
-  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  T89_L,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "cR", NULL },
+  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  T89_L,   T9L_LL,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "", NULL },
+  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  T9L_ULL,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN  }, "q", "", NULL },
+  { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "", NULL },
+  { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "cR", NULL },
 
   /* gfc conversion specifiers.  */
 
@@ -4843,12 +4844,73 @@ init_dynamic_asm_fprintf_info (void)
     }
 }
 
+static const format_length_info*
+get_init_dynamic_hwi (void)
+{
+  static tree hwi;
+  static format_length_info *diag_ls;
+
+  if (!hwi)
+    {
+      unsigned int i;
+
+      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
+	 length modifier to work, one must have issued: "typedef
+	 HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
+	 prior to using that modifier.  */
+      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
+	{
+	  hwi = identifier_global_value (hwi);
+	  if (hwi)
+	    {
+	      if (TREE_CODE (hwi) != TYPE_DECL)
+		{
+		  error ("%<__gcc_host_wide_int__%> is not defined as a type");
+		  hwi = 0;
+		}
+	      else
+		{
+		  hwi = DECL_ORIGINAL_TYPE (hwi);
+		  gcc_assert (hwi);
+		  if (hwi != long_integer_type_node
+		      && hwi != long_long_integer_type_node)
+		    {
+		      error ("%<__gcc_host_wide_int__%> is not defined"
+			     " as %<long%> or %<long long%>");
+		      hwi = 0;
+		    }
+		}
+	    }
+	}
+      if (!diag_ls)
+	diag_ls = (format_length_info *)
+		  xmemdup (gcc_diag_length_specs,
+			   sizeof (gcc_diag_length_specs),
+			   sizeof (gcc_diag_length_specs));
+      if (hwi)
+	{
+	  /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
+	  i = find_length_info_modifier_index (diag_ls, 'w');
+	  if (hwi == long_integer_type_node)
+	    diag_ls[i].index = FMT_LEN_l;
+	  else if (hwi == long_long_integer_type_node)
+	    diag_ls[i].index = FMT_LEN_ll;
+	  else
+	    gcc_unreachable ();
+	}
+    }
+  return diag_ls;
+}
+
 /* Determine the type of a "locus" in the code being compiled for use
    in GCC's __gcc_gfc__ custom format attribute.  You must have set
    dynamic_format_types before calling this function.  */
 static void
 init_dynamic_gfc_info (void)
 {
+  dynamic_format_types[gcc_gfc_format_type].length_char_specs
+    = get_init_dynamic_hwi ();
+
   if (!locus)
     {
       static format_char_info *gfc_fci;
@@ -4985,67 +5047,13 @@ init_dynamic_diag_info (void)
       || local_event_ptr_node == void_type_node)
     local_event_ptr_node = get_named_type ("diagnostic_event_id_t");
 
-  static tree hwi;
-
-  if (!hwi)
-    {
-      static format_length_info *diag_ls;
-      unsigned int i;
-
-      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
-	 length modifier to work, one must have issued: "typedef
-	 HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
-	 prior to using that modifier.  */
-      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
-	{
-	  hwi = identifier_global_value (hwi);
-	  if (hwi)
-	    {
-	      if (TREE_CODE (hwi) != TYPE_DECL)
-		{
-		  error ("%<__gcc_host_wide_int__%> is not defined as a type");
-		  hwi = 0;
-		}
-	      else
-		{
-		  hwi = DECL_ORIGINAL_TYPE (hwi);
-		  gcc_assert (hwi);
-		  if (hwi != long_integer_type_node
-		      && hwi != long_long_integer_type_node)
-		    {
-		      error ("%<__gcc_host_wide_int__%> is not defined"
-			     " as %<long%> or %<long long%>");
-		      hwi = 0;
-		    }
-		}
-	    }
-	}
-
-      /* Assign the new data for use.  */
-
-      /* All the GCC diag formats use the same length specs.  */
-      if (!diag_ls)
-	dynamic_format_types[gcc_diag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_dump_printf_format_type].length_char_specs =
-	  diag_ls = (format_length_info *)
-		    xmemdup (gcc_diag_length_specs,
-			     sizeof (gcc_diag_length_specs),
-			     sizeof (gcc_diag_length_specs));
-      if (hwi)
-	{
-	  /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
-	  i = find_length_info_modifier_index (diag_ls, 'w');
-	  if (hwi == long_integer_type_node)
-	    diag_ls[i].index = FMT_LEN_l;
-	  else if (hwi == long_long_integer_type_node)
-	    diag_ls[i].index = FMT_LEN_ll;
-	  else
-	    gcc_unreachable ();
-	}
-    }
+  /* All the GCC diag formats use the same length specs.  */
+  dynamic_format_types[gcc_diag_format_type].length_char_specs =
+    dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_dump_printf_format_type].length_char_specs
+    = get_init_dynamic_hwi ();
 
   /* It's safe to "re-initialize these to the same values.  */
   dynamic_format_types[gcc_diag_format_type].conversion_specs =
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 529d97fff8a..5e6e87316a6 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -136,7 +136,7 @@ error_string (const char *p)
 #define IBUF_LEN 60
 
 static void
-error_uinteger (unsigned long int i)
+error_uinteger (unsigned long long int i)
 {
   char *p, int_buf[IBUF_LEN];
 
@@ -156,13 +156,50 @@ error_uinteger (unsigned long int i)
 }
 
 static void
-error_integer (long int i)
+error_integer (long long int i)
 {
-  unsigned long int u;
+  unsigned long long int u;
 
   if (i < 0)
     {
-      u = (unsigned long int) -i;
+      u = (unsigned long long int) -i;
+      error_char ('-');
+    }
+  else
+    u = i;
+
+  error_uinteger (u);
+}
+
+
+static void
+error_hwuint (unsigned HOST_WIDE_INT i)
+{
+  char *p, int_buf[IBUF_LEN];
+
+  p = int_buf + IBUF_LEN - 1;
+  *p-- = '\0';
+
+  if (i == 0)
+    *p-- = '0';
+
+  while (i > 0)
+    {
+      *p-- = i % 10 + '0';
+      i = i / 10;
+    }
+
+  error_string (p + 1);
+}
+
+static void
+error_hwint (HOST_WIDE_INT i)
+{
+  unsigned HOST_WIDE_INT u;
+
+  if (i < 0)
+    {
+      u = (unsigned HOST_WIDE_INT) -i;
       error_char ('-');
     }
   else
@@ -482,8 +519,8 @@ static void ATTRIBUTE_GCC_GFC(2,0)
 error_print (const char *type, const char *format0, va_list argp)
 {
   enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
-         TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
-	 NOTYPE };
+	 TYPE_LONGINT, TYPE_ULONGINT, TYPE_LLONGINT, TYPE_ULLONGINT,
+	 TYPE_HWINT, TYPE_HWUINT, TYPE_CHAR, TYPE_STRING, NOTYPE };
   struct
   {
     int type;
@@ -494,6 +531,10 @@ error_print (const char *type, const char *format0, va_list argp)
       unsigned int uintval;
       long int longintval;
       unsigned long int ulongintval;
+      long long int llongintval;
+      unsigned long long int ullongintval;
+      HOST_WIDE_INT hwintval;
+      unsigned HOST_WIDE_INT hwuintval;
       char charval;
       const char * stringval;
     } u;
@@ -577,7 +618,17 @@ error_print (const char *type, const char *format0, va_list argp)
 
 	  case 'l':
 	    c = *format++;
-	    if (c == 'u')
+	    if (c == 'l')
+	      {
+		c = *format++;
+		if (c == 'u')
+		  arg[pos].type = TYPE_ULLONGINT;
+		else if (c == 'i' || c == 'd')
+		  arg[pos].type = TYPE_LLONGINT;
+		else
+		  gcc_unreachable ();
+	      }
+	    else if (c == 'u')
 	      arg[pos].type = TYPE_ULONGINT;
 	    else if (c == 'i' || c == 'd')
 	      arg[pos].type = TYPE_LONGINT;
@@ -585,6 +636,16 @@ error_print (const char *type, const char *format0, va_list argp)
 	      gcc_unreachable ();
 	    break;
 
+	  case 'w':
+	    c = *format++;
+	    if (c == 'u')
+	      arg[pos].type = TYPE_HWUINT;
+	    else if (c == 'i' || c == 'd')
+	      arg[pos].type = TYPE_HWINT;
+	    else
+	      gcc_unreachable ();
+	    break;
+
 	  case 'c':
 	    arg[pos].type = TYPE_CHAR;
 	    break;
@@ -649,6 +710,22 @@ error_print (const char *type, const char *format0, va_list argp)
 	    arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
 	    break;
 
+	  case TYPE_LLONGINT:
+	    arg[pos].u.llongintval = va_arg (argp, long long int);
+	    break;
+
+	  case TYPE_ULLONGINT:
+	    arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
+	    break;
+
+	  case TYPE_HWINT:
+	    arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
+	    break;
+
+	  case TYPE_HWUINT:
+	    arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
+	    break;
+
 	  case TYPE_CHAR:
 	    arg[pos].u.charval = (char) va_arg (argp, int);
 	    break;
@@ -725,12 +802,27 @@ error_print (const char *type, const char *format0, va_list argp)
 
 	case 'l':
 	  format++;
+	  if (*format == 'l')
+	    {
+	      format++;
+	      if (*format == 'u')
+		error_uinteger (spec[n++].u.ullongintval);
+	      else
+		error_integer (spec[n++].u.llongintval);
+	    }
 	  if (*format == 'u')
 	    error_uinteger (spec[n++].u.ulongintval);
 	  else
 	    error_integer (spec[n++].u.longintval);
 	  break;
 
+	case 'w':
+	  format++;
+	  if (*format == 'u')
+	    error_hwuint (spec[n++].u.hwintval);
+	  else
+	    error_hwint (spec[n++].u.hwuintval);
+	  break;
 	}
     }
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 492867e12cb..4cb73e836c7 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4554,8 +4554,7 @@ substring_has_constant_len (gfc_expr *e)
     {
       if (istart < 1)
 	{
-	  gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
-		     ") at %L below 1",
+	  gfc_error ("Substring start index (%wd) at %L below 1",
 		     istart, &ref->u.ss.start->where);
 	  return false;
 	}
@@ -4567,8 +4566,7 @@ substring_has_constant_len (gfc_expr *e)
 	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
       if (iend > length)
 	{
-	  gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
-		     ") at %L exceeds string length",
+	  gfc_error ("Substring end index (%wd) at %L exceeds string length",
 		     iend, &ref->u.ss.end->where);
 	  return false;
 	}

Re: [Patch] c-format.c/Fortran: Support %wd / host-wide integer in gfc_error (Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514)

[Jakub Jelinek]

On Fri, Aug 20, 2021 at 01:50:00PM +0200, Tobias Burnus wrote:
> On 20.08.21 11:16, Jakub Jelinek wrote:
> 
> > Now, the non-Fortran FE diagnostic code actually has %wd for this (w
> > modifier like l modifier), which takes HOST_WIDE_INT/unsigned HOST_WIDE_INT
> > argument and prints it.
> > 
> > So, either you get through the hops to support that, unfortunately it isn't
> > just adding support for that in fortran/error.c (error_print) and some
> > helper functions, which wouldn't be that hard, just add 'w' next to 'l'
> > handling, TYPE_* for that and union member etc., but one needs to modify
> > c-family/c-format.c too to register the modifier so that gcc doesn't warn
> > about it and knows the proper argument type etc.
> 
> That's what the attached patch does.
> 
> Build on x86-64 GNU Linux; I tried to build it with -m32 (cf. my
> previous email) but as I did not run into the original issue, this does
> not proof much.
> 
> Comments? OK?

LGTM (except that the last hunk won't apply anymore).

> c-format.c/Fortran: Support %wd / host-wide integer in gfc_error
> 
> This patch adds support for the 'll' (long double)
> and 'w' (HOST_WIDE_INT) length modifiers to the
> Fortran FE diagnostic function (gfc_error, gfc_warning, ...)
> 
> gcc/c-family/ChangeLog:
> 
> 	* c-format.c (gcc_gfc_length_specs): Add 'll' and 'w'.
> 	(gcc_gfc_char_table): Add T9L_LL and T9L_ULL to
> 	"di" and "u", respecitively; fill with BADLEN to match
> 	size of 'types'.
> 	(get_init_dynamic_hwi): Split off from ...
> 	(init_dynamic_diag_info): ... here. Call it.
> 	(init_dynamic_gfc_info): Call it.
> 
> gcc/fortran/ChangeLog:
> 
> 	* error.c
> 	(error_uinteger): Take 'long long unsigned' instead
> 	of 'long unsigned' as argumpent.
> 	(error_integer): Take 'long long' instead of 'long'.
> 	(error_hwuint, error_hwint): New.
> 	(error_print): Update to handle 'll' and 'w'
> 	length modifiers.
> 	* simplify.c (substring_has_constant_len): Replace
> 	HOST_WIDE_INT_PRINT_DEC by '%wd'.
> 
> diff --git a/gcc/c-family/c-format.c b/gcc/c-family/c-format.c
> index 6fd0bb33d21..b4cb765a9d3 100644
> --- a/gcc/c-family/c-format.c
> +++ b/gcc/c-family/c-format.c
> @@ -546,10 +546,11 @@ static const format_length_info strfmon_length_specs[] =
>  };
>  
>  
> -/* For now, the Fortran front-end routines only use l as length modifier.  */
> +/* Length modifiers used by the fortran/error.c routines.  */
>  static const format_length_info gcc_gfc_length_specs[] =
>  {
> -  { "l", FMT_LEN_l, STD_C89, NO_FMT, 0 },
> +  { "l", FMT_LEN_l, STD_C89, "ll", FMT_LEN_ll, STD_C89, 0 },
> +  { "w", FMT_LEN_w, STD_C89, NO_FMT, 0 },
>    { NO_FMT, NO_FMT, 0 }
>  };
>  
> @@ -821,10 +822,10 @@ static const format_char_info gcc_cxxdiag_char_table[] =
>  static const format_char_info gcc_gfc_char_table[] =
>  {
>    /* C89 conversion specifiers.  */
> -  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  T89_L,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
> -  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
> -  { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
> -  { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "cR", NULL },
> +  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  T89_L,   T9L_LL,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "", NULL },
> +  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  T9L_ULL,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN  }, "q", "", NULL },
> +  { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "", NULL },
> +  { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "cR", NULL },
>  
>    /* gfc conversion specifiers.  */
>  
> @@ -4843,12 +4844,73 @@ init_dynamic_asm_fprintf_info (void)
>      }
>  }
>  
> +static const format_length_info*
> +get_init_dynamic_hwi (void)
> +{
> +  static tree hwi;
> +  static format_length_info *diag_ls;
> +
> +  if (!hwi)
> +    {
> +      unsigned int i;
> +
> +      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
> +	 length modifier to work, one must have issued: "typedef
> +	 HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
> +	 prior to using that modifier.  */
> +      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
> +	{
> +	  hwi = identifier_global_value (hwi);
> +	  if (hwi)
> +	    {
> +	      if (TREE_CODE (hwi) != TYPE_DECL)
> +		{
> +		  error ("%<__gcc_host_wide_int__%> is not defined as a type");
> +		  hwi = 0;
> +		}
> +	      else
> +		{
> +		  hwi = DECL_ORIGINAL_TYPE (hwi);
> +		  gcc_assert (hwi);
> +		  if (hwi != long_integer_type_node
> +		      && hwi != long_long_integer_type_node)
> +		    {
> +		      error ("%<__gcc_host_wide_int__%> is not defined"
> +			     " as %<long%> or %<long long%>");
> +		      hwi = 0;
> +		    }
> +		}
> +	    }
> +	}
> +      if (!diag_ls)
> +	diag_ls = (format_length_info *)
> +		  xmemdup (gcc_diag_length_specs,
> +			   sizeof (gcc_diag_length_specs),
> +			   sizeof (gcc_diag_length_specs));
> +      if (hwi)
> +	{
> +	  /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
> +	  i = find_length_info_modifier_index (diag_ls, 'w');
> +	  if (hwi == long_integer_type_node)
> +	    diag_ls[i].index = FMT_LEN_l;
> +	  else if (hwi == long_long_integer_type_node)
> +	    diag_ls[i].index = FMT_LEN_ll;
> +	  else
> +	    gcc_unreachable ();
> +	}
> +    }
> +  return diag_ls;
> +}
> +
>  /* Determine the type of a "locus" in the code being compiled for use
>     in GCC's __gcc_gfc__ custom format attribute.  You must have set
>     dynamic_format_types before calling this function.  */
>  static void
>  init_dynamic_gfc_info (void)
>  {
> +  dynamic_format_types[gcc_gfc_format_type].length_char_specs
> +    = get_init_dynamic_hwi ();
> +
>    if (!locus)
>      {
>        static format_char_info *gfc_fci;
> @@ -4985,67 +5047,13 @@ init_dynamic_diag_info (void)
>        || local_event_ptr_node == void_type_node)
>      local_event_ptr_node = get_named_type ("diagnostic_event_id_t");
>  
> -  static tree hwi;
> -
> -  if (!hwi)
> -    {
> -      static format_length_info *diag_ls;
> -      unsigned int i;
> -
> -      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
> -	 length modifier to work, one must have issued: "typedef
> -	 HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
> -	 prior to using that modifier.  */
> -      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
> -	{
> -	  hwi = identifier_global_value (hwi);
> -	  if (hwi)
> -	    {
> -	      if (TREE_CODE (hwi) != TYPE_DECL)
> -		{
> -		  error ("%<__gcc_host_wide_int__%> is not defined as a type");
> -		  hwi = 0;
> -		}
> -	      else
> -		{
> -		  hwi = DECL_ORIGINAL_TYPE (hwi);
> -		  gcc_assert (hwi);
> -		  if (hwi != long_integer_type_node
> -		      && hwi != long_long_integer_type_node)
> -		    {
> -		      error ("%<__gcc_host_wide_int__%> is not defined"
> -			     " as %<long%> or %<long long%>");
> -		      hwi = 0;
> -		    }
> -		}
> -	    }
> -	}
> -
> -      /* Assign the new data for use.  */
> -
> -      /* All the GCC diag formats use the same length specs.  */
> -      if (!diag_ls)
> -	dynamic_format_types[gcc_diag_format_type].length_char_specs =
> -	  dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
> -	  dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
> -	  dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
> -	  dynamic_format_types[gcc_dump_printf_format_type].length_char_specs =
> -	  diag_ls = (format_length_info *)
> -		    xmemdup (gcc_diag_length_specs,
> -			     sizeof (gcc_diag_length_specs),
> -			     sizeof (gcc_diag_length_specs));
> -      if (hwi)
> -	{
> -	  /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
> -	  i = find_length_info_modifier_index (diag_ls, 'w');
> -	  if (hwi == long_integer_type_node)
> -	    diag_ls[i].index = FMT_LEN_l;
> -	  else if (hwi == long_long_integer_type_node)
> -	    diag_ls[i].index = FMT_LEN_ll;
> -	  else
> -	    gcc_unreachable ();
> -	}
> -    }
> +  /* All the GCC diag formats use the same length specs.  */
> +  dynamic_format_types[gcc_diag_format_type].length_char_specs =
> +    dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
> +    dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
> +    dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
> +    dynamic_format_types[gcc_dump_printf_format_type].length_char_specs
> +    = get_init_dynamic_hwi ();
>  
>    /* It's safe to "re-initialize these to the same values.  */
>    dynamic_format_types[gcc_diag_format_type].conversion_specs =
> diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
> index 529d97fff8a..5e6e87316a6 100644
> --- a/gcc/fortran/error.c
> +++ b/gcc/fortran/error.c
> @@ -136,7 +136,7 @@ error_string (const char *p)
>  #define IBUF_LEN 60
>  
>  static void
> -error_uinteger (unsigned long int i)
> +error_uinteger (unsigned long long int i)
>  {
>    char *p, int_buf[IBUF_LEN];
>  
> @@ -156,13 +156,50 @@ error_uinteger (unsigned long int i)
>  }
>  
>  static void
> -error_integer (long int i)
> +error_integer (long long int i)
>  {
> -  unsigned long int u;
> +  unsigned long long int u;
>  
>    if (i < 0)
>      {
> -      u = (unsigned long int) -i;
> +      u = (unsigned long long int) -i;
> +      error_char ('-');
> +    }
> +  else
> +    u = i;
> +
> +  error_uinteger (u);
> +}
> +
> +
> +static void
> +error_hwuint (unsigned HOST_WIDE_INT i)
> +{
> +  char *p, int_buf[IBUF_LEN];
> +
> +  p = int_buf + IBUF_LEN - 1;
> +  *p-- = '\0';
> +
> +  if (i == 0)
> +    *p-- = '0';
> +
> +  while (i > 0)
> +    {
> +      *p-- = i % 10 + '0';
> +      i = i / 10;
> +    }
> +
> +  error_string (p + 1);
> +}
> +
> +static void
> +error_hwint (HOST_WIDE_INT i)
> +{
> +  unsigned HOST_WIDE_INT u;
> +
> +  if (i < 0)
> +    {
> +      u = (unsigned HOST_WIDE_INT) -i;
>        error_char ('-');
>      }
>    else
> @@ -482,8 +519,8 @@ static void ATTRIBUTE_GCC_GFC(2,0)
>  error_print (const char *type, const char *format0, va_list argp)
>  {
>    enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
> -         TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
> -	 NOTYPE };
> +	 TYPE_LONGINT, TYPE_ULONGINT, TYPE_LLONGINT, TYPE_ULLONGINT,
> +	 TYPE_HWINT, TYPE_HWUINT, TYPE_CHAR, TYPE_STRING, NOTYPE };
>    struct
>    {
>      int type;
> @@ -494,6 +531,10 @@ error_print (const char *type, const char *format0, va_list argp)
>        unsigned int uintval;
>        long int longintval;
>        unsigned long int ulongintval;
> +      long long int llongintval;
> +      unsigned long long int ullongintval;
> +      HOST_WIDE_INT hwintval;
> +      unsigned HOST_WIDE_INT hwuintval;
>        char charval;
>        const char * stringval;
>      } u;
> @@ -577,7 +618,17 @@ error_print (const char *type, const char *format0, va_list argp)
>  
>  	  case 'l':
>  	    c = *format++;
> -	    if (c == 'u')
> +	    if (c == 'l')
> +	      {
> +		c = *format++;
> +		if (c == 'u')
> +		  arg[pos].type = TYPE_ULLONGINT;
> +		else if (c == 'i' || c == 'd')
> +		  arg[pos].type = TYPE_LLONGINT;
> +		else
> +		  gcc_unreachable ();
> +	      }
> +	    else if (c == 'u')
>  	      arg[pos].type = TYPE_ULONGINT;
>  	    else if (c == 'i' || c == 'd')
>  	      arg[pos].type = TYPE_LONGINT;
> @@ -585,6 +636,16 @@ error_print (const char *type, const char *format0, va_list argp)
>  	      gcc_unreachable ();
>  	    break;
>  
> +	  case 'w':
> +	    c = *format++;
> +	    if (c == 'u')
> +	      arg[pos].type = TYPE_HWUINT;
> +	    else if (c == 'i' || c == 'd')
> +	      arg[pos].type = TYPE_HWINT;
> +	    else
> +	      gcc_unreachable ();
> +	    break;
> +
>  	  case 'c':
>  	    arg[pos].type = TYPE_CHAR;
>  	    break;
> @@ -649,6 +710,22 @@ error_print (const char *type, const char *format0, va_list argp)
>  	    arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
>  	    break;
>  
> +	  case TYPE_LLONGINT:
> +	    arg[pos].u.llongintval = va_arg (argp, long long int);
> +	    break;
> +
> +	  case TYPE_ULLONGINT:
> +	    arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
> +	    break;
> +
> +	  case TYPE_HWINT:
> +	    arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
> +	    break;
> +
> +	  case TYPE_HWUINT:
> +	    arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
> +	    break;
> +
>  	  case TYPE_CHAR:
>  	    arg[pos].u.charval = (char) va_arg (argp, int);
>  	    break;
> @@ -725,12 +802,27 @@ error_print (const char *type, const char *format0, va_list argp)
>  
>  	case 'l':
>  	  format++;
> +	  if (*format == 'l')
> +	    {
> +	      format++;
> +	      if (*format == 'u')
> +		error_uinteger (spec[n++].u.ullongintval);
> +	      else
> +		error_integer (spec[n++].u.llongintval);
> +	    }
>  	  if (*format == 'u')
>  	    error_uinteger (spec[n++].u.ulongintval);
>  	  else
>  	    error_integer (spec[n++].u.longintval);
>  	  break;
>  
> +	case 'w':
> +	  format++;
> +	  if (*format == 'u')
> +	    error_hwuint (spec[n++].u.hwintval);
> +	  else
> +	    error_hwint (spec[n++].u.hwuintval);
> +	  break;
>  	}
>      }
>  
> diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
> index 492867e12cb..4cb73e836c7 100644
> --- a/gcc/fortran/simplify.c
> +++ b/gcc/fortran/simplify.c
> @@ -4554,8 +4554,7 @@ substring_has_constant_len (gfc_expr *e)
>      {
>        if (istart < 1)
>  	{
> -	  gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
> -		     ") at %L below 1",
> +	  gfc_error ("Substring start index (%wd) at %L below 1",
>  		     istart, &ref->u.ss.start->where);
>  	  return false;
>  	}
> @@ -4567,8 +4566,7 @@ substring_has_constant_len (gfc_expr *e)
>  	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
>        if (iend > length)
>  	{
> -	  gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
> -		     ") at %L exceeds string length",
> +	  gfc_error ("Substring end index (%wd) at %L exceeds string length",
>  		     iend, &ref->u.ss.end->where);
>  	  return false;
>  	}


	Jakub

Re: [Patch] c-format.c/Fortran: Support %wd / host-wide integer in gfc_error (Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514)

[Tobias Burnus]

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

On 20.08.21 13:56, Jakub Jelinek wrote:

> On Fri, Aug 20, 2021 at 01:50:00PM +0200, Tobias Burnus wrote:
>> Comments? OK?
> LGTM (except that the last hunk won't apply anymore).

Now applied as r12-3044; I have now changed it to %wd ...

... but as discussed in another email in the thread, I think the
gfc_error should be removed (as unused); possibly with some additional
testcases running into the resolve errors for those (out of bound).

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: committed.diff --]
[-- Type: text/x-patch, Size: 13376 bytes --]

commit 1b507b1e3c58c063b9cf803dff80c28d4626cb5d
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Fri Aug 20 15:43:32 2021 +0200

    c-format.c/Fortran: Support %wd / host-wide integer in gfc_error
    
    This patch adds support for the 'll' (long double)
    and 'w' (HOST_WIDE_INT) length modifiers to the
    Fortran FE diagnostic function (gfc_error, gfc_warning, ...)
    
    gcc/c-family/ChangeLog:
    
            * c-format.c (gcc_gfc_length_specs): Add 'll' and 'w'.
            (gcc_gfc_char_table): Add T9L_LL and T9L_ULL to
            "di" and "u", respecitively; fill with BADLEN to match
            size of 'types'.
            (get_init_dynamic_hwi): Split off from ...
            (init_dynamic_diag_info): ... here. Call it.
            (init_dynamic_gfc_info): Call it.
    
    gcc/fortran/ChangeLog:
    
            * error.c
            (error_uinteger): Take 'long long unsigned' instead
            of 'long unsigned' as argumpent.
            (error_integer): Take 'long long' instead of 'long'.
            (error_hwuint, error_hwint): New.
            (error_print): Update to handle 'll' and 'w'
            length modifiers.
            * simplify.c (substring_has_constant_len): Use '%wd'
            in gfc_error.
---
 gcc/c-family/c-format.c | 142 +++++++++++++++++++++++++-----------------------
 gcc/fortran/error.c     | 106 +++++++++++++++++++++++++++++++++---
 gcc/fortran/simplify.c  |  11 ++--
 3 files changed, 178 insertions(+), 81 deletions(-)

diff --git a/gcc/c-family/c-format.c b/gcc/c-family/c-format.c
index 6fd0bb33d21..b4cb765a9d3 100644
--- a/gcc/c-family/c-format.c
+++ b/gcc/c-family/c-format.c
@@ -546,10 +546,11 @@ static const format_length_info strfmon_length_specs[] =
 };
 
 
-/* For now, the Fortran front-end routines only use l as length modifier.  */
+/* Length modifiers used by the fortran/error.c routines.  */
 static const format_length_info gcc_gfc_length_specs[] =
 {
-  { "l", FMT_LEN_l, STD_C89, NO_FMT, 0 },
+  { "l", FMT_LEN_l, STD_C89, "ll", FMT_LEN_ll, STD_C89, 0 },
+  { "w", FMT_LEN_w, STD_C89, NO_FMT, 0 },
   { NO_FMT, NO_FMT, 0 }
 };
 
@@ -821,10 +822,10 @@ static const format_char_info gcc_cxxdiag_char_table[] =
 static const format_char_info gcc_gfc_char_table[] =
 {
   /* C89 conversion specifiers.  */
-  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  T89_L,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "cR", NULL },
+  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  T89_L,   T9L_LL,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "", NULL },
+  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  T9L_ULL,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN  }, "q", "", NULL },
+  { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "", NULL },
+  { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "cR", NULL },
 
   /* gfc conversion specifiers.  */
 
@@ -4843,12 +4844,73 @@ init_dynamic_asm_fprintf_info (void)
     }
 }
 
+static const format_length_info*
+get_init_dynamic_hwi (void)
+{
+  static tree hwi;
+  static format_length_info *diag_ls;
+
+  if (!hwi)
+    {
+      unsigned int i;
+
+      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
+	 length modifier to work, one must have issued: "typedef
+	 HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
+	 prior to using that modifier.  */
+      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
+	{
+	  hwi = identifier_global_value (hwi);
+	  if (hwi)
+	    {
+	      if (TREE_CODE (hwi) != TYPE_DECL)
+		{
+		  error ("%<__gcc_host_wide_int__%> is not defined as a type");
+		  hwi = 0;
+		}
+	      else
+		{
+		  hwi = DECL_ORIGINAL_TYPE (hwi);
+		  gcc_assert (hwi);
+		  if (hwi != long_integer_type_node
+		      && hwi != long_long_integer_type_node)
+		    {
+		      error ("%<__gcc_host_wide_int__%> is not defined"
+			     " as %<long%> or %<long long%>");
+		      hwi = 0;
+		    }
+		}
+	    }
+	}
+      if (!diag_ls)
+	diag_ls = (format_length_info *)
+		  xmemdup (gcc_diag_length_specs,
+			   sizeof (gcc_diag_length_specs),
+			   sizeof (gcc_diag_length_specs));
+      if (hwi)
+	{
+	  /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
+	  i = find_length_info_modifier_index (diag_ls, 'w');
+	  if (hwi == long_integer_type_node)
+	    diag_ls[i].index = FMT_LEN_l;
+	  else if (hwi == long_long_integer_type_node)
+	    diag_ls[i].index = FMT_LEN_ll;
+	  else
+	    gcc_unreachable ();
+	}
+    }
+  return diag_ls;
+}
+
 /* Determine the type of a "locus" in the code being compiled for use
    in GCC's __gcc_gfc__ custom format attribute.  You must have set
    dynamic_format_types before calling this function.  */
 static void
 init_dynamic_gfc_info (void)
 {
+  dynamic_format_types[gcc_gfc_format_type].length_char_specs
+    = get_init_dynamic_hwi ();
+
   if (!locus)
     {
       static format_char_info *gfc_fci;
@@ -4985,67 +5047,13 @@ init_dynamic_diag_info (void)
       || local_event_ptr_node == void_type_node)
     local_event_ptr_node = get_named_type ("diagnostic_event_id_t");
 
-  static tree hwi;
-
-  if (!hwi)
-    {
-      static format_length_info *diag_ls;
-      unsigned int i;
-
-      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
-	 length modifier to work, one must have issued: "typedef
-	 HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
-	 prior to using that modifier.  */
-      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
-	{
-	  hwi = identifier_global_value (hwi);
-	  if (hwi)
-	    {
-	      if (TREE_CODE (hwi) != TYPE_DECL)
-		{
-		  error ("%<__gcc_host_wide_int__%> is not defined as a type");
-		  hwi = 0;
-		}
-	      else
-		{
-		  hwi = DECL_ORIGINAL_TYPE (hwi);
-		  gcc_assert (hwi);
-		  if (hwi != long_integer_type_node
-		      && hwi != long_long_integer_type_node)
-		    {
-		      error ("%<__gcc_host_wide_int__%> is not defined"
-			     " as %<long%> or %<long long%>");
-		      hwi = 0;
-		    }
-		}
-	    }
-	}
-
-      /* Assign the new data for use.  */
-
-      /* All the GCC diag formats use the same length specs.  */
-      if (!diag_ls)
-	dynamic_format_types[gcc_diag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_dump_printf_format_type].length_char_specs =
-	  diag_ls = (format_length_info *)
-		    xmemdup (gcc_diag_length_specs,
-			     sizeof (gcc_diag_length_specs),
-			     sizeof (gcc_diag_length_specs));
-      if (hwi)
-	{
-	  /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
-	  i = find_length_info_modifier_index (diag_ls, 'w');
-	  if (hwi == long_integer_type_node)
-	    diag_ls[i].index = FMT_LEN_l;
-	  else if (hwi == long_long_integer_type_node)
-	    diag_ls[i].index = FMT_LEN_ll;
-	  else
-	    gcc_unreachable ();
-	}
-    }
+  /* All the GCC diag formats use the same length specs.  */
+  dynamic_format_types[gcc_diag_format_type].length_char_specs =
+    dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_dump_printf_format_type].length_char_specs
+    = get_init_dynamic_hwi ();
 
   /* It's safe to "re-initialize these to the same values.  */
   dynamic_format_types[gcc_diag_format_type].conversion_specs =
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 529d97fff8a..5e6e87316a6 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -136,7 +136,7 @@ error_string (const char *p)
 #define IBUF_LEN 60
 
 static void
-error_uinteger (unsigned long int i)
+error_uinteger (unsigned long long int i)
 {
   char *p, int_buf[IBUF_LEN];
 
@@ -156,13 +156,50 @@ error_uinteger (unsigned long int i)
 }
 
 static void
-error_integer (long int i)
+error_integer (long long int i)
 {
-  unsigned long int u;
+  unsigned long long int u;
 
   if (i < 0)
     {
-      u = (unsigned long int) -i;
+      u = (unsigned long long int) -i;
+      error_char ('-');
+    }
+  else
+    u = i;
+
+  error_uinteger (u);
+}
+
+
+static void
+error_hwuint (unsigned HOST_WIDE_INT i)
+{
+  char *p, int_buf[IBUF_LEN];
+
+  p = int_buf + IBUF_LEN - 1;
+  *p-- = '\0';
+
+  if (i == 0)
+    *p-- = '0';
+
+  while (i > 0)
+    {
+      *p-- = i % 10 + '0';
+      i = i / 10;
+    }
+
+  error_string (p + 1);
+}
+
+static void
+error_hwint (HOST_WIDE_INT i)
+{
+  unsigned HOST_WIDE_INT u;
+
+  if (i < 0)
+    {
+      u = (unsigned HOST_WIDE_INT) -i;
       error_char ('-');
     }
   else
@@ -482,8 +519,8 @@ static void ATTRIBUTE_GCC_GFC(2,0)
 error_print (const char *type, const char *format0, va_list argp)
 {
   enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
-         TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
-	 NOTYPE };
+	 TYPE_LONGINT, TYPE_ULONGINT, TYPE_LLONGINT, TYPE_ULLONGINT,
+	 TYPE_HWINT, TYPE_HWUINT, TYPE_CHAR, TYPE_STRING, NOTYPE };
   struct
   {
     int type;
@@ -494,6 +531,10 @@ error_print (const char *type, const char *format0, va_list argp)
       unsigned int uintval;
       long int longintval;
       unsigned long int ulongintval;
+      long long int llongintval;
+      unsigned long long int ullongintval;
+      HOST_WIDE_INT hwintval;
+      unsigned HOST_WIDE_INT hwuintval;
       char charval;
       const char * stringval;
     } u;
@@ -577,7 +618,17 @@ error_print (const char *type, const char *format0, va_list argp)
 
 	  case 'l':
 	    c = *format++;
-	    if (c == 'u')
+	    if (c == 'l')
+	      {
+		c = *format++;
+		if (c == 'u')
+		  arg[pos].type = TYPE_ULLONGINT;
+		else if (c == 'i' || c == 'd')
+		  arg[pos].type = TYPE_LLONGINT;
+		else
+		  gcc_unreachable ();
+	      }
+	    else if (c == 'u')
 	      arg[pos].type = TYPE_ULONGINT;
 	    else if (c == 'i' || c == 'd')
 	      arg[pos].type = TYPE_LONGINT;
@@ -585,6 +636,16 @@ error_print (const char *type, const char *format0, va_list argp)
 	      gcc_unreachable ();
 	    break;
 
+	  case 'w':
+	    c = *format++;
+	    if (c == 'u')
+	      arg[pos].type = TYPE_HWUINT;
+	    else if (c == 'i' || c == 'd')
+	      arg[pos].type = TYPE_HWINT;
+	    else
+	      gcc_unreachable ();
+	    break;
+
 	  case 'c':
 	    arg[pos].type = TYPE_CHAR;
 	    break;
@@ -649,6 +710,22 @@ error_print (const char *type, const char *format0, va_list argp)
 	    arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
 	    break;
 
+	  case TYPE_LLONGINT:
+	    arg[pos].u.llongintval = va_arg (argp, long long int);
+	    break;
+
+	  case TYPE_ULLONGINT:
+	    arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
+	    break;
+
+	  case TYPE_HWINT:
+	    arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
+	    break;
+
+	  case TYPE_HWUINT:
+	    arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
+	    break;
+
 	  case TYPE_CHAR:
 	    arg[pos].u.charval = (char) va_arg (argp, int);
 	    break;
@@ -725,12 +802,27 @@ error_print (const char *type, const char *format0, va_list argp)
 
 	case 'l':
 	  format++;
+	  if (*format == 'l')
+	    {
+	      format++;
+	      if (*format == 'u')
+		error_uinteger (spec[n++].u.ullongintval);
+	      else
+		error_integer (spec[n++].u.llongintval);
+	    }
 	  if (*format == 'u')
 	    error_uinteger (spec[n++].u.ulongintval);
 	  else
 	    error_integer (spec[n++].u.longintval);
 	  break;
 
+	case 'w':
+	  format++;
+	  if (*format == 'u')
+	    error_hwuint (spec[n++].u.hwintval);
+	  else
+	    error_hwint (spec[n++].u.hwuintval);
+	  break;
 	}
     }
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index eaabbffca4d..4cb73e836c7 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4552,12 +4552,10 @@ substring_has_constant_len (gfc_expr *e)
 
   if (istart <= iend)
     {
-      char buffer[21];
       if (istart < 1)
 	{
-	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
-	  gfc_error ("Substring start index (%s) at %L below 1",
-		     buffer, &ref->u.ss.start->where);
+	  gfc_error ("Substring start index (%wd) at %L below 1",
+		     istart, &ref->u.ss.start->where);
 	  return false;
 	}
 
@@ -4568,9 +4566,8 @@ substring_has_constant_len (gfc_expr *e)
 	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
       if (iend > length)
 	{
-	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
-	  gfc_error ("Substring end index (%s) at %L exceeds string length",
-		     buffer, &ref->u.ss.end->where);
+	  gfc_error ("Substring end index (%wd) at %L exceeds string length",
+		     iend, &ref->u.ss.end->where);
 	  return false;
 	}
       length = iend - istart + 1;

Re: [Patch] c-format.c/Fortran: Support %wd / host-wide integer in gfc_error (Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514)

[Jakub Jelinek]

On Fri, Aug 20, 2021 at 03:47:54PM +0200, Tobias Burnus wrote:
> On 20.08.21 13:56, Jakub Jelinek wrote:
> 
> > On Fri, Aug 20, 2021 at 01:50:00PM +0200, Tobias Burnus wrote:
> > > Comments? OK?
> > LGTM (except that the last hunk won't apply anymore).
> 
> Now applied as r12-3044; I have now changed it to %wd ...
> 
> ... but as discussed in another email in the thread, I think the
> gfc_error should be removed (as unused); possibly with some additional
> testcases running into the resolve errors for those (out of bound).

Yeah, it makes sense that if there are errors in user code, they are
diagnosed during resolve, no matter whether simplification is possible
or not and simplification either asserts the errors aren't there or just
punts on the simplification, but doesn't repeat those diagnostics.

	Jakub

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

[Tobias Burnus]

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

On 20.08.21 02:21, H.J. Lu wrote:
> This may have broken bootstrap on 32-bit hosts:
> https://gcc.gnu.org/pipermail/gcc-regression/2021-August/075209.html
The latter has:
> ../../src-master/gcc/fortran/simplify.c:4557:22: error: unknown conversion type character ‘l’ in format [-Werror=format=]
>   4557 |           gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
>        |                      ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

HOST_WIDE_INT_PRINT_DEC is:
   #define HOST_WIDE_INT_PRINT_DEC "%" PRId64
and the latter is something like:
   "ld"  or "lld"

I fail to see why that shouldn't work – and also building with:

  CC="gcc-10 -m32 -fno-lto -O2" CXX="g++-10 -m32 -fno-lto -O2" .../configure --prefix=... --disable-multilib --disable-libstdcxx-pch --enable-multiarch --enable-languages=c,c++,fortran --disable-lto

did succeed.


Looking at the format checking:
   gfortran.h:void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
with
   gfortran.h:#define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)

I do see that the C/C++ part (which also uses
HOST_WIDE_INT_PRINT_DEC) have some special code
for HWI, which is used for via
    init_dynamic_diag_info
contains support for hwi not for gfc_{error,warning} via
    init_dynamic_gfc_info

I did wonder whether that causes the differences (→ attached patch).
On the other hand, %ld and %lld are pretty standard – and the
comment in the function talks about %w – which is not used
(except in spec files and in 'go').

Hence: No idea what's the problem or goes wrong.

Maybe the patch is still useful – at least it gives an
error when HWI is neither long nor long long ...
(Build with and without that patch with the options
shown aboved (and 'error:' in stage 1, 2, 3 plus
the usual bootstrap on x86-64.)

Comments?

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: fix-gfc-format-check.diff --]
[-- Type: text/x-patch, Size: 5485 bytes --]

c-family/c-format.c: Support HOST_WIDE_INT in __gcc_gfc__

This patch fixes x86 -m32 builds as gcc/fortran now uses HOST_WIDE_INT
with gfc_error.

gcc/c-family/ChangeLog:

	* c-format.c (init_dynamic_diag_hwi): New. Moved from ...
	(init_dynamic_diag_info): ... here; call it.
	(init_dynamic_gfc_info): Call it.

 gcc/c-family/c-format.c | 135 ++++++++++++++++++++++++++----------------------
 1 file changed, 74 insertions(+), 61 deletions(-)

diff --git a/gcc/c-family/c-format.c b/gcc/c-family/c-format.c
index 6fd0bb33d21..1db4fd33dbc 100644
--- a/gcc/c-family/c-format.c
+++ b/gcc/c-family/c-format.c
@@ -4843,12 +4843,85 @@ init_dynamic_asm_fprintf_info (void)
     }
 }
 
+/* Called by init_dynamic_gfc_info and init_dynamic_diag_info.
+   Determine the type of "HOST_WIDE_INT" in the code being compiled for
+   use in GCC's diagnostic custom format attributes.  You
+   must have set dynamic_format_types before calling this function.  */
+static void
+init_dynamic_diag_hwi (void)
+{
+  static tree hwi;
+
+  if (!hwi)
+    {
+      static format_length_info *diag_ls;
+      unsigned int i;
+
+      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
+	 length modifier to work, one must have issued: "typedef
+	 HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
+	 prior to using that modifier.  */
+      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
+	{
+	  hwi = identifier_global_value (hwi);
+	  if (hwi)
+	    {
+	      if (TREE_CODE (hwi) != TYPE_DECL)
+		{
+		  error ("%<__gcc_host_wide_int__%> is not defined as a type");
+		  hwi = 0;
+		}
+	      else
+		{
+		  hwi = DECL_ORIGINAL_TYPE (hwi);
+		  gcc_assert (hwi);
+		  if (hwi != long_integer_type_node
+		      && hwi != long_long_integer_type_node)
+		    {
+		      error ("%<__gcc_host_wide_int__%> is not defined"
+			     " as %<long%> or %<long long%>");
+		      hwi = 0;
+		    }
+		}
+	    }
+	}
+
+      /* Assign the new data for use.  */
+
+      /* All the GCC diag formats use the same length specs.  */
+      if (!diag_ls)
+	dynamic_format_types[gcc_diag_format_type].length_char_specs =
+	  dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
+	  dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
+	  dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
+	  dynamic_format_types[gcc_dump_printf_format_type].length_char_specs =
+	  diag_ls = (format_length_info *)
+		    xmemdup (gcc_diag_length_specs,
+			     sizeof (gcc_diag_length_specs),
+			     sizeof (gcc_diag_length_specs));
+      if (hwi)
+	{
+	  /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
+	  i = find_length_info_modifier_index (diag_ls, 'w');
+	  if (hwi == long_integer_type_node)
+	    diag_ls[i].index = FMT_LEN_l;
+	  else if (hwi == long_long_integer_type_node)
+	    diag_ls[i].index = FMT_LEN_ll;
+	  else
+	    gcc_unreachable ();
+	}
+    }
+}
+
+
 /* Determine the type of a "locus" in the code being compiled for use
    in GCC's __gcc_gfc__ custom format attribute.  You must have set
    dynamic_format_types before calling this function.  */
 static void
 init_dynamic_gfc_info (void)
 {
+  init_dynamic_diag_hwi ();
+
   if (!locus)
     {
       static format_char_info *gfc_fci;
@@ -4985,67 +5058,7 @@ init_dynamic_diag_info (void)
       || local_event_ptr_node == void_type_node)
     local_event_ptr_node = get_named_type ("diagnostic_event_id_t");
 
-  static tree hwi;
-
-  if (!hwi)
-    {
-      static format_length_info *diag_ls;
-      unsigned int i;
-
-      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
-	 length modifier to work, one must have issued: "typedef
-	 HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
-	 prior to using that modifier.  */
-      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
-	{
-	  hwi = identifier_global_value (hwi);
-	  if (hwi)
-	    {
-	      if (TREE_CODE (hwi) != TYPE_DECL)
-		{
-		  error ("%<__gcc_host_wide_int__%> is not defined as a type");
-		  hwi = 0;
-		}
-	      else
-		{
-		  hwi = DECL_ORIGINAL_TYPE (hwi);
-		  gcc_assert (hwi);
-		  if (hwi != long_integer_type_node
-		      && hwi != long_long_integer_type_node)
-		    {
-		      error ("%<__gcc_host_wide_int__%> is not defined"
-			     " as %<long%> or %<long long%>");
-		      hwi = 0;
-		    }
-		}
-	    }
-	}
-
-      /* Assign the new data for use.  */
-
-      /* All the GCC diag formats use the same length specs.  */
-      if (!diag_ls)
-	dynamic_format_types[gcc_diag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
-	  dynamic_format_types[gcc_dump_printf_format_type].length_char_specs =
-	  diag_ls = (format_length_info *)
-		    xmemdup (gcc_diag_length_specs,
-			     sizeof (gcc_diag_length_specs),
-			     sizeof (gcc_diag_length_specs));
-      if (hwi)
-	{
-	  /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
-	  i = find_length_info_modifier_index (diag_ls, 'w');
-	  if (hwi == long_integer_type_node)
-	    diag_ls[i].index = FMT_LEN_l;
-	  else if (hwi == long_long_integer_type_node)
-	    diag_ls[i].index = FMT_LEN_ll;
-	  else
-	    gcc_unreachable ();
-	}
-    }
+  init_dynamic_diag_hwi ();
 
   /* It's safe to "re-initialize these to the same values.  */
   dynamic_format_types[gcc_diag_format_type].conversion_specs =

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

[Harald Anlauf]

*PING*

> Gesendet: Mittwoch, 09. Juni 2021 um 23:39 Uhr
> Von: "Harald Anlauf" <anlauf@gmx.de>
> An: "fortran" <fortran@gcc.gnu.org>, "gcc-patches" <gcc-patches@gcc.gnu.org>
> Betreff: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514
>
> Dear Fortranners,
>
> we should be able to simplify the length of a substring with known
> constant bounds.  The attached patch adds this.
>
> Regtested on x86_64-pc-linux-gnu.
>
> OK for mainline?  Since this should be rather safe, to at least 11-branch?
>
> 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.
>
>