[flang] Implement GET_ENVIRONMENT_VARIABLE(LENGTH)

[rovka]

Summary

Search for the environment variable in the envp string passed to
ProgramStart. This will only work if ProgramStart was actually called,
i.e. if the main program is Fortran.

[klausler]

flang/runtime/command.cpp

86

This will fail badly when the entire name is blank.

flang/runtime/environment.cpp

74

This won't work at all if ProgramStart is never called, and it won't be called when the main program is not Fortran. You need to test envp for validity and deal with the case of it being null.

[rovka]

Fixed. I'm working on a follow-up patch to call std::getenv if we don't find anything in envp. Does that sound good?

[klausler]

Please implement a getenv path for the case without envp, or put a big TODO comment about it in the place where it needs to go. It might be easiest to simply implement it.

flang/runtime/command.cpp

 //===-- runtime/command.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 "flang/Runtime/command.h"
 #include "environment.h"
 #include "stat.h"
 #include "flang/Runtime/descriptor.h"
+#include <cstdlib>
 #include <limits>
 
 namespace Fortran::runtime {
 std::int32_t RTNAME(ArgumentCount)() {
   int argc{executionEnvironment.argc};
   if (argc > 1) {
     // C counts the command name as one of the arguments, but Fortran doesn't.
     return argc - 1;
if (IsValidCharDescriptor(value)) {
 
     if (argLen > toCopy) {
       return ToErrmsg(errmsg, StatValueTooShort);
     }
   }
 
   return StatOk;
 }
+
+static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
+  std::size_t s{d.ElementBytes() - 1};
+  while (*d.OffsetElement(s) == ' ') {
+    --s;
+  }
+  return s + 1;
+}
+
+std::int64_t RTNAME(EnvVariableLength)(const Descriptor &name, bool trim_name) {
+  std::size_t nameLength{
+      trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()};
+  if (nameLength == 0) {
+    return 0;
+  }
+
+  const char *value{
+      executionEnvironment.GetEnv(name.OffsetElement(), nameLength)};
+  if (!value) {
+    return 0;
+  }
+  return std::strlen(value);
+}
 } // namespace Fortran::runtime

flang/runtime/environment.h

 
 // External unformatted I/O data conversions
 enum class Convert { Unknown, Native, LittleEndian, BigEndian, Swap };
 
 std::optional<Convert> GetConvertFromString(const char *, std::size_t);
 
 struct ExecutionEnvironment {
   void Configure(int argc, const char *argv[], const char *envp[]);
+  const char *GetEnv(const char *name, std::size_t name_length);
 
   int argc;
   const char **argv;
   const char **envp;
   int listDirectedOutputLineLengthLimit;
   enum decimal::FortranRounding defaultOutputRoundingMode;
   Convert conversion;
 };
 extern ExecutionEnvironment executionEnvironment;
 } // namespace Fortran::runtime
 
 #endif // FORTRAN_RUNTIME_ENVIRONMENT_H_

flang/runtime/environment.cpp

if (auto *x{std::getenv("FORT_CONVERT")}) {
     } else {
       std::fprintf(
           stderr, "Fortran runtime: FORT_CONVERT=%s is invalid; ignored\n", x);
     }
   }
 
   // TODO: Set RP/ROUND='PROCESSOR_DEFINED' from environment
 }
+
+const char *ExecutionEnvironment::GetEnv(
+    const char *name, std::size_t name_length) {
+  if (!envp) {
+    // TODO: Ask std::getenv.
+    return nullptr;
+  }
+
+  // envp is an array of strings of the form "name=value".
+  for (const char **var{envp}; *var != nullptr; ++var) {
+    const char *eq{std::strchr(*var, '=')};
+    if (!eq) {
+      // Found a malformed environment string, just ignore it.
+      continue;
+    }
+    if (static_cast<std::size_t>(eq - *var) != name_length) {
+      continue;
+    }
+    if (std::memcmp(*var, name, name_length) == 0) {
+      return eq + 1;
+    }
+  }
+  return nullptr;
+}
 } // namespace Fortran::runtime

flang/unittests/Runtime/CommandTest.cpp

static OwningPtr<Descriptor> CreateEmptyCharDescriptor() {
   OwningPtr<Descriptor> descriptor{Descriptor::Create(
       sizeof(char), n, nullptr, 0, nullptr, CFI_attribute_allocatable)};
   if (descriptor->Allocate() != 0) {
     return nullptr;
   }
   return descriptor;
 }
 
+static OwningPtr<Descriptor> CharDescriptor(const char *value) {
+  std::size_t n{std::strlen(value)};
+  OwningPtr<Descriptor> descriptor{Descriptor::Create(
+      sizeof(char), n, nullptr, 0, nullptr, CFI_attribute_allocatable)};
+  if (descriptor->Allocate() != 0) {
+    return nullptr;
+  }
+  std::memcpy(descriptor->OffsetElement(), value, n);
+  return descriptor;
+}
+
 class CommandFixture : public ::testing::Test {
 protected:
   CommandFixture(int argc, const char *argv[]) {
     RTNAME(ProgramStart)(argc, argv, {});
   }
 
+  CommandFixture(const char *envp[]) { RTNAME(ProgramStart)(0, nullptr, envp); }
+
   std::string GetPaddedStr(const char *text, std::size_t len) const {
     std::string res{text};
     assert(res.length() <= len && "No room to pad");
     res.append(len - res.length(), ' ');
     return res;
   }
 
   void CheckDescriptorEqStr(
TEST_F(SeveralArguments, ValueTooShort) {
   CheckDescriptorEqStr(errMsg.get(), expectedErrMsg);
 }
 
 TEST_F(SeveralArguments, ErrMsgTooShort) {
   OwningPtr<Descriptor> errMsg{CreateEmptyCharDescriptor<3>()};
   EXPECT_GT(RTNAME(ArgumentValue)(-1, nullptr, errMsg.get()), 0);
   CheckDescriptorEqStr(errMsg.get(), "Inv");
 }
+
+static const char *env[]{"NAME=value", nullptr};
+class EnvironmentVariables : public CommandFixture {
+protected:
+  EnvironmentVariables() : CommandFixture(env) {}
+};
+
+TEST_F(EnvironmentVariables, Length) {
+  EXPECT_EQ(5, RTNAME(EnvVariableLength)(*CharDescriptor("NAME")));
+  EXPECT_EQ(0, RTNAME(EnvVariableLength)(*CharDescriptor("DOESNT_EXIST")));
+
+  EXPECT_EQ(5, RTNAME(EnvVariableLength)(*CharDescriptor("NAME  ")));
+  EXPECT_EQ(0,
+      RTNAME(EnvVariableLength)(*CharDescriptor("NAME "), /*trim_name=*/false));
+
+  EXPECT_EQ(0, RTNAME(EnvVariableLength)(*CharDescriptor("     ")));
+}