This patch is for PR101320, another issue related to missing bind(c) diagnostics. OK to commit?

-Sandra
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"),
+			 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

Reply via email to