Repository: stfc/fparser

Issue:
Allocate with mold= parameter
This is valid Fortran, but not accepted by fparser:
```
subroutine a(b1)
   integer, dimension(:,:), allocatable :: b1
   integer, dimension(:,:), allocatable :: a1
   allocate(a1, mold=b1)
end subroutine a
```
Supporting the `mold` argument makes it easier to create the kernel-extraction driver (since we can then allocate variables without having to analyse the number of dimensions). It's not urgent, since I have a work around.

Comments:

Patch:
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 40457c1..a0853d0 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -35,6 +35,8 @@ Modifications by (in alphabetical order):
 
 20/06/2022 PR #345 - add fparser2 performance benchmark in the scripts folder.
 
+02/09/2022 PR #356 - add support for the mold allocate parameter.
+
 ## Release 0.0.16 (16/06/2022) ##
 
 14/06/2022 PR #337 towards #312 (performance improvements). Removes some
diff --git a/doc/fparser2.rst b/doc/fparser2.rst
index 2404d23..dfbb20b 100644
--- a/doc/fparser2.rst
+++ b/doc/fparser2.rst
@@ -1,4 +1,4 @@
-..  Copyright (c) 2017-2020 Science and Technology Facilities Council.
+..  Copyright (c) 2017-2022 Science and Technology Facilities Council.
 
     All rights reserved.
 
@@ -42,8 +42,8 @@ Fortran 2003. This is implemented in the Fortran2003.py `file`__ and
 contains an entirely separate parser to fparser1 that includes rules
 for Fortran 2003 syntax. Support for Fortran 2008 is being added in
 the Fortran2008.py `file`__ which extends the Fortran2003 rules
-appropriately. At this time fparser2 supports submodules, co-arrays
-and the continguous keyword in Fortran2008.
+appropriately. At this time fparser2 supports submodules, co-arrays,
+the 'mold' argument to allocate and the 'contiguous' keyword in Fortran2008.
 
 __ https://github.com/stfc/fparser/blob/master/src/fparser/two/Fortran2003.py
 __ https://github.com/stfc/fparser/blob/master/src/fparser/two/Fortran2008.py
diff --git a/src/fparser/two/Fortran2003.py b/src/fparser/two/Fortran2003.py
index 518be7b..fd18b0c 100644
--- a/src/fparser/two/Fortran2003.py
+++ b/src/fparser/two/Fortran2003.py
@@ -4805,8 +4805,43 @@ class Vector_Subscript(Base):  # R622
 
 class Allocate_Stmt(StmtBase):  # R623
     """
-    <allocate-stmt> = ALLOCATE ( [ <type-spec> :: ] <allocation-list>
-        [ , <alloc-opt-list> ] )
+    Fortran2003 rule R623
+    allocate-stmt is ALLOCATE ( [ type-spec :: ] allocation-list
+                                [, alloc-opt-list ] )
+
+    Subject to the following constraints:
+
+    C622 (R629) Each allocate-object shall be a nonprocedure pointer or an
+                 allocatable variable.
+    C623 (R623) If any allocate-object in the statement has a deferred type
+                parameter, either type-spec or SOURCE= shall appear.
+    C624 (R623) If a type-spec appears, it shall specify a type with which
+                each allocate-object is type compatible.
+    C625 (R623) If any allocate-object is unlimited polymorphic, either
+                type-spec or SOURCE= shall appear.
+    C626 (R623) A type-param-value in a type-spec shall be an asterisk if and
+                only if each allocate-object is a dummy argument for which the
+                corresponding type parameter is assumed.
+    C627 (R623) If a type-spec appears, the kind type parameter values of each
+                allocate-object shall be the same as the corresponding type
+                parameter values of the type-spec.
+    C628 (R628) An allocate-shape-spec-list shall appear if and only if the
+                allocate-object is an array.
+    C629 (R628) The number of allocate-shape-specs in an
+                allocate-shape-spec-list shall be the same as the rank of the
+                allocate-object.
+    C630 (R624) No alloc-opt shall appear more than once in a given
+                alloc-opt-list.
+    C631 (R623) If SOURCE= appears, type-spec shall not appear and
+                allocation-list shall contain only one allocate-object, which
+                shall be type compatible (5.1.1.2) with source-expr.
+    C632 (R623) The source-expr shall be a scalar or have the same rank as
+                allocate-object.
+    C633 (R623) Corresponding kind type parameters of allocate-object and
+                source-expr shall have the same values.
+
+    None of these constraints are currently applied - issue #355.
+
     """
 
     subclass_names = []
