Repository: stfc/fparser

Issue:
fparser2 Rule 1101 ordering bug
Rule 1101 defines a main program. If the specification-part, execution-part or internal-subprogram-part are in the wrong order then no exception is raised. For example ...

```
xed67771@arcgdel01:~/proj/fparser/src/fparser/two/tests$ cat tmp2.f90
program aa
  a=0
  integer a
end program aa

xed67771@arcgdel01:~/proj/fparser/src/fparser/two/tests$ ../../scripts/fparser2.py tmp2.f90 
PROGRAM aa
  a = 0
  INTEGER :: a
END PROGRAM aa
xed67771@arcgdel01:~/proj/fparser/src/fparser/two/tests$ 
```
This is because the implementation uses BlockBase to match and BlockBase does not impose an ordering on its optional classes.


Discussion:

Patch:
diff --git a/src/fparser/two/Fortran2003.py b/src/fparser/two/Fortran2003.py
index 41658f7..4ecde5b 100644
--- a/src/fparser/two/Fortran2003.py
+++ b/src/fparser/two/Fortran2003.py
@@ -8371,7 +8371,7 @@ class Main_Program(BlockBase):  # R1101 [C1101, C1102, C1103]
                   `Execution_Part` followed by an optional \
                   `Internal_Subprogram_Part`.
         :rtype: `NoneType` or \
