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 {
StatErrorString(int stat)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 default:
64 return nullptr;
65 }
66 }
67
ToErrmsg(const Descriptor * errmsg,int stat)68 int ToErrmsg(const Descriptor *errmsg, int stat) {
69 if (stat != StatOk && errmsg && errmsg->raw().base_addr &&
70 errmsg->type() == TypeCode(TypeCategory::Character, 1) &&
71 errmsg->rank() == 0) {
72 if (const char *msg{StatErrorString(stat)}) {
73 char *buffer{errmsg->OffsetElement()};
74 std::size_t bufferLength{errmsg->ElementBytes()};
75 std::size_t msgLength{std::strlen(msg)};
76 if (msgLength >= bufferLength) {
77 std::memcpy(buffer, msg, bufferLength);
78 } else {
79 std::memcpy(buffer, msg, msgLength);
80 std::memset(buffer + msgLength, ' ', bufferLength - msgLength);
81 }
82 }
83 }
84 return stat;
85 }
86
ReturnError(Terminator & terminator,int stat,const Descriptor * errmsg,bool hasStat)87 int ReturnError(
88 Terminator &terminator, int stat, const Descriptor *errmsg, bool hasStat) {
89 if (stat == StatOk || hasStat) {
90 return ToErrmsg(errmsg, stat);
91 } else if (const char *msg{StatErrorString(stat)}) {
92 terminator.Crash(msg);
93 } else {
94 terminator.Crash("Invalid Fortran runtime STAT= code %d", stat);
95 }
96 return stat;
97 }
98 } // namespace Fortran::runtime
99