diff options
author | Peter Klausler <35819229+klausler@users.noreply.github.com> | 2024-01-15 12:18:34 -0800 |
---|---|---|
committer | GitHub <noreply@github.com> | 2024-01-15 12:18:34 -0800 |
commit | 9fdd25e18c04f3543f7de9727f11f034498ca07e (patch) | |
tree | 0cf46faf7c989183d2884417e06a7368274aecfa | |
parent | 7b8012338745ab16a88d78b3772d21dd6f87224b (diff) | |
download | llvm-9fdd25e18c04f3543f7de9727f11f034498ca07e.zip llvm-9fdd25e18c04f3543f7de9727f11f034498ca07e.tar.gz llvm-9fdd25e18c04f3543f7de9727f11f034498ca07e.tar.bz2 |
[flang] Don't change size of allocatable in error situation (#77386)
When an already-allocated allocatable array is about to fail
reallocation, don't allow its size or other characteristics to be
changed.
Fixes
llvm-test-suite/Fortran/gfortran/regression/multiple_allocation_1.f90
and .../multiple_allocation_3.f90.
-rw-r--r-- | flang/runtime/allocatable.cpp | 68 |
1 files changed, 34 insertions, 34 deletions
diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp index e69795e..5e065f4 100644 --- a/flang/runtime/allocatable.cpp +++ b/flang/runtime/allocatable.cpp @@ -44,26 +44,23 @@ void RTDEF(AllocatableInitDerived)(Descriptor &descriptor, void RTDEF(AllocatableInitIntrinsicForAllocate)(Descriptor &descriptor, TypeCategory category, int kind, int rank, int corank) { - if (descriptor.IsAllocated()) { - return; + if (!descriptor.IsAllocated()) { + RTNAME(AllocatableInitIntrinsic)(descriptor, category, kind, rank, corank); } - RTNAME(AllocatableInitIntrinsic)(descriptor, category, kind, rank, corank); } void RTDEF(AllocatableInitCharacterForAllocate)(Descriptor &descriptor, SubscriptValue length, int kind, int rank, int corank) { - if (descriptor.IsAllocated()) { - return; + if (!descriptor.IsAllocated()) { + RTNAME(AllocatableInitCharacter)(descriptor, length, kind, rank, corank); } - RTNAME(AllocatableInitCharacter)(descriptor, length, kind, rank, corank); } void RTDEF(AllocatableInitDerivedForAllocate)(Descriptor &descriptor, const typeInfo::DerivedType &derivedType, int rank, int corank) { - if (descriptor.IsAllocated()) { - return; + if (!descriptor.IsAllocated()) { + RTNAME(AllocatableInitDerived)(descriptor, derivedType, rank, corank); } - RTNAME(AllocatableInitDerived)(descriptor, derivedType, rank, corank); } std::int32_t RTDEF(MoveAlloc)(Descriptor &to, Descriptor &from, @@ -114,24 +111,26 @@ std::int32_t RTDEF(MoveAlloc)(Descriptor &to, Descriptor &from, void RTDEF(AllocatableSetBounds)(Descriptor &descriptor, int zeroBasedDim, SubscriptValue lower, SubscriptValue upper) { INTERNAL_CHECK(zeroBasedDim >= 0 && zeroBasedDim < descriptor.rank()); - descriptor.GetDimension(zeroBasedDim).SetBounds(lower, upper); - // The byte strides are computed when the object is allocated. + if (descriptor.IsAllocatable() && !descriptor.IsAllocated()) { + descriptor.GetDimension(zeroBasedDim).SetBounds(lower, upper); + // The byte strides are computed when the object is allocated. + } } void RTDEF(AllocatableSetDerivedLength)( Descriptor &descriptor, int which, SubscriptValue x) { - DescriptorAddendum *addendum{descriptor.Addendum()}; - INTERNAL_CHECK(addendum != nullptr); - addendum->SetLenParameterValue(which, x); + if (descriptor.IsAllocatable() && !descriptor.IsAllocated()) { + DescriptorAddendum *addendum{descriptor.Addendum()}; + INTERNAL_CHECK(addendum != nullptr); + addendum->SetLenParameterValue(which, x); + } } void RTDEF(AllocatableApplyMold)( Descriptor &descriptor, const Descriptor &mold, int rank) { - if (descriptor.IsAllocated()) { - // 9.7.1.3 Return so the error can be emitted by AllocatableAllocate. - return; + if (descriptor.IsAllocatable() && !descriptor.IsAllocated()) { + descriptor.ApplyMold(mold, rank); } - descriptor.ApplyMold(mold, rank); } int RTDEF(AllocatableAllocate)(Descriptor &descriptor, bool hasStat, @@ -139,21 +138,22 @@ int RTDEF(AllocatableAllocate)(Descriptor &descriptor, bool hasStat, Terminator terminator{sourceFile, sourceLine}; if (!descriptor.IsAllocatable()) { return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat); - } - if (descriptor.IsAllocated()) { + } else if (descriptor.IsAllocated()) { return ReturnError(terminator, StatBaseNotNull, errMsg, hasStat); - } - int stat{ReturnError(terminator, descriptor.Allocate(), errMsg, hasStat)}; - if (stat == StatOk) { - if (const DescriptorAddendum * addendum{descriptor.Addendum()}) { - if (const auto *derived{addendum->derivedType()}) { - if (!derived->noInitializationNeeded()) { - stat = Initialize(descriptor, *derived, terminator, hasStat, errMsg); + } else { + int stat{ReturnError(terminator, descriptor.Allocate(), errMsg, hasStat)}; + if (stat == StatOk) { + if (const DescriptorAddendum * addendum{descriptor.Addendum()}) { + if (const auto *derived{addendum->derivedType()}) { + if (!derived->noInitializationNeeded()) { + stat = + Initialize(descriptor, *derived, terminator, hasStat, errMsg); + } } } } + return stat; } - return stat; } int RTDEF(AllocatableAllocateSource)(Descriptor &alloc, @@ -173,14 +173,14 @@ int RTDEF(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat, Terminator terminator{sourceFile, sourceLine}; if (!descriptor.IsAllocatable()) { return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat); - } - if (!descriptor.IsAllocated()) { + } else if (!descriptor.IsAllocated()) { return ReturnError(terminator, StatBaseNull, errMsg, hasStat); + } else { + return ReturnError(terminator, + descriptor.Destroy( + /*finalize=*/true, /*destroyPointers=*/false, &terminator), + errMsg, hasStat); } - return ReturnError(terminator, - descriptor.Destroy( - /*finalize=*/true, /*destroyPointers=*/false, &terminator), - errMsg, hasStat); } int RTDEF(AllocatableDeallocatePolymorphic)(Descriptor &descriptor, |