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   default:
64     return nullptr;
65   }
66 }
67 
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 
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