Support for representing cray pointers using OFP or FP (fixes #338)

loki/frontend/fparser.py

@@ -210,14 +210,17 @@ def rget_child(node, node_type):
     Searches for the last, immediate child of the supplied node that is of
     the specified type.
 
-    :param node: the node whose children will be searched.
-    :type node: :py:class:`fparser.two.utils.Base`
-    :param node_type: the class(es) of child node to search for.
-    :type node_type: type or tuple of type
-
-    :returns: the last child node of type node_type that is encountered or None.
-    :rtype: py:class:`fparser.two.utils.Base`
+    Parameters
+    ----------
+    node : :any:`fparser.two.utils.Base`
+        the node whose children will be searched
+    node_type : class name or tuple of class names
+        the class(es) of child node to search for.
 
+    Returns
+    -------
+    :any:`fparser.two.utils.Base`
+        the last child node of type node_type that is encountered or ``None``.
     """
     for child in reversed(node.children):
         if isinstance(child, node_type):
@@ -227,7 +230,7 @@ def rget_child(node, node_type):
 
 def extract_fparser_source(node, raw_source):
     """
-    Extract the :any:`Source` object for any py:class:`fparser.two.utils.BlockBase`
+    Extract the :any:`Source` object for any :any:`fparser.two.utils.BlockBase`
     from the raw source string.
     """
     assert isinstance(node, BlockBase)
@@ -3211,6 +3214,7 @@ def visit_Parenthesis(self, o, **kwargs):
     visit_Backspace_Stmt = visit_Intrinsic_Stmt
     visit_Rewind_Stmt = visit_Intrinsic_Stmt
     visit_Entry_Stmt = visit_Intrinsic_Stmt
+    visit_Cray_Pointer_Stmt = visit_Intrinsic_Stmt
 
     def visit_Cpp_If_Stmt(self, o, **kwargs):
         return ir.PreprocessorDirective(text=o.tostr(), source=kwargs.get('source'))

loki/frontend/ofp.py

@@ -778,6 +778,8 @@ def visit_declaration(self, o, **kwargs):
                 return self.visit(o.find('module-nature'), **kwargs)
             if o.find('enum-def-stmt') is not None:
                 return self.create_enum(o, **kwargs)
+            if o.find('cray-pointer-stmt') is not None:
+                return ir.Intrinsic(text=source.string.strip(), label=label, source=source)
             raise ValueError('Unsupported declaration')
         if o.attrib['type'] in ('implicit', 'intrinsic', 'parameter'):
             return ir.Intrinsic(text=source.string.strip(), label=label, source=source)

loki/ir/tests/test_control_flow.py

@@ -677,3 +677,25 @@ def test_multi_line_forall_construct(tmp_path, frontend):
     assert regenerated_code[8].strip() == "c(i, j) = c(i, j + 2) + c(i, j - 2) + c(i + 2, j) + c(i - 2, j)"
     assert regenerated_code[9].strip() == "d(i, j) = c(i, j)"
     assert regenerated_code[10].strip() == "END FORALL"
+
+
+@pytest.mark.parametrize('frontend', available_frontends(
+    xfail=[(OMNI, 'No support for Cray Pointers')]
+))
+def test_cray_pointers(frontend):
+    fcode = """
+SUBROUTINE SUBROUTINE_WITH_CRAY_POINTER (KLON,KLEV,POOL)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KLON, KLEV
+REAL, INTENT(INOUT) :: POOL(:)
+REAL, DIMENSION(KLON,KLEV) :: ZQ
+POINTER(IP_ZQ, ZQ)
+IP_ZQ = LOC(POOL)
+END SUBROUTINE
+    """.strip()
+    routine = Subroutine.from_source(fcode, frontend=frontend)
+    intrinsics = FindNodes(ir.Intrinsic).visit(routine.spec)
+    assert len(intrinsics) == 2
+    assert 'IMPLICIT NONE' in intrinsics[0].text
+    assert 'POINTER(IP_ZQ, ZQ)' in intrinsics[1].text
+    assert 'POINTER(IP_ZQ, ZQ)' in routine.to_fortran()