issue #403 First working version with tests.

src/fparser/two/Fortran2003.py

@@ -7949,14 +7949,14 @@ def get_start_name(self):
         return self.item.name
 
 
-class Loop_Control(Base):  # pylint: disable=invalid-name
+# pylint: disable=invalid-name
+class Loop_Control(Base):  # R830
     """
-    R830::
+    Fortran 2008 rule R830
 
-        <loop-control> = [ , ] <do-variable> = scalar-int-expr,
-                                               scalar-int-expr
-                                               [ , <scalar-int-expr> ]
-                         | [ , ] WHILE ( <scalar-logical-expr> )
+    loop-control is [ , ] do-variable = scalar-int-expr , scalar-int-expr
+                       [ , scalar-int-expr ]
+                    or [ , ] WHILE ( scalar-logical-expr )
 
     """
 
@@ -7965,66 +7965,72 @@ class Loop_Control(Base):  # pylint: disable=invalid-name
 
     @staticmethod
     def match(string):
-        """
-        :param str string: Fortran code to check for a match
-        :return: 3-tuple containing strings and instances of the classes
-                 determining loop control (optional comma delimiter,
-                 optional scalar logical expression describing "WHILE"
-                 condition or optional counter expression containing loop
-                 counter and scalar integer expression)
-        :rtype: 3-tuple of objects or nothing for an "infinite loop"
+        """Attempts to match the supplied text with this rule.
+
+        :param str string: Fortran code to check for a match.
+
+        :returns: 3-tuple containing strings and instances of the classes \
+            determining loop control. The first entry indicates the type of \
+            match ("WHILE" or "COUNTER"), the second entry provides the \
+            classes resulting from matching and the third entry inidcates \
+            whether there is an optional preceding ','.
+        :rtype: Optional[Tuple[ \
+            str,
+            Tuple[:py:class:`fparser.two.Fortran2003.Do_Variable`, List[str]]| \
+                :py:class:`fparser.two.Fortran2003.Scalar_Logical_Expr`, \
+            Optional[str]]]
+
         """
         # pylint: disable=unbalanced-tuple-unpacking
+        line = string.lstrip().rstrip()
+        # Try to match optional delimiter
         optional_delim = None
-        # Match optional delimiter
-        if string.startswith(","):
-            line, repmap = string_replace_map(string[1:].lstrip())
-            optional_delim = ", "
-        else:
-            line, repmap = string_replace_map(string)
-        # Match "WHILE" scalar logical expression
+        if line.startswith(","):
+            line = line[1:].lstrip()
+            optional_delim = ","
+        line, repmap = string_replace_map(line)
+        # Try to match with WHILE
         if line[:5].upper() == "WHILE" and line[5:].lstrip().startswith("("):
-            lbrak = line[5:].lstrip()
-            i = lbrak.find(")")
-            if i != -1 and i == len(lbrak) - 1:
-                scalar_logical_expr = Scalar_Logical_Expr(repmap(lbrak[1:i].strip()))
-                return scalar_logical_expr, None, optional_delim
-        # Match counter expression
-        # More than one '=' in counter expression
+            brackets = line[5:].lstrip()
+            rbrack_index = brackets.find(")")
+            if rbrack_index != -1 and rbrack_index == len(brackets) - 1:
+                scalar_logical_expr = Scalar_Logical_Expr(
+                    repmap(brackets[1:rbrack_index].strip())
+                )
+                if not scalar_logical_expr:
+                    return None
+                return ("WHILE", scalar_logical_expr, optional_delim)
+        # Try to match counter expression
+        # More than one '=' in counter expression is not valid
         if line.count("=") != 1:
-            return
+            return None
         var, rhs = line.split("=")
-        rhs = [s.strip() for s in rhs.lstrip().split(",")]
+        rhs = [entry.strip() for entry in rhs.lstrip().split(",")]
         # Incorrect number of elements in counter expression
         if not 2 <= len(rhs) <= 3:
-            return
+            return None
         counter_expr = (
-            Variable(repmap(var.rstrip())),
+            Do_Variable(repmap(var.rstrip())),
             list(map(Scalar_Int_Expr, list(map(repmap, rhs)))),
         )
-        return None, counter_expr, optional_delim
+        return ("COUNTER", counter_expr, optional_delim)
 
     def tostr(self):
         """
