[flang] Implement the runtime portion of the CSHIFT intrinsic

[PeteSteinfeld]

Summary

This change fixes a bug in the runtime portion of the CSHIFT intrinsic that happens when the value of the SHIFT argument is negative.

[mleair]

flang/runtime/transformational.cpp

190

llvm style recommends no braces for single statement blocks.

[PeteSteinfeld]

flang/runtime/transformational.cpp

190

I didn't think that we were following this recommendation for flang code. This file, in particular is full of single statement blocks that are enclosed by braces. There's one at line 162, another at line 167, line 232, ...

[jeanPerier]

flang/runtime/transformational.cpp

177

I am shared. I understand why you are doing this interface change to have simpler lowering code, but using a descriptor instead of a simple integer has user runtime cost (creating the descriptor and reading it).
In this specific case, the extra runtime cost coming from the descriptor might be negligible compared to what CSHIFT is doing, and it's hard for me to complain about performance without any numbers/benchmark. So this change is probably OK.
In general, think we should find solution in lowering to keep lowering code as simple as possible rather than moving the cost to the user.

[PeteSteinfeld]

flang/runtime/transformational.cpp

177

I'm not sure what previous problem I was running into, but my latest implementation doesn't require a change to the interface.

[PeteSteinfeld]

Responding to Jean's comments by reverting my change to the vector version of
CSHIFT.

[PeteSteinfeld]

Trying to ensure that things are in sync.

[PeteSteinfeld]

Adding needed changes in .../flang/unittests/RuntimeGtest/Transformational.cpp.

[mleair]

LGTM

flang/runtime/transformational.cpp

190

OK

flang/runtime/transformational.h

void RTNAME(Reshape)(Descriptor &result, const Descriptor &source,
     const Descriptor &shape, const Descriptor *pad = nullptr,
     const Descriptor *order = nullptr, const char *sourceFile = nullptr,
     int line = 0);
 
 void RTNAME(Cshift)(Descriptor &result, const Descriptor &source,
     const Descriptor &shift, int dim = 1, const char *sourceFile = nullptr,
     int line = 0);
 void RTNAME(CshiftVector)(Descriptor &result, const Descriptor &source,
-    std::int64_t shift, const char *sourceFile = nullptr, int line = 0);
+    const Descriptor &shift, const char *sourceFile = nullptr, int line = 0);
 
 void RTNAME(Eoshift)(Descriptor &result, const Descriptor &source,
     const Descriptor &shift, const Descriptor *boundary = nullptr, int dim = 1,
     const char *sourceFile = nullptr, int line = 0);
 void RTNAME(EoshiftVector)(Descriptor &result, const Descriptor &source,
     std::int64_t shift, const Descriptor *boundary = nullptr,
     const char *sourceFile = nullptr, int line = 0);
 

flang/runtime/transformational.cpp

if (int stat{result.Allocate()}) {
     terminator.Crash(
         "%s: Could not allocate memory for result (stat=%d)", function, stat);
   }
   return elementLen;
 }
 
 extern "C" {
 
-// CSHIFT of rank > 1
+// CSHIFT where rank of ARRAY argument > 1
 void RTNAME(Cshift)(Descriptor &result, const Descriptor &source,
     const Descriptor &shift, int dim, const char *sourceFile, int line) {
   Terminator terminator{sourceFile, line};
   int rank{source.rank()};
   RUNTIME_CHECK(terminator, rank > 1);
   RUNTIME_CHECK(terminator, dim >= 1 && dim <= rank);
   ShiftControl shiftControl{shift, terminator, dim};
   shiftControl.Init(source);
for (resDim = 1; resDim <= dimExtent; ++resDim) {
       if (++sourceDim == dimLB + dimExtent) {
         sourceDim = dimLB;
       }
     }
     result.IncrementSubscripts(resultAt);
   }
 }
 
