(Towards #428) Implementation of the Fortran2008 intrinsics

doc/source/developers_guide.rst

@@ -170,6 +170,14 @@ returned. An example of a simple choice rule is `R202`. See the
 :ref:`program-unit-class` section for a description of its
 implementation.
 
+Another example is the support for Fortran 2008 intrinsics.
+These are defined in the `Fortran2008_Intrinsic_Names` class, which is then
+defined in the `subclass_names` list of the base `Intrinsic_Names` class in
+the Fortran2003 spec. When fparser runs with the 2008 standard, it will attempt
+to match both the Fortran2003 `Intrinsic_Names` and the
+`Fortran2008_Intrinsic_Names` classes, but with only the 2003 standard it will
+only use the base Fortran2003 intrinsic lists.
+
 The `use_names` list should contain any classes that are referenced by the
 implementation of the current class. These lists of names are aggregated
 (along with `subclass_names`) and used to ensure that all necessary `Scalar_`,

src/fparser/two/Fortran2003.py

@@ -12457,7 +12457,7 @@ class Intrinsic_Name(STRINGBase):  # No explicit rule
         specific_function_names.keys()
     )
 
-    subclass_names = []
+    subclass_names = ["Fortran2008_Intrinsic_Names"]
 
     @staticmethod
     def match(string):
@@ -12509,9 +12509,9 @@ def match(string):
         result = CallBase.match(Intrinsic_Name, Actual_Arg_Spec_List, string)
         if not result:
             return None
-
         # There is a match so check the number of args provided
         # matches the number of args expected by the intrinsic.
+        intrinsic_type = type(result[0])
         function_name = str(result[0])
         function_args = result[1]
 
@@ -12528,16 +12528,15 @@ def match(string):
             pass
 
         nargs = 0 if function_args is None else len(function_args.items)
-
-        if function_name in Intrinsic_Name.specific_function_names.keys():
+        if function_name in intrinsic_type.specific_function_names.keys():
             # If this is a specific function then use its generic
             # name to test min and max number of arguments.
-            test_name = Intrinsic_Name.specific_function_names[function_name]
+            test_name = intrinsic_type.specific_function_names[function_name]
         else:
             test_name = function_name
 
-        min_nargs = Intrinsic_Name.generic_function_names[test_name]["min"]
-        max_nargs = Intrinsic_Name.generic_function_names[test_name]["max"]
+        min_nargs = intrinsic_type.generic_function_names[test_name]["min"]
+        max_nargs = intrinsic_type.generic_function_names[test_name]["max"]
 
         # None indicates an unlimited number of arguments
         if max_nargs is None:

src/fparser/two/Fortran2008/__init__.py

@@ -101,6 +101,7 @@
 )
 from fparser.two.Fortran2008.label_do_stmt_r816 import Label_Do_Stmt
 from fparser.two.Fortran2008.nonlabel_do_stmt_r817 import Nonlabel_Do_Stmt
+from fparser.two.Fortran2008.f08_intrinsics import Fortran2008_Intrinsic_Names
 
 # pylint: disable=eval-used
 # pylint: disable=exec-used

src/fparser/two/Fortran2008/f08_intrinsics.py

