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 --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7a1f51e51aeac976bbf2c524c5f3c1bba5759862..6c45e9b16825a36175cb676a9a92af492e97c243 100644 (file)
--- 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 12ce8d9b265bf347b62a3bf18605b903473e609e..19a7a2b33785c0e13d561930825c99f07b3eb5c7 100644 (file)
--- 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 66e7c8baf492613e436fc6fbae6428cbf52033cc..26e4b40d48e3457af95427db619c4b3308ac5ceb 100644 (file)
--- 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 (file)
index 0000000..b212fa5
--- /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