diff --git a/CHANGELOG.md b/CHANGELOG.md index c90af255..96810a3b 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/src/fparser/two/Fortran2003.py b/src/fparser/two/Fortran2003.py index 3f93fd21..7cd4f96a 100644 --- a/src/fparser/two/Fortran2003.py +++ b/src/fparser/two/Fortran2003.py @@ -7787,8 +7787,8 @@ 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` @@ -7796,7 +7796,7 @@ def match(reader): :rtype: string """ return BlockBase.match( - Label_Do_Stmt, + cls.label_do_stmt_cls(), [Execution_Part_Construct], End_Do, reader, @@ -7804,6 +7804,15 @@ def match(reader): 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,8 +7846,8 @@ 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` @@ -7846,7 +7855,7 @@ def match(reader): :rtype: string """ return BlockBase.match( - Nonlabel_Do_Stmt, + cls.nonlabel_do_stmt_cls(), [Execution_Part_Construct], End_Do_Stmt, reader, @@ -7854,6 +7863,15 @@ def match(reader): 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,10 +8194,10 @@ 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, @@ -8169,6 +8205,15 @@ def match(reader): 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)) diff --git a/src/fparser/two/Fortran2008/__init__.py b/src/fparser/two/Fortran2008/__init__.py index a68307d5..b260000c 100644 --- a/src/fparser/two/Fortran2008/__init__.py +++ b/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 diff --git a/src/fparser/two/Fortran2008/action_term_do_construct_r824.py b/src/fparser/two/Fortran2008/action_term_do_construct_r824.py new file mode 100644 index 00000000..6452c303 --- /dev/null +++ b/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 diff --git a/src/fparser/two/Fortran2008/block_label_do_construct_r814_1.py b/src/fparser/two/Fortran2008/block_label_do_construct_r814_1.py new file mode 100644 index 00000000..88398d76 --- /dev/null +++ b/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 diff --git a/src/fparser/two/Fortran2008/block_nonlabel_do_construct_r814_2.py b/src/fparser/two/Fortran2008/block_nonlabel_do_construct_r814_2.py new file mode 100644 index 00000000..c2e5458f --- /dev/null +++ b/src/fparser/two/Fortran2008/block_nonlabel_do_construct_r814_2.py @@ -0,0 +1,59 @@ +# ----------------------------------------------------------------------------- +# 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. + +""" + +from fparser.two.Fortran2003 import ( + Block_Nonlabel_Do_Construct as Block_Nonlabel_Do_Construct_2003, +) +from fparser.two.Fortran2008.nonlabel_do_stmt_r817 import Nonlabel_Do_Stmt + + +class Block_Nonlabel_Do_Construct(Block_Nonlabel_Do_Construct_2003): + """Subclass the 2003 version so that this class will import the + Fortran2008 Nonlabel_Do_Stmt class + + """ + + @staticmethod + def nonlabel_do_stmt_cls(): + """ + :returns: Fortran2008 Nonlabel_Do_Stmt class. + :rtype: :py:class:`fparser.two.Fortran2008.Nonlabel_Do_Stmt` + + """ + return Nonlabel_Do_Stmt diff --git a/src/fparser/two/Fortran2008/label_do_stmt_r816.py b/src/fparser/two/Fortran2008/label_do_stmt_r816.py new file mode 100644 index 00000000..ffcaf477 --- /dev/null +++ b/src/fparser/two/Fortran2008/label_do_stmt_r816.py @@ -0,0 +1,60 @@ +# ----------------------------------------------------------------------------- +# 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 +label-do-stmt rule r816. + + label-do-stmt is [ do-construct-name : ] DO label [ loop-control ] + +The only difference to F2003 rule R828 is that we force this rule to +use the F2008 version of loop-control + +""" +from fparser.two.Fortran2003 import Label_Do_Stmt as Label_Do_Stmt_2003 +from fparser.two.Fortran2008 import Loop_Control + + +class Label_Do_Stmt(Label_Do_Stmt_2003): + """Subclass the 2003 version so that this class will import the + Fortran2008 Label_Do_Stmt class. + + """ + + @staticmethod + def loop_control_cls(): + """ + :returns: Fortran2008 Loop_Control class. + :rtype: :py:class:`fparser.two.Fortran2008.Loop_Control` + + """ + return Loop_Control diff --git a/src/fparser/two/Fortran2008/nonlabel_do_stmt_r817.py b/src/fparser/two/Fortran2008/nonlabel_do_stmt_r817.py new file mode 100644 index 00000000..8db76f2c --- /dev/null +++ b/src/fparser/two/Fortran2008/nonlabel_do_stmt_r817.py @@ -0,0 +1,60 @@ +# ----------------------------------------------------------------------------- +# 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 +nonlabel-do-stmt rule r817. + + nonlabel-do-stmt is [ do-construct-name : ] DO [ loop-control ] + +The only difference to F2003 rule R829 is that we force this rule +to use the F2008 version of loop-control + +""" +from fparser.two.Fortran2003 import Nonlabel_Do_Stmt as Nonlabel_Do_Stmt_2003 +from fparser.two.Fortran2008 import Loop_Control + + +class Nonlabel_Do_Stmt(Nonlabel_Do_Stmt_2003): + """Subclass the 2003 version so that this class will import the + Fortran2008 Label_Do_Stmt class. + + """ + + @staticmethod + def loop_control_cls(): + """ + :returns: Fortran2008 Loop_Control class. + :rtype: :py:class:`fparser.two.Fortran2008.Loop_Control` + + """ + return Loop_Control diff --git a/src/fparser/two/tests/fortran2008/test_action_term_do_construct_r824.py b/src/fparser/two/tests/fortran2008/test_action_term_do_construct_r824.py new file mode 100644 index 00000000..2254ca06 --- /dev/null +++ b/src/fparser/two/tests/fortran2008/test_action_term_do_construct_r824.py @@ -0,0 +1,78 @@ +# ----------------------------------------------------------------------------- +# 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. +# ----------------------------------------------------------------------------- + +"""Test Fortran 2008 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 + +""" +import pytest + +from fparser.api import get_reader +from fparser.two.Fortran2008 import Action_Term_Do_Construct + + +@pytest.mark.usefixtures("f2008_create") +def test_concurrent(): + """Test that the Fortran2008 version supports do concurrent.""" + code = "DO 10 CONCURRENT (i = 1 : 20)\n a(i) = 0.0\n10 b(i) = 1.0" + reader = get_reader(code) + obj = Action_Term_Do_Construct(reader) + assert isinstance(obj, Action_Term_Do_Construct) + assert str(obj) == code + + +def test_functional(f2008_parser): + """The 2008 version of the Action_Term_Do_Construct class is only + added to make sure that that a labelled do concurrent (where the + label is not attached to a continue) is parsed in f2008. Therefore + add a functional test to make sure this class does its job. + + """ + code = ( + "PROGRAM test\n" + " INTEGER :: i\n" + " REAL :: a(20), b(20)\n" + " DO 10 CONCURRENT (i = 1 : 20)\n" + " a(i) = 0.0\n" + "10 b(i) = 1.0\n" + "END PROGRAM" + ) + tree = f2008_parser(get_reader(code)) + assert str(tree) == code diff --git a/src/fparser/two/tests/fortran2008/test_block_label_do_construct_r814_1.py b/src/fparser/two/tests/fortran2008/test_block_label_do_construct_r814_1.py new file mode 100644 index 00000000..dee8ffe2 --- /dev/null +++ b/src/fparser/two/tests/fortran2008/test_block_label_do_construct_r814_1.py @@ -0,0 +1,82 @@ +# ----------------------------------------------------------------------------- +# 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. +# ----------------------------------------------------------------------------- + +"""Test Fortran 2008 rule R814_1 + + block-do-construct is do-stmt + do-block + end-do + +The implementation in fparser2 actually implements the case when +do-stmt is a label-do-stmt (hence the name R814_1). R814_2 implements +the case when do-stmt is a nonlabel-do-stmt. + +The only difference to F2003 rule R835 is that we force this rule to +use the F2008 version of label-do-stmt + +""" +import pytest + +from fparser.api import get_reader +from fparser.two.Fortran2008 import Block_Label_Do_Construct + + +@pytest.mark.usefixtures("f2008_create") +def test_concurrent(): + """Test that the Fortran2008 version supports do concurrent.""" + code = "DO 10 CONCURRENT (i = 1 : 20)\n a(i) = 0.0\n10 CONTINUE" + reader = get_reader(code) + obj = Block_Label_Do_Construct(reader) + assert isinstance(obj, Block_Label_Do_Construct) + assert str(obj) == code + + +def test_functional(f2008_parser): + """The 2008 version of the Block_Label_Do_Construct class is only + added to make sure that that a labelled do concurrent (where the + label is attached to a continue) is parsed in f2008. Therefore add + a functional test to make sure this class does its job. + + """ + code = ( + "PROGRAM test\n" + " INTEGER :: i\n" + " REAL :: a(20)\n" + " DO 10 CONCURRENT (i = 1 : 20)\n" + " a(i) = 0.0\n" + "10 CONTINUE\n" + "END PROGRAM" + ) + tree = f2008_parser(get_reader(code)) + assert str(tree) == code diff --git a/src/fparser/two/tests/fortran2008/test_block_nonlabel_do_construct_r814_2.py b/src/fparser/two/tests/fortran2008/test_block_nonlabel_do_construct_r814_2.py new file mode 100644 index 00000000..ae234e99 --- /dev/null +++ b/src/fparser/two/tests/fortran2008/test_block_nonlabel_do_construct_r814_2.py @@ -0,0 +1,82 @@ +# ----------------------------------------------------------------------------- +# 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. +# ----------------------------------------------------------------------------- + +"""Test Fortran 2008 rule R814_2 + + block-do-construct is do-stmt + do-block + end-do + +The implementation in fparser2 actually implements the case when +do-stmt is a nonlabel-do-stmt (hence the name R814_2). R814_1 implements +the case when do-stmt is a label-do-stmt. + +The only difference to F2003 rule R835 is that we force this rule to +use the F2008 version of nonlabel-do-stmt + +""" +import pytest + +from fparser.api import get_reader +from fparser.two.Fortran2008 import Block_Nonlabel_Do_Construct + + +@pytest.mark.usefixtures("f2008_create") +def test_concurrent(): + """Test that the Fortran2008 version supports do concurrent.""" + code = "DO CONCURRENT (i = 1 : 20)\n a(i) = 0.0\nEND DO" + reader = get_reader(code) + obj = Block_Nonlabel_Do_Construct(reader) + assert isinstance(obj, Block_Nonlabel_Do_Construct) + assert str(obj) == code + + +def test_functional(f2008_parser): + """The 2008 version of the Block_Nonlabel_Do_Construct class is only + added to make sure that that an non-labelled do concurrent (where + end do is used) is parsed in f2008. Therefore add a functional + test to make sure this class does its job. + + """ + code = ( + "PROGRAM test\n" + " INTEGER :: i\n" + " REAL :: a(20)\n" + " DO CONCURRENT (i = 1 : 20)\n" + " a(i) = 0.0\n" + " END DO\n" + "END PROGRAM" + ) + tree = f2008_parser(get_reader(code)) + assert str(tree) == code diff --git a/src/fparser/two/tests/fortran2008/test_label_do_stmt_r816.py b/src/fparser/two/tests/fortran2008/test_label_do_stmt_r816.py new file mode 100644 index 00000000..14d37733 --- /dev/null +++ b/src/fparser/two/tests/fortran2008/test_label_do_stmt_r816.py @@ -0,0 +1,64 @@ +# ----------------------------------------------------------------------------- +# 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. +# ----------------------------------------------------------------------------- + +"""Test Fortran 2008 rule R816 + + label-do-stmt is [ do-construct-name : ] DO label [ loop-control ] + +The only difference to F2003 rule R828 is that we force this rule to +use the F2008 version of loop-control + +""" +import pytest + +from fparser.api import get_reader +from fparser.two.Fortran2008 import Label_Do_Stmt + + +@pytest.mark.usefixtures("f2008_create") +def test_concurrent(): + """Test that the Fortran2008 version supports do concurrent.""" + code = "DO 10 CONCURRENT (i = 1 : 20)" + reader = get_reader(code) + obj = Label_Do_Stmt(reader) + assert isinstance(obj, Label_Do_Stmt) + assert str(obj) == code + + +# The 2008 version of the Label_Do_Stmt class is only added to make +# sure that that a labelled do concurrent is parsed in f2008. There +# are already functional tests (called test_functional) in +# test_block_label_do_construct_r814_1.py and +# test_action_term_do_construct_r824.py which make sure this class +# does its job. diff --git a/src/fparser/two/tests/fortran2008/test_nonlabel_do_stmt_r817.py b/src/fparser/two/tests/fortran2008/test_nonlabel_do_stmt_r817.py new file mode 100644 index 00000000..34da69de --- /dev/null +++ b/src/fparser/two/tests/fortran2008/test_nonlabel_do_stmt_r817.py @@ -0,0 +1,63 @@ +# ----------------------------------------------------------------------------- +# 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. +# ----------------------------------------------------------------------------- + +"""Test Fortran 2008 rule R817 + + nonlabel-do-stmt is [ do-construct-name : ] DO [ loop-control ] + +The only difference to F2003 rule R829 is that we force this rule to +use the F2008 version of loop-control + +""" +import pytest + +from fparser.api import get_reader +from fparser.two.Fortran2008 import Nonlabel_Do_Stmt + + +@pytest.mark.usefixtures("f2008_create") +def test_concurrent(): + """Test that the Fortran2008 version supports do concurrent.""" + code = "DO CONCURRENT (i = 1 : 20)" + reader = get_reader(code) + obj = Nonlabel_Do_Stmt(reader) + assert isinstance(obj, Nonlabel_Do_Stmt) + assert str(obj) == code + + +# The 2008 version of the Nonlabel_Do_Stmt class is only added to make +# sure that that a labelled do concurrent is parsed in f2008. There is +# already a functional tests (called test_functional) in +# test_block_nonlabel_do_construct_r814_2.py which make sure this +# class does its job.