Fortran: fix warnings for symbols with C binding and declared PRIVATE [PR49111]

The Fortran standard does not prohibit restricting the accessibility of a
symbol by use of the PRIVATE attribute and exposing it via a C binding
label.  Instead of unconditionally generating a warning, only warn if the
binding label is surprisingly identical to the privatized Fortran symbol
and when -Wsurprising is specified.

	PR fortran/49111

gcc/fortran/ChangeLog:

	* decl.cc (verify_bind_c_sym): Modify condition for generation of
	accessibility warning, and adjust warning message.

gcc/testsuite/ChangeLog:

	* gfortran.dg/binding_label_tests_9.f03: Adjust test.
	* gfortran.dg/module_private_2.f90: Likewise.
	* gfortran.dg/public_private_module_2.f90: Likewise.
	* gfortran.dg/binding_label_tests_35.f90: New test.

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index ab43cec6f4ba1d7d46d8e915f060103d127aa1c7..3fba8b1af3967a19f64de33f97ecf31043aa510e 100644 (file)
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -6420,15 +6420,17 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
                         &(tmp_sym->declared_at));
     }
 
-  /* See if the symbol has been marked as private.  If it has, make sure
-     there is no binding label and warn the user if there is one.  */
+  /* See if the symbol has been marked as private.  If it has, warn if
+     there is a binding label with default binding name.  */
   if (tmp_sym->attr.access == ACCESS_PRIVATE
-      && tmp_sym->binding_label)
-      /* Use gfc_warning_now because we won't say that the symbol fails
-        just because of this.  */
-      gfc_warning_now (0, "Symbol %qs at %L is marked PRIVATE but has been "
-                      "given the binding label %qs", tmp_sym->name,
-                      &(tmp_sym->declared_at), tmp_sym->binding_label);
+      && tmp_sym->binding_label
+      && strcmp (tmp_sym->name, tmp_sym->binding_label) == 0
+      && (tmp_sym->attr.flavor == FL_VARIABLE
+         || tmp_sym->attr.if_source == IFSRC_DECL))
+    gfc_warning (OPT_Wsurprising,
+                "Symbol %qs at %L is marked PRIVATE but is accessible "
+                "via its default binding name %qs", tmp_sym->name,
+                &(tmp_sym->declared_at), tmp_sym->binding_label);
 
   return retval;
 }

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_35.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_35.f90
new file mode 100644 (file)
index 0000000..ae3973f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_35.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-Wsurprising" }
+! PR fortran/49111
+!
+! Do not warn for interface declarations with C binding declared PRIVATE
+
+module mod1
+  use iso_c_binding
+  implicit none
+  save
+
+  interface
+     function strerror(errnum) bind(C, NAME = 'strerror')
+       import
+       type(C_PTR) :: strerror
+       integer(C_INT), value :: errnum
+     end function strerror
+  end interface
+
+  private strerror
+end module mod1

diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03
index bb61cbf12c771411cc5b56ce1f4294fe72f2b26e..81d74af019e2f2c7a0e04da4233ee358f06822c0 100644 (file)
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_9.f03
@@ -1,4 +1,5 @@
 ! { dg-do compile }
+! { dg-options "-Wsurprising" }
 module x
   use iso_c_binding
   implicit none
@@ -7,13 +8,13 @@ module x
   private :: my_private_sub_2
   public :: my_public_sub
 contains
-  subroutine bar() bind(c,name="foo") ! { dg-warning "PRIVATE but has been given the binding label" }
+  subroutine bar() bind(c,name="foo")
   end subroutine bar
   
   subroutine my_private_sub() bind(c, name="")
   end subroutine my_private_sub
 
-  subroutine my_private_sub_2() bind(c) ! { dg-warning "PRIVATE but has been given the binding label" }
+  subroutine my_private_sub_2() bind(c) ! { dg-warning "is marked PRIVATE" }
   end subroutine my_private_sub_2
 
   subroutine my_public_sub() bind(c, name="my_sub")

diff --git a/gcc/testsuite/gfortran.dg/module_private_2.f90 b/gcc/testsuite/gfortran.dg/module_private_2.f90
index 847c58d5e37cae87c98046ae7696da8d39b6b759..58dbb1e23fe56716429cae0b6d17dec6403839d3 100644 (file)
--- a/gcc/testsuite/gfortran.dg/module_private_2.f90
+++ b/gcc/testsuite/gfortran.dg/module_private_2.f90
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-O2 -fdump-tree-optimized" }
+! { dg-options "-O2 -Wsurprising -fdump-tree-optimized" }
 !
 ! PR fortran/47266
 !

diff --git a/gcc/testsuite/gfortran.dg/public_private_module_2.f90 b/gcc/testsuite/gfortran.dg/public_private_module_2.f90
index e84429e10033184f8c841e6fcde19edaf328ba28..87276ccdfd187e4fd51d5db404722de59cad9f0e 100644 (file)
--- a/gcc/testsuite/gfortran.dg/public_private_module_2.f90
+++ b/gcc/testsuite/gfortran.dg/public_private_module_2.f90
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-O2" }
+! { dg-options "-O2 -Wsurprising" }
 ! { dg-require-visibility "" }
 !
 ! PR fortran/52751 (top, "module mod")
@@ -8,16 +8,16 @@
 ! Ensure that (only) those module variables and procedures which are PRIVATE
 ! and have no C-binding label are optimized away.
 !
-      module mod
-        integer :: aa
-        integer, private :: iii
-        integer, private, bind(C) :: jj             ! { dg-warning "PRIVATE but has been given the binding label" }
-        integer, private, bind(C,name='lll') :: kk  ! { dg-warning "PRIVATE but has been given the binding label" }
-        integer, private, bind(C,name='') :: mmmm
-        integer, bind(C) :: nnn
-        integer, bind(C,name='oo') :: pp
-        integer, bind(C,name='') :: qq
-      end module mod
+module mod
+  integer :: aa
+  integer, private :: iii
+  integer, private, bind(C) :: jj       ! { dg-warning "is marked PRIVATE" }
+  integer, private, bind(C,name='lll') :: kk
+  integer, private, bind(C,name='') :: mmmm
+  integer, bind(C) :: nnn
+  integer, bind(C,name='oo') :: pp
+  integer, bind(C,name='') :: qq
+end module mod
 
 ! The two xfails below have appeared with the introduction of submodules. 'iii' and
 ! 'mmm' now are TREE_PUBLIC but has DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN set.
@@ -43,10 +43,10 @@ CONTAINS
   integer FUNCTION two()
      two = 42
   END FUNCTION two
-  integer FUNCTION three() bind(C) ! { dg-warning "PRIVATE but has been given the binding label" }
+  integer FUNCTION three() bind(C) ! { dg-warning "is marked PRIVATE" }
      three = 43
   END FUNCTION three
-  integer FUNCTION four() bind(C, name='five') ! { dg-warning "PRIVATE but has been given the binding label" }
+  integer FUNCTION four() bind(C, name='five')
      four = 44
   END FUNCTION four
   integer FUNCTION six() bind(C, name='')