-        :return: parsed representation of loop control construct
-        :rtype: string
+        :returns: the Fortran representation of this object.
+        :rtype: str
         """
-        # pylint: disable=unbalanced-tuple-unpacking
-        scalar_logical_expr, counter_expr, optional_delim = self.items
-        # Return loop control construct containing "WHILE" condition and
-        # its <scalar-logical-expr>
-        if scalar_logical_expr is not None:
-            loopctrl = "WHILE (%s)" % scalar_logical_expr
-        # Return loop control construct containing counter expression:
-        # <do-variable> as LHS and <scalar-int-expr> list as RHS
-        elif counter_expr[0] is not None and counter_expr[1] is not None:
-            loopctrl = "%s = %s" % (
-                counter_expr[0],
-                ", ".join(map(str, counter_expr[1])),
-            )
+        if self.items[0] == "WHILE":
+            # Return loop control construct containing "WHILE" condition and
+            # its <scalar-logical-expr>
+            loopctrl = f"WHILE ({self.items[1]})"
+        else:  # name == "COUNTER"
+            # Return loop control construct containing counter expression:
+            # <do-variable> as LHS and <scalar-int-expr> list as RHS
+            loopctrl = f"{self.items[1][0]} = {', '.join(map(str, self.items[1][1]))}"
         # Add optional delimiter to loop control construct if present
-        if optional_delim is not None:
-            loopctrl = optional_delim + loopctrl
+        if self.items[2]:
+            loopctrl = f"{self.items[2]} {loopctrl}"
         return loopctrl
 
 

src/fparser/two/Fortran2008.py

@@ -105,6 +105,7 @@
     Execution_Part_Construct,
     File_Name_Expr,
     File_Unit_Number,
+    Forall_Header,
     Implicit_Part,
     Implicit_Part_Stmt,
     Import_Stmt,
@@ -818,7 +819,7 @@ def alloc_opt_list(cls):
         return Alloc_Opt_List
 
 
-class Loop_Control(Loop_Control_2003): # R818
+class Loop_Control(Loop_Control_2003):  # R818
     """
     Fortran 2008 rule R818
 
@@ -830,34 +831,68 @@ class Loop_Control(Loop_Control_2003): # R818
     Extends the Fortran2003 rule R830 with the additional CONCURRENT clause.
 
     """
-    use_names = ["Do_Variable",
-                 "Scalar_Int_Expr",
-                 "Scalar_Logical_Expr",
-                 "Forall_Header"]
+
+    subclass_names = []
+    use_names = [
+        "Do_Variable",
+        "Scalar_Int_Expr",
+        "Scalar_Logical_Expr",
+        "Forall_Header",
+    ]
 
     @staticmethod
     def match(string):
-        """
-        :param str string: Fortran code to check for a match
-        :return: 3-tuple containing strings and instances of the classes
-                 determining loop control (optional comma delimiter,
-                 optional scalar logical expression describing "WHILE"
-                 condition or optional counter expression containing loop
-                 counter and scalar integer expression)
-        :rtype: 3-tuple of objects or nothing for an "infinite loop"
+        """Attempts to match the supplied text with this rule.
 
-        """
+        :param str string: Fortran code to check for a match.
 
-        *** result = Loop_Control_2003.match(string)
+        :returns: 3-tuple containing strings and instances of the \
+            classes determining loop control. The first entry \
+            indicates the type of match ("WHILE", "COUNTER" or \
+            "CONCURRENT"), the second entry provides the classes \
+            resulting from matching and the third entry inidcates \
+            whether there is an optional preceding ','.
+        :rtype: Optional[Tuple[ \
+            str, \
+            Tuple[:py:class:`fparser.two.Fortran2003.Do_Variable`, \
+                  List[str]]| \
+                :py:class:`fparser.two.Fortran2003.Scalar_Logical_Expr`| \
+                :py:class:`fparser.two.Fortran2003.Forall_Header`, \
+            Optional[str]]]
 
