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

(cherry picked from commit 2646d0e06b170569be1da28fce1d6e2f03a15f60)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 37f9ef63de7194484167c7b1020e16ccaab505b7..b2a15fc5cef691b7b34a97e80a9f60910323b7e3 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,12 @@
+2021-09-24  Sandra Loosemore  <sandra@codesourcery.com>
+
+       Backported from master:
+       2021-09-23  Sandra Loosemore  <sandra@codesourcery.com>
+
+       PR fortran/101320
+       * decl.c (gfc_verify_c_interop_param): Handle F2018 C1557,
+       aka TS29113 C516.
+
 2021-09-22  Sandra Loosemore  <sandra@codesourcery.com>
 
        Backported from master:

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7d4af47fdc0b51593bda06e50d7b904389c3bca1..d5e8a5aaecf5ccca5dd34183280dc6117263fcab 100644 (file)
--- 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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index c3151ad716212c42199c45a0204287f702913614..96a11596c8e501ede997529d1260222e89131dd8 100644 (file)
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,12 @@
+2021-09-24  Sandra Loosemore  <sandra@codesourcery.com>
+
+       Backported from master:
+       2021-09-23  Sandra Loosemore  <sandra@codesourcery.com>
+
+       PR fortran/101320
+       * gfortran.dg/c-interop/c516.f90: Remove xfails.  Add more
+        tests.
+
 2021-09-23  Tobias Burnus  <tobias@codesourcery.com>
 
        2021-09-23  Jakub Jelinek  <jakub@redhat.com>

diff --git a/gcc/testsuite/gfortran.dg/c-interop/c516.f90 b/gcc/testsuite/gfortran.dg/c-interop/c516.f90
index 208eb846ea562e5a5354fbe9b1f3a450787802e0..d6a65affdb2d5183a94f479c00808810367a00c9 100644 (file)
--- 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