[PATCH] D104936: [flang] Implement semantic check for the UNPACK intrinsic

[Pete Steinfeld via Phabricator via llvm-commits]

PeteSteinfeld created this revision.
Herald added a reviewer: sscalpone.
PeteSteinfeld requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

According to 16.9.198, the FIELD argument "shall be conformable with MASK".  This change implements that check and adds a test.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D104936

Files:
  flang/lib/Evaluate/intrinsics.cpp
  flang/test/Semantics/unpack.f90


Index: flang/test/Semantics/unpack.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/unpack.f90
@@ -0,0 +1,15 @@
+! RUN: %S/test_errors.sh %s %t %flang_fc1
+! UNPACK() intrinsic function error tests
+program test_unpack
+  integer, dimension(2) :: vector = [343, 512]
+  logical, dimension(2, 2) :: mask = &
+    reshape([.true., .false., .true., .false.], [2, 2])
+  integer, dimension(2, 2) :: field = reshape([1, 2, 3, 4, 5, 6], [2, 2])
+  integer, dimension(2, 1) :: bad_field = reshape([1, 2], [2, 1])
+  integer :: scalar_field
+  integer, dimension(2, 2) :: result
+  result = unpack(vector, mask, field)
+  !ERROR: Dimension 2 of FIELD= argument has extent 1, but MASK= arguement has extent 2
+  result = unpack(vector, mask, bad_field)
+  result = unpack(vector, mask, scalar_field)
+end program
Index: flang/lib/Evaluate/intrinsics.cpp
===================================================================
--- flang/lib/Evaluate/intrinsics.cpp
+++ flang/lib/Evaluate/intrinsics.cpp
@@ -2138,6 +2138,21 @@
       context.messages().Say(
           "Argument of PRESENT() must be the name of an OPTIONAL dummy argument"_err_en_US);
     }
+  } else if (name == "unpack") {
+    if (const auto &fieldArg{call.arguments[2]}) {
+      if (const auto &maskArg{call.arguments[1]}) {
+        if (const std::optional<Shape> &fieldShape{
+                GetShape(context, *fieldArg)}) {
+          if (const std::optional<Shape> &maskShape{
+                  GetShape(context, *maskArg)}) {
+            return CheckConformance(context.messages(), *fieldShape, *maskShape,
+                CheckConformanceFlags::LeftScalarExpandable, "FIELD= argument",
+                "MASK= arguement")
+                .value_or(false /*fail if not known now to conform*/);
+          }
+        }
+      }
+    }
   }
   return ok;
 }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D104936.354561.patch
Type: text/x-patch
Size: 1886 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210625/56c15776/attachment.bin>