[flang-commits] [flang] 6111c9c - [flang][runtime] Handle ALLOCATE(..., short SOURCE=) (#155715)

[via flang-commits]

Author: Peter Klausler
Date: 2025-08-29T07:50:17-07:00
New Revision: 6111c9cfdcc054306de0a17d9eab5274ca6a34e1

URL: https://github.com/llvm/llvm-project/commit/6111c9cfdcc054306de0a17d9eab5274ca6a34e1
DIFF: https://github.com/llvm/llvm-project/commit/6111c9cfdcc054306de0a17d9eab5274ca6a34e1.diff

LOG: [flang][runtime] Handle ALLOCATE(..., short SOURCE=) (#155715)

Ensure that blank padding takes place when a fixed-length character
allocatable is allocated with a short SOURCE= specifier. While here,
clean up DoFromSourceAssign() so that it uses a temporary descriptor on
the stack rather than allocating one from the heap.

Fixes https://github.com/llvm/llvm-project/issues/155703.

Added: 
    

Modified: 
    flang-rt/lib/runtime/assign.cpp
    flang/include/flang/Runtime/assign.h

Removed: 
    


################################################################################
diff  --git a/flang-rt/lib/runtime/assign.cpp b/flang-rt/lib/runtime/assign.cpp
index 2c29a98d5a5cb..a21e899c2c658 100644
--- a/flang-rt/lib/runtime/assign.cpp
+++ b/flang-rt/lib/runtime/assign.cpp
@@ -244,7 +244,7 @@ static RT_API_ATTRS void BlankPadCharacterAssignment(Descriptor &to,
   for (; elements-- > 0;
        to.IncrementSubscripts(toAt), from.IncrementSubscripts(fromAt)) {
     CHAR *p{to.Element<CHAR>(toAt)};
-    Fortran::runtime::memmove(
+    runtime::memmove(
         p, from.Element<std::add_const_t<CHAR>>(fromAt), fromElementBytes);
     p += copiedCharacters;
     for (auto n{padding}; n-- > 0;) {
@@ -743,22 +743,35 @@ RT_API_ATTRS void DoFromSourceAssign(Descriptor &alloc,
   if (alloc.rank() > 0 && source.rank() == 0) {
     // The value of each element of allocate object becomes the value of source.
     DescriptorAddendum *allocAddendum{alloc.Addendum()};
-    const typeInfo::DerivedType *allocDerived{
-        allocAddendum ? allocAddendum->derivedType() : nullptr};
     SubscriptValue allocAt[maxRank];
     alloc.GetLowerBounds(allocAt);
-    if (allocDerived) {
+    std::size_t allocElementBytes{alloc.ElementBytes()};
+    if (const typeInfo::DerivedType *allocDerived{
+            allocAddendum ? allocAddendum->derivedType() : nullptr}) {
+      // Handle derived type or short character source
       for (std::size_t n{alloc.InlineElements()}; n-- > 0;
           alloc.IncrementSubscripts(allocAt)) {
-        Descriptor allocElement{*Descriptor::Create(*allocDerived,
-            reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0)};
+        StaticDescriptor<maxRank, true, 8 /*?*/> statDesc;
+        Descriptor &allocElement{statDesc.descriptor()};
+        allocElement.Establish(*allocDerived,
+            reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0);
         Assign(allocElement, source, terminator, NoAssignFlags, memmoveFct);
       }
-    } else { // intrinsic type
+    } else if (allocElementBytes > source.ElementBytes()) {
+      // Scalar expansion of short character source
+      for (std::size_t n{alloc.InlineElements()}; n-- > 0;
+          alloc.IncrementSubscripts(allocAt)) {
+        StaticDescriptor<maxRank, true, 8 /*?*/> statDesc;
+        Descriptor &allocElement{statDesc.descriptor()};
+        allocElement.Establish(source.type(), allocElementBytes,
+            reinterpret_cast<void *>(alloc.Element<char>(allocAt)), 0);
+        Assign(allocElement, source, terminator, NoAssignFlags, memmoveFct);
+      }
+    } else { // intrinsic type scalar expansion, same data size
       for (std::size_t n{alloc.InlineElements()}; n-- > 0;
           alloc.IncrementSubscripts(allocAt)) {
         memmoveFct(alloc.Element<char>(allocAt), source.raw().base_addr,
-            alloc.ElementBytes());
+            allocElementBytes);
       }
     }
   } else {

diff  --git a/flang/include/flang/Runtime/assign.h b/flang/include/flang/Runtime/assign.h
index 7d198bdcc9e89..c145239c8c1ad 100644
--- a/flang/include/flang/Runtime/assign.h
+++ b/flang/include/flang/Runtime/assign.h
@@ -44,11 +44,10 @@ enum AssignFlags {
 
 #ifdef RT_DEVICE_COMPILATION
 RT_API_ATTRS void Assign(Descriptor &to, const Descriptor &from,
-    Terminator &terminator, int flags, MemmoveFct memmoveFct = &MemmoveWrapper);
+    Terminator &terminator, int flags, MemmoveFct = &MemmoveWrapper);
 #else
 RT_API_ATTRS void Assign(Descriptor &to, const Descriptor &from,
-    Terminator &terminator, int flags,
-    MemmoveFct memmoveFct = &Fortran::runtime::memmove);
+    Terminator &terminator, int flags, MemmoveFct = &runtime::memmove);
 #endif
 
 extern "C" {