Repository: stfc/fparser

Issue:
Shadowed intrinsics fail in F2008 mode
The fantastic new symbol table (many, many thanks!) resolves the problem with local declarations shadowing intrinsics. However, this seems to only work in f2003 mode and the problem persists in f2008 mode. Unfortunately, it's unclear to me what is the reason for this.

To reproduce:
1) Duplicate `test_intrinsics.py` using `f2008_create`/`f2008_parser` fixtures makes `test_shadowed_intrinsic` fail.
2) For a full example, you can use [ecrad](https://github.com/ecmwf-ifs/ecrad/blob/0fb57d1a3c0b623a83e1b73b04cc73f5374c9e6c/ifsrrtm/srtm_spcvrt_mcica.F90#L256) (requires commenting the optimization pragma on l.2):
```
> fparser2 ecrad/master/ifsrrtm/srtm_spcvrt_mcica.F90
... parses without problems ...
> fparser2 --std=f2008 ecrad/master/ifsrrtm/srtm_spcvrt_mcica.F90
Syntax error: at line 256
>>>    JL=INDEX(IC)
Intrinsic 'INDEX' expects between 2 and 4 args but found 1.
```

Comments:

Patch:
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 26cb232..fdd5c20 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -15,6 +15,9 @@ Modifications by (in alphabetical order):
 * P. Vitt, University of Siegen, Germany
 * A. Voysey, UK Met Office
 
+23/03/2022 PR #317 for #316. Fixes the creation of symbol table entries
+           in the F2008 parser.
+
 21/03/2022 PR #315 for #314. Adds support for the F2008 Error_Stop_Stmt.
 
 ## Release 0.0.14 (16/03/2022) ##
diff --git a/src/fparser/two/Fortran2003.py b/src/fparser/two/Fortran2003.py
index 5ebe5d9..36af7ac 100644
--- a/src/fparser/two/Fortran2003.py
+++ b/src/fparser/two/Fortran2003.py
@@ -2664,21 +2664,30 @@ class Type_Declaration_Stmt(Type_Declaration_StmtBase):  # R501
     use_names = ['Declaration_Type_Spec', 'Attr_Spec_List', 'Entity_Decl_List']
 
     @staticmethod
-    def match(string):
+    def get_attr_spec_list_cls():
+        '''Return the type used to match the attr-spec-list
+
+        This method allows to overwrite the type used in :py:meth:`match`
+        in derived classes
+        (e.g., :py:class:`fparser.two.Fortran2008.Type_Declaration_Stmt`).
+
+        This cannot be implemented as an attribute because the relevant type
+        :class:`Attr_Spec_List` is auto-generated at the end of the file
+        using the :attr:`use_names` property of the class.
+
         '''
-        Attempts to match the supplied string as a type declaration. If the
-        match is successful the declared symbols are added to the symbol table
-        of the current scope (if there is one).
+        return Attr_Spec_List
 
-        :param str string: the string to match.
+    @staticmethod
+    def add_to_symbol_table(result):
+        '''Capture the declared symbols in the symbol table of the current
+        scoping region
 
-        :returns: 3-tuple containing the matched declaration.
-        :rtype: (Declaration_Type_Spec, Attr_Spec_List or NoneType, \
+        :param result: the declared type, attributes and entities or None
+        :type result: `NoneType` or \
+                (Declaration_Type_Spec, Attr_Spec_List or NoneType, \
                  Entity_Decl_List)
-
         '''
-        result = Type_Declaration_StmtBase.match(
-            Declaration_Type_Spec, Attr_Spec_List, Entity_Decl_List, string)
         if result:
             # We matched a declaration - capture the declared symbols in the
             # symbol table of the current scoping region.
@@ -2692,6 +2701,28 @@ class Type_Declaration_Stmt(Type_Declaration_StmtBase):  # R501
                     # type rather than a string.
                     table.add_data_symbol(decl.items[0].string, str(result[0]))
             # TODO #201 support symbols that are not of intrinsic type.
+
+    @classmethod
+    def match(cls, string):
+        '''
+        Attempts to match the supplied string as a type declaration. If the
+        match is successful the declared symbols are added to the symbol table
+        of the current scope (if there is one).
+
+        Note that this is implemented as a class method to allow parameterizing
+        the type used to match attr-spec-list via :py:meth:`get_attr_spec_list_cls`.
+
+        :param str string: the string to match.
+
+        :returns: 3-tuple containing the matched declaration.
+        :rtype: (Declaration_Type_Spec, Attr_Spec_List or NoneType, \
+                 Entity_Decl_List)
+
+        '''
+        result = Type_Declaration_StmtBase.match(
+            Declaration_Type_Spec, cls.get_attr_spec_list_cls(), Entity_Decl_List,
+            string)
+        cls.add_to_symbol_table(result)
         return result
 
     @staticmethod
diff --git a/src/fparser/two/Fortran2008.py b/src/fparser/two/Fortran2008.py
index 4792876..2aeb8cb 100644
--- a/src/fparser/two/Fortran2008.py
+++ b/src/fparser/two/Fortran2008.py
@@ -356,11 +356,8 @@ class Type_Declaration_Stmt(Type_Declaration_Stmt_2003):  # R501
                              entity-decl-list
 
     The implementation of this rule does not add anything to the Fortran 2003
-    variant but reimplements the match method identical to Fortran 2003 as
-    otherwise the generated Fortran 2008 variant of `Attr_Spec_List` would not
-    be used. Unfortunately, the required `attr_spec_list_cls` can not simply be
-    provided as a class property since the relevant class is only generated
-    at the end of this file using the `use_names` class property of this class.
+    variant but overwrites :py:meth:`get_attr_spec_list_cls` to use
+    the Fortran 2008 variant of :py:class:`Attr_Spec_List`.
 
     Associated constraints are:
 
@@ -378,23 +375,13 @@ class Type_Declaration_Stmt(Type_Declaration_Stmt_2003):  # R501
     '''
 
     @staticmethod
-    def match(string):
-        '''Implements the matching of a type declaration statement.
+    def get_attr_spec_list_cls():
+        '''Return the type used to match the attr-spec-list
 
-        :param str string: the reader or string to match as a type \
-                           declaration statement.
-
-        :return: a 3-tuple containing declaration type specification, \
-                 attributespecification and entity declaration list \
-                 if there is a match or None if there is no match.
-        :rtype: `NoneType` or \
-            (:py:class:`fparser.two.Fortran2003.Declaration_Type_Spec`, \
-             :py:class:`fparser.two.Fortran2008.Attr_Spec_List`, \
-             :py:class:`fparser.two.Fortran2003.Entity_Decl_List`)
+        This overwrites the Fortran 2003 type with the Fortran 2008 variant.
 
         '''
-        return Type_Declaration_StmtBase.match(
-            Declaration_Type_Spec, Attr_Spec_List, Entity_Decl_List, string)
+        return Attr_Spec_List
 
 
 class Codimension_Attr_Spec(WORDClsBase):  # R502.d


Test patch:
diff --git a/src/fparser/two/tests/fortran2008/test_type_declaration_stmt_r501.py b/src/fparser/two/tests/fortran2008/test_type_declaration_stmt_r501.py
index bbaa2f9..17b5cff 100644
--- a/src/fparser/two/tests/fortran2008/test_type_declaration_stmt_r501.py
+++ b/src/fparser/two/tests/fortran2008/test_type_declaration_stmt_r501.py
@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Science and Technology Facilities Council
+# Copyright (c) 2020-2022 Science and Technology Facilities Council.
 
 # All rights reserved.
 
@@ -39,9 +39,15 @@
 
 '''
 
+import pytest
+from fparser.two.Fortran2003 import Intrinsic_Function_Reference
 from fparser.two.Fortran2008 import Type_Declaration_Stmt
+from fparser.two.symbol_table import SYMBOL_TABLES
+from fparser.two.utils import walk
+from fparser.api import get_reader
 
 
+@pytest.mark.usefixtures("fake_symbol_table")
 def test_type_declaration_stmt():  # R501
     '''
     Tests copied from Fortran 2003.
@@ -56,21 +62,21 @@ def test_type_declaration_stmt():  # R501
             "None), None, Entity_Decl_List(',', (Entity_Decl(Name('a'), None, "
             "None, None),)))")
 
