https://gcc.gnu.org/g:d3d984e9a0670b8b1076089e2cbc85f9a58578b6

commit r17-1148-gd3d984e9a0670b8b1076089e2cbc85f9a58578b6
Author: Jerry DeLisle <[email protected]>
Date:   Mon May 25 09:29:33 2026 -0700

    fortran: submodule cannot access internal subprograms of ancestor module 
via host association
    
    A submodule could not access internal subprograms of its ancestor module
    via host association.  References to such procedures were rejected with
    "has no IMPLICIT type".  Fortran 2018 ยง14.6.1.3 requires submodules to
    host-associate the specification part and the module subprogram part of
    their ancestor module; Intel Fortran and NAG Fortran accept this usage.
    
    Root cause: when parse_module processes a submodule, gfc_current_ns->parent
    is left NULL, so the host-association walk cannot reach the ancestor
    module's namespace and its internal procedures.
    
    Fix (parse.cc, parse_module): after use_modules() and gfc_traverse_ns(),
    strip the child suffix from the submodule's dotted name (e.g. "m.s" -> "m"),
    search gfc_global_ns_list for the matching ancestor namespace, and set
    gfc_current_ns->parent to it.
    
    Fix (parse.cc, clean_up_modules): before calling gfc_done_2(), reset
    gfc_current_ns->parent to NULL to prevent gfc_symbol_done_2 from walking up
    to and double-freeing the ancestor module namespace during teardown.
    
    The new parent link also required boundary guards in three places that walk
    up the namespace chain:
    
    Fix (class.cc, gfc_find_derived_vtab): the vtab lookup walks up ns->parent
    to find the top-level namespace.  Stop at module/submodule boundaries
    (FL_MODULE flavor) so that vtables for types defined in a submodule are not
    incorrectly placed in the ancestor module namespace.
    
    Fix (openmp.cc, gfc_omp_requires_add_clause, gfc_match_omp_requires,
    gfc_match_omp_atomic): three OpenMP helpers walk ns->parent to find the
    enclosing program unit.  Each acquired the same boundary guard so the
    submodule is treated as its own program unit for OMP REQUIRES purposes.
    
    PR fortran/125527
    
    Assisted by: Claude Sonnet 4.6
    
    gcc/fortran/ChangeLog:
    
            PR fortran/125527
            * class.cc (gfc_find_derived_vtab): Stop the top-level namespace
            walk at module/submodule boundaries to avoid escaping a submodule
            into its ancestor module namespace.
            * openmp.cc (gfc_omp_requires_add_clause): Likewise; treat the
            submodule as its own program unit for OMP REQUIRES.
            (gfc_match_omp_requires): Likewise; allow OMP REQUIRES in a 
submodule
            spec part even when gfc_current_ns->parent is now non-NULL.
            (gfc_match_omp_atomic): Likewise.
            * parse.cc (parse_module): After processing USE statements and
            host-association traversal, link the submodule namespace to its
            ancestor module namespace so internal subprograms are visible via
            host association (Fortran 2018, 14.6.1.3).
            (clean_up_modules): Reset gfc_current_ns->parent before gfc_done_2
            to prevent double-free of the ancestor module namespace.
    
    gcc/testsuite/ChangeLog:
    
            PR fortran/125527
            * gfortran.dg/submodule_host_assoc_1.f90: New test.
            * gfortran.dg/submodule_host_assoc_1_aux.f90: New test.

Diff:
---
 gcc/fortran/class.cc                               |  9 +++++--
 gcc/fortran/openmp.cc                              | 16 ++++++++++-
 gcc/fortran/parse.cc                               | 31 ++++++++++++++++++++++
 .../gfortran.dg/submodule_host_assoc_1.f90         | 28 +++++++++++++++++++
 .../gfortran.dg/submodule_host_assoc_1_aux.f90     | 15 +++++++++++
 5 files changed, 96 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index d49c7da1e9da..a4c3c37104a4 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -2461,9 +2461,14 @@ gfc_find_derived_vtab (gfc_symbol *derived)
   if (derived->attr.pdt_template)
     return NULL;
 
-  /* Find the top-level namespace.  */
+  /* Find the top-level namespace, stopping at module/submodule boundaries.
+     A submodule's namespace may have its parent pointer set to the ancestor
+     module namespace for host-association purposes; we must not escape that
+     boundary, because vtables for types defined in a submodule belong in
+     the submodule namespace, not in its parent module.  */
   for (ns = gfc_current_ns; ns; ns = ns->parent)
-    if (!ns->parent)
+    if (!ns->parent
+       || (ns->proc_name && ns->proc_name->attr.flavor == FL_MODULE))
       break;
 
   /* If the type is a class container, use the underlying derived type.  */
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 5c3c373c27d3..476a6604892e 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -7854,6 +7854,12 @@ gfc_omp_requires_add_clause (gfc_omp_requires_kind 
clause,
       if (gfc_state_stack->previous
          && gfc_state_stack->previous->state == COMP_INTERFACE)
        break;
+      /* A submodule namespace may have its parent set to the ancestor module
+        for host-association purposes.  Do not escape the submodule boundary:
+        the submodule itself is the program unit for OMP REQUIRES purposes.  */
+      if (prog_unit->proc_name
+         && prog_unit->proc_name->attr.flavor == FL_MODULE)
+       break;
       prog_unit = prog_unit->parent;
     }
 
