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 "flang/Runtime/descriptor.h"
  12
  13 namespace Fortran::runtime {
  14 const char *StatErrorString(int stat) {
  15   switch (stat) {
  16   case StatOk:
  17     return "No error";
  18
  19   case StatBaseNull:
  20     return "Base address is null";
  21   case StatBaseNotNull:
  22     return "Base address is not null";
  23   case StatInvalidElemLen:
  24     return "Invalid element length";
  25   case StatInvalidRank:
  26     return "Invalid rank";
  27   case StatInvalidType:
  28     return "Invalid type";
  29   case StatInvalidAttribute:
  30     return "Invalid attribute";
  31   case StatInvalidExtent:
  32     return "Invalid extent";
  33   case StatInvalidDescriptor:
  34     return "Invalid descriptor";
  35   case StatMemAllocation:
  36     return "Memory allocation failed";
  37   case StatOutOfBounds:
  38     return "Out of bounds";
  39
  40   case StatFailedImage:
  41     return "Failed image";
  42   case StatLocked:
  43     return "Locked";
  44   case StatLockedOtherImage:
  45     return "Other image locked";
  46   case StatStoppedImage:
  47     return "Image stopped";
  48   case StatUnlocked:
  49     return "Unlocked";
  50   case StatUnlockedFailedImage:
  51     return "Failed image unlocked";
  52
  53   case StatInvalidArgumentNumber:
  54     return "Invalid argument number";
  55   case StatMissingArgument:
  56     return "Missing argument";
  57   case StatValueTooShort:
  58     return "Value too short";
  59
  60   case StatMissingEnvVariable:
  61     return "Missing environment variable";
  62
  63   case StatMoveAllocSameAllocatable:
  64     return "MOVE_ALLOC passed the same address as to and from";
  65
  66   default:
  67     return nullptr;
  68   }
  69 }
  70
  71 int ToErrmsg(const Descriptor *errmsg, int stat) {
  72   if (stat != StatOk && errmsg && errmsg->raw().base_addr &&
  73       errmsg->type() == TypeCode(TypeCategory::Character, 1) &&
  74       errmsg->rank() == 0) {
  75     if (const char *msg{StatErrorString(stat)}) {
  76       char *buffer{errmsg->OffsetElement()};
  77       std::size_t bufferLength{errmsg->ElementBytes()};
  78       std::size_t msgLength{std::strlen(msg)};
  79       if (msgLength >= bufferLength) {
  80         std::memcpy(buffer, msg, bufferLength);
  81       } else {
  82         std::memcpy(buffer, msg, msgLength);
  83         std::memset(buffer + msgLength, ' ', bufferLength - msgLength);
  84       }
  85     }
  86   }
  87   return stat;
  88 }
  89
  90 int ReturnError(
  91     Terminator &terminator, int stat, const Descriptor *errmsg, bool hasStat) {
  92   if (stat == StatOk || hasStat) {
  93     return ToErrmsg(errmsg, stat);
  94   } else if (const char *msg{StatErrorString(stat)}) {
  95     terminator.Crash(msg);
  96   } else {
  97     terminator.Crash("Invalid Fortran runtime STAT= code %d", stat);
  98   }
  99   return stat;
 100 }
 101 } // namespace Fortran::runtime