[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

Author: PeixinQiao

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) {

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

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