[flang-commits] [flang] 2472b68 - [flang] Add one semantic check for masked array assignment

[via flang-commits]

Author: PeixinQiao
Date: 2022-05-06T22:19:20+08:00
New Revision: 2472b6869a6eeb198a4e982fd7c3ffc89dd4f6f5

URL: https://github.com/llvm/llvm-project/commit/2472b6869a6eeb198a4e982fd7c3ffc89dd4f6f5
DIFF: https://github.com/llvm/llvm-project/commit/2472b6869a6eeb198a4e982fd7c3ffc89dd4f6f5.diff

LOG: [flang] Add one semantic check for masked array assignment

As Fortran 2018 states, in each where-assignment-stmt, the mask-expr and
the variable being defined shall be arrays of the same shape. The
previous check does not consider checking if it is an array.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D125022

Added: 
    

Modified: 
    flang/lib/Semantics/assignment.cpp
    flang/test/Semantics/assign01.f90
    flang/test/Semantics/assign04.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index 650f31b2dacf4..c95c924e345df 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -216,10 +216,13 @@ bool AssignmentContext::CheckForPureContext(const SomeExpr &lhs,
   return true;
 }
 
-// 10.2.3.1(2) The masks and LHS of assignments must all have the same shape
+// 10.2.3.1(2) The masks and LHS of assignments must be arrays of the same shape
 void AssignmentContext::CheckShape(parser::CharBlock at, const SomeExpr *expr) {
   if (auto shape{evaluate::GetShape(foldingContext(), expr)}) {
     std::size_t size{shape->size()};
+    if (size == 0) {
+      Say(at, "The mask or variable must not be scalar"_err_en_US);
+    }
     if (whereDepth_ == 0) {
       whereExtents_.resize(size);
     } else if (whereExtents_.size() != size) {

diff  --git a/flang/test/Semantics/assign01.f90 b/flang/test/Semantics/assign01.f90
index 351fecfa103bf..658f76c351ab3 100644
--- a/flang/test/Semantics/assign01.f90
+++ b/flang/test/Semantics/assign01.f90
@@ -52,3 +52,26 @@ subroutine s3
     end where
   end where
 end
+
+subroutine s4
+  integer :: x1 = 0, x2(2) = 0
+  logical :: l1 = .false., l2(2) = (/.true., .false./), l3 = .false.
+  !ERROR: The mask or variable must not be scalar
+  where (l1)
+    !ERROR: The mask or variable must not be scalar
+    x1 = 1
+  end where
+  !ERROR: The mask or variable must not be scalar
+  where (l1)
+    !ERROR: The mask or variable must not be scalar
+    where (l3)
+      !ERROR: The mask or variable must not be scalar
+      x1 = 1
+    end where
+  end where
+  !ERROR: The mask or variable must not be scalar
+  where (l2(2))
+    !ERROR: The mask or variable must not be scalar
+    x2(2) = 1
+  end where
+end

diff  --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90
index 998eb98cc144a..064cb0aa868c5 100644
--- a/flang/test/Semantics/assign04.f90
+++ b/flang/test/Semantics/assign04.f90
@@ -185,17 +185,25 @@ subroutine s13()
   where ([1==1]) x='*'
   where ([1==1]) n='*' ! fine
   forall (j=1:1)
+    !ERROR: The mask or variable must not be scalar
     where (j==1)
       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
+      !ERROR: The mask or variable must not be scalar
       x(j)='?'
+      !ERROR: The mask or variable must not be scalar
       n(j)='?' ! fine
+    !ERROR: The mask or variable must not be scalar
     elsewhere (.false.)
       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
+      !ERROR: The mask or variable must not be scalar
       x(j)='1'
+      !ERROR: The mask or variable must not be scalar
       n(j)='1' ! fine
     elsewhere
       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
+      !ERROR: The mask or variable must not be scalar
       x(j)='9'
+      !ERROR: The mask or variable must not be scalar
       n(j)='9' ! fine
     end where
   end forall