@@ -4847,32 +4882,6 @@ class Allocate_Stmt(StmtBase):  # R623
             return "ALLOCATE(%s)" % (lst)
 
 
-class Alloc_Opt(KeywordValueBase):  # R624
-    """
-    <alloc-opt> = STAT = <stat-variable>
-                  | ERRMSG = <errmsg-variable>
-                  | SOURCE = <source-expr>
-    """
-
-    subclass_names = []
-    use_names = ["Stat_Variable", "Errmsg_Variable", "Source_Expr"]
-
-    @staticmethod
-    def match(string):
-        for (k, v) in [
-            ("STAT", Stat_Variable),
-            ("ERRMSG", Errmsg_Variable),
-            ("SOURCE", Source_Expr),
-        ]:
-            try:
-                obj = KeywordValueBase.match(k, v, string, upper_lhs=True)
-            except NoMatchError:
-                obj = None
-            if obj is not None:
-                return obj
-        return None
-
-
 class Stat_Variable(Base):  # R625
     """
     <stat-variable> = <scalar-int-variable>
@@ -4897,6 +4906,31 @@ class Source_Expr(Base):  # R627
     subclass_names = ["Expr"]
 
 
+class Alloc_Opt(KeywordValueBase):  # R624
+    """
+    <alloc-opt> = STAT = <stat-variable>
+                  | ERRMSG = <errmsg-variable>
+                  | SOURCE = <source-expr>
+    """
+
+    subclass_names = []
+    use_names = ["Stat_Variable", "Errmsg_Variable", "Source_Expr"]
+    #: The keywords tested for in the match() method.
+    _keyword_pairs = [
+        ("STAT", Stat_Variable),
+        ("ERRMSG", Errmsg_Variable),
+        ("SOURCE", Source_Expr),
+    ]
+
+    @classmethod
+    def match(cls, string):
+        for (k, v) in cls._keyword_pairs:
+            obj = KeywordValueBase.match(k, v, string, upper_lhs=True)
+            if obj is not None:
+                return obj
+        return None
+
+
 class Allocation(CallBase):  # R628
     """
     <allocation> = <allocate-object> [ ( <allocate-shape-spec-list> ) ]
