Re: [PATCH] PR fortran/50549 - should detect different type parameters in structure constructors

[Harald Anlauf <anlauf@gmx.de>]

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

Hi Tobias,

Am 28.03.22 um 12:05 schrieb Tobias Burnus:
> Thanks for the patch! LGTM and I think GCC 12 is still okay.
> 
> However, I have a nit:
> 
>> --- a/gcc/fortran/resolve.cc
>> +++ b/gcc/fortran/resolve.cc
>> @@ -1375,11 +1375,22 @@ resolve_structure_cons (gfc_expr *expr, int init)
>> ...
>> +           long len_a, len_b;
>> +           len_a = mpz_get_si (comp->ts.u.cl->length->value.integer);
>> +           len_b = mpz_get_si 
>> (cons->expr->ts.u.cl->length->value.integer);
>> +           gfc_error ("Unequal character lengths (%ld/%ld) for pointer "
>> +                      "component %qs in constructor at %L",
>> +                      len_a, len_b, comp->name, &cons->expr->where);
> 
> 'long' might be int32_t instead of int64_t (e.g. on Windows, I think both
> MinGW32 and MinGW64, but I am not quite sure). Thus, I wonder whether it
> makes more sense to use:
> 
>    HOST_WIDE_INT, gfc_mpz_get_hwi() and '%wd'
> 
> I note that '%wd' (and '%lld') is only supported since last August
> (commit https://gcc.gnu.org/r12-3044-g1b507b1e3c5 ), but now that it is,
> I think we should use it at places where the value can be larger than 
> INT_MAX.

using HOST_WIDE_INT as in the updated patch (sort of) works, but for
some reason I do not yet understand the format check kicks in for
gfc_error, producing:

../../gcc-trunk/gcc/fortran/resolve.cc: In function 'bool 
resolve_structure_cons(gfc_expr*, int)':
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: unknown 
conversion type character 'w' in format [-Wformat=]
      la, lb, comp->name, &cons->expr->where);
                                            ^
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: unknown 
conversion type character 'w' in format [-Wformat=]
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: format '%s' 
expects argument of type 'char*', but argument 2 has type 'long int' 
[-Wformat=]
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: format '%L' 
expects argument of type 'locus*', but argument 3 has type 'long int' 
[-Wformat=]
../../gcc-trunk/gcc/fortran/resolve.cc:1388:43: warning: too many 
arguments for format [-Wformat-extra-args]

This would likely lead to a bootstrap error.

Do I need to add some forgotten include?  Or some annotation to
suppress the warning?

Or should I rather convert the character lengths via sprintf first
before generating the error message?  (That would be the quick fix.)

> I think at some point, we should also check the rest of the code and
> change those mpz_get_si to gfc_mpz_get_hwi which can exceed INT_MAX.
> Likewise, some of the %ld/%lu or %lld/%llu code should be also converted 
> to %wd/%wu.
> 
> Tobias
> 
> PS: For using HWI with 'sprintf' instead of diagnostic's error/warning,
> HOST_WIDE_INT_PRINT_DEC exists and has to be used.

All current cases of printing a HOST_WIDE_INT in gcc/fortran/ use
'sprintf', and I did not find any other use of %wd/%wu.  So the
mentioned implementation is not really stressed yet... ;-)

Thanks,
Harald

> -----------------
> 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: 0001-Fortran-character-length-of-pointer-assignments-in-s.patch --]
[-- Type: text/x-patch, Size: 3184 bytes --]

From 7efd0613261c5d2120e189387f4b916917c25683 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 27 Mar 2022 21:35:15 +0200
Subject: [PATCH] Fortran: character length of pointer assignments in structure
 constructors

gcc/fortran/ChangeLog:

	PR fortran/50549
	* resolve.cc (resolve_structure_cons): Reject pointer assignments
	of character with different lengths in structure constructor.

gcc/testsuite/ChangeLog:

	PR fortran/50549
	* gfortran.dg/char_pointer_assign_7.f90: New test.
---
 gcc/fortran/resolve.cc                        | 13 ++++++-
 .../gfortran.dg/char_pointer_assign_7.f90     | 38 +++++++++++++++++++
 2 files changed, 50 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 5522be75199..290767723d8 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1375,11 +1375,22 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	  && comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
 	  && cons->expr->ts.u.cl && cons->expr->ts.u.cl->length
 	  && cons->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
-	  && cons->expr->rank != 0
 	  && mpz_cmp (cons->expr->ts.u.cl->length->value.integer,
 		      comp->ts.u.cl->length->value.integer) != 0)
 	{
+	  if (comp->attr.pointer)
+	    {
+	      HOST_WIDE_INT la, lb;
+	      la = gfc_mpz_get_hwi (comp->ts.u.cl->length->value.integer);
+	      lb = gfc_mpz_get_hwi (cons->expr->ts.u.cl->length->value.integer);
+	      gfc_error ("Unequal character lengths (%wd/%wd) for pointer "
+			 "component %qs in constructor at %L",
+			 la, lb, comp->name, &cons->expr->where);
+	      t = false;
+	    }
+
 	  if (cons->expr->expr_type == EXPR_VARIABLE
+	      && cons->expr->rank != 0
 	      && cons->expr->symtree->n.sym->attr.flavor == FL_PARAMETER)
 	    {
 	      /* Wrap the parameter in an array constructor (EXPR_ARRAY)
diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90
new file mode 100644
index 00000000000..08bdf176d8b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_7.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! PR fortran/50549 - should reject pointer assignments of different lengths
+! in structure constructors
+
+program test
+  implicit none
+  type t
+     character(2), pointer ::  p2
+  end type t
+  type t2
+     character(2), pointer ::  p(:)
+  end type t2
+  type td
+     character(:), pointer ::  pd
+  end type td
+  interface
+     function f1 ()
+       character(1), pointer :: f1
+     end function f1
+     function f2 ()
+       character(2), pointer :: f2
+     end function f2
+  end interface
+
+  character(1),    target  ::  p1
+  character(1),    pointer ::  q1(:)
+  character(2),    pointer ::  q2(:)
+  type(t)  :: u
+  type(t2) :: u2
+  type(td) :: v
+  u  = t(p1)    ! { dg-error "Unequal character lengths" }
+  u  = t(f1())  ! { dg-error "Unequal character lengths" }
+  u  = t(f2())  ! OK
+  u2 = t2(q1)   ! { dg-error "Unequal character lengths" }
+  u2 = t2(q2)   ! OK
+  v  = td(p1)   ! OK
+  v  = td(f1()) ! OK
+end
-- 
2.34.1