diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp index b53440c2c3fad..4b9e438e8a109 100644 --- a/flang/runtime/allocatable.cpp +++ b/flang/runtime/allocatable.cpp @@ -168,9 +168,6 @@ int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat, int RTNAME(AllocatableAllocateSource)(Descriptor &alloc, const Descriptor &source, bool hasStat, const Descriptor *errMsg, const char *sourceFile, int sourceLine) { - if (alloc.Elements() == 0) { - return StatOk; - } int stat{RTNAME(AllocatableAllocate)( alloc, hasStat, errMsg, sourceFile, sourceLine)}; if (stat == StatOk) { diff --git a/flang/runtime/descriptor.cpp b/flang/runtime/descriptor.cpp index 1964a6798776b..ab6460708e9b6 100644 --- a/flang/runtime/descriptor.cpp +++ b/flang/runtime/descriptor.cpp @@ -142,8 +142,11 @@ std::size_t Descriptor::Elements() const { int Descriptor::Allocate() { std::size_t byteSize{Elements() * ElementBytes()}; - void *p{std::malloc(byteSize)}; - if (!p && byteSize) { + // Zero size allocation is possible in Fortran and the resulting + // descriptor must be allocated/associated. Since std::malloc(0) + // result is implementation defined, always allocate at least one byte. + void *p{byteSize ? std::malloc(byteSize) : std::malloc(1)}; + if (!p) { return CFI_ERROR_MEM_ALLOCATION; } // TODO: image synchronization diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp index 4024b78c88e33..0320468ffdc79 100644 --- a/flang/runtime/pointer.cpp +++ b/flang/runtime/pointer.cpp @@ -154,9 +154,6 @@ int RTNAME(PointerAllocate)(Descriptor &pointer, bool hasStat, int RTNAME(PointerAllocateSource)(Descriptor &pointer, const Descriptor &source, bool hasStat, const Descriptor *errMsg, const char *sourceFile, int sourceLine) { - if (pointer.Elements() == 0) { - return StatOk; - } int stat{RTNAME(PointerAllocate)( pointer, hasStat, errMsg, sourceFile, sourceLine)}; if (stat == StatOk) { diff --git a/flang/unittests/Runtime/Allocatable.cpp b/flang/unittests/Runtime/Allocatable.cpp index ed8e919320491..f15f26bfd9c57 100644 --- a/flang/unittests/Runtime/Allocatable.cpp +++ b/flang/unittests/Runtime/Allocatable.cpp @@ -95,6 +95,27 @@ TEST(AllocatableTest, AllocateFromScalarSource) { a->Destroy(); } +TEST(AllocatableTest, AllocateSourceZeroSize) { + using Fortran::common::TypeCategory; + // REAL(4), ALLOCATABLE :: a(:) + auto a{createAllocatable(TypeCategory::Real, 4)}; + // REAL(4) :: s(-1:-2) = 0. + float sourecStorage{0.F}; + const SubscriptValue extents[1]{0}; + auto s{Descriptor::Create(TypeCategory::Real, 4, + reinterpret_cast(&sourecStorage), 1, extents, + CFI_attribute_other)}; + // ALLOCATE(a, SOURCE=s) + RTNAME(AllocatableSetBounds)(*a, 0, -1, -2); + RTNAME(AllocatableAllocateSource) + (*a, *s, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__); + EXPECT_TRUE(a->IsAllocated()); + EXPECT_EQ(a->Elements(), 0u); + EXPECT_EQ(a->GetDimension(0).LowerBound(), 1); + EXPECT_EQ(a->GetDimension(0).UpperBound(), 0); + a->Destroy(); +} + TEST(AllocatableTest, DoubleAllocation) { // CLASS(*), ALLOCATABLE :: r // ALLOCATE(REAL::r) diff --git a/flang/unittests/Runtime/Pointer.cpp b/flang/unittests/Runtime/Pointer.cpp index 09ae3c4b4d966..4ce13ebc50a56 100644 --- a/flang/unittests/Runtime/Pointer.cpp +++ b/flang/unittests/Runtime/Pointer.cpp @@ -83,3 +83,25 @@ TEST(Pointer, AllocateFromScalarSource) { EXPECT_EQ(*p->OffsetElement(), 3.4F); p->Destroy(); } + +TEST(Pointer, AllocateSourceZeroSize) { + using Fortran::common::TypeCategory; + // REAL(4), POINTER :: p(:) + auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4, + nullptr, 1, nullptr, CFI_attribute_pointer)}; + // REAL(4) :: s(-1:-2) = 0. + float sourecStorage{0.F}; + const SubscriptValue extents[1]{0}; + auto s{Descriptor::Create(TypeCategory::Real, 4, + reinterpret_cast(&sourecStorage), 1, extents, + CFI_attribute_other)}; + // ALLOCATE(p, SOURCE=s) + RTNAME(PointerSetBounds)(*p, 0, -1, -2); + RTNAME(PointerAllocateSource) + (*p, *s, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__); + EXPECT_TRUE(RTNAME(PointerIsAssociated)(*p)); + EXPECT_EQ(p->Elements(), 0u); + EXPECT_EQ(p->GetDimension(0).LowerBound(), 1); + EXPECT_EQ(p->GetDimension(0).UpperBound(), 0); + p->Destroy(); +}