[flang] add API to copy and update descriptors for assumed ranks (#93305)

When passing assumed-rank around, the lower bounds, dynamic type and
attribute must sometimes be updated to match the dummy attributes. See
https://github.com/llvm/llvm-project/blob/main/flang/docs/AssumedRank.md#annex-1---descriptor-temporary-for-the-dummy-arguments
for more details.

Doing it inline would require generating many instructions and block CFG
at the LLVM IR dialect level in codegen. Go for a simple runtime API
instead.
A matching fir.rebox_assumed_rank operation will be created and will
allow for easier future optimizations when inlining is done in FIR.

Author: jeanPerier

flang/include/flang/Runtime/support.h

@@ -10,6 +10,7 @@
 #ifndef FORTRAN_RUNTIME_SUPPORT_H_
 #define FORTRAN_RUNTIME_SUPPORT_H_
 
+#include "flang/ISO_Fortran_binding_wrapper.h"
 #include "flang/Runtime/entry-names.h"
 #include <cstddef>
 #include <cstdint>
@@ -18,11 +19,29 @@ namespace Fortran::runtime {
 
 class Descriptor;
 
+namespace typeInfo {
+class DerivedType;
+}
+
+enum class LowerBoundModifier : int {
+  Preserve = 0,
+  SetToOnes = 1,
+  SetToZeroes = 2
+};
+
 extern "C" {
 
 // Predicate: is the storage described by a Descriptor contiguous in memory?
 bool RTDECL(IsContiguous)(const Descriptor &);
 
+// Copy "from" descriptor into "to" descriptor and update "to" dynamic type,
+// CFI_attribute, and lower bounds according to the other arguments.
+// "newDynamicType" may be a null pointer in which case "to" dynamic type is the
+// one of "from".
+void RTDECL(CopyAndUpdateDescriptor)(Descriptor &to, const Descriptor &from,
+    const typeInfo::DerivedType *newDynamicType,
+    ISO::CFI_attribute_t newAttribute, enum LowerBoundModifier newLowerBounds);
+
 } // extern "C"
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_SUPPORT_H_

flang/runtime/support.cpp

@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "flang/Runtime/support.h"
+#include "type-info.h"
 #include "flang/Runtime/descriptor.h"
 
 namespace Fortran::runtime {
@@ -17,6 +18,27 @@ bool RTDEF(IsContiguous)(const Descriptor &descriptor) {
   return descriptor.IsContiguous();
 }
 
+void RTDEF(CopyAndUpdateDescriptor)(Descriptor &to, const Descriptor &from,
+    const typeInfo::DerivedType *newDynamicType,
+    ISO::CFI_attribute_t newAttribute, enum LowerBoundModifier newLowerBounds) {
+  to = from;
+  if (newDynamicType) {
+    DescriptorAddendum *toAddendum{to.Addendum()};
+    INTERNAL_CHECK(toAddendum);
+    toAddendum->set_derivedType(newDynamicType);
+    to.raw().elem_len = newDynamicType->sizeInBytes();
+  }
+  to.raw().attribute = newAttribute;
+  if (newLowerBounds != LowerBoundModifier::Preserve) {
+    const ISO::CFI_index_t newLowerBound{
+        newLowerBounds == LowerBoundModifier::SetToOnes ? 1 : 0};
+    const int rank{to.rank()};
+    for (int i = 0; i < rank; ++i) {
+      to.GetDimension(i).SetLowerBound(newLowerBound);
+    }
+  }
+}
+
 RT_EXT_API_GROUP_END
 } // extern "C"
 } // namespace Fortran::runtime

flang/unittests/Runtime/CMakeLists.txt

@@ -25,6 +25,7 @@ add_flang_unittest(FlangRuntimeTests
   Reduction.cpp
   RuntimeCrashTest.cpp
   Stop.cpp
+  Support.cpp
   Time.cpp
   TemporaryStack.cpp
   Transformational.cpp

flang/unittests/Runtime/Support.cpp

@@ -0,0 +1,58 @@
+//===-- flang/unittests/Runtime/Support.cpp ----------------------*- C++-*-===//
+//
+// 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/support.h"
+#include "gtest/gtest.h"
+#include "tools.h"
+#include "flang/Runtime/descriptor.h"
+
+using namespace Fortran::runtime;
+using Fortran::common::TypeCategory;
+TEST(CopyAndUpdateDescriptor, Basic) {
+  auto x{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{2, 3}, std::vector<std::int32_t>{0, 1, 2, 3, 4, 5})};
+  x->GetDimension(0).SetLowerBound(11);
+  x->GetDimension(1).SetLowerBound(12);
+
+  StaticDescriptor<2, false> statDesc;
+  Descriptor &result{statDesc.descriptor()};
+
+  RTNAME(CopyAndUpdateDescriptor)
+  (result, *x, nullptr, CFI_attribute_pointer, LowerBoundModifier::Preserve);
+  ASSERT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.raw().base_addr, x->raw().base_addr);
+  EXPECT_TRUE(result.IsPointer());
+  EXPECT_EQ(result.GetDimension(0).Extent(), x->GetDimension(0).Extent());
+  EXPECT_EQ(
+      result.GetDimension(0).LowerBound(), x->GetDimension(0).LowerBound());
+  EXPECT_EQ(result.GetDimension(1).Extent(), x->GetDimension(1).Extent());
+  EXPECT_EQ(
+      result.GetDimension(1).LowerBound(), x->GetDimension(1).LowerBound());
+
+  RTNAME(CopyAndUpdateDescriptor)
+  (result, *x, nullptr, CFI_attribute_allocatable,
+      LowerBoundModifier::SetToZeroes);
+  ASSERT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.raw().base_addr, x->raw().base_addr);
+  EXPECT_TRUE(result.IsAllocatable());
+  EXPECT_EQ(result.GetDimension(0).Extent(), x->GetDimension(0).Extent());
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 0);
+  EXPECT_EQ(result.GetDimension(1).Extent(), x->GetDimension(1).Extent());
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 0);
+
+  RTNAME(CopyAndUpdateDescriptor)
+  (result, *x, nullptr, CFI_attribute_other, LowerBoundModifier::SetToOnes);
+  ASSERT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.raw().base_addr, x->raw().base_addr);
+  EXPECT_FALSE(result.IsAllocatable());
+  EXPECT_FALSE(result.IsPointer());
+  EXPECT_EQ(result.GetDimension(0).Extent(), x->GetDimension(0).Extent());
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(1).Extent(), x->GetDimension(1).Extent());
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
+}