-// CSHIFT of vector
+// CSHIFT where rank of ARRAY argument == 1
 void RTNAME(CshiftVector)(Descriptor &result, const Descriptor &source,
-    std::int64_t shift, const char *sourceFile, int line) {
+    const Descriptor &shift, const char *sourceFile, int line) {
   Terminator terminator{sourceFile, line};
   RUNTIME_CHECK(terminator, source.rank() == 1);
   const Dimension &sourceDim{source.GetDimension(0)};
   SubscriptValue extent{sourceDim.Extent()};
   AllocateResult(result, source, 1, &extent, terminator, "CSHIFT");
   SubscriptValue lb{sourceDim.LowerBound()};
+  auto catAndKind{shift.type().GetCategoryAndKind()};
+  std::int64_t shiftCount{
+      GetInt64(shift.OffsetElement<char>(), catAndKind->second, terminator)};
   for (SubscriptValue j{0}; j < extent; ++j) {
     SubscriptValue resultAt{1 + j};
-    SubscriptValue sourceAt{lb + (j + shift) % extent};
+    SubscriptValue sourceAt{lb + (j + shiftCount) % extent};
+    if (sourceAt < 0) {
+      sourceAt += extent;
+    }
     CopyElement(result, &resultAt, source, &sourceAt, terminator);
   }
 }
 
 // EOSHIFT of rank > 1
 void RTNAME(Eoshift)(Descriptor &result, const Descriptor &source,
     const Descriptor &shift, const Descriptor *boundary, int dim,
     const char *sourceFile, int line) {

flang/unittests/RuntimeGTest/Transformational.cpp

TEST(Transformational, Shifts) {
   EXPECT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 4}));
   static std::int32_t cshiftExpect2[6]{3, 6, 5, 2, 1, 4};
   for (int j{0}; j < 6; ++j) {
     EXPECT_EQ(
         *result.ZeroBasedIndexedElement<std::int32_t>(j), cshiftExpect2[j]);
   }
   result.Destroy();
 
+  // VECTOR  1 3 5 2 4 6
+  auto vector{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{6}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
+  vector->GetDimension(0).SetLowerBound(0);
+  StaticDescriptor<1, true> vectorDesc;
+  Descriptor &vectorResult{vectorDesc.descriptor()};
+
+  auto shiftVector{MakeArray<TypeCategory::Integer, 8>(
+      std::vector<int>{1}, std::vector<std::int64_t>{2})};
+  RTNAME(CshiftVector)(vectorResult, *vector, *shiftVector, __FILE__, __LINE__);
+  EXPECT_EQ(vectorResult.type(), array->type());
+  EXPECT_EQ(vectorResult.rank(), 1);
+  EXPECT_EQ(vectorResult.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(vectorResult.GetDimension(0).Extent(), 6);
+  EXPECT_EQ(vectorResult.type(), (TypeCode{TypeCategory::Integer, 4}));
+  static std::int32_t cshiftExpect3[6]{3, 4, 5, 6, 1, 2};
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(*vectorResult.ZeroBasedIndexedElement<std::int32_t>(j),
+        cshiftExpect3[j]);
+  }
+  vectorResult.Destroy();
+
+  auto shiftVector1{MakeArray<TypeCategory::Integer, 8>(
+      std::vector<int>{1}, std::vector<std::int64_t>{-2})};
+  RTNAME(CshiftVector)
+  (vectorResult, *vector, *shiftVector1, __FILE__, __LINE__);
+  EXPECT_EQ(vectorResult.type(), array->type());
+  EXPECT_EQ(vectorResult.rank(), 1);
+  EXPECT_EQ(vectorResult.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(vectorResult.GetDimension(0).Extent(), 6);
+  EXPECT_EQ(vectorResult.type(), (TypeCode{TypeCategory::Integer, 4}));
+  static std::int32_t cshiftExpect4[6]{5, 6, 1, 2, 3, 4};
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(*vectorResult.ZeroBasedIndexedElement<std::int32_t>(j),
+        cshiftExpect4[j]);
+  }
+  vectorResult.Destroy();
+
   auto boundary{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{3}, std::vector<std::int32_t>{-1, -2, -3})};
   boundary->GetDimension(0).SetLowerBound(9); // shouldn't matter
   RTNAME(Eoshift)(result, *array, *shift3, &*boundary, 1, __FILE__, __LINE__);
   EXPECT_EQ(result.type(), array->type());
   EXPECT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);