@@ -0,0 +1,97 @@
+# -----------------------------------------------------------------------------
+# BSD 3-Clause License
+#
+# Copyright (c) 2026, Science and Technology Facilities Council.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+# * Redistributions of source code must retain the above copyright notice, this
+#   list of conditions and the following disclaimer.
+#
+# * Redistributions in binary form must reproduce the above copyright notice,
+#   this list of conditions and the following disclaimer in the documentation
+#   and/or other materials provided with the distribution.
+#
+# * Neither the name of the copyright holder nor the names of its
+#   contributors may be used to endorse or promote products derived from
+#   this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+# -----------------------------------------------------------------------------
+
+"""
+Module containing Fortran2008 Intrinsics.
+"""
+
+from fparser.two.Fortran2003 import Intrinsic_Name
+
+
+class Fortran2008_Intrinsic_Names(Intrinsic_Name):
+    """
+    Represents the name of a Fortran 2008 intrinsic function.
+
+    All generic intrinsic names are specified as keys in the
+    `generic_function_names` dictionary, with their values indicating
+    the minimum and maximum number of arguments allowed for this
+    intrinsic function. A `-1` indicates an unlimited number of
+    arguments. The names are split into the categories specified in
+    the Fortran2003 specification document.
+
+    All specific intrinsic names (which have a different name to their
+    generic counterpart) are specified as keys in the
+    `specific_function_names` dictionary, with their values indicating
+    which generic function they are associated with
+    """
+
+    f08_math_intrinsics = {
+        "ERF": {"min": 1, "max": 1},
+        "GAMMA": {"min": 1, "max": 1},
+    }
+
+    f08_bitshift_intrinsics = {
+        "SHIFTL": {"min": 2, "max": 2},
+        "SHIFTR": {"min": 2, "max": 2},
+        "SHIFTA": {"min": 2, "max": 2},
+    }
+
+    generic_function_names = {}
+    generic_function_names.update(f08_math_intrinsics)
+    generic_function_names.update(f08_bitshift_intrinsics)
+
+    specific_function_names = {}
+
+    # A list of all function names
+    function_names = list(generic_function_names.keys()) + list(
+        specific_function_names.keys()
+    )
+
+    @staticmethod
+    def match(string):
+        """Attempt to match the input `string` with the intrinsic function
+        names defined in `generic_function_names` or
+        `specific_function_names`. If there is a match the resultant
+        string will be converted to upper case.
+
+        :param str string: The pattern to be matched.
+
+        :returns: A tuple containing the matched string (converted to \
+        upper case) if there is a match or None if there is not.
+        :rtype: (str,) or NoneType
+
+        """
+        from fparser.two.utils import STRINGBase
+
+        return STRINGBase.match(Fortran2008_Intrinsic_Names.function_names, string)

src/fparser/two/tests/fortran2008/test_f08_intrinsics.py

@@ -0,0 +1,71 @@
+# -----------------------------------------------------------------------------
+# BSD 3-Clause License
+#
+# Copyright (c) 2023-2024, Science and Technology Facilities Council.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are met:
+#
+# * Redistributions of source code must retain the above copyright notice, this
+#   list of conditions and the following disclaimer.
+#
+# * Redistributions in binary form must reproduce the above copyright notice,
+#   this list of conditions and the following disclaimer in the documentation
+#   and/or other materials provided with the distribution.
+#
+# * Neither the name of the copyright holder nor the names of its
+#   contributors may be used to endorse or promote products derived from
+#   this software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+# -----------------------------------------------------------------------------
+
+"""Test the Fortran 2008 intrinsic support."""
+
+from fparser.common.readfortran import FortranStringReader
+from fparser.two.Fortran2003 import Part_Ref
+from fparser.two.Fortran2008 import Fortran2008_Intrinsic_Names
+from fparser.two.utils import walk
+
+
+def test_f2008_intrinsic(f2008_parser):
+    """Test Fortran2008 intrinsic is created with the f2008 parser."""
+
+    reader = FortranStringReader("""subroutine test
+        integer :: i
+
+        i = erf(i)
+        end subroutine test
+        """)
+    tree = f2008_parser(reader)
+    intrinsic = walk(tree, Fortran2008_Intrinsic_Names)
+    assert len(intrinsic) == 1
+    assert str(intrinsic[0]) == "ERF"
+
+
+def test_f2008_intrinsic_f2003_parse(f2003_parser):
+    """Test Fortran2008 intrinsic is not created with the f2003 parser."""
+    reader = FortranStringReader("""subroutine test
+        integer :: i
+
+        i = erf(i)
+        end subroutine test
+        """)
+    tree = f2003_parser(reader)
+    intrinsic = walk(tree, Fortran2008_Intrinsic_Names)
+    assert len(intrinsic) == 0
+    partref = walk(tree, Part_Ref)
+    assert len(partref) == 1
+    assert str(partref[0]) == "erf(i)"