+        """
+        # Fortran2003 matches all but CONCURRENT so try this first
+        result = Loop_Control_2003.match(string)
+        if result:
+            return result
+        # Try to match with CONCURRENT
         line = string.lstrip()
         optional_delim = None
         if line.startswith(","):
             line = line[1:].lstrip()
             optional_delim = ","
         if line[:10].upper() != "CONCURRENT":
             return None
-        ?????return (Forall_Header(line[:10].lstrip()), None, optional_delim)
+        return (
+            "CONCURRENT",
+            Forall_Header(line[10:].lstrip().rstrip()),
+            optional_delim,
+        )
+
+    def tostr(self):
+        """
+        :returns: the Fortran representation of this object.
+        :rtype: str
+        """
+        if self.items[0] != "CONCURRENT":
+            # Use the F2003 tostr() implementation
+            return Loop_Control_2003.tostr(self)
+        # Return loop control construct containing "CONCURRENT" clause
+        loopctrl = f"CONCURRENT {self.items[1]}"
+        # Add optional delimiter to loop control construct if present
+        if self.items[2]:
+            loopctrl = f"{self.items[2]} {loopctrl}"
+        return loopctrl
 
 
 class If_Stmt(If_Stmt_2003):  # R837

src/fparser/two/tests/fortran2003/test_loop_control_r830.py

@@ -0,0 +1,116 @@
+# Copyright (c) 2023 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 2003 rule R830 : This file tests the support for the
+loop-control rule.
+
+"""
+import pytest
+from fparser.two.Fortran2003 import Loop_Control
+from fparser.two.utils import NoMatchError
+
+
+def test_start_end_space_while():
+    """Test that there is a match if the string contains white space at
+    the start and end and that the tostr() output is as expected. Also
+    test matching to the while form of this rule.
+
+    """
+    result = Loop_Control(" while (.true.) ")
+    assert isinstance(result, Loop_Control)
+    assert str(result) == "WHILE (.TRUE.)"
+
+
+def test_delim():
+    """Test that there is a match if the string contains an optional
+    delimiter at the start and that the tostr() output is as expected.
+
+    """
+    result = Loop_Control(" , while (.true.) ")
+    assert isinstance(result, Loop_Control)
+    assert str(result) == ", WHILE (.TRUE.)"
+
+
+def test_repmap():
+    """Test matching when the while logical expresssion contains
+    brackets. This tests the use of the string_replace_map() function.
+
+    """
+    result = Loop_Control(" , while (((a .or. b) .and. (c .or. d))) ")
+    assert isinstance(result, Loop_Control)
+    assert str(result) == ", WHILE (((a .OR. b) .AND. (c .OR. d)))"
+
+
+def test_counter():
+    """Test matching to the counter form of this rule and that the tostr()
+    output is as expected.
+
+    """
+    # Lower-bound and upper-bound only
+    result = Loop_Control("idx = start,stop")
+    assert isinstance(result, Loop_Control)
+    assert str(result) == "idx = start, stop"
+    # Lower-bound, upper-bound and step
+    result = Loop_Control("idx = start,stop,step")
+    assert isinstance(result, Loop_Control)
+    assert str(result) == "idx = start, stop, step"
+
+
+@pytest.mark.parametrize(
+    "string",
+    [
+        "",
+        " ",
+        ": while(.true.)",
+        "whil (.true.)",
+        "while .true.",
+        "while ()",
+        "while( )",
+        "while (.true ",
+        "while ())",
+        "while(a=b)",
+        " == ",
+        " = ",
+        "idx=",
+        "=1,2",
+        "idx=1",
+        "idx=1,2,3,4",
+        "1=1,2",
+        "idx=1,.false.",
+    ],
+)
+def test_invalid(string):
+    """Test that there is no match for various invalid input strings."""
+    with pytest.raises(NoMatchError):
+        _ = Loop_Control(string)