[flang] Return arrays in Transfer runtime with SIZE argument

[jeanPerier]

Summary

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.

[klausler]

flang/runtime/misc-intrinsic.cpp

16–17

The "extern "C"" can be after the (now) static first function.

24–25

I know this is safe, but future code readers might be misled by the (apparently) unprotected reference to the value of resultExtent here. Can you change the if() predicate to "if (resultExtent)"?

[jeanPerier]

Move static function outisde of extern "C" and use "if (resultExtent)".

[jeanPerier]

flang/runtime/misc-intrinsic.cpp

24–25

Fair point, I changed it.

flang/runtime/misc-intrinsic.cpp

 //===-- runtime/misc-intrinsic.cpp ----------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Runtime/misc-intrinsic.h"
 #include "terminator.h"
 #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;
   }
   if (int stat{result.Allocate()}) {
     Terminator{sourceFile, line}.Crash(
         "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];
   source.GetLowerBounds(sourceAt);
   while (resultBytes > 0 && sourceElements > 0) {
     std::size_t toMove{std::min(resultBytes, sourceElementBytes)};
     std::memcpy(to, source.Element<char>(sourceAt), toMove);
     to += toMove;
     resultBytes -= toMove;
     --sourceElements;
     source.IncrementSubscripts(sourceAt);
   }
   if (resultBytes > 0) {
     std::memset(to, 0, resultBytes);
   }
 }
 
+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

flang/unittests/Runtime/MiscIntrinsic.cpp

TEST(MiscIntrinsic, TransferSize) {
   EXPECT_EQ(result.rank(), 1);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 1);
   EXPECT_EQ(result.type().raw(), (TypeCode{TypeCategory::Complex, 4}.raw()));
   EXPECT_EQ(result.OffsetElement<float>()[0], 1.1F);
   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();
+}