From: Mikael Morin <[email protected]>
Regression-tested on powerpc64le-unknown-linux-gnu.
OK for master?
-- >8 --
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.
---
gcc/fortran/symbol.cc | 15 +++++-
gcc/testsuite/gfortran.dg/submodule_34.f90 | 63 ++++++++++++++++++++++
2 files changed, 77 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/submodule_34.f90
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 81aa81df2ee..8211d926cf6 100644
--- 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
index 00000000000..5978ecd2f99
--- /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 <[email protected]>
+
+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
+
--
2.51.0
