(Closes #320) nonstandard stop

CHANGELOG.md

@@ -18,6 +18,9 @@ Modifications by (in alphabetical order):
 * P. Vitt, University of Siegen, Germany
 * A. Voysey, UK Met Office
 
+14/10/2024 PR #451 for #320. Adds an extension to Fortran2003 to support non-standard STOP
+           expressions and adds support for them in 2008.
+
 11/10/2024 PR #450 for #448. Adds an example script for removing all protected/private
            attributes from a parse tree.
 

doc/source/developers_guide.rst

@@ -403,7 +403,7 @@ and for Fortran2008 it is
     R202 program-unit is main-program
                          or external-subprogram
                          or module
-			 or submodule
+                         or submodule
                          or block-data
 
 Therefore to implement the Fortran2008 version of this class, the
@@ -1009,7 +1009,7 @@ f2003_create        --                      Sets-up the class hierarchy for the
                                             Fortran2003 parser.
 f2003_parser        `Fortran2003.Program`   Sets-up the class hierarchy for the
                                             Fortran2003 parser and returns the
-					    top-level Program object.
+                                            top-level Program object.
 clear_symbol_table  --                      Removes all stored symbol tables.
 fake_symbol_table   --                      Creates a fake scoping region and
                                             associated symbol table.

doc/source/fparser2.rst

@@ -374,6 +374,19 @@ This extension is supported by (at least) the Gnu, Intel and Cray compilers
 but is not a part of any Fortran standard. More details can be found at
 https://gcc.gnu.org/onlinedocs/gfortran/CONVERT-specifier.html
 
+Extended arguments for STOP
++++++++++++++++++++++++++++
+
+Many compilers support extended arguments for the STOP statement before Fortran 2008.
+Examples are negative numbers, and string operations::
+
+    STOP -1
+    STOP str1 // str2
+
+This extension will accept these expressions in Fortran 2003. Note that the
+Fortran 2008 standard changes the definition of the stop code to accept even
+more flexible expressions.
+
 Classes
 -------
 

src/fparser/two/Fortran2003.py

@@ -8504,14 +8504,19 @@ class Stop_Code(StringBase):  # R850
 
         <stop-code> = <scalar-char-constant>
                       | <digit> [ <digit> [ <digit> [ <digit> [ <digit> ] ] ] ]
-
+        Extension:
+                      | Level_3_Expr
     """
 
     subclass_names = ["Scalar_Char_Constant"]
 
     @staticmethod
     def match(string):
-        return StringBase.match(pattern.abs_label, string)
+        result = StringBase.match(pattern.abs_label, string)
+        if result or not "extended-stop-args" in EXTENSIONS():
+            return result
+        # This will allow statements like `stop -1` and `stop str1//str2`
+        return Level_3_Expr(string)
 
 
 #

src/fparser/two/Fortran2008/__init__.py

@@ -1,7 +1,7 @@
 # -----------------------------------------------------------------------------
 # BSD 3-Clause License
 #
-# Copyright (c) 2023, Science and Technology Facilities Council.
+# Copyright (c) 2023-2024, Science and Technology Facilities Council.
 # All rights reserved.
 #
 # Redistribution and use in source and binary forms, with or without
@@ -66,6 +66,7 @@
 from fparser.two.Fortran2008.loop_control_r818 import Loop_Control
 from fparser.two.Fortran2008.if_stmt_r837 import If_Stmt
 from fparser.two.Fortran2008.error_stop_stmt_r856 import Error_Stop_Stmt
+from fparser.two.Fortran2008.stop_code_r857 import Stop_Code
 from fparser.two.Fortran2008.specification_part_c1112 import Specification_Part_C1112
 from fparser.two.Fortran2008.implicit_part_c1112 import Implicit_Part_C1112
 from fparser.two.Fortran2008.implicit_part_stmt_c1112 import Implicit_Part_Stmt_C1112

src/fparser/two/Fortran2008/stop_code_r857.py

@@ -0,0 +1,50 @@
+# -----------------------------------------------------------------------------
+# BSD 3-Clause License
+#
+# Copyright (c) 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.
+# -----------------------------------------------------------------------------
+
+"""
+    Module containing Fortran2008 Error_Stop_Stmt rule R857
+"""
+from fparser.two.utils import Base
+
+
+class Stop_Code(Base):  # R857
+    """
+    Fortran2008 rule R867. Changes the allowed stop code type.
+
+    stop-code is scalar-default-char-constant-expr
+                 or scalar-int-constant-expr
+    """
+
+    subclass_names = ["Scalar_Default_Char_Expr", "Scalar_Int_Expr"]
+    use_names = ["Stop_Code"]

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

@@ -0,0 +1,96 @@
+# Copyright (c) 2024 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 R856
+
+    error-stop-stmt is ERROR STOP [ stop-code ]
+"""
+
+import pytest
+
+from fparser.api import get_reader
+from fparser.two.utils import NoMatchError, walk
+from fparser.two import Fortran2003, utils
+from fparser.two.Fortran2008 import Stop_Code
+
+
+@pytest.mark.usefixtures("f2008_create")
+@pytest.mark.parametrize("string", ["1", "- 1", '"abc"', "'abc'", "'abc' // 'def'"])
+def test_simple_stop_code(string):
+    """Test that error-stop matches the expected valid values."""
+    result = Stop_Code(string)
+    assert str(result) == string
+
+
+@pytest.mark.usefixtures("f2008_create")
+@pytest.mark.parametrize("string", ["call sub()", "do i", "1, 2, 3"])
+def test_simple_stop_code_errors(string):
+    """Test that invalid stop codes are handled."""
+    with pytest.raises(NoMatchError) as err:
+        Stop_Code(string)
+    assert f"Stop_Code: '{string}'" in str(err.value)
+
+
+@pytest.mark.parametrize("string", ["1", "12345"])
+def test_stop_stmt_2003_stop_code(f2008_parser, string):
+    """Test that 'stop' parsing works in real code, and returns a 2003
+    StopCode. This is the case if the stop code is between one and
+    five digits only:
+    """
+    code = f"""
+    subroutine dummy()
+    stop {string}
+    end subroutine dummy
+    """
+    tree = f2008_parser(get_reader(code))
+    stop_code = walk(tree, Fortran2003.Stop_Code)[0]
+    assert str(stop_code) == string
+
+
+@pytest.mark.parametrize("string", ["1234567", "12 .AND. 34"])
+def test_stop_stmt_2008(f2008_parser, string, monkeypatch):
+    """Test that stop parsing works in real code when using F2008
+    only (i.e. not F2003) statements. Note that '12 .and. 34' is a
+    level-5-expr, and as such would not be accepted by the F2003
+    "extended-stop-args" extension in fparser.
+    """
+    monkeypatch.setattr(utils, "_EXTENSIONS", [])
+    code = f"""
+    subroutine dummy()
+    stop {string}
+    end subroutine dummy
+    """
+    tree = f2008_parser(get_reader(code))
+    stop_stmt = walk(tree, Fortran2003.Stop_Stmt)[0]
+    assert str(stop_stmt.children[1]) == string

src/fparser/two/tests/test_fortran2003.py

@@ -1,4 +1,4 @@
-# Modified work Copyright (c) 2017-2023 Science and Technology
+# Modified work Copyright (c) 2017-2024 Science and Technology
 # Facilities Council.
 # Original work Copyright (c) 1999-2008 Pearu Peterson
 #
@@ -68,10 +68,12 @@
 """
 
 import pytest
+
 from fparser.two.Fortran2003 import *
 from fparser.two import Fortran2003
 from fparser.two.symbol_table import SYMBOL_TABLES
 from fparser.two.utils import NoMatchError
+from fparser.two import utils
 from fparser.api import get_reader
 
 
@@ -2096,7 +2098,17 @@ def test_continue_stmt():  # R848
     assert repr(obj) == "Continue_Stmt('CONTINUE')"
 
 
-def test_stop_stmt():  # R849
+@pytest.mark.parametrize("standard_only", [True, False])
+def test_stop_stmt_standard_2003(standard_only, monkeypatch):
+    """Test that stop statements are parsed correctly [R849].
+    It tests both pure 2003 standard compliance, but also
+    that negative numbers and string concatenations are accepted.
+    """
+    if standard_only:
+        # Disable the stop-stmt extension for this test to verify
+        # that really only standard expressions are accepted
+        monkeypatch.setattr(utils, "_EXTENSIONS", [])
+
     tcls = Stop_Stmt
     obj = tcls("stop")
     assert isinstance(obj, tcls), repr(obj)
@@ -2110,6 +2122,33 @@ def test_stop_stmt():  # R849
     assert isinstance(obj, tcls), repr(obj)
     assert str(obj) == "STOP 'hey you'"
 
+    # This should not be accepted even with the extension enabled:
+    with pytest.raises(NoMatchError) as excinfo:
+        tcls("stop 12 .and. 34")
+    assert "Stop_Stmt: 'stop 12 .and. 34'" in str(excinfo.value)
+
+    if standard_only:
+        # This should not be accepted according to F2003
+        with pytest.raises(NoMatchError) as excinfo:
+            tcls('stop "123"//"456"')
+        assert 'Stop_Stmt: \'stop "123"//"456"' in str(excinfo.value)
+
+        # This should not be accepted according to F2003
+        with pytest.raises(NoMatchError) as excinfo:
+            tcls("stop -321")
+        assert "Stop_Stmt: 'stop -321'" in str(excinfo.value)
+
+    else:
+        # Test the F2003 standard extensions, which should
+        # accept these expressions
+        obj = tcls('stop "123"//"456"')
+        assert isinstance(obj, tcls), repr(obj)
+        assert str(obj) == 'STOP "123" // "456"'
+
+        obj = tcls("stop -321")
+        assert isinstance(obj, tcls), repr(obj)
+        assert str(obj) == "STOP - 321"
+
 
 #
 # SECTION 9

src/fparser/two/utils.py

@@ -114,6 +114,11 @@
 # when reading/writing data using unformatted IO.
 _EXTENSIONS += ["open-convert"]
 
+# While non-standard, many compilers support negative numbers, and string
+# operations in stop statements, e.g. `stop -1` or `stop str1//str2`.
+# With this extension, these statements will be allowed.
+_EXTENSIONS += ["extended-stop-args"]
+
 
 def EXTENSIONS():
     """