-                ([:py:class:`fparser.two.Fortran2003.Program_Stmt`,
+                ([:py:class:`fparser.two.Fortran2003.Program_Stmt`, \
                 optional \
                 :py:class:`fparser.two.Fortran2003.Specification_Part`, \
                 optional \
@@ -8384,7 +8384,7 @@ class Main_Program(BlockBase):  # R1101 [C1101, C1102, C1103]
         return BlockBase.match(
             Program_Stmt, [Specification_Part, Execution_Part,
                            Internal_Subprogram_Part], End_Program_Stmt,
-            reader, match_names=True)
+            reader, match_names=True, strict_order=True)
 
 
 class Main_Program0(BlockBase):
diff --git a/src/fparser/two/utils.py b/src/fparser/two/utils.py
index e7be5a6..1440bf6 100644
--- a/src/fparser/two/utils.py
+++ b/src/fparser/two/utils.py
@@ -406,7 +406,9 @@ content : tuple
               enable_if_construct_hook=False,
               enable_where_construct_hook=False,
               enable_select_type_construct_hook=False,
-              enable_case_construct_hook=False):
+              enable_case_construct_hook=False,
+              strict_order=False,
+              ):
         '''
         Checks whether the content in reader matches the given
         type of block statement (e.g. DO..END DO, IF...END IF etc.)
@@ -426,6 +428,8 @@ content : tuple
         :param bool enable_where_construct_hook: TBD
         :param bool enable_select_type_construct_hook: TBD
         :param bool enable_case_construct_hook: TBD
+        :param bool strict_order: Whether to enforce the order of the
+                                  given subclasses.
 
         :return: instance of startcls or None if no match is found
         :rtype: startcls
@@ -534,8 +538,9 @@ content : tuple
                 # We've found the enclosing end statement so break out
                 found_end = True
                 break
-            # Return to start of classes list now that we've matched
-            i = 0
+            if not strict_order:
+                # Return to start of classes list now that we've matched.
+                i = 0
             if enable_if_construct_hook:
                 from fparser.two.Fortran2003 import Else_If_Stmt, Else_Stmt, \
                     End_If_Stmt


Test patch:
diff --git a/src/fparser/two/tests/fortran2003/test_main_program_r1101.py b/src/fparser/two/tests/fortran2003/test_main_program_r1101.py
index 155ea2a..694aff3 100644
--- a/src/fparser/two/tests/fortran2003/test_main_program_r1101.py
+++ b/src/fparser/two/tests/fortran2003/test_main_program_r1101.py
@@ -125,8 +125,6 @@ def test_invalid1(f2003_create):
         in str(excinfo.value)
 
 
-@pytest.mark.xfail(reason="Fails to raise an exception with incorrect "
-                   "ordering. See issue #136.")
 def test_invalid2(f2003_create):
     '''Test that specification-part after execution-part produces an
     error.
@@ -135,11 +133,9 @@ def test_invalid2(f2003_create):
     with pytest.raises(NoMatchError) as excinfo:
         _ = Main_Program(get_reader("program a\ni=10\ninteger i\n"
                                     "end program a"))
-    assert "ADD CORRECT OUTPUT HERE" in str(excinfo.value)
+    assert "at line 3\n>>>integer i\n" in str(excinfo.value)
 
 
-@pytest.mark.xfail(reason="Fails to raise an exception with incorrect "
-                   "ordering. See issue #136.")
 def test_invalid3(f2003_create):
     '''Test that execution-part after internal-subprogram-part produces an
     error.
@@ -148,4 +144,4 @@ def test_invalid3(f2003_create):
     with pytest.raises(NoMatchError) as excinfo:
         _ = Main_Program(get_reader("program a\ncontains\nsubroutine foo\n"
                                     "end\ni=10\nend program a"))
-    assert "ADD CORRECT OUTPUT HERE" in str(excinfo.value)
+    assert "at line 5\n>>>i=10\n" in str(excinfo.value)
diff --git a/src/fparser/two/tests/utils/test_blockbase.py b/src/fparser/two/tests/utils/test_blockbase.py
index c7f8f1f..cc1fa41 100644
--- a/src/fparser/two/tests/utils/test_blockbase.py
+++ b/src/fparser/two/tests/utils/test_blockbase.py
@@ -34,7 +34,11 @@
 
 ''' File containing unit tests for the BlockBase baseclass in utils.py '''
 
+import pytest
+
+from fparser.api import get_reader
 from fparser.two.utils import BlockBase
+import fparser.two.Fortran2003 as F2003
 
 # TODO #179: full testing of this class. We currently only test the
 # comment and include support.
@@ -47,13 +51,10 @@ def test_include(f2003_create):
 
     '''
     # Use the Main Program rule R1101 as an example
-    from fparser.two.Fortran2003 import Program_Stmt, Specification_Part, \
-        Execution_Part, Internal_Subprogram_Part, End_Program_Stmt
-    from fparser.api import get_reader
-    startcls = Program_Stmt
-    subclasses = [Specification_Part, Execution_Part,
-                  Internal_Subprogram_Part]
-    endcls = End_Program_Stmt
+    startcls = F2003.Program_Stmt
+    subclasses = [F2003.Specification_Part, F2003.Execution_Part,
+                  F2003.Internal_Subprogram_Part]
+    endcls = F2003.End_Program_Stmt
     reader = get_reader((
         "include '1'\n"
         "! comment1\n"
@@ -87,3 +88,99 @@ def test_include(f2003_create):
         "'! comment5')), End_Program_Stmt('PROGRAM', Name('test'))],)") \
         in str(result)
     assert "should" not in str(result)
+
+
+@pytest.mark.parametrize('strict_order', [True, False])
+def test_strict_order_invalid_code(f2003_create, strict_order):
+    '''Check that the strict_order flag toggles the parse behaviour as
+    expected.
+    '''
+    subclasses = [F2003.Specification_Part, F2003.Execution_Part]
+    reader = get_reader("""
+        program main
+            i = 2
+            integer :: i
+        end program main
+        """)
+
+    expected = remove_indentation("""([
+      Program_Stmt('PROGRAM', Name('main')),
+      Execution_Part(
+          Assignment_Stmt(Name('i'), '=',
+          Int_Literal_Constant('2', None))),
+      Specification_Part(
+          Type_Declaration_Stmt(
+              Intrinsic_Type_Spec('INTEGER', None),
+              None,
+              Entity_Decl(Name('i'), None, None, None))),
+      End_Program_Stmt('PROGRAM', Name('main'))
+     ],)
+    """)
+    result = BlockBase.match(
+        F2003.Program_Stmt, subclasses, F2003.End_Program_Stmt, reader,
+        strict_order=strict_order)
+
+    if strict_order:
+        assert result is None
+    else:
+        assert str(result) == expected
+
+
+def test_strict_order_valid_code(f2003_create):
+    '''Tests that the strict_order keyword allows repeated types.
+    '''
+    subclasses = [F2003.Specification_Part, F2003.Execution_Part]
+    reader = get_reader("""
+        program main
+            integer :: i
+            real    :: rho
+            i = 2
+            rho = i * 3.14
+        end program main
+        """)
+
+    expected = remove_indentation("""([
+      Program_Stmt('PROGRAM', Name('main')),
+      Specification_Part(
+          Type_Declaration_Stmt(
+              Intrinsic_Type_Spec('INTEGER', None), None,
+              Entity_Decl(Name('i'), None, None, None)),
+          Type_Declaration_Stmt(
+              Intrinsic_Type_Spec('REAL', None), None,
+              Entity_Decl(Name('rho'), None, None, None))),
+      Execution_Part(
+          Assignment_Stmt(Name('i'), '=', Int_Literal_Constant('2', None)),
+          Assignment_Stmt(
+              Name('rho'), '=', Add_Operand(Name('i'), '*',
+              Real_Literal_Constant('3.14', None)))),
+      End_Program_Stmt('PROGRAM', Name('main'))
+     ],)
+    """)
+    result = BlockBase.match(
+        F2003.Program_Stmt, subclasses, F2003.End_Program_Stmt, reader,
+        strict_order=True)
+
+    assert str(result) == expected
+
+
+def remove_indentation(string):
+    '''
+    A utility function that removes indented multiline strings of reprs.
+
+    :param string: the string to dedent
+    :type reader: str
+
+    '''
+    # Note, unlike textwrap.dedent this function removes the leading
+    # whitespace on each line in a context sensitive way.
+    block_indent = 0
+    result = ''
+    for line in string.split('\n'):
+        this_indent = len(line) - len(line.lstrip())
+        line = line.lstrip()
+        if this_indent > block_indent or not result.endswith(','):
+            result += line
+        else:
+            result += ' ' + line
+        block_indent = this_indent
+    return result.strip()