fortran: Favor parser-generated module procedure namespaces [PR122046]

In the testcase from the PR, an assertion triggers because the compiler
tries to access the parent namespace of a contained procedure.  But the
namespace is the formal namespace of a module procedure symbol in a
submodule, which hasn't its parent set.

To add a bit of context, in submodules, module procedures inherited from
their parent module have two different namespaces holding their dummy
arguments.  The first one is generated by the the host association of
the module from the .mod file, and is made accessible in the procedure
symbol's formal_ns field.  Its parent field is not set.  The second one
is generated by the parser and contains the procedure implementation.
It's accessible from the list of contained procedures in the submodule
namespace.  Its parent field is set.

This change modifies gfc_get_procedure_ns to favor the parser-generated
namespace in the submodule case where there are two namespaces to choose
from.

	PR fortran/122046

gcc/fortran/ChangeLog:

	* symbol.cc (gfc_get_procedure_ns): Try to find the namespace
	among the list of contained namespaces before returning the
	value from the formal_ns field.

gcc/testsuite/ChangeLog:

	* gfortran.dg/submodule_34.f90: New test.

diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 81aa81df2eecbae25439828ad392e57f7db65bd2..8211d926cf63edd675e8e2b55fb112580c1b71fa 100644 (file)
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5500,7 +5500,16 @@ gfc_namespace *
 gfc_get_procedure_ns (gfc_symbol *sym)
 {
   if (sym->formal_ns
-      && sym->formal_ns->proc_name == sym)
+      && sym->formal_ns->proc_name == sym
+      /* For module procedures used in submodules, there are two namespaces.
+        The one generated by the host association of the module is directly
+        accessible through SYM->FORMAL_NS but doesn't have any parent set.
+        The one generated by the parser is only accessible by walking the
+        contained namespace but has its parent set.  Prefer the one generated
+        by the parser below.  */
+      && !(sym->attr.used_in_submodule
+          && sym->attr.contained
+          && sym->formal_ns->parent == nullptr))
     return sym->formal_ns;
 
   /* The above should have worked in most cases.  If it hasn't, try some other
@@ -5515,6 +5524,10 @@ gfc_get_procedure_ns (gfc_symbol *sym)
       if (ns->proc_name == sym)
        return ns;
 
+  if (sym->formal_ns
+      && sym->formal_ns->proc_name == sym)
+    return sym->formal_ns;
+
   if (sym->formal)
     for (gfc_formal_arglist *f = sym->formal; f != nullptr; f = f->next)
       if (f->sym)

diff --git a/gcc/testsuite/gfortran.dg/submodule_34.f90 b/gcc/testsuite/gfortran.dg/submodule_34.f90
new file mode 100644 (file)
index 0000000..5978ecd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_34.f90
@@ -0,0 +1,63 @@
+! { dg-do compile }
+!
+! PR fortran/122046
+! The check for illegal recursion used to trigger on assertion when resolving
+! the array spec of the dummy argument in the submodule
+!
+! Contributed by Tomáš Trnka <trnka@scm.com>
+
+module ChemicalSystemModule
+
+   implicit none
+   private
+
+   type, public :: ChemicalSystemType
+   contains
+      procedure, public  :: NumAtoms
+   end type
+
+contains
+
+   elemental integer function NumAtoms(self)
+      class(ChemicalSystemType), intent(in) :: self
+
+      NumAtoms = 123
+
+   end function
+
+end module
+
+module ChemicalSystemUtilsModule
+
+   use ChemicalSystemModule
+
+   implicit none
+   private
+
+   public :: ChemicalSystemRMSD
+
+   interface
+
+      module subroutine ChemicalSystemRMSD(modelSys, rmsdGrad)
+         type(ChemicalSystemType), intent(in)  :: modelSys
+         real                    , intent(out) :: rmsdGrad(3,modelSys%NumAtoms())
+      end subroutine
+
+   end interface
+
+end module
+
+submodule(ChemicalSystemUtilsModule) ChemicalSystemUtilsSubModule
+   use ChemicalSystemModule
+
+   implicit none
+
+contains
+
+   module subroutine ChemicalSystemRMSD(modelSys, rmsdGrad)
+      type(ChemicalSystemType), intent(in)   :: modelSys
+      real                    , intent(out)  :: rmsdGrad(3,modelSys%NumAtoms())
+   end subroutine
+
+end submodule
+