Improve representation of procedure pointers (fix #393)

loki/backend/tests/test_fgen.py

@@ -7,10 +7,11 @@
 
 import pytest
 
-from loki import Module, Subroutine
+from loki import Module, Subroutine, Sourcefile
 from loki.backend import fgen
 from loki.frontend import available_frontends, OMNI, OFP
 from loki.ir import Intrinsic, DataDeclaration
+from loki.types import ProcedureType, BasicType
 
 
 @pytest.mark.parametrize('frontend', available_frontends())
@@ -189,3 +190,67 @@ def test_fgen_save_attribute(frontend, tmp_path):
     assert len(module.declarations) == 1
     assert 'SAVE' in fgen(module.declarations[0])
     assert 'SAVE' in module.to_fortran()
+
+
+@pytest.mark.parametrize('frontend', available_frontends())
+@pytest.mark.parametrize('use_module', (True, False))
+def test_fgen_procedure_pointer(frontend, use_module, tmp_path):
+    """
+    Test correct code generation for procedure pointers
+
+    This was reported in #393
+    """
+    fcode_module = """
+MODULE SPSI_MODNEW
+IMPLICIT NONE
+INTERFACE
+    REAL FUNCTION SPNSI ()
+    END FUNCTION SPNSI
+END INTERFACE
+END MODULE SPSI_MODNEW
+    """.strip()
+
+    fcode = """
+SUBROUTINE SPCMNEW(FUNC)
+USE SPSI_MODNEW, ONLY : SPNSI
+IMPLICIT NONE
+PROCEDURE(SPNSI), POINTER :: SPNSIPTR
+PROCEDURE(REAL), POINTER, INTENT(OUT) :: FUNC
+FUNC => SPNSIPTR
+END SUBROUTINE SPCMNEW
+    """.strip()
+
+    if frontend == OMNI and not use_module:
+        pytest.skip('Parsing without module definitions impossible in OMNI')
+
+    definitions = []
+    if use_module:
+        module = Sourcefile.from_source(fcode_module, frontend=frontend, xmods=[tmp_path])
+        definitions.extend(module.definitions)
+    source = Sourcefile.from_source(fcode, frontend=frontend, definitions=definitions, xmods=[tmp_path])
+    routine = source['spcmnew']
+    ptr = routine.variable_map['spnsiptr']
+    func = routine.variable_map['func']
+
+    # Make sure we always have procedure type as dtype for the declared pointers
+    assert isinstance(ptr.type.dtype, ProcedureType)
+    assert isinstance(func.type.dtype, ProcedureType)
+
+    # We should have the inter-procedural annotation in place if the module
+    # definition was provided
+    if use_module:
+        assert ptr.type.dtype.procedure is module['spnsi'].body[0]
+    else:
+        assert ptr.type.dtype.procedure == BasicType.DEFERRED
+
+    # With an implicit interface routine like this, we will never have
+    # procedure information in place
+    assert func.type.dtype.procedure == BasicType.DEFERRED
+    assert func.type.dtype.return_type.dtype == BasicType.REAL
+
+    # Check the interfaces declared on the variable declarations
+    assert tuple(decl.interface for decl in routine.declarations) == ('SPNSI', BasicType.REAL)
+
+    # Ensure that the fgen backend does the right thing
+    assert 'procedure(spnsi), pointer :: spnsiptr' in source.to_fortran().lower()
+    assert 'procedure(real), pointer, intent(out) :: func' in source.to_fortran().lower()

loki/frontend/fparser.py

@@ -944,6 +944,13 @@ def visit_Procedure_Declaration_Stmt(self, o, **kwargs):
         if return_type is None:
             interface = self.visit(o.children[0], **kwargs)
             interface = AttachScopesMapper()(interface, scope=scope)
+            if interface.type.dtype is BasicType.DEFERRED:
+                # This is (presumably!) an external function with explicit interface that we
+                # don't know because the type information is not available, e.g., because it's been
+                # imported from another module or sits in an intfb.h header file.
+                # So, we create a ProcedureType object with the interface name and use that
+                dtype = ProcedureType(interface.name)
+                interface = interface.clone(type=interface.type.clone(dtype=dtype))
             _type = interface.type.clone(**attrs)
         else:
             interface = return_type.dtype
@@ -978,7 +985,7 @@ def visit_Proc_Attr_Spec(self, o, **kwargs):
         * attribute name (`str`)
         * attribute value (such as ``IN``, ``OUT``, ``INOUT``) or `None`
         """
-        return (o.children[0].lower(), o.children[1].lower() if o.children[1] is not None else True)
+        return (o.children[0].lower(), str(o.children[1]).lower() if o.children[1] is not None else True)
 
     visit_Proc_Decl_List = visit_List
 

loki/frontend/ofp.py

@@ -1098,15 +1098,23 @@ def visit_declaration(self, o, **kwargs):
             # Update symbol table entries
             if isinstance(_type.dtype, ProcedureType):
                 scope.symbol_attrs.update({var.name: var.type.clone(**_type.__dict__) for var in symbols})
-            else:
-                # This is (presumably!) an external or dummy function with implicit interface,
-                # which is declared as `PROCEDURE(<return_type>) [::] <name>`. Easy, isn't it...?
-                # Great, now we have to update each symbol's type one-by-one...
-                assert o.find('procedure-declaration-stmt').get('hasProcInterface')
-                interface = _type.dtype
-                for var in symbols:
-                    dtype = ProcedureType(var.name, is_function=True, return_type=_type)
-                    scope.symbol_attrs[var.name] = var.type.clone(dtype=dtype)
+            elif o.find('procedure-declaration-stmt').get('hasProcInterface'):
+                if o.find('proc-interface').get('id'):
+                    # This is (presumably!) an external function with explicit interface that we
+                    # don't know because the type information is not available, e.g., because it's been
+                    # imported from another module or sits in an intfb.h header file.
+                    # So, we create a ProcedureType object with the proc-interface name and use that
+                    dtype = ProcedureType(o.find('proc-interface').get('id'))
+                    _type = _type.clone(dtype=dtype)
+                    scope.symbol_attrs.update({var.name: var.type.clone(**_type.__dict__) for var in symbols})
+                else:
+                    # This is (presumably!) an external or dummy function with implicit interface,
+                    # which is declared as `PROCEDURE(<return_type>) [::] <name>`. Easy, isn't it...?
+                    # Great, now we have to update each symbol's type one-by-one...
+                    interface = _type.dtype
+                    for var in symbols:
+                        dtype = ProcedureType(var.name, is_function=True, return_type=_type)
+                        scope.symbol_attrs[var.name] = _type.clone(dtype=dtype)
 
             # Rescope variables so they know their type
             symbols = tuple(var.rescope(scope=scope) for var in symbols)

loki/frontend/omni.py

@@ -547,6 +547,9 @@ def visit_varDecl(self, o, **kwargs):
         name = o.find('name')
         variable = self.visit(name, **kwargs)
 
+        interface = None
+        scope = kwargs['scope']
+
         # Create the declared type
         if name.attrib['type'] in self._omni_types:
             # Intrinsic scalar type
@@ -571,10 +574,20 @@ def visit_varDecl(self, o, **kwargs):
                         variable.name, is_function=_type.dtype.is_function, return_type=_type.dtype.return_type
                     )
                     _type = _type.clone(dtype=dtype)
-
-                if tast.attrib.get('is_external') == 'true':
-                    _type.external = True
-                elif variable == kwargs['scope'].name and _type.dtype.return_type is not None:
+                    interface = dtype.return_type.dtype
+
+                if variable != scope.name:
+                    # Instantiate the symbol representing the procedure in the current scope to create
+                    # relevant symbol table entries, and then extract the dtype
+                    try:
+                        symbol_scope = scope.get_symbol_scope(_type.dtype.name)
+                        interface = symbol_scope.Variable(name=_type.dtype.name)
+                        _type = _type.clone(dtype=interface.type.dtype)
+                    except AttributeError:
+                        # Interface symbol could not be found
+                        pass
+
+                elif _type.dtype.return_type is not None:
                     # This is the declaration of the return type inside a function, which is
                     # why we restore the return_type
                     _type = _type.dtype.return_type
@@ -584,10 +597,12 @@ def visit_varDecl(self, o, **kwargs):
                     if _type.shape:
                         variable = variable.clone(dimensions=_type.shape)
 
+                if tast.attrib.get('is_external') == 'true':
+                    _type.external = True
+
         else:
             raise ValueError
 
-        scope = kwargs['scope']
         if o.find('value') is not None:
             _type = _type.clone(initial=AttachScopesMapper()(self.visit(o.find('value'), **kwargs), scope=scope))
         if _type.kind is not None:
@@ -598,14 +613,10 @@ def visit_varDecl(self, o, **kwargs):
 
         if isinstance(_type.dtype, ProcedureType):
             # This is actually a function or subroutine (EXTERNAL or PROCEDURE declaration)
-            if _type.external:
-                return ir.ProcedureDeclaration(symbols=(variable,), external=True, source=kwargs['source'])
-            if _type.dtype.name == variable and _type.dtype.is_function:
-                return ir.ProcedureDeclaration(
-                    symbols=(variable,), interface=_type.dtype.return_type.dtype, source=kwargs['source']
-                )
-            interface = sym.Variable(name=_type.dtype.name, scope=scope.get_symbol_scope(_type.dtype.name))
-            return ir.ProcedureDeclaration(symbols=(variable,), interface=interface, source=kwargs['source'])
+            return ir.ProcedureDeclaration(
+                symbols=(variable,), interface=interface, external=_type.external or False,
+                source=kwargs['source']
+            )
 
         return ir.VariableDeclaration(symbols=(variable,), source=kwargs['source'])