diff --git a/src/fparser/two/Fortran2008.py b/src/fparser/two/Fortran2008.py
index 5cad698..31a9646 100644
--- a/src/fparser/two/Fortran2008.py
+++ b/src/fparser/two/Fortran2008.py
@@ -90,6 +90,10 @@ from fparser.two.Fortran2003 import (
     SequenceBase,
     Base,
     Specification_Part,
+    Stat_Variable,
+    Errmsg_Variable,
+    Source_Expr,
+    KeywordValueBase,
     Module_Subprogram_Part,
     Implicit_Part,
     Implicit_Part_Stmt,
@@ -106,6 +110,8 @@ from fparser.two.Fortran2003 import (
 from fparser.two.Fortran2003 import (
     Program_Unit as Program_Unit_2003,
     Attr_Spec as Attr_Spec_2003,
+    Alloc_Opt as Alloc_Opt_2003,
+    Allocate_Stmt as Allocate_Stmt_2003,
     Type_Declaration_Stmt as Type_Declaration_Stmt_2003,
     Component_Attr_Spec as Component_Attr_Spec_2003,
     Data_Component_Def_Stmt as Data_Component_Def_Stmt_2003,
@@ -719,6 +725,42 @@ class Do_Term_Action_Stmt(Do_Term_Action_Stmt_2003):  # R826
     subclass_names = ["Action_Stmt_C816"]
 
 
+class Alloc_Opt(Alloc_Opt_2003):
+    """
+    Fortran2008 rule R627
+    alloc-opt is ERRMSG = errmsg-variable
+              or MOLD = source-expr
+              or SOURCE = source-expr
+              or STAT = stat-variable
+
+    Extends the Fortran2003 version of this class by updating the keyword
+    pairs (used in match) with support for MOLD.
+
+    """
+
+    _keyword_pairs = [
+        ("STAT", Stat_Variable),
+        ("ERRMSG", Errmsg_Variable),
+        ("SOURCE", Source_Expr),
+        ("MOLD", Source_Expr),
+    ]
+
+
+class Allocate_Stmt(Allocate_Stmt_2003):  # R626
+    """
+    Fortran 2008 rule R626
+    allocate-stmt is ALLOCATE ( [ type-spec :: ] allocation-list
+                                [, alloc-opt-list ] )
+
+    The implementation of this rule simply ensures that the Fortran2008 version
+    of Alloc_Opt is used.
+
+    """
+
+    subclass_names = []
+    use_names = ["Type_Spec", "Allocation_List", "Alloc_Opt_List"]
+
+
 class If_Stmt(If_Stmt_2003):  # R837
     """
     Fortran 2008 rule R837


Test patch:
diff --git a/src/fparser/two/tests/fortran2003/test_allocate_stmt_r623.py b/src/fparser/two/tests/fortran2003/test_allocate_stmt_r623.py
new file mode 100644
index 0000000..1290b23
--- /dev/null
+++ b/src/fparser/two/tests/fortran2003/test_allocate_stmt_r623.py
@@ -0,0 +1,75 @@
+# This Python file uses the following encoding: utf-8
+# Copyright (c) 2022 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.
+
+""" pytest module for the Fortran2003 Allocate Statement - R263. """
+
+import pytest
+from fparser.two.utils import NoMatchError
+from fparser.two.Fortran2003 import Allocate_Stmt, Alloc_Opt
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_allocate_stmt():
+    """Tests for the allocate statement: R623."""
+    tcls = Allocate_Stmt
+    obj = tcls("allocate(a,b)")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "ALLOCATE(a, b)"
+
+    obj = tcls("allocate(real::a)")
+    assert str(obj) == "ALLOCATE(REAL::a)"
+
+    obj = tcls("allocate(real(kind=8)::a, stat=b, source=c//d)")
+    assert str(obj) == "ALLOCATE(REAL(KIND = 8)::a, STAT = b, SOURCE = c // d)"
+
+
+@pytest.mark.usefixtures("f2003_create")
+def test_alloc_opt():
+    """Tests for the various forms of alloc-opt: R624."""
+    tcls = Alloc_Opt
+    obj = tcls("stat=a")
+    assert isinstance(obj, tcls), repr(obj)
+    assert str(obj) == "STAT = a"
+    assert repr(obj) == "Alloc_Opt('STAT', Name('a'))"
+    obj = tcls("errmsg=my_msg")
+    assert str(obj) == "ERRMSG = my_msg"
+    obj = tcls("source=b")
+    assert str(obj) == "SOURCE = b"
+    # Check for a failed match - use 'mold' as that's a Fortran2008 addition
+    # so should not match here.
+    with pytest.raises(NoMatchError):
+        tcls("MOLD=b")
+    with pytest.raises(NoMatchError):
+        tcls("value")
diff --git a/src/fparser/two/tests/fortran2008/test_alloc_opt_r627.py b/src/fparser/two/tests/fortran2008/test_alloc_opt_r627.py
new file mode 100644
index 0000000..914656c
--- /dev/null
+++ b/src/fparser/two/tests/fortran2008/test_alloc_opt_r627.py
@@ -0,0 +1,65 @@
+# Copyright (c) 2022 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 2008 rule R627
+
+    alloc-opt is ERRMSG = errmsg-variable
+              or MOLD = source-expr
+              or SOURCE = source-expr
+              or STAT = stat-variable
+
+The only difference to 2003 is the addition of 'MOLD' so that's what we
+test for.
+
+"""
+
+import pytest
+from fparser.two.Fortran2008 import Allocate_Stmt, Alloc_Opt
+
+
+@pytest.mark.usefixtures("f2008_create")
+def test_alloc_opt():
+    """Test that Alloc_Opt supports the F2008 addition of 'MOLD'."""
+    obj = Alloc_Opt("MOLD=c")
+    assert isinstance(obj, Alloc_Opt), repr(obj)
+    assert str(obj) == "MOLD = c"
+
+
+@pytest.mark.usefixtures("f2008_create")
+def test_allocate_stmt():
+    """Check that the Fortran2008 version of allocate has picked up the
+    version of Alloc_Opt that supports MOLD."""
+    obj = Allocate_Stmt("allocate(b, mold=c)")
+    assert isinstance(obj, Allocate_Stmt), repr(obj)
+    assert str(obj) == "ALLOCATE(b, MOLD = c)"