diff --git a/CHANGELOG.md b/CHANGELOG.md index 2971f7ef..06a0f7ce 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,6 +22,10 @@ Modifications by (in alphabetical order): * P. Vitt, University of Siegen, Germany * A. Voysey, UK Met Office +21/04/2026 PR #502. Widen Proc_Decl (R1214) for Fortran 2008 to accept an + initial-proc-target (R1217) on the right-hand side of ``=>``, + not only null-init. See J3/10-007r1 ยง12.4.3.6. + 19/03/2026 PR #496. Add support for F2008 unlimited-format-item. 13/03/2026 PR #495 for #494. Fix CI issues with the black formatting check. diff --git a/src/fparser/two/Fortran2008/__init__.py b/src/fparser/two/Fortran2008/__init__.py index e3707be3..832a46d2 100644 --- a/src/fparser/two/Fortran2008/__init__.py +++ b/src/fparser/two/Fortran2008/__init__.py @@ -87,6 +87,7 @@ from fparser.two.Fortran2008.critical_construct_r810 import Critical_Construct from fparser.two.Fortran2008.critical_stmt_r811 import Critical_Stmt from fparser.two.Fortran2008.end_critical_stmt_r812 import End_Critical_Stmt +from fparser.two.Fortran2008.proc_decl_r1214 import Proc_Decl from fparser.two.Fortran2008.procedure_stmt_r1206 import Procedure_Stmt from fparser.two.Fortran2008.action_term_do_construct_r824 import ( diff --git a/src/fparser/two/Fortran2008/proc_decl_r1214.py b/src/fparser/two/Fortran2008/proc_decl_r1214.py new file mode 100644 index 00000000..8495a7cf --- /dev/null +++ b/src/fparser/two/Fortran2008/proc_decl_r1214.py @@ -0,0 +1,106 @@ +# ----------------------------------------------------------------------------- +# 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 Fortran 2008 Proc_Decl rule R1214 +""" + +from typing import Optional, Tuple, Union + +from fparser.two.Fortran2003 import ( + Name, + Null_Init, + Procedure_Entity_Name, + Proc_Decl as Proc_Decl_2003, +) +from fparser.two.utils import BinaryOpBase, NoMatchError + + +class Proc_Decl(Proc_Decl_2003): # R1214 + """Fortran 2008 rule R1214 + + proc-decl is procedure-entity-name [ => proc-pointer-init ] + + where (R1216) proc-pointer-init is either null-init or + initial-proc-target, and (R1217) initial-proc-target is a + procedure-name. The Fortran 2003 form of R1214 only accepts + null-init on the right-hand side of ``=>``; this subclass + extends it to also accept an initial-proc-target so that + declarations such as:: + + procedure(cb), pointer, nopass :: eval => dummy + + parse under ``std='f2008'``. + + """ + + # Inherit the parent's subclass_names and include "Proc_Decl" itself + # so that this F2008 class is registered in Base.subclasses["Proc_Decl"] + # and discovered when F2003 code (e.g. Proc_Decl_List.match) references + # the F2003 Proc_Decl class directly. + subclass_names = Proc_Decl_2003.subclass_names[:] + ["Proc_Decl"] + use_names = Proc_Decl_2003.use_names[:] + ["Name"] + + @staticmethod + def match( + string: str, + ) -> Optional[Tuple[Procedure_Entity_Name, str, Union[Null_Init, Name]]]: + """Attempts to match the supplied text with this rule. + + Calls the Fortran 2003 match first (which handles the + null-init branch); if that fails, tries the Fortran 2008 + initial-proc-target branch where the right-hand side of + ``=>`` is a procedure-name. + + :param string: Fortran code to check for a match. + + :returns: None if there is no match, otherwise a 3-tuple + of (procedure-entity-name, ``"=>"``, proc-pointer-init). + + """ + if not string: + return None + try: + result = Proc_Decl_2003.match(string) + except NoMatchError: + result = None + if result: + return result + # Fortran 2008 initial-proc-target (R1217): the RHS of "=>" + # is a procedure-name. Match it as a bare Name, consistent + # with how fparser treats other name-bearing rules. + try: + return BinaryOpBase.match(Procedure_Entity_Name, "=>", Name, string) + except NoMatchError: + return None diff --git a/src/fparser/two/tests/fortran2008/test_proc_decl_r1214.py b/src/fparser/two/tests/fortran2008/test_proc_decl_r1214.py new file mode 100644 index 00000000..54171396 --- /dev/null +++ b/src/fparser/two/tests/fortran2008/test_proc_decl_r1214.py @@ -0,0 +1,171 @@ +# Copyright (c) 2026 Science and Technology Facilities Council + +# All rights reserved. + +# Modifications made as part of the fparser project are distributed +# under the following license: + +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are +# met: + +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. + +# 2. 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. + +# 3. 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 Fortran 2008 rule R1214 + +proc-decl is procedure-entity-name [ => proc-pointer-init ] + +where (R1216) proc-pointer-init is either null-init or +initial-proc-target, and (R1217) initial-proc-target is a +procedure-name. + +Extends the Fortran 2003 rule R1214, which only accepted +null-init on the right-hand side of ``=>``. + +""" + +import pytest + +from fparser.common.readfortran import FortranStringReader +from fparser.two.Fortran2008 import Proc_Decl +from fparser.two.parser import ParserFactory +from fparser.two.utils import NoMatchError, walk + + +def test_proc_decl_bare_name(): + """A bare procedure-entity-name matches via the inherited + subclass_names branch (no `=>` present).""" + obj = Proc_Decl("my_proc") + assert str(obj) == "my_proc" + + +def test_proc_decl_null_init(): + """The F2003 null-init branch still matches (regression guard).""" + obj = Proc_Decl("p => null()") + assert isinstance(obj, Proc_Decl) + assert str(obj).lower() == "p => null()" + + +@pytest.mark.parametrize( + "text,expected", + [ + ("p => dummy", "p => dummy"), + ("eval => compute_result", "eval => compute_result"), + ("cb => foo_impl", "cb => foo_impl"), + ], +) +def test_proc_decl_initial_proc_target(text, expected): + """The F2008 initial-proc-target branch matches a plain + procedure-name on the RHS of ``=>``.""" + obj = Proc_Decl(text) + assert isinstance(obj, Proc_Decl) + assert str(obj) == expected + + +@pytest.mark.parametrize("text", ["=> dummy", "p =>", "p => 1", "p => 'x'"]) +def test_proc_decl_invalid(text): + """Malformed proc-decls raise NoMatchError.""" + with pytest.raises(NoMatchError): + _ = Proc_Decl(text) + + +def test_proc_decl_match_empty_string(): + """An empty string returns None from match() rather than raising.""" + assert Proc_Decl.match("") is None + + +def test_proc_pointer_component_f2008(): + """End-to-end: a derived-type component with a procedure pointer + initialised to a module procedure parses under std='f2008'.""" + f2008 = ParserFactory().create(std="f2008") + reader = FortranStringReader( + "module m\n" + " abstract interface\n" + " subroutine cb()\n" + " end subroutine cb\n" + " end interface\n" + " type :: t\n" + " procedure(cb), pointer, nopass :: eval => dummy\n" + " end type t\n" + "contains\n" + " subroutine dummy()\n" + " end subroutine dummy\n" + "end module m\n" + ) + tree = f2008(reader) + assert tree is not None + proc_decls = walk(tree, Proc_Decl) + assert any("eval => dummy" in str(pd) for pd in proc_decls) + + +def test_proc_pointer_component_null_init_f2008(): + """Regression guard: the null-init form still parses end-to-end + under std='f2008'. The null-init branch is still handled by the + inherited F2003 match, so the resulting node may be an instance + of the F2003 Proc_Decl (the F2008 subclass's parent).""" + from fparser.two.Fortran2003 import Proc_Decl as Proc_Decl_2003 + + f2008 = ParserFactory().create(std="f2008") + reader = FortranStringReader( + "module m\n" + " abstract interface\n" + " subroutine cb()\n" + " end subroutine cb\n" + " end interface\n" + " type :: t\n" + " procedure(cb), pointer, nopass :: eval => null()\n" + " end type t\n" + "end module m\n" + ) + tree = f2008(reader) + assert tree is not None + proc_decls = walk(tree, Proc_Decl_2003) + assert any( + "eval => " in str(pd) and "null()" in str(pd).lower() for pd in proc_decls + ) + + +def test_proc_pointer_component_initial_proc_target_f2003_fails(): + """An initial-proc-target on the RHS of ``=>`` is *only* valid in + F2008; under std='f2003' the same source must fail to parse + because the F2003 grammar only allows null-init.""" + from fparser.two.utils import FortranSyntaxError + + f2003 = ParserFactory().create(std="f2003") + reader = FortranStringReader( + "module m\n" + " abstract interface\n" + " subroutine cb()\n" + " end subroutine cb\n" + " end interface\n" + " type :: t\n" + " procedure(cb), pointer, nopass :: eval => dummy\n" + " end type t\n" + "contains\n" + " subroutine dummy()\n" + " end subroutine dummy\n" + "end module m\n" + ) + with pytest.raises(FortranSyntaxError): + _ = f2003(reader)