Peter Klausler a3bbe627d2
[flang][runtime] Validate pointer DEALLOCATE (#78612)
The standard requires a compiler to diagnose an incorrect use of a
pointer in a DEALLOCATE statement. The pointer must be associated with
an entire object that was allocated as a pointer (not allocatable) by an
ALLOCATE statement.

Implement by appending a validation footer to pointer allocations. This
is an extra allocated word that encodes the base address of the
allocation. If it is not found after the data payload when the pointer
is deallocated, signal an error. There is a chance of a false positive
result, but that should be vanishingly unlikely.

This change requires all pointer allocations (not allocatables) to take
place in the runtime in PointerAllocate(), which might be slower in
cases that could otherwise be handled with a native memory allocation
operation. I believe that memory allocation of pointers is less common
than with allocatables, which are not affected. If this turns out to
become a performance problem, we can inline the creation and
initialization of the footer word.

Fixes https://github.com/llvm/llvm-project/issues/78391.
2024-01-25 14:44:09 -08:00

111 lines
3.1 KiB
C++

//===-- runtime/stat.cpp --------------------------------------------------===//
//
// 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 "stat.h"
#include "terminator.h"
#include "tools.h"
#include "flang/Runtime/descriptor.h"
namespace Fortran::runtime {
RT_OFFLOAD_API_GROUP_BEGIN
RT_API_ATTRS const char *StatErrorString(int stat) {
switch (stat) {
case StatOk:
return "No error";
case StatBaseNull:
return "Base address is null";
case StatBaseNotNull:
return "Base address is not null";
case StatInvalidElemLen:
return "Invalid element length";
case StatInvalidRank:
return "Invalid rank";
case StatInvalidType:
return "Invalid type";
case StatInvalidAttribute:
return "Invalid attribute";
case StatInvalidExtent:
return "Invalid extent";
case StatInvalidDescriptor:
return "Invalid descriptor";
case StatMemAllocation:
return "Memory allocation failed";
case StatOutOfBounds:
return "Out of bounds";
case StatFailedImage:
return "Failed image";
case StatLocked:
return "Locked";
case StatLockedOtherImage:
return "Other image locked";
case StatStoppedImage:
return "Image stopped";
case StatUnlocked:
return "Unlocked";
case StatUnlockedFailedImage:
return "Failed image unlocked";
case StatInvalidArgumentNumber:
return "Invalid argument number";
case StatMissingArgument:
return "Missing argument";
case StatValueTooShort:
return "Value too short";
case StatMissingEnvVariable:
return "Missing environment variable";
case StatMoveAllocSameAllocatable:
return "MOVE_ALLOC passed the same address as to and from";
case StatBadPointerDeallocation:
return "DEALLOCATE of a pointer that is not the whole content of a pointer "
"ALLOCATE";
default:
return nullptr;
}
}
RT_API_ATTRS int ToErrmsg(const Descriptor *errmsg, int stat) {
if (stat != StatOk && errmsg && errmsg->raw().base_addr &&
errmsg->type() == TypeCode(TypeCategory::Character, 1) &&
errmsg->rank() == 0) {
if (const char *msg{StatErrorString(stat)}) {
char *buffer{errmsg->OffsetElement()};
std::size_t bufferLength{errmsg->ElementBytes()};
std::size_t msgLength{Fortran::runtime::strlen(msg)};
if (msgLength >= bufferLength) {
std::memcpy(buffer, msg, bufferLength);
} else {
std::memcpy(buffer, msg, msgLength);
std::memset(buffer + msgLength, ' ', bufferLength - msgLength);
}
}
}
return stat;
}
RT_API_ATTRS int ReturnError(
Terminator &terminator, int stat, const Descriptor *errmsg, bool hasStat) {
if (stat == StatOk || hasStat) {
return ToErrmsg(errmsg, stat);
} else if (const char *msg{StatErrorString(stat)}) {
terminator.Crash(msg);
} else {
terminator.Crash("Invalid Fortran runtime STAT= code %d", stat);
}
return stat;
}
RT_OFFLOAD_API_GROUP_END
} // namespace Fortran::runtime