-    obj = tcls('integer ,dimension(2):: a*3')
+    obj = tcls('integer ,dimension(2):: b*3')
     assert isinstance(obj, tcls), repr(obj)
-    assert str(obj) == 'INTEGER, DIMENSION(2) :: a*3'
+    assert str(obj) == 'INTEGER, DIMENSION(2) :: b*3'
 
-    obj = tcls('real a')
+    obj = tcls('real c')
     assert isinstance(obj, tcls), repr(obj)
-    assert str(obj) == 'REAL :: a'
+    assert str(obj) == 'REAL :: c'
     assert (repr(obj) ==
             "Type_Declaration_Stmt(Intrinsic_Type_Spec('REAL', None), None, "
-            "Entity_Decl_List(',', (Entity_Decl(Name('a'), None, None, "
+            "Entity_Decl_List(',', (Entity_Decl(Name('c'), None, None, "
             "None),)))")
 
-    obj = tcls('REAL A( LDA, * ), B( LDB, * )')
+    obj = tcls('REAL D( LDA, * ), E( LDB, * )')
     assert isinstance(obj, tcls), repr(obj)
-    assert str(obj) == 'REAL :: A(LDA, *), B(LDB, *)'
+    assert str(obj) == 'REAL :: D(LDA, *), E(LDB, *)'
 
     obj = tcls('DOUBLE PRECISION   ALPHA, BETA')
     assert isinstance(obj, tcls), repr(obj)
@@ -84,6 +90,28 @@ def test_type_declaration_stmt():  # R501
     assert isinstance(obj, tcls), repr(obj)
     assert str(obj) == 'CHARACTER(LEN = n), PRIVATE :: x(n)'
 
-    obj = tcls('character(lenmax),private:: x(n)')
+    obj = tcls('character(lenmax),private:: y(n)')
     assert isinstance(obj, tcls), repr(obj)
-    assert str(obj) == 'CHARACTER(LEN = lenmax), PRIVATE :: x(n)'
+    assert str(obj) == 'CHARACTER(LEN = lenmax), PRIVATE :: y(n)'
+
+
+def test_shadowed_intrinsic(f2008_parser):
+    ''' Check that a locally-defined symbol that shadows (overwrites) a
+    Fortran intrinsic is correctly identified. '''
+    tree = f2008_parser(get_reader('''\
+module my_mod
+  use some_mod
+  real :: dot_product(2,2)
+contains
+  subroutine my_sub()
+    real :: result
+    result = dot_product(1,1)
+  end subroutine my_sub
+end module my_mod
+    '''))
+    tables = SYMBOL_TABLES
+    # We should not have an intrinsic-function reference in the parse tree
+    assert not walk(tree, Intrinsic_Function_Reference)
+    table = tables.lookup("my_mod")
+    sym = table.children[0].lookup("dot_product")
+    assert sym.primitive_type == "real"