Merge pull request #423 from stfc/403_do_concurrent

add support for do concurrent - 2nd try (closes #403)

CHANGELOG.md

@@ -18,6 +18,9 @@ Modifications by (in alphabetical order):
 * P. Vitt, University of Siegen, Germany
 * A. Voysey, UK Met Office
 
+12/09/2023 PR #423 for #403. Adds full support for DO CONCURRENT in F2008
+           (fixes bugs in previous implementation).
+
 12/06/2023 PR #417 towards #411. Moves Fortran2008.py into a 'Fortran2008'
            directory and moves the associated class generation into an '__init__.py'
            in that directory.

src/fparser/two/Fortran2003.py

@@ -7787,23 +7787,32 @@ class Block_Label_Do_Construct(BlockBase):  # pylint: disable=invalid-name
     subclass_names = []
     use_names = ["Label_Do_Stmt", "Execution_Part_Construct", "End_Do"]
 
-    @staticmethod
-    def match(reader):
+    @classmethod
+    def match(cls, reader):
         """
         :param reader: instance of `FortranReaderBase` class
         :type reader: :py:class:`FortranReaderBase`
         :return: code block matching the labeled "DO" construct
         :rtype: string
         """
         return BlockBase.match(
-            Label_Do_Stmt,
+            cls.label_do_stmt_cls(),
             [Execution_Part_Construct],
             End_Do,
             reader,
             match_labels=True,
             enable_do_label_construct_hook=True,
         )
 
+    @staticmethod
+    def label_do_stmt_cls():
+        """
+        :returns: Fortran2003 Label_Do_Stmt class.
+        :rtype: :py:class:`fparser.two.Fortran2003.Label_Do_Stmt`
+
+        """
+        return Label_Do_Stmt
+
     def tofortran(self, tab="", isfix=None):
         """
         :param str tab: tab character or empty string.
@@ -7837,23 +7846,32 @@ class Block_Nonlabel_Do_Construct(BlockBase):  # pylint: disable=invalid-name
     subclass_names = []
     use_names = ["Nonlabel_Do_Stmt", "Execution_Part_Construct", "End_Do_Stmt"]
 
-    @staticmethod
-    def match(reader):
+    @classmethod
+    def match(cls, reader):
         """
         :param reader: instance of `FortranReaderBase` class
         :type reader: :py:class:`FortranReaderBase`
         :return: code block matching the nonlabeled "DO" construct
         :rtype: string
         """
         return BlockBase.match(
-            Nonlabel_Do_Stmt,
+            cls.nonlabel_do_stmt_cls(),
             [Execution_Part_Construct],
             End_Do_Stmt,
             reader,
             match_names=True,  # C821
             strict_match_names=True,  # C821
         )
 
+    @staticmethod
+    def nonlabel_do_stmt_cls():
+        """
+        :returns: Fortran2003 Nonlabel_Do_Stmt class.
+        :rtype: :py:class:`fparser.two.Fortran2003.Nonlabel_Do_Stmt`
+
+        """
+        return Nonlabel_Do_Stmt
+
 
 class Do_Stmt(Base):  # pylint: disable=invalid-name
     """
@@ -7878,8 +7896,8 @@ class Label_Do_Stmt(StmtBase):  # pylint: disable=invalid-name
     subclass_names = []
     use_names = ["Do_Construct_Name", "Label", "Loop_Control"]
 
-    @staticmethod
-    def match(string):
+    @classmethod
+    def match(cls, string):
         """
         :param string: (source of) Fortran string to parse
         :type string: str or :py:class:`FortranReaderBase`
@@ -7898,9 +7916,18 @@ def match(string):
         label = mpat.group()
         line = line[mpat.end() :].lstrip()
         if line:
-            return None, Label(label), Loop_Control(line)
+            return None, Label(label), cls.loop_control_cls()(line)
         return None, Label(label), None
 
+    @staticmethod
+    def loop_control_cls():
+        """
+        :returns: Fortran2003 Loop_Control class.
+        :rtype: :py:class:`fparser.two.Fortran2003.Loop_Control`
+
+        """
+        return Loop_Control
+
     def tostr(self):
         """
         :return: string containing Fortran code for the parsed
@@ -7947,19 +7974,28 @@ class Nonlabel_Do_Stmt(StmtBase, WORDClsBase):  # pylint: disable=invalid-name
     subclass_names = []
     use_names = ["Do_Construct_Name", "Loop_Control"]
 
+    @classmethod
+    def match(cls, string):
+        """
+        :param str string: Fortran code to check for a match.
+        :return: code line matching the nonlabeled "DO" statement.
+        :rtype: str
+        """
+        return WORDClsBase.match("DO", cls.loop_control_cls(), string)
+
     @staticmethod
-    def match(string):
+    def loop_control_cls():
         """
-        :param str string: Fortran code to check for a match
-        :return: code line matching the nonlabeled "DO" statement
-        :rtype: string
+        :returns: Fortran2003 Loop_Control class.
+        :rtype: :py:class:`fparser.two.Fortran2003.Loop_Control`
+
         """
-        return WORDClsBase.match("DO", Loop_Control, string)
+        return Loop_Control
 
     def get_start_name(self):
         """
         :return: optional labeled "DO" statement name
-        :rtype: string
+        :rtype: str
         """
         return self.item.name
 
@@ -8158,17 +8194,26 @@ class Action_Term_Do_Construct(BlockBase):  # R836
     subclass_names = []
     use_names = ["Label_Do_Stmt", "Execution_Part_Construct", "Do_Term_Action_Stmt"]
 
-    @staticmethod
-    def match(reader):
+    @classmethod
+    def match(cls, reader):
         return BlockBase.match(
-            Label_Do_Stmt,
+            cls.label_do_stmt_cls(),
             [Execution_Part_Construct],
             Do_Term_Action_Stmt,
             reader,
             match_labels=True,
             enable_do_label_construct_hook=True,
         )
 
+    @staticmethod
+    def label_do_stmt_cls():
+        """
+        :returns: Fortran2003 Label_Do_Stmt class.
+        :rtype: :py:class:`fparser.two.Fortran2003.Label_Do_Stmt`
+
+        """
+        return Label_Do_Stmt
+
     def tofortran(self, tab="", isfix=None):
         """
         Converts this node (and all children) into Fortran.
@@ -8187,7 +8232,7 @@ def tofortran(self, tab="", isfix=None):
         line.append(start.tofortran(tab=tab, isfix=isfix))
         for item in self.content[1:-1]:
             line.append(item.tofortran(tab=tab + extra_tab, isfix=isfix))
-            if isinstance(item, Label_Do_Stmt):
+            if isinstance(item, self.label_do_stmt_cls()):
                 extra_tab += "  "
         if len(self.content) > 1:
             line.append(end.tofortran(tab=tab, isfix=isfix))

src/fparser/two/Fortran2008/__init__.py

@@ -86,6 +86,18 @@
     Procedure_Stmt,
 )
 
+from fparser.two.Fortran2008.action_term_do_construct_r824 import (
+    Action_Term_Do_Construct,
+)
+from fparser.two.Fortran2008.block_label_do_construct_r814_1 import (
+    Block_Label_Do_Construct,
+)
+from fparser.two.Fortran2008.block_nonlabel_do_construct_r814_2 import (
+    Block_Nonlabel_Do_Construct,
+)
+from fparser.two.Fortran2008.label_do_stmt_r816 import Label_Do_Stmt
+from fparser.two.Fortran2008.nonlabel_do_stmt_r817 import Nonlabel_Do_Stmt
+
 
 # pylint: disable=eval-used
 # pylint: disable=exec-used

src/fparser/two/Fortran2008/action_term_do_construct_r824.py

@@ -0,0 +1,65 @@
+# -----------------------------------------------------------------------------
+# BSD 3-Clause License
+#
+# Copyright (c) 2023, 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.
+# -----------------------------------------------------------------------------
+"""This module provides the Fortran2008-specific version of the
+action-term-do-construct rule R824.
+
+    action-term-do-construct is label-do-stmt
+                                      do-body
+                                      do-term-action-stmt
+
+The only difference to F2003 rule R835 is that we force this rule to
+use the F2008 version of label-do-stmt
+
+"""
+
+from fparser.two.Fortran2003 import (
+    Action_Term_Do_Construct as Action_Term_Do_Construct_2003,
+)
+from fparser.two.Fortran2008.label_do_stmt_r816 import Label_Do_Stmt
+
+
+class Action_Term_Do_Construct(Action_Term_Do_Construct_2003):
+    """Subclass the 2003 version so that this class will import the
+    Fortran2008 Label_Do_Stmt class.
+
+    """
+
+    @staticmethod
+    def label_do_stmt_cls():
+        """
+        :returns: Fortran2008 Label_Do_Stmt class.
+        :rtype: :py:class:`fparser.two.Fortran2008.Label_Do_Stmt`
+
+        """
+        return Label_Do_Stmt

src/fparser/two/Fortran2008/block_label_do_construct_r814_1.py

@@ -0,0 +1,68 @@
+# -----------------------------------------------------------------------------
+# BSD 3-Clause License
+#
+# Copyright (c) 2023, 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.
+# -----------------------------------------------------------------------------
+"""This module provides the Fortran2008-specific version of a partial
+implementation of the block-do-construct rule r814. fparser splits
+this rule into a label and nonlabel version for do-stmt (which is
+specified by rule r815). This class implements the label version of
+the rule: r814_1
+
+    block-do-construct is do-stmt
+                          do-block
+                          end-do
+
+The only difference to F2003 rule R826_1 is that we force this rule to
+use the F2008 version of label-do-stmt
+
+"""
+
+from fparser.two.Fortran2003 import (
+    Block_Label_Do_Construct as Block_Label_Do_Construct_2003,
+)
+from fparser.two.Fortran2008.label_do_stmt_r816 import Label_Do_Stmt
+
+
+class Block_Label_Do_Construct(Block_Label_Do_Construct_2003):
+    """Subclass the 2003 version so that this class will import the
+    Fortran2008 Label_Do_Stmt class
+
+    """
+
+    @staticmethod
+    def label_do_stmt_cls():
+        """
+        :returns: Fortran2008 Label_Do_Stmt class.
+        :rtype: :py:class:`fparser.two.Fortran2008.Label_Do_Stmt`
+
+        """
+        return Label_Do_Stmt