Merge pull request #438 from stfc/437_type_guard_stmt_bug

fix type guard stmt bug and update tests.

CHANGELOG.md

@@ -18,6 +18,8 @@ Modifications by (in alphabetical order):
 * P. Vitt, University of Siegen, Germany
 * A. Voysey, UK Met Office
 
+15/07/2024 PR #438 for #437. Fix type guard statement bug. 
+
 24/04/2024 PR #444 for #443. Adds an option to the reader to handle code
            behind OpenMP sentinels (e.g. '!$ write(*,*) "hello"').
 

src/fparser/two/Fortran2003.py

@@ -7658,16 +7658,16 @@ def get_start_name(self):
 
 
 class Type_Guard_Stmt(StmtBase):  # R823
-    """
-    ::
+    """Fortran 2003 rule R823
 
-        <type-guard-stmt> = TYPE IS ( <type-spec> ) [ <select-construct-name> ]
-                            | CLASS IS ( <type-spec> ) [ <select-construct-name> ]
-                            | CLASS DEFAULT [ <select-construct-name> ]
+    type-guard-stmt is TYPE IS ( type-spec ) [ select-construct-name ]
+                    or CLASS IS ( type-spec ) [ select-construct-name ]
+                    or CLASS DEFAULT [ select-construct-name ]
 
-    The `items` attribute for this class will contain::
+    The `items` attribute for this class will contain:
 
-        ({'TYPE IS', 'CLASS IS', 'CLASS DEFAULT'}, Type_Spec, Select_Construct_Name)
+    ({'TYPE IS', 'CLASS IS', 'CLASS DEFAULT'}, Type_Spec,
+    Select_Construct_Name)
 
     """
 
@@ -7676,10 +7676,23 @@ class Type_Guard_Stmt(StmtBase):  # R823
 
     @staticmethod
     def match(string):
+        """Implements the matching of a Type_Guard_Stmt rule.
+
+        :param str string: the code that we are trying to match.
+
+        :returns: a 3-tuple, containing the guard rule as a string (one of
+            'TYPE IS', 'CLASS IS' or 'CLASS DEFAULT'),
+            followed by an optional Type_Spec and an optional
+            Select_Construct_Name. Returns None if there is no match.
+        :rtype: Optional[Tuple[str, Optional[:py:class:`fparser.two.Type_Spec`],
+            Optional[:py:class:`fparser.two.Select_Construct_Name`]]]
+
+        """
+        string = string.lstrip()
         if string[:4].upper() == "TYPE":
             line = string[4:].lstrip()
             if not line[:2].upper() == "IS":
-                return
+                return None
             line = line[2:].lstrip()
             kind = "TYPE IS"
         elif string[:5].upper() == "CLASS":
@@ -7690,39 +7703,45 @@ def match(string):
             elif line[:7].upper() == "DEFAULT":
                 line = line[7:].lstrip()
                 if line:
-                    if isalnum(line[0]):
-                        return
                     return "CLASS DEFAULT", None, Select_Construct_Name(line)
                 return "CLASS DEFAULT", None, None
             else:
-                return
+                return None
         else:
-            return
+            return None
         if not line.startswith("("):
-            return
-        i = line.rfind(")")
-        if i == -1:
-            return
-        tmp = line[1:i].strip()
+            return None
+        index = line.rfind(")")
+        if index == -1:
+            return None
+        tmp = line[1:index].strip()
         if not tmp:
-            return
-        line = line[i + 1 :].lstrip()
+            return None
+        line = line[index + 1 :].lstrip()
         if line:
             return kind, Type_Spec(tmp), Select_Construct_Name(line)
         return kind, Type_Spec(tmp), None
 
     def tostr(self):
-        s = str(self.items[0])
+        """
+        :returns: string containing Fortran code for the parsed
+            Type_Guard_Stmt rule.
+        :rtype: str
+
+        """
+        string = str(self.items[0])
         if self.items[1] is not None:
-            s += " (%s)" % (self.items[1])
+            string += f" ({self.items[1]})"
         if self.items[2] is not None:
-            s += " %s" % (self.items[2])
-        return s
+            string += f" {self.items[2]}"
+        return string
 
     def get_end_name(self):
         """
