111 lines · cpp
1//===-- lib/runtime/stat.cpp ------------------------------------*- C++ -*-===//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-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang-rt/runtime/stat.h"10#include "flang-rt/runtime/descriptor.h"11#include "flang-rt/runtime/terminator.h"12#include "flang-rt/runtime/tools.h"13 14namespace Fortran::runtime {15RT_OFFLOAD_API_GROUP_BEGIN16 17RT_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 78RT_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 runtime::memcpy(buffer, msg, bufferLength);88 } else {89 runtime::memcpy(buffer, msg, msgLength);90 runtime::memset(buffer + msgLength, ' ', bufferLength - msgLength);91 }92 }93 }94 return stat;95}96 97RT_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 109RT_OFFLOAD_API_GROUP_END110} // namespace Fortran::runtime111