Merge pull request #404 from ecmwf-ifs/57-external-procedures-possibl…

…y-trigger-assertion-in-fgen-backend

Remove duplicate declarations for external statements (fix #57)

loki/backend/tests/test_fgen.py

@@ -9,6 +9,7 @@
 
 from loki import Module, Subroutine, Sourcefile
 from loki.backend import fgen
+from loki.expression import symbols as sym
 from loki.frontend import available_frontends, OMNI, OFP
 from loki.ir import Intrinsic, DataDeclaration
 from loki.types import ProcedureType, BasicType
@@ -192,6 +193,27 @@ def test_fgen_save_attribute(frontend, tmp_path):
     assert 'SAVE' in module.to_fortran()
 
 
+@pytest.mark.parametrize('frontend', available_frontends())
+@pytest.mark.parametrize('external_decl', ('real :: x\n    external x', 'real, external :: x'))
+@pytest.mark.parametrize('body', ('', 'y = x()'))
+def test_fgen_external_procedure(frontend, external_decl, body):
+    fcode = f"""
+SUBROUTINE DRIVER
+    implicit none
+    real :: y
+    {external_decl}
+    {body}
+END SUBROUTINE DRIVER
+    """.strip()
+    routine = Subroutine.from_source(fcode, frontend=frontend)
+    x = routine.variable_map['x']
+    assert x.type.external
+    assert isinstance(x.type.dtype, ProcedureType)
+    assert x.type.dtype.return_type.dtype == BasicType.REAL
+    assert isinstance(x, (sym.Scalar, sym.ProcedureSymbol))
+    assert 'real, external :: x' in routine.to_fortran().lower()
+
+
 @pytest.mark.parametrize('frontend', available_frontends())
 @pytest.mark.parametrize('use_module', (True, False))
 def test_fgen_procedure_pointer(frontend, use_module, tmp_path):

loki/frontend/fparser.py

@@ -879,12 +879,12 @@ def visit_External_Stmt(self, o, **kwargs):
         # ...and update their symbol table entry...
         scope = kwargs['scope']
         for var in symbols:
-            _type = scope.symbol_attrs.lookup(var.name)
-            if _type is None or _type.dtype == BasicType.DEFERRED:
+            _type = scope.symbol_attrs.lookup(var.name) or SymbolAttributes(dtype=BasicType.DEFERRED)
+            if _type.dtype == BasicType.DEFERRED:
                 dtype = ProcedureType(var.name, is_function=False)
             else:
-                dtype = _type.dtype
-            scope.symbol_attrs[var.name] = SymbolAttributes(dtype, external=True)
+                dtype = ProcedureType(var.name, is_function=True, return_type=_type)
+            scope.symbol_attrs[var.name] = _type.clone(dtype=dtype, external=True)
 
         symbols = tuple(v.rescope(scope=scope) for v in symbols)
         declaration = ir.ProcedureDeclaration(symbols=symbols, external=True,

loki/frontend/ofp.py

@@ -791,12 +791,12 @@ def visit_declaration(self, o, **kwargs):
 
             variables = self.visit(o.findall('names'), **kwargs)
             for var in variables:
-                _type = kwargs['scope'].symbol_attrs.lookup(var.name)
-                if _type is None:
-                    _type = SymbolAttributes(dtype=ProcedureType(var.name, is_function=False), external=True)
+                _type = kwargs['scope'].symbol_attrs.lookup(var.name) or SymbolAttributes(dtype=BasicType.DEFERRED)
+                if _type.dtype == BasicType.DEFERRED:
+                    dtype = ProcedureType(var.name, is_function=False)
                 else:
-                    _type = _type.clone(external=True)
-                kwargs['scope'].symbol_attrs[var.name] = _type
+                    dtype = ProcedureType(var.name, is_function=True, return_type=_type)
+                kwargs['scope'].symbol_attrs[var.name] = _type.clone(dtype=dtype, external=True)
 
             variables = tuple(v.clone(scope=kwargs['scope']) for v in variables)
             declaration = ir.ProcedureDeclaration(symbols=variables, external=True, source=source, label=label)

loki/frontend/util.py

@@ -22,6 +22,7 @@
 from loki.frontend.source import join_source_list
 from loki.logging import detail, warning, error
 from loki.tools import group_by_class, replace_windowed, as_tuple
+from loki.types import ProcedureType
 
 
 __all__ = [
@@ -299,6 +300,47 @@ def visit_VariableDeclaration(self, o, **kwargs):  # pylint: disable=unused-argu
         return o.clone(symbols=mapper(o.symbols, recurse_to_declaration_attributes=True))
 
 
+class RemoveDuplicateVariableDeclarationsForExternalProcedures(Transformer):
+    """
+    :any:`Transformer` that removes procedure symbols from
+    :any:`VariableDeclarations` if they have the ``external`` attribute
+
+    This is because Fortran's external-stmt allows to declare procedure
+    symbols as external separate to their return type declaration. That makes
+    it virtually impossible to determine that this return type declaration
+    refers to a procedure rather than a local variable until the corresponding
+    ``EXTERNAL`` statement has been encountered.
+
+    Because Fortran allows to represent this also as an attribute in the same
+    declaration, we choose this to represent external procedures in all cases.
+    This means, we are replacing
+
+    .. code-block::
+        REAL :: ext_func
+        EXTERNAL ext_func
+
+    by the equivalent representation
+
+    .. code-block::
+        REAL, EXTERNAL :: ext_func
+
+    The frontends will readily translate external statements to the
+    procedure declaration with the ``EXTERNAL`` attribute, and therefore this
+    transformer only has to remove the duplicate variable declarations.
+    """
+
+    def visit_VariableDeclaration(self, o, **kwargs):  # pylint: disable=unused-argument
+        symbols = tuple(
+            s for s in o.symbols
+            if not (s.type.external and isinstance(s.type.dtype, ProcedureType))
+        )
+        if not symbols:
+            return None
+        if len(symbols) < len(o.symbols):
+            return o._update(symbols=symbols)
+        return o
+
+
 @Timer(logger=detail, text=lambda s: f'[Loki::Frontend] Executed sanitize_ir in {s:.2f}s')
 def sanitize_ir(_ir, frontend, pp_registry=None, pp_info=None):
     """
@@ -344,5 +386,6 @@ def sanitize_ir(_ir, frontend, pp_registry=None, pp_info=None):
 
     if frontend in (FP, OFP):
         _ir = CombineMultilinePragmasTransformer(inplace=True, invalidate_source=False).visit(_ir)
+        _ir = RemoveDuplicateVariableDeclarationsForExternalProcedures(inplace=True, invalidate_source=False).visit(_ir)
 
     return _ir