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.

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;
 }

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

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")

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
 !

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='')