[flang] Update DE/ALLOCATE statement runtime message processing

Make error message descriptors on runtime DE/ALLOCATE API calls constant.
Fix a bug in error message truncation/padding.

Differential Revision: https://reviews.llvm.org/D98551

flang/runtime/allocatable.cpp

@@ -40,8 +40,8 @@ void RTNAME(AllocatableAssign)(Descriptor &to, const Descriptor & /*from*/) {
 }
 
 int RTNAME(MoveAlloc)(Descriptor &to, const Descriptor & /*from*/,
-    bool /*hasStat*/, Descriptor * /*errMsg*/, const char * /*sourceFile*/,
+    bool /*hasStat*/, const Descriptor * /*errMsg*/,
-    int /*sourceLine*/) {
+    const char * /*sourceFile*/, int /*sourceLine*/) {
   INTERNAL_CHECK(false); // MoveAlloc is not yet implemented
   return StatOk;
 }
@@ -54,7 +54,7 @@ void RTNAME(AllocatableSetBounds)(Descriptor &descriptor, int zeroBasedDim,
 }
 
 int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat,
-    Descriptor *errMsg, const char *sourceFile, int sourceLine) {
+    const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (!descriptor.IsAllocatable()) {
     return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
@@ -66,7 +66,7 @@ int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat,
 }
 
 int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,
-    Descriptor *errMsg, const char *sourceFile, int sourceLine) {
+    const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (!descriptor.IsAllocatable()) {
     return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);

flang/runtime/allocatable.h

@@ -42,7 +42,7 @@ void RTNAME(AllocatableInitDerived)(
 // this API allows the error to be caught before descriptor is modified.)
 // Return 0 on success (deallocated state), else the STAT= value.
 int RTNAME(AllocatableCheckAllocated)(Descriptor &,
-    Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+    const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
     int sourceLine = 0);
 
 // For MOLD= allocation; sets bounds, cobounds, and length type
@@ -72,7 +72,7 @@ void RTNAME(AllocatableSetDerivedLength)(
 // Returns 0 for success, or the STAT= value on failure with hasStat==true.
 int RTNAME(AllocatableCheckLengthParameter)(Descriptor &,
     int which /* 0 for CHARACTER length */, SubscriptValue other,
-    bool hasStat = false, Descriptor *errMsg = nullptr,
+    bool hasStat = false, const Descriptor *errMsg = nullptr,
     const char *sourceFile = nullptr, int sourceLine = 0);
 
 // Allocates an allocatable.  The allocatable descriptor must have been
@@ -85,10 +85,10 @@ int RTNAME(AllocatableCheckLengthParameter)(Descriptor &,
 // derived type, and is always initialized by AllocatableAllocateSource().
 // Performs all necessary coarray synchronization and validation actions.
 int RTNAME(AllocatableAllocate)(Descriptor &, bool hasStat = false,
-    Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+    const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
     int sourceLine = 0);
 int RTNAME(AllocatableAllocateSource)(Descriptor &, const Descriptor &source,
-    bool hasStat = false, Descriptor *errMsg = nullptr,
+    bool hasStat = false, const Descriptor *errMsg = nullptr,
     const char *sourceFile = nullptr, int sourceLine = 0);
 
 // Assigns to a whole allocatable, with automatic (re)allocation when the
@@ -105,14 +105,14 @@ void RTNAME(AllocatableAssign)(Descriptor &to, const Descriptor &from);
 // with the other APIs for allocatables.)  The destination descriptor
 // must be initialized.
 int RTNAME(MoveAlloc)(Descriptor &to, const Descriptor &from,
-    bool hasStat = false, Descriptor *errMsg = nullptr,
+    bool hasStat = false, const Descriptor *errMsg = nullptr,
     const char *sourceFile = nullptr, int sourceLine = 0);
 
 // Deallocates an allocatable.  Finalizes elements &/or components as needed.
 // The allocatable is left in an initialized state suitable for reallocation
 // with the same bounds, cobounds, and length type parameters.
 int RTNAME(AllocatableDeallocate)(Descriptor &, bool hasStat = false,
-    Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
+    const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
     int sourceLine = 0);
 }
 } // namespace Fortran::runtime

flang/runtime/stat.cpp

@@ -55,7 +55,7 @@ const char *StatErrorString(int stat) {
   }
 }
 
-int ToErrmsg(Descriptor *errmsg, int stat) {
+int ToErrmsg(const Descriptor *errmsg, int stat) {
   if (stat != StatOk && errmsg && errmsg->raw().base_addr &&
       errmsg->type() == TypeCode(TypeCategory::Character, 1) &&
       errmsg->rank() == 0) {
@@ -63,7 +63,7 @@ int ToErrmsg(Descriptor *errmsg, int stat) {
       char *buffer{errmsg->OffsetElement()};
       std::size_t bufferLength{errmsg->ElementBytes()};
       std::size_t msgLength{std::strlen(msg)};
-      if (msgLength <= bufferLength) {
+      if (msgLength >= bufferLength) {
         std::memcpy(buffer, msg, bufferLength);
       } else {
         std::memcpy(buffer, msg, msgLength);
@@ -75,7 +75,7 @@ int ToErrmsg(Descriptor *errmsg, int stat) {
 }
 
 int ReturnError(
-    Terminator &terminator, int stat, Descriptor *errmsg, bool hasStat) {
+    Terminator &terminator, int stat, const Descriptor *errmsg, bool hasStat) {
   if (stat == StatOk || hasStat) {
     return ToErrmsg(errmsg, stat);
   } else if (const char *msg{StatErrorString(stat)}) {

flang/runtime/stat.h

@@ -47,8 +47,8 @@ enum Stat {
 };
 
 const char *StatErrorString(int);
-int ToErrmsg(Descriptor *errmsg, int stat); // returns stat
+int ToErrmsg(const Descriptor *errmsg, int stat); // returns stat
-int ReturnError(
+int ReturnError(Terminator &, int stat, const Descriptor *errmsg = nullptr,
-    Terminator &, int stat, Descriptor *errmsg = nullptr, bool hasStat = false);
+    bool hasStat = false);
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_STAT_H