-        :return: the name at the END of this block, if it exists
-        :rtype: str or NoneType
+        :returns: the name at the END of this block, if it exists,
+            otherwise None.
+        :rtype: Optional[str]
+
         """
         name = self.items[-1]
         if name is not None:

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

@@ -0,0 +1,221 @@
+# 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 R823
+
+        type-guard-stmt is TYPE IS ( type-spec ) [ select-construct-name ]
+                        or CLASS IS ( type-spec ) [ select-construct-name ]
+                        or CLASS DEFAULT [ select-construct-name ]
+
+"""
+import pytest
+
+from fparser.two.Fortran2003 import Type_Guard_Stmt
+from fparser.two.utils import NoMatchError
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_type_is():
+    """Test that the match works as expected when trying to match 'type
+    is'
+
+    """
+    # Space before 'type is'
+    tcls = Type_Guard_Stmt
+    obj = tcls("  type is (real)")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "TYPE IS (REAL)"
+
+    # Mixed case keyword
+    obj = tcls("TyPe Is (mytype)")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "TYPE IS (mytype)"
+
+    # Invalid 'type' keyword
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls("TYP Is (mytype)")
+    assert "Type_Guard_Stmt: 'TYP Is (mytype)'" in str(info.value)
+
+    # Invalid 'is' keyword
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls("TYPE IZ (mytype)")
+    assert "Type_Guard_Stmt: 'TYPE IZ (mytype)'" in str(info.value)
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_class_is():
+    """Test that the match works as expected when trying to match 'class
+    is'
+
+    """
+    # Space before 'class is'
+    tcls = Type_Guard_Stmt
+    obj = tcls("  class is (real)")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "CLASS IS (REAL)"
+
+    # Mixed case keyword
+    obj = tcls("ClAsS Is (mytype)")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "CLASS IS (mytype)"
+
+    # Invalid 'class' keyword
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls("CLAS IS (mytype)")
+    assert "Type_Guard_Stmt: 'CLAS IS (mytype)'" in str(info.value)
+
+    # Invalid 'is' keyword
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls("CLASS IZ (mytype)")
+    assert "Type_Guard_Stmt: 'CLASS IZ (mytype)'" in str(info.value)
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_default():
+    """Test that the match works as expected when trying to match 'class
+    default'
+
+    """
+    # Space before 'class default'
+    tcls = Type_Guard_Stmt
+    obj = tcls("  class default")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "CLASS DEFAULT"
+
+    # Mixed case keyword
+    obj = tcls("ClAsS DeFaUlT")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "CLASS DEFAULT"
+
+    # Invalid 'class' keyword
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls("CLAS DEFAULT")
+    assert "Type_Guard_Stmt: 'CLAS DEFAULT'" in str(info.value)
+
+    # Invalid 'default' keyword
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls("CLASS DERFAULT")
+    assert "Type_Guard_Stmt: 'CLASS DERFAULT'" in str(info.value)
+
+    # Invalid optional name after CLASS DEFAULT
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls("CLASS DEFAULT (mytype)")
+    assert "Type_Guard_Stmt: 'CLASS DEFAULT (mytype)'" in str(info.value)
+
+    # Valid name after CLASS DEFAULT
+    obj = tcls("class default myname")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "CLASS DEFAULT myname"
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_invalid_keyword():
+    """Test that the match fails if the initial matching keyword is not
+    CLASS or TYPE.
+
+    """
+    tcls = Type_Guard_Stmt
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls("invalid")
+    assert "Type_Guard_Stmt: 'invalid'" in str(info.value)
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_clause():
+    """Test matching works as expected when trying to match 'class is
+    (mytype)'. Also covers case with 'type is' so no need for
+    additional tests.
+
+    """
+    # invalid ( location
+    tcls = Type_Guard_Stmt
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls(" class is m(ytype)")
+    assert "Type_Guard_Stmt: ' class is m(ytype)'" in str(info.value)
+
+    # non-existant )
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls(" class is (mytype")
+    assert "Type_Guard_Stmt: ' class is (mytype'" in str(info.value)
+
+    # no content in ()
+    with pytest.raises(NoMatchError) as info:
+        _ = tcls(" class is ()")
+    assert "Type_Guard_Stmt: ' class is ()'" in str(info.value)
+
+    # valid string
+    obj = tcls(" class is (mytype)")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "CLASS IS (mytype)"
+
+    # valid string with optional name
+    obj = tcls(" class is (mytype) name")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "CLASS IS (mytype) name"
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_tostr():
+    """Test the tostr() method works as expected"""
+
+    tcls = Type_Guard_Stmt
+    obj = tcls("class default")
+    assert obj.tostr() == "CLASS DEFAULT"
+
+    obj = tcls("class default name")
+    assert obj.tostr() == "CLASS DEFAULT name"
+
+    obj = tcls("class is (real)")
+    assert obj.tostr() == "CLASS IS (REAL)"
+
+    obj = tcls("class is (real) name")
+    assert obj.tostr() == "CLASS IS (REAL) name"
+
+    obj = tcls("type is (real)")
+    assert obj.tostr() == "TYPE IS (REAL)"
+
+    obj = tcls("type is (real) name")
+    assert obj.tostr() == "TYPE IS (REAL) name"
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_get_end_name():
+    """Test the get_end_name method works as expected."""
+
+    tcls = Type_Guard_Stmt
+    obj = tcls("type is (real)")
+    assert obj.get_end_name() is None
+
+    obj = tcls("type is (real) name")
+    assert obj.get_end_name() == "name"

src/fparser/two/tests/test_fortran2003.py

@@ -2079,21 +2079,6 @@ def test_select_type_stmt():  # R822
     assert str(obj) == "SELECT TYPE(a)"
 
 
-def test_type_guard_stmt():  # R823
-    tcls = Type_Guard_Stmt
-    obj = tcls("type is (real*8)")
-    assert isinstance(obj, tcls), repr(obj)
-    assert str(obj) == "TYPE IS (REAL*8)"
-
-    obj = tcls("class is (mytype) name")
-    assert isinstance(obj, tcls), repr(obj)
-    assert str(obj) == "CLASS IS (mytype) name"
-
-    obj = tcls("classdefault")
-    assert isinstance(obj, tcls), repr(obj)
-    assert str(obj) == "CLASS DEFAULT"
-
-
 def test_label_do_stmt():
     """Tests that labeled DO statement is parsed correctly (R828)."""
     tcls = Label_Do_Stmt