https://gcc.gnu.org/g:50959e53e40ae087ee7bdbce7229b4b8b3cd1bb6
commit r16-4308-g50959e53e40ae087ee7bdbce7229b4b8b3cd1bb6 Author: Harald Anlauf <[email protected]> Date: Tue Oct 7 21:54:45 2025 +0200 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: --- gcc/fortran/decl.cc | 18 ++++++++------- .../gfortran.dg/binding_label_tests_35.f90 | 21 +++++++++++++++++ .../gfortran.dg/binding_label_tests_9.f03 | 5 +++-- gcc/testsuite/gfortran.dg/module_private_2.f90 | 2 +- .../gfortran.dg/public_private_module_2.f90 | 26 +++++++++++----------- 5 files changed, 48 insertions(+), 24 deletions(-) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index ab43cec6f4ba..3fba8b1af396 100644 --- 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 index 000000000000..ae3973fe5bf2 --- /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 bb61cbf12c77..81d74af019e2 100644 --- 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 847c58d5e37c..58dbb1e23fe5 100644 --- 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 e84429e10033..87276ccdfd18 100644 --- 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='')
