824bf90819
Add support for reading environment variables directly, via std::getenv. This needs to allocate a C-style string to pass into std::getenv. If the memory allocation for that fails, we terminate. This also changes the interface for EnvVariableLength to receive the source file and line so we can crash gracefully. Note that we are now completely ignoring the envp pointer passed into ProgramStart, since that could go stale if the environment is modified during execution. Differential Revision: https://reviews.llvm.org/D111785
113 lines
3.2 KiB
C++
113 lines
3.2 KiB
C++
//===-- runtime/tools.cpp -------------------------------------------------===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "tools.h"
|
|
#include "terminator.h"
|
|
#include <algorithm>
|
|
#include <cstdint>
|
|
#include <cstdlib>
|
|
#include <cstring>
|
|
|
|
namespace Fortran::runtime {
|
|
|
|
std::size_t TrimTrailingSpaces(const char *s, std::size_t n) {
|
|
while (n > 0 && s[n - 1] == ' ') {
|
|
--n;
|
|
}
|
|
return n;
|
|
}
|
|
|
|
OwningPtr<char> SaveDefaultCharacter(
|
|
const char *s, std::size_t length, const Terminator &terminator) {
|
|
if (s) {
|
|
auto *p{static_cast<char *>(AllocateMemoryOrCrash(terminator, length + 1))};
|
|
std::memcpy(p, s, length);
|
|
p[length] = '\0';
|
|
return OwningPtr<char>{p};
|
|
} else {
|
|
return OwningPtr<char>{};
|
|
}
|
|
}
|
|
|
|
static bool CaseInsensitiveMatch(
|
|
const char *value, std::size_t length, const char *possibility) {
|
|
for (; length-- > 0; ++possibility) {
|
|
char ch{*value++};
|
|
if (ch >= 'a' && ch <= 'z') {
|
|
ch += 'A' - 'a';
|
|
}
|
|
if (*possibility != ch) {
|
|
if (*possibility != '\0' || ch != ' ') {
|
|
return false;
|
|
}
|
|
// Ignore trailing blanks (12.5.6.2 p1)
|
|
while (length-- > 0) {
|
|
if (*value++ != ' ') {
|
|
return false;
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
}
|
|
return *possibility == '\0';
|
|
}
|
|
|
|
int IdentifyValue(
|
|
const char *value, std::size_t length, const char *possibilities[]) {
|
|
if (value) {
|
|
for (int j{0}; possibilities[j]; ++j) {
|
|
if (CaseInsensitiveMatch(value, length, possibilities[j])) {
|
|
return j;
|
|
}
|
|
}
|
|
}
|
|
return -1;
|
|
}
|
|
|
|
void ToFortranDefaultCharacter(
|
|
char *to, std::size_t toLength, const char *from) {
|
|
std::size_t len{std::strlen(from)};
|
|
if (len < toLength) {
|
|
std::memcpy(to, from, len);
|
|
std::memset(to + len, ' ', toLength - len);
|
|
} else {
|
|
std::memcpy(to, from, toLength);
|
|
}
|
|
}
|
|
|
|
void CheckConformability(const Descriptor &to, const Descriptor &x,
|
|
Terminator &terminator, const char *funcName, const char *toName,
|
|
const char *xName) {
|
|
if (x.rank() == 0) {
|
|
return; // scalar conforms with anything
|
|
}
|
|
int rank{to.rank()};
|
|
if (x.rank() != rank) {
|
|
terminator.Crash(
|
|
"Incompatible array arguments to %s: %s has rank %d but %s has rank %d",
|
|
funcName, toName, rank, xName, x.rank());
|
|
} else {
|
|
for (int j{0}; j < rank; ++j) {
|
|
auto toExtent{static_cast<std::int64_t>(to.GetDimension(j).Extent())};
|
|
auto xExtent{static_cast<std::int64_t>(x.GetDimension(j).Extent())};
|
|
if (xExtent != toExtent) {
|
|
terminator.Crash("Incompatible array arguments to %s: dimension %d of "
|
|
"%s has extent %" PRId64 " but %s has extent %" PRId64,
|
|
funcName, j, toName, toExtent, xName, xExtent);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
void CheckIntegerKind(Terminator &terminator, int kind, const char *intrinsic) {
|
|
if (kind < 1 || kind > 16 || (kind & (kind - 1)) != 0) {
|
|
terminator.Crash("%s: bad KIND=%d argument", intrinsic, kind);
|
|
}
|
|
}
|
|
} // namespace Fortran::runtime
|