https://gcc.gnu.org/g:449a42185a6cf304325d905544cecbbca8164284
commit r17-649-g449a42185a6cf304325d905544cecbbca8164284 Author: Thomas Koenig <[email protected]> Date: Thu May 21 15:34:04 2026 +0200 Fix PR 125379, ICE with BIND(C) and PRIVATE This fixes a recent regression introduced by my patch for PR 125902. The problem was that, for private entities, the symbols cannot be found by gfc_find_symbol a gsymbol's namespace. This patch uses the approach of iterating over all the symbols to look for the right name if direct lookup fails. gcc/fortran/ChangeLog: PR fortran/125379 * gfortran.h (gfc_find_symbol_by_name): Add prototype. * resolve.cc (gfc_verify_binding_labels): Call gfc_find_symbol_by_name if direct lookup fails. * symbol.cc (compare_target_sym_name): New function. (gfc_find_symbol_by_name): New function. gcc/testsuite/ChangeLog: PR fortran/125379 * gfortran.dg/binding_label_tests_38.f90: New test. Diff: --- gcc/fortran/gfortran.h | 2 + gcc/fortran/resolve.cc | 7 +++ gcc/fortran/symbol.cc | 30 ++++++++++++ .../gfortran.dg/binding_label_tests_38.f90 | 56 ++++++++++++++++++++++ 4 files changed, 95 insertions(+) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 7a1f51e51aea..6c45e9b16825 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3852,6 +3852,8 @@ int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **); bool gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **); int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **, locus * = NULL); +bool gfc_find_symbol_by_name (const char *, gfc_namespace *, + gfc_symbol **); bool gfc_verify_c_interop (gfc_typespec *); bool gfc_verify_c_interop_param (gfc_symbol *); bool verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *); diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 12ce8d9b265b..19a7a2b33785 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -15084,6 +15084,13 @@ gfc_verify_binding_labels (gfc_symbol *sym) { gfc_symbol *global_sym; gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &global_sym); + + /* For when the symtree does not match the symbol name, which can happen + in modules with PRIVATE. */ + + if (global_sym == NULL) + gfc_find_symbol_by_name (gsym->sym_name, gsym->ns, &global_sym); + gcc_assert (global_sym); /* If subroutines and functions are conflated, there is little point diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 66e7c8baf492..26e4b40d48e3 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -5727,3 +5727,33 @@ gfc_get_spec_ns (gfc_symbol *sym) return sym->ns; } + +/* This section deals with looking up a symbol when the symtree name and symbol + name do not agree, so gfc_find_symbol() cannot be used. */ + +static gfc_symbol* found_sym; /* Where to store the symbol. */ +static const char* sym_target_name; /* What name to look for. */ + +/* Helper function. */ + +static void +compare_target_sym_name (gfc_symbol *sym) +{ + if (strcmp(sym->name, sym_target_name) == 0) + found_sym = sym; +} + +/* Search for a symbol when the symtree name may be different from the + symbol name. Return true if found. */ + +bool +gfc_find_symbol_by_name (const char *name, gfc_namespace *ns, + gfc_symbol **result) +{ + found_sym = NULL; + sym_target_name = name; + + do_traverse_symtree (ns->sym_root, NULL, compare_target_sym_name); + *result = found_sym; + return result != 0; +} diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_38.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_38.f90 new file mode 100644 index 000000000000..b212fa503c26 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_38.f90 @@ -0,0 +1,56 @@ +! { dg-do compile } +! PR fortran/125379 - this gave an ICE due to C binding private +! globals. +! Test case by Juergen Reuter. + +module blha_olp_interfaces + use, intrinsic :: iso_c_binding !NODEP! + use, intrinsic :: iso_fortran_env + implicit none + private + public :: olp_polvec + type :: blha_driver_t + procedure(olp_polvec), nopass, pointer :: blha_olp_polvec => null () + end type blha_driver_t + + interface + subroutine olp_polvec (eps) bind(C) + import + real(kind = c_double), dimension(0:7), intent(out) :: eps + end subroutine + end interface +end module blha_olp_interfaces + + +module pcm_base + use blha_olp_interfaces + implicit none + private +end module pcm_base + + +module api + use pcm_base + implicit none + private + public :: whizard_api_t + + type :: whizard_api_t + private + character(:), allocatable :: logfile + end type whizard_api_t + +end module api + +function whizard_get_char (whizard_handle) result (stat) bind (C) + use iso_c_binding, only: c_ptr !NODEP! + use iso_c_binding, only: c_f_pointer !NODEP! + use api, only: whizard_api_t + implicit none + integer :: stat + type(c_ptr), intent(in) :: whizard_handle + type(whizard_api_t), pointer :: whizard + + call c_f_pointer (whizard_handle, whizard) + +end function whizard_get_char
