flang/runtime/stat.cpp

   1 //===-- runtime/stat.cpp --------------------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "stat.h"
  10 #include "terminator.h"
  11 #include "tools.h"
  12 #include "flang/Runtime/descriptor.h"
  13
  14 namespace Fortran::runtime {
  15 RT_OFFLOAD_API_GROUP_BEGIN
  16
  17 RT_API_ATTRS const char *StatErrorString(int stat) {
  18   switch (stat) {
  19   case StatOk:
  20     return "No error";
  21
  22   case StatBaseNull:
  23     return "Base address is null";
  24   case StatBaseNotNull:
  25     return "Base address is not null";
  26   case StatInvalidElemLen:
  27     return "Invalid element length";
  28   case StatInvalidRank:
  29     return "Invalid rank";
  30   case StatInvalidType:
  31     return "Invalid type";
  32   case StatInvalidAttribute:
  33     return "Invalid attribute";
  34   case StatInvalidExtent:
  35     return "Invalid extent";
  36   case StatInvalidDescriptor:
  37     return "Invalid descriptor";
  38   case StatMemAllocation:
  39     return "Memory allocation failed";
  40   case StatOutOfBounds:
  41     return "Out of bounds";
  42
  43   case StatFailedImage:
  44     return "Failed image";
  45   case StatLocked:
  46     return "Locked";
  47   case StatLockedOtherImage:
  48     return "Other image locked";
  49   case StatStoppedImage:
  50     return "Image stopped";
  51   case StatUnlocked:
  52     return "Unlocked";
  53   case StatUnlockedFailedImage:
  54     return "Failed image unlocked";
  55
  56   case StatInvalidArgumentNumber:
  57     return "Invalid argument number";
  58   case StatMissingArgument:
  59     return "Missing argument";
  60   case StatValueTooShort:
  61     return "Value too short";
  62
  63   case StatMissingEnvVariable:
  64     return "Missing environment variable";
  65
  66   case StatMoveAllocSameAllocatable:
  67     return "MOVE_ALLOC passed the same address as to and from";
  68
  69   case StatBadPointerDeallocation:
  70     return "DEALLOCATE of a pointer that is not the whole content of a pointer "
  71            "ALLOCATE";
  72
  73   default:
  74     return nullptr;
  75   }
  76 }
  77
  78 RT_API_ATTRS int ToErrmsg(const Descriptor *errmsg, int stat) {
  79   if (stat != StatOk && errmsg && errmsg->raw().base_addr &&
  80       errmsg->type() == TypeCode(TypeCategory::Character, 1) &&
  81       errmsg->rank() == 0) {
  82     if (const char *msg{StatErrorString(stat)}) {
  83       char *buffer{errmsg->OffsetElement()};
  84       std::size_t bufferLength{errmsg->ElementBytes()};
  85       std::size_t msgLength{Fortran::runtime::strlen(msg)};
  86       if (msgLength >= bufferLength) {
  87         std::memcpy(buffer, msg, bufferLength);
  88       } else {
  89         std::memcpy(buffer, msg, msgLength);
  90         std::memset(buffer + msgLength, ' ', bufferLength - msgLength);
  91       }
  92     }
  93   }
  94   return stat;
  95 }
  96
  97 RT_API_ATTRS int ReturnError(
  98     Terminator &terminator, int stat, const Descriptor *errmsg, bool hasStat) {
  99   if (stat == StatOk || hasStat) {
 100     return ToErrmsg(errmsg, stat);
 101   } else if (const char *msg{StatErrorString(stat)}) {
 102     terminator.Crash(msg);
 103   } else {
 104     terminator.Crash("Invalid Fortran runtime STAT= code %d", stat);
 105   }
 106   return stat;
 107 }
 108
 109 RT_OFFLOAD_API_GROUP_END
 110 } // namespace Fortran::runtime