[flang] Accept polymorphic component element in storage_size
[llvm-project.git] / flang / runtime / command.cpp
blob6c4f611daaa7cbd408cb219eafbfa8d166152f73
1 //===-- runtime/command.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 //===----------------------------------------------------------------------===//
9 #include "flang/Runtime/command.h"
10 #include "environment.h"
11 #include "stat.h"
12 #include "terminator.h"
13 #include "tools.h"
14 #include "flang/Runtime/descriptor.h"
15 #include <cstdlib>
16 #include <limits>
18 namespace Fortran::runtime {
19 std::int32_t RTNAME(ArgumentCount)() {
20 int argc{executionEnvironment.argc};
21 if (argc > 1) {
22 // C counts the command name as one of the arguments, but Fortran doesn't.
23 return argc - 1;
25 return 0;
28 // Returns the length of the \p string. Assumes \p string is valid.
29 static std::int64_t StringLength(const char *string) {
30 std::size_t length{std::strlen(string)};
31 if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
32 return static_cast<std::int64_t>(length);
33 } else {
34 std::size_t max{std::numeric_limits<std::int64_t>::max()};
35 return length > max ? 0 // Just fail.
36 : static_cast<std::int64_t>(length);
40 static bool IsValidCharDescriptor(const Descriptor *value) {
41 return value && value->IsAllocated() &&
42 value->type() == TypeCode(TypeCategory::Character, 1) &&
43 value->rank() == 0;
46 static bool IsValidIntDescriptor(const Descriptor *length) {
47 auto typeCode{length->type().GetCategoryAndKind()};
48 // Check that our descriptor is allocated and is a scalar integer with
49 // kind != 1 (i.e. with a large enough decimal exponent range).
50 return length->IsAllocated() && length->rank() == 0 &&
51 length->type().IsInteger() && typeCode && typeCode->second != 1;
54 static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
55 if (offset < value.ElementBytes()) {
56 std::memset(
57 value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
61 static std::int32_t CopyToDescriptor(const Descriptor &value,
62 const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
63 std::size_t offset = 0) {
65 std::int64_t toCopy{std::min(rawValueLength,
66 static_cast<std::int64_t>(value.ElementBytes() - offset))};
67 if (toCopy < 0) {
68 return ToErrmsg(errmsg, StatValueTooShort);
71 std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
73 if (rawValueLength > toCopy) {
74 return ToErrmsg(errmsg, StatValueTooShort);
77 return StatOk;
80 static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
81 const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
82 bool haveValue{IsValidCharDescriptor(value)};
84 std::int64_t len{StringLength(rawValue)};
85 if (len <= 0) {
86 if (haveValue) {
87 FillWithSpaces(*value);
89 return ToErrmsg(errmsg, StatMissingArgument);
92 std::int32_t stat{StatOk};
93 if (haveValue) {
94 stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
97 offset += len;
98 return stat;
101 static void StoreLengthToDescriptor(
102 const Descriptor *length, std::int64_t value, Terminator &terminator) {
103 auto typeCode{length->type().GetCategoryAndKind()};
104 int kind{typeCode->second};
105 Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, void>(
106 kind, terminator, *length, /* atIndex = */ 0, value);
109 template <int KIND> struct FitsInIntegerKind {
110 bool operator()(std::int64_t value) {
111 return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
112 Fortran::common::TypeCategory::Integer, KIND>>::max();
116 static bool FitsInDescriptor(
117 const Descriptor *length, std::int64_t value, Terminator &terminator) {
118 auto typeCode{length->type().GetCategoryAndKind()};
119 int kind{typeCode->second};
120 return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
121 kind, terminator, value);
124 std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
125 const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
126 int line) {
127 Terminator terminator{sourceFile, line};
129 if (value) {
130 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
131 FillWithSpaces(*value);
134 // Store 0 in case we error out later on.
135 if (length) {
136 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
137 StoreLengthToDescriptor(length, 0, terminator);
140 if (n < 0 || n >= executionEnvironment.argc) {
141 return ToErrmsg(errmsg, StatInvalidArgumentNumber);
144 const char *arg{executionEnvironment.argv[n]};
145 std::int64_t argLen{StringLength(arg)};
146 if (argLen <= 0) {
147 return ToErrmsg(errmsg, StatMissingArgument);
150 if (length && FitsInDescriptor(length, argLen, terminator)) {
151 StoreLengthToDescriptor(length, argLen, terminator);
154 if (value) {
155 return CopyToDescriptor(*value, arg, argLen, errmsg);
158 return StatOk;
161 std::int32_t RTNAME(GetCommand)(const Descriptor *value,
162 const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
163 int line) {
164 Terminator terminator{sourceFile, line};
166 if (value) {
167 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
170 // Store 0 in case we error out later on.
171 if (length) {
172 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
173 StoreLengthToDescriptor(length, 0, terminator);
176 auto shouldContinue = [&](std::int32_t stat) -> bool {
177 // We continue as long as everything is ok OR the value descriptor is
178 // too short, but we still need to compute the length.
179 return stat == StatOk || (length && stat == StatValueTooShort);
182 std::size_t offset{0};
184 if (executionEnvironment.argc == 0) {
185 return CheckAndCopyToDescriptor(value, "", errmsg, offset);
188 // value = argv[0]
189 std::int32_t stat{CheckAndCopyToDescriptor(
190 value, executionEnvironment.argv[0], errmsg, offset)};
191 if (!shouldContinue(stat)) {
192 return stat;
195 // value += " " + argv[1:n]
196 for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
197 stat = CheckAndCopyToDescriptor(value, " ", errmsg, offset);
198 if (!shouldContinue(stat)) {
199 return stat;
202 stat = CheckAndCopyToDescriptor(
203 value, executionEnvironment.argv[i], errmsg, offset);
204 if (!shouldContinue(stat)) {
205 return stat;
209 if (length && FitsInDescriptor(length, offset, terminator)) {
210 StoreLengthToDescriptor(length, offset, terminator);
213 // value += spaces for padding
214 if (value) {
215 FillWithSpaces(*value, offset);
218 return stat;
221 static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
222 std::size_t s{d.ElementBytes() - 1};
223 while (*d.OffsetElement(s) == ' ') {
224 --s;
226 return s + 1;
229 std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
230 const Descriptor *value, const Descriptor *length, bool trim_name,
231 const Descriptor *errmsg, const char *sourceFile, int line) {
232 Terminator terminator{sourceFile, line};
234 if (value) {
235 RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
236 FillWithSpaces(*value);
239 // Store 0 in case we error out later on.
240 if (length) {
241 RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
242 StoreLengthToDescriptor(length, 0, terminator);
245 const char *rawValue{nullptr};
246 std::size_t nameLength{
247 trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()};
248 if (nameLength != 0) {
249 rawValue = executionEnvironment.GetEnv(
250 name.OffsetElement(), nameLength, terminator);
252 if (!rawValue) {
253 return ToErrmsg(errmsg, StatMissingEnvVariable);
256 std::int64_t varLen{StringLength(rawValue)};
257 if (length && FitsInDescriptor(length, varLen, terminator)) {
258 StoreLengthToDescriptor(length, varLen, terminator);
261 if (value) {
262 return CopyToDescriptor(*value, rawValue, varLen, errmsg);
264 return StatOk;
267 } // namespace Fortran::runtime