Repository: stfc/fparser

Issue:
where statement bug in fparser1
There is a bug in the processing of fparser1 for where statements. We get the internal expression on output instead of the value of the external expression. For example, the following input code ...

```
subroutine columnwise_op_asm_m2v_lumped_inv_kernel_code()
  where (columnwise_matrix(:,:,cell) /= 0.0_r_solver)
     columnwise_matrix(:,:,cell) = 1.0_r_solver/columnwise_matrix(:,:,cell)
  end where
end subroutine columnwise_op_asm_m2v_lumped_inv_kernel_code
```

gives

```
!BEGINSOURCE
  SUBROUTINE columnwise_op_asm_m2v_lumped_inv_kernel_code()
    WHERE ( F2PY_EXPR_TUPLE_1 )
      columnwise_matrix(:,:,cell) = 1.0_r_solver/columnwise_matrix(:,:,cell)
    END WHERE
  END SUBROUTINE columnwise_op_asm_m2v_lumped_inv_kernel_code
```

We are not actively supporting fparser1 anymore, however, PSyclone still uses it for parsing LFRic and this fixes that bug without having to wait for the new fparser2/psyir parsing of LFRic which will take some time to complete.


Comments:

Patch:
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 9563415..210c960 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -18,6 +18,8 @@ Modifications by (in alphabetical order):
 * P. Vitt, University of Siegen, Germany
 * A. Voysey, UK Met Office
 
+03/10/2023 PR #431 for #430. Fixes bug in WHERE handling in fparser1.
+
 14/09/2023 PR #425 for #411. Splits the monolithic Fortran2008.py file
            into separate classes.
 
diff --git a/src/fparser/one/block_statements.py b/src/fparser/one/block_statements.py
index 125073b..4fa946b 100644
--- a/src/fparser/one/block_statements.py
+++ b/src/fparser/one/block_statements.py
@@ -1089,7 +1089,7 @@ class Where(BeginStatement):
     name = ""
 
     def tostr(self):
-        return "WHERE ( %s )" % (self.expr)
+        return f"WHERE ( {self.item.apply_map(self.expr)} )"
 
     def process_item(self):
         self.expr = self.item.get_line()[5:].lstrip()[1:-1].strip()


Test patch:
diff --git a/src/fparser/one/tests/test_where_construct_stmt_r745.py b/src/fparser/one/tests/test_where_construct_stmt_r745.py
new file mode 100644
index 0000000..c4baad4
--- /dev/null
+++ b/src/fparser/one/tests/test_where_construct_stmt_r745.py
@@ -0,0 +1,74 @@
+# -----------------------------------------------------------------------------
+# 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.
+# -----------------------------------------------------------------------------
+
+"""
+    Module containing tests for Fortran2003 where_construct_stmt rule R745.
+
+    R745 where-construct-stmt is [where-construct-name:] WHERE ( mask-expr )
+
+"""
+import pytest
+
+from fparser.common.sourceinfo import FortranFormat
+from fparser.one.parsefortran import FortranParser
+from fparser.common.readfortran import FortranStringReader
+
+
+@pytest.mark.parametrize("name", ["", "name"])
+def test_where_construct_stmt(name):
+    """Test that the Fortran2003 where_construct_stmt rule R745 works
+    correctly. Test with and without the optional
+    where-construct-name.
+
+    R745 where-construct-stmt is [where-construct-name:] WHERE ( mask-expr )
+
+    """
+    space = ""
+    colon = ""
+    if name:
+        colon = ":"
+        space = " "
+    code = (
+        f"  SUBROUTINE columnwise_code()\n"
+        f"    {name}{colon}{space}WHERE ( col_mat(:,:,cell) /= 0.0_r_solve )\n"
+        f"      col_mat(:,:,cell) = 1.0_r_solver/col_mat(:,:,cell)\n"
+        f"    END WHERE{space}{name}\n"
+        f"  END SUBROUTINE columnwise_code"
+    )
+    reader = FortranStringReader(code)
+    reader.set_format(FortranFormat(True, False))
+    parser = FortranParser(reader)
+    parser.parse()
+    mod = parser.block.content[0]
+    assert str(mod) == code