@@ -7937,7 +7943,13 @@ gfc_match_omp_requires (void)
   bool first = true;
   locus old_loc;
 
+  /* A submodule's namespace may have its parent pointer set to the ancestor
+     module namespace for host-association purposes.  The submodule spec part
+     is still a valid program-unit spec part for OMP REQUIRES.  Only reject
+     the directive when we are genuinely nested inside a procedure.  */
   if (gfc_current_ns->parent
+      && !(gfc_current_ns->proc_name
+          && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
       && (!gfc_state_stack->previous
          || gfc_state_stack->previous->state != COMP_INTERFACE))
     {
@@ -8475,7 +8487,9 @@ gfc_match_omp_atomic (void)
   if (c->memorder == OMP_MEMORDER_UNSET)
     {
       gfc_namespace *prog_unit = gfc_current_ns;
-      while (prog_unit->parent)
+      while (prog_unit->parent
+            && !(prog_unit->proc_name
+                 && prog_unit->proc_name->attr.flavor == FL_MODULE))
        prog_unit = prog_unit->parent;
       switch (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
        {
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 7d59a8b326d1..7fec02c12599 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -7397,6 +7397,32 @@ parse_module (void)
     {
       use_modules ();
       gfc_traverse_ns (gfc_current_ns, set_syms_host_assoc);
+
+      /* Link the submodule namespace to the parent (sub)module namespace so
+        that internal subprograms of the ancestor module are accessible via
+        host association (Fortran 2018, 14.6.1.3).  The parent namespace is
+        already in gfc_global_ns_list when both units are compiled together.
+        The submodule's fully-qualified name is "parent.child"; strip the
+        child part to obtain the parent's name, then search the global list.  
*/
+      {
+       const char *submod_name = gfc_new_block->name;
+       const char *dot = strrchr (submod_name, '.');
+       if (dot != NULL)
+         {
+           size_t plen = (size_t) (dot - submod_name);
+           char parent_name[GFC_MAX_SYMBOL_LEN + 1];
+           gcc_assert (plen < sizeof (parent_name));
+           memcpy (parent_name, submod_name, plen);
+           parent_name[plen] = '\0';
+           for (gfc_namespace *ns = gfc_global_ns_list; ns; ns = ns->sibling)
+             if (ns->proc_name
+                 && strcmp (ns->proc_name->name, parent_name) == 0)
+               {
+                 gfc_current_ns->parent = ns;
+                 break;
+               }
+         }
+      }
     }
 
   st = parse_spec (ST_NONE);
@@ -7555,6 +7581,11 @@ clean_up_modules (gfc_gsymbol *&gsym)
   if (gsym->ns)
     {
       gfc_current_ns = gsym->ns;
+      /* Disconnect any host-association parent link set for submodules
+        (see parse_module): each module/submodule namespace in gfc_gsym_root
+        is independently managed, so gfc_symbol_done_2 must not walk up to
+        and double-free a sibling top-level namespace.  */
+      gfc_current_ns->parent = NULL;
       gfc_derived_types = gfc_current_ns->derived_types;
       gfc_done_2 ();
       gsym->ns = NULL;
diff --git a/gcc/testsuite/gfortran.dg/submodule_host_assoc_1.f90 
b/gcc/testsuite/gfortran.dg/submodule_host_assoc_1.f90
new file mode 100644
index 000000000000..32d27f18e456
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_host_assoc_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-additional-sources submodule_host_assoc_1_aux.f90 }
+!
+! PR fortran/125527
+!
+! A submodule must be able to access internal subprograms of its ancestor
+! module via host association (Fortran 2018, 14.6.1.3).
+! gfortran was incorrectly rejecting such references with
+! "has no IMPLICIT type" when the internal procedure was declared PRIVATE.
+
+module m
+  implicit none
+  private
+  public :: test
+
+  interface
+    module subroutine test()
+    end subroutine
+  end interface
+
+contains
+  pure function double_it(x) result(y)
+    double precision, intent(in) :: x
+    double precision :: y
+    y = 2.0d0 * x
+  end function
+
+end module m
diff --git a/gcc/testsuite/gfortran.dg/submodule_host_assoc_1_aux.f90 
b/gcc/testsuite/gfortran.dg/submodule_host_assoc_1_aux.f90
new file mode 100644
index 000000000000..84deac686f1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_host_assoc_1_aux.f90
@@ -0,0 +1,15 @@
+! Auxiliary file for submodule_host_assoc_1.f90
+! { dg-skip-if "" { *-*-* } }
+submodule(m) s
+  implicit none
+contains
+  module subroutine test()
+    if (abs(double_it(3.0d0) - 6.0d0) > 1d-10) stop 1
+  end subroutine
+end submodule s
+
+program p
+  use m
+  implicit none
+  call test()
+end program p

Reply via email to