[flang-commits] [flang] [flang][runtime] Let FORT_CHECK_POINTER_DEALLOCATE=0 disable runtime … (PR #84956)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Mar 12 10:33:47 PDT 2024
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/84956
>From 18812ba4c9665bad946b48a866252375218339c7 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 12 Mar 2024 10:27:25 -0700
Subject: [PATCH] [flang][runtime] Let FORT_CHECK_POINTER_DEALLOCATION=0
disable runtime check
Add an environment variable by which a user can disable the pointer
validation check in DEALLOCATE statement handling. This is not
safe, but it can help make a code work that allocates a pointer
with an extended derived type, associates its target with a pointer
to one of its ancestor types, and then deallocates that pointer.
---
flang/docs/RuntimeEnvironment.md | 57 ++++++++++++++++++++++++++++++++
flang/runtime/environment.cpp | 13 ++++++++
flang/runtime/environment.h | 1 +
flang/runtime/pointer.cpp | 26 +++++++++------
4 files changed, 86 insertions(+), 11 deletions(-)
create mode 100644 flang/docs/RuntimeEnvironment.md
diff --git a/flang/docs/RuntimeEnvironment.md b/flang/docs/RuntimeEnvironment.md
new file mode 100644
index 00000000000000..083e379072e807
--- /dev/null
+++ b/flang/docs/RuntimeEnvironment.md
@@ -0,0 +1,57 @@
+<!--===- docs/RuntimeTypeInfo.md
+
+ 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
+
+-->
+
+```{contents}
+---
+local:
+---
+```
+
+# Environment variables of significance to Fortran execution
+
+A few environment variables are queried by the Fortran runtime support
+library.
+
+The following environment variables can affect the behavior of
+Fortran programs during execution.
+
+## `DEFAULT_UTF8=1`
+
+Set `DEFAULT_UTF8` to cause formatted external input to assume UTF-8
+encoding on input and use UTF-8 encoding on formatted external output.
+
+## `FORT_CONVERT`
+
+Determines data conversions applied to unformatted I/O.
+
+* `NATIVE`: no conversions (default)
+* `LITTLE_ENDIAN`: assume input is little-endian; emit little-endian output
+* `BIG_ENDIAN`: assume input is big-endian; emit big-endian output
+* `SWAP`: reverse endianness (always convert)
+
+## `FORT_CHECK_POINTER_DEALLOCATION`
+
+Fortran requires that a pointer that appears in a `DEALLOCATE` statement
+must have been allocated in an `ALLOCATE` statement with the same declared
+type.
+The runtime support library validates this requirement by checking the
+size of the allocated data, and will fail with an error message if
+the deallocated pointer is not valid.
+Set `FORT_CHECK_POINTER_DEALLOCATION=0` to disable this check.
+
+## `FORT_FMT_RECL`
+
+Set to an integer value to specify the record length for list-directed
+and `NAMELIST` output.
+The default is 72.
+
+## `NO_STOP_MESSAGE`
+
+Set `NO_STOP_MESSAGE=1` to disable the extra information about
+IEEE floating-point exception flags that the Fortran language
+standard requires for `STOP` and `ERROR STOP` statements.
diff --git a/flang/runtime/environment.cpp b/flang/runtime/environment.cpp
index 62d9ee2afd1ceb..29196ae8f31051 100644
--- a/flang/runtime/environment.cpp
+++ b/flang/runtime/environment.cpp
@@ -123,6 +123,19 @@ void ExecutionEnvironment::Configure(int ac, const char *av[],
}
}
+ if (auto *x{std::getenv("FORT_CHECK_POINTER_DEALLOCATION")}) {
+ char *end;
+ auto n{std::strtol(x, &end, 10)};
+ if (n >= 0 && n <= 1 && *end == '\0') {
+ checkPointerDeallocation = n != 0;
+ } else {
+ std::fprintf(stderr,
+ "Fortran runtime: FORT_CHECK_POINTER_DEALLOCATION=%s is invalid; "
+ "ignored\n",
+ x);
+ }
+ }
+
// TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment
}
diff --git a/flang/runtime/environment.h b/flang/runtime/environment.h
index 82a5ec8f4ebfb0..6da2c7bb3cf78a 100644
--- a/flang/runtime/environment.h
+++ b/flang/runtime/environment.h
@@ -48,6 +48,7 @@ struct ExecutionEnvironment {
Convert conversion{Convert::Unknown}; // FORT_CONVERT
bool noStopMessage{false}; // NO_STOP_MESSAGE=1 inhibits "Fortran STOP"
bool defaultUTF8{false}; // DEFAULT_UTF8
+ bool checkPointerDeallocation{true}; // FORT_CHECK_POINTER_DEALLOCATION
};
extern ExecutionEnvironment executionEnvironment;
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
index fc9e0eeb7dac99..08a1223764f393 100644
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -9,6 +9,7 @@
#include "flang/Runtime/pointer.h"
#include "assign-impl.h"
#include "derived.h"
+#include "environment.h"
#include "stat.h"
#include "terminator.h"
#include "tools.h"
@@ -184,17 +185,20 @@ int RTDEF(PointerDeallocate)(Descriptor &pointer, bool hasStat,
if (!pointer.IsAllocated()) {
return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
}
- // Validate the footer. This should fail if the pointer doesn't
- // span the entire object, or the object was not allocated as a
- // pointer.
- std::size_t byteSize{pointer.Elements() * pointer.ElementBytes()};
- constexpr std::size_t align{sizeof(std::uintptr_t)};
- byteSize = ((byteSize + align - 1) / align) * align;
- void *p{pointer.raw().base_addr};
- std::uintptr_t *footer{
- reinterpret_cast<std::uintptr_t *>(static_cast<char *>(p) + byteSize)};
- if (*footer != ~reinterpret_cast<std::uintptr_t>(p)) {
- return ReturnError(terminator, StatBadPointerDeallocation, errMsg, hasStat);
+ if (executionEnvironment.checkPointerDeallocation) {
+ // Validate the footer. This should fail if the pointer doesn't
+ // span the entire object, or the object was not allocated as a
+ // pointer.
+ std::size_t byteSize{pointer.Elements() * pointer.ElementBytes()};
+ constexpr std::size_t align{sizeof(std::uintptr_t)};
+ byteSize = ((byteSize + align - 1) / align) * align;
+ void *p{pointer.raw().base_addr};
+ std::uintptr_t *footer{
+ reinterpret_cast<std::uintptr_t *>(static_cast<char *>(p) + byteSize)};
+ if (*footer != ~reinterpret_cast<std::uintptr_t>(p)) {
+ return ReturnError(
+ terminator, StatBadPointerDeallocation, errMsg, hasStat);
+ }
}
return ReturnError(terminator,
pointer.Destroy(/*finalize=*/true, /*destroyPointers=*/true, &terminator),
More information about the flang-commits
mailing list