[flang-commits] [flang] 1c16b0d - [flang] Return arrays in Transfer runtime with SIZE argument

[Jean Perier via flang-commits]

Author: Jean Perier
Date: 2021-12-03T08:23:30+01:00
New Revision: 1c16b0db9d56ba533147cfbe2c4e1bb0a8bcbc45

URL: https://github.com/llvm/llvm-project/commit/1c16b0db9d56ba533147cfbe2c4e1bb0a8bcbc45
DIFF: https://github.com/llvm/llvm-project/commit/1c16b0db9d56ba533147cfbe2c4e1bb0a8bcbc45.diff

LOG: [flang] Return arrays in Transfer runtime with SIZE argument

In TRANSFER runtime the result was an array only if the MOLD was an array.
This is not in line with TRANSFER definition in 16.9.193 that rules that it
must also be an array if MOLD is scalar and SIZE if provided.

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

Added: 
    

Modified: 
    flang/runtime/misc-intrinsic.cpp
    flang/unittests/Runtime/MiscIntrinsic.cpp

Removed: 
    


################################################################################
diff  --git a/flang/runtime/misc-intrinsic.cpp b/flang/runtime/misc-intrinsic.cpp
index 7b8509a8dccb5..356046ee05f88 100644
--- a/flang/runtime/misc-intrinsic.cpp
+++ b/flang/runtime/misc-intrinsic.cpp
@@ -11,33 +11,19 @@
 #include "flang/Runtime/descriptor.h"
 #include <algorithm>
 #include <cstring>
+#include <optional>
 
 namespace Fortran::runtime {
-extern "C" {
 
-void RTNAME(Transfer)(Descriptor &result, const Descriptor &source,
-    const Descriptor &mold, const char *sourceFile, int line) {
-  if (mold.rank() > 0) {
-    std::size_t moldElementBytes{mold.ElementBytes()};
-    std::size_t elements{
-        (source.Elements() * source.ElementBytes() + moldElementBytes - 1) /
-        moldElementBytes};
-    return RTNAME(TransferSize)(result, source, mold, sourceFile, line,
-        static_cast<std::int64_t>(elements));
-  } else {
-    return RTNAME(TransferSize)(result, source, mold, sourceFile, line, 1);
-  }
-}
-
-void RTNAME(TransferSize)(Descriptor &result, const Descriptor &source,
+static void TransferImpl(Descriptor &result, const Descriptor &source,
     const Descriptor &mold, const char *sourceFile, int line,
-    std::int64_t size) {
-  int rank{mold.rank() > 0 ? 1 : 0};
+    std::optional<std::int64_t> resultExtent) {
+  int rank{resultExtent.has_value() ? 1 : 0};
   std::size_t elementBytes{mold.ElementBytes()};
   result.Establish(mold.type(), elementBytes, nullptr, rank, nullptr,
       CFI_attribute_allocatable, mold.Addendum() != nullptr);
-  if (rank > 0) {
-    result.GetDimension(0).SetBounds(1, size);
+  if (resultExtent) {
+    result.GetDimension(0).SetBounds(1, *resultExtent);
   }
   if (const DescriptorAddendum * addendum{mold.Addendum()}) {
     *result.Addendum() = *addendum;
@@ -47,7 +33,7 @@ void RTNAME(TransferSize)(Descriptor &result, const Descriptor &source,
         "TRANSFER: could not allocate memory for result; STAT=%d", stat);
   }
   char *to{result.OffsetElement<char>()};
-  std::size_t resultBytes{size * elementBytes};
+  std::size_t resultBytes{result.Elements() * result.ElementBytes()};
   const std::size_t sourceElementBytes{source.ElementBytes()};
   std::size_t sourceElements{source.Elements()};
   SubscriptValue sourceAt[maxRank];
@@ -65,5 +51,27 @@ void RTNAME(TransferSize)(Descriptor &result, const Descriptor &source,
   }
 }
 
+extern "C" {
+
+void RTNAME(Transfer)(Descriptor &result, const Descriptor &source,
+    const Descriptor &mold, const char *sourceFile, int line) {
+  if (mold.rank() > 0) {
+    std::size_t moldElementBytes{mold.ElementBytes()};
+    std::size_t elements{
+        (source.Elements() * source.ElementBytes() + moldElementBytes - 1) /
+        moldElementBytes};
+    return TransferImpl(result, source, mold, sourceFile, line,
+        static_cast<std::int64_t>(elements));
+  } else {
+    return TransferImpl(result, source, mold, sourceFile, line, {});
+  }
+}
+
+void RTNAME(TransferSize)(Descriptor &result, const Descriptor &source,
+    const Descriptor &mold, const char *sourceFile, int line,
+    std::int64_t size) {
+  return TransferImpl(result, source, mold, sourceFile, line, size);
+}
+
 } // extern "C"
 } // namespace Fortran::runtime

diff  --git a/flang/unittests/Runtime/MiscIntrinsic.cpp b/flang/unittests/Runtime/MiscIntrinsic.cpp
index bfdd6d6f6865c..aaa3692d49a11 100644
--- a/flang/unittests/Runtime/MiscIntrinsic.cpp
+++ b/flang/unittests/Runtime/MiscIntrinsic.cpp
@@ -68,3 +68,21 @@ TEST(MiscIntrinsic, TransferSize) {
   EXPECT_EQ(result.OffsetElement<float>()[1], 2.2F);
   result.Destroy();
 }
+TEST(MiscIntrinsic, TransferSizeScalarMold) {
+  StaticDescriptor<2, true, 2> staticDesc[2];
+  auto &result{staticDesc[0].descriptor()};
+  std::complex<float> sourecStorage{1.1F, -2.2F};
+  auto source{Descriptor::Create(TypeCategory::Complex, 4,
+      reinterpret_cast<void *>(&sourecStorage), 0, nullptr,
+      CFI_attribute_pointer)};
+  auto &mold{staticDesc[1].descriptor()};
+  mold.Establish(TypeCategory::Real, 4, nullptr, 0, nullptr);
+  RTNAME(TransferSize)(result, *source, mold, __FILE__, __LINE__, 2);
+  EXPECT_EQ(result.rank(), 1);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Real, 4}.raw()));
+  EXPECT_EQ(result.OffsetElement<float>()[0], 1.1F);
+  EXPECT_EQ(result.OffsetElement<float>()[1], -2.2F);
+  result.Destroy();
+}