mirror of
https://github.com/capstone-engine/llvm-capstone.git
synced 2024-12-04 03:44:59 +00:00
[flang][runtime] zero size allocation in source allocation (#66124)
Source allocation with a zero sized array is legal, and the resulting allocatable/pointer should be allocated/associated. The current code skipped the actual allocation, leading the allocatable or pointer to look unallocated/disassociated.
This commit is contained in:
parent
ed8bd7176d
commit
79508db494
@ -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) {
|
||||
|
@ -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
|
||||
|
@ -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) {
|
||||
|
@ -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<void *>(&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)
|
||||
|
@ -83,3 +83,25 @@ TEST(Pointer, AllocateFromScalarSource) {
|
||||
EXPECT_EQ(*p->OffsetElement<float>(), 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<void *>(&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();
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user