diff --git a/CHANGELOG.md b/CHANGELOG.md index 2534268f..aee0f6fc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,6 +22,8 @@ Modifications by (in alphabetical order): * P. Vitt, University of Siegen, Germany * A. Voysey, UK Met Office +25/06/2026 PR #514 towards #428. Add some Fortran2008-only intrinsics. + 19/06/2026 PR #513 for #512. Fix circular import in Fortran2008. ## Release 0.2.3 (11/06/2026) ## diff --git a/doc/source/developers_guide.rst b/doc/source/developers_guide.rst index 63d7f558..d71b02a2 100644 --- a/doc/source/developers_guide.rst +++ b/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_`, diff --git a/src/fparser/two/Fortran2003.py b/src/fparser/two/Fortran2003.py index 177b40e4..b9ad9972 100644 --- a/src/fparser/two/Fortran2003.py +++ b/src/fparser/two/Fortran2003.py @@ -12459,8 +12459,8 @@ class Intrinsic_Name(STRINGBase): # No explicit rule subclass_names = [] - @staticmethod - def match(string): + @classmethod + def match(cls, 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 @@ -12473,7 +12473,7 @@ def match(string): :rtype: (str,) or NoneType """ - return STRINGBase.match(Intrinsic_Name.function_names, string) + return STRINGBase.match(cls.function_names, string) class Intrinsic_Function_Reference(CallBase): # No explicit rule @@ -12486,9 +12486,12 @@ class Intrinsic_Function_Reference(CallBase): # No explicit rule subclass_names = [] use_names = ["Intrinsic_Name", "Actual_Arg_Spec_List"] + # Set the type of Intrinsic_Name to be used (so it can be overridden + # in subclasses). + _intrinsic_type = Intrinsic_Name - @staticmethod - def match(string): + @classmethod + def match(cls, string): """Match the string as an intrinsic function. Also check that the number of arguments provided matches the number expected by the intrinsic. @@ -12506,12 +12509,12 @@ def match(string): (that overrides it) into scope. """ - result = CallBase.match(Intrinsic_Name, Actual_Arg_Spec_List, string) + result = CallBase.match(cls._intrinsic_type, 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 +12531,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: diff --git a/src/fparser/two/Fortran2008/__init__.py b/src/fparser/two/Fortran2008/__init__.py index 832a46d2..e381a04f 100644 --- a/src/fparser/two/Fortran2008/__init__.py +++ b/src/fparser/two/Fortran2008/__init__.py @@ -101,6 +101,10 @@ ) 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.intrinsics_f08 import ( + Intrinsic_Name, + Intrinsic_Function_Reference, +) # pylint: disable=eval-used # pylint: disable=exec-used diff --git a/src/fparser/two/Fortran2008/intrinsics_f08.py b/src/fparser/two/Fortran2008/intrinsics_f08.py new file mode 100644 index 00000000..d80096c4 --- /dev/null +++ b/src/fparser/two/Fortran2008/intrinsics_f08.py @@ -0,0 +1,96 @@ +# ----------------------------------------------------------------------------- +# 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 as F2003_Intrinsic_Name +from fparser.two.Fortran2003 import ( + Intrinsic_Function_Reference as F2003_Intrinsic_Function_Reference, +) + + +class Intrinsic_Name(F2003_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}, + } + + # Create the dicts (not inherited from F2003_Intrinsic_Name) + generic_function_names = {} + generic_function_names.update(F2003_Intrinsic_Name.generic_function_names) + generic_function_names.update(f08_math_intrinsics) + generic_function_names.update(f08_bitshift_intrinsics) + + specific_function_names = F2003_Intrinsic_Name.specific_function_names + + # A list of all function names + function_names = list(generic_function_names.keys()) + list( + specific_function_names.keys() + ) + + +class Intrinsic_Function_Reference(F2003_Intrinsic_Function_Reference): + """ + Represents Fortran intrinsics:: + + function-reference is intrinsic-name ( [ actual-arg-spec-list ] ) + + """ + + # Set the type of Intrinsic_Name to be used + _intrinsic_type = Intrinsic_Name diff --git a/src/fparser/two/tests/fortran2008/test_intrinsics_2008.py b/src/fparser/two/tests/fortran2008/test_intrinsics_2008.py index 10d9e195..ff54ee60 100644 --- a/src/fparser/two/tests/fortran2008/test_intrinsics_2008.py +++ b/src/fparser/two/tests/fortran2008/test_intrinsics_2008.py @@ -32,14 +32,16 @@ # (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 intrinsic handling within Fortran2008. At the moment, the only -special consideration (beyond 2003) is that we can't disambiguate a -shadowed intrinsic within a submodule. +"""Test intrinsic handling within Fortran2008. In particular: the special +consideration (beyond 2003) is that we can't disambiguate a shadowed +intrinsic within a submodule. There are also a few new intrinsic +functions. """ import pytest from fparser.api import get_reader +from fparser.common.readfortran import FortranStringReader from fparser.two import Fortran2003, Fortran2008 from fparser.two.utils import walk @@ -63,3 +65,34 @@ def test_intrinsic_in_submodule(): """) ast = Fortran2008.Submodule(reader) assert not walk(ast, Fortran2003.Intrinsic_Function_Reference) + + +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_Name) + 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_Name) + assert len(intrinsic) == 0 + partref = walk(tree, Fortran2003.Part_Ref) + assert len(partref) == 1 + assert str(partref[0]) == "erf(i)"