On 23.09.21 17:50, Sandra Loosemore wrote:
This patch is for PR101320, another issue related to missing bind(c)
diagnostics.  OK to commit?
LGTM - I am only ...
commit d3507154fd34e65e2887262218fec09d5fb082a2
Author: Sandra Loosemore<san...@codesourcery.com>
Date:   Thu Sep 23 08:03:52 2021 -0700

     Fortran: Diagnose default-initialized pointer/allocatable dummies

     TS29113 changed what was then C516 in the 2010 Fortran standard (now
     C1557 in F2018) from disallowing all of pointer, allocatable, and
     optional attributes on dummy arguments to BIND(C) functions, to
     disallowing only pointer/allocatable with default-initialization.
     gfortran was previously failing to diagnose violations of this
     constraint.

     2021-09-23  Sandra Loosemore<san...@codesourcery.com>

      PR Fortran/101320

      gcc/fortran/
      * decl.c (gfc_verify_c_interop_param): Handle F2018 C1557,
      aka TS29113 C516.

      gcc/testsuite/
      * gfortran.dg/c-interop/c516.f90: Remove xfails.  Add more
      tests.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index f2e8896..b3c65b7 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1557,6 +1557,20 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
                     "CONTIGUOUS attribute as procedure %qs is BIND(C)",
                     sym->name, &sym->declared_at, sym->ns->proc_name->name);

+       /* Per F2018, C1557, pointer/allocatable dummies to a bind(c)
+          procedure that are default-initialized are not permitted.  */
+       if ((sym->attr.pointer || sym->attr.allocatable)
+           && sym->ts.type == BT_DERIVED
+           && gfc_has_default_initializer (sym->ts.u.derived))
+         {
+           gfc_error ("Default-initialized %s dummy argument %qs "
+                      "at %L is not permitted in BIND(C) procedure %qs",
+                      (sym->attr.pointer ? "pointer" : "allocatable"),

... wondering how to best handle such strings for translators. Namely,
whether to duplicate the string and fill-in the %s, rewriting it them to
make it clearer for the translator ("dummy argument %qs with %s
attribute"), or leaving it as is.

I think the later is acceptable – thus, I assume you will choose that
option :-)

Thanks,

Tobias


+                      sym->name, &sym->declared_at,
+                      sym->ns->proc_name->name);
+           retval = false;
+         }
+
            /* Character strings are only C interoperable if they have a
           length of 1.  However, as an argument they are also iteroperable
           when passed as descriptor (which requires len=: or len=*).  */
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c516.f90 
b/gcc/testsuite/gfortran.dg/c-interop/c516.f90
index 208eb84..d6a65af 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c516.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c516.f90
@@ -27,6 +27,10 @@ module m2

    interface

+    ! First test versions with optional attributes on the argument.
+    ! TS29113 removed the constraint disallowing optional arguments
+    ! that previously used to be in C516.
+
      ! good, no default initialization, no pointer/allocatable attribute
      subroutine s1a (x) bind (c)
        use m1
@@ -52,16 +56,54 @@ module m2
      end subroutine

      ! bad, default initialization + allocatable
-    subroutine s2b (x) bind (c)  ! { dg-error "BIND\\(C\\)" "pr101320" { xfail 
*-*-* } }
+    subroutine s2b (x) bind (c)  ! { dg-error "BIND\\(C\\)" }
        use m1
        type(t2), allocatable, optional :: x
      end subroutine

      ! bad, default initialization + pointer
-    subroutine s2c (x) bind (c)  ! { dg-error "BIND\\(C\\)" "pr101320" { xfail 
*-*-* } }
+    subroutine s2c (x) bind (c)  ! { dg-error "BIND\\(C\\)" }
        use m1
        type(t2), pointer, optional :: x
      end subroutine

+    ! Now do all the same tests without the optional attribute.
+
+    ! good, no default initialization, no pointer/allocatable attribute
+    subroutine s3a (x) bind (c)
+      use m1
+      type(t1) :: x
+    end subroutine
+
+    ! good, no default initialization
+    subroutine s3b (x) bind (c)
+      use m1
+      type(t1), allocatable :: x
+    end subroutine
+
+    ! good, no default initialization
+    subroutine s3c (x) bind (c)
+      use m1
+      type(t1), pointer :: x
+    end subroutine
+
+    ! good, default initialization but no pointer/allocatable attribute
+    subroutine s4a (x) bind (c)
+      use m1
+      type(t2) :: x
+    end subroutine
+
+    ! bad, default initialization + allocatable
+    subroutine s4b (x) bind (c)  ! { dg-error "BIND\\(C\\)" }
+      use m1
+      type(t2), allocatable :: x
+    end subroutine
+
+    ! bad, default initialization + pointer
+    subroutine s4c (x) bind (c)  ! { dg-error "BIND\\(C\\)" }
+      use m1
+      type(t2), pointer :: x
+    end subroutine
+
    end interface
  end module
-----------------
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

Reply via email to