[patch, fortran] Fix PR 125379, ICE with BIND(C) and PRIVATE
Thomas Koenig <[email protected]>
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <[email protected]> |
Hello world, the attached patch regtests cleanly and fixes a recent regression introduced by myself and discovered by Jürgen Reuter. OK for trunk? Best regards Thomas 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: * 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: * gfortran.dg/binding_label_tests_38.f90: New test.
p2.diff
(text/x-patch, 4.4 KB)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 37a8582e36d..fa8b9653527 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3808,6 +3808,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 6d2ebed813f..a997ea757ca 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 e1b49b0ba0d..a49033e3ea7 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5711,3 +5711,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 00000000000..b212fa503c2
--- /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