[flang] Implement GET_ENVIRONMENT_VARIABLE(VALUE)

Implement the second entry point for GET_ENVIRONMENT_VARIABLE. Reuse
existing bits and pieces wherever possible.

This patch also increases CFI_* error codes in order to avoid conflicts.
GET_ENVIRONMENT_VARIABLE is required to return a status of 1 if an
environment variable does not exist and 2 if environment variables are
not supported. However, if we add status codes for that they will
conflict with CFI_ERROR_BASE_ADDR_NULL and CFI_ERROR_BASE_ADDR_NOT_NULL,
which are also 1 and 2 at the moment. We therefore move all CFI error
codes up (an arbitrary) 10 spots to make room. Hopefully this isn't
a problem, since we weren't matching the CFI error codes that gfortran
uses anyway. It may still be an issue if any other runtime functions
will need to return a status of 1 or 2, but we should probably deal with
that when/if it occurs.

Differential Revision: https://reviews.llvm.org/D112698

flang/include/flang/ISO_Fortran_binding.h

@@ -84,18 +84,20 @@ typedef signed char CFI_type_t;
 #define CFI_TYPE_LAST CFI_type_char32_t
 #define CFI_type_other (-1) // must be negative
 
-/* Error code macros */
+/* Error code macros - skip some of the small values to avoid conflicts with
+ * other status codes mandated by the standard, e.g. those returned by
+ * GET_ENVIRONMENT_VARIABLE (16.9.84) */
 #define CFI_SUCCESS 0 /* must be zero */
-#define CFI_ERROR_BASE_ADDR_NULL 1
-#define CFI_ERROR_BASE_ADDR_NOT_NULL 2
-#define CFI_INVALID_ELEM_LEN 3
-#define CFI_INVALID_RANK 4
-#define CFI_INVALID_TYPE 5
-#define CFI_INVALID_ATTRIBUTE 6
-#define CFI_INVALID_EXTENT 7
-#define CFI_INVALID_DESCRIPTOR 8
-#define CFI_ERROR_MEM_ALLOCATION 9
-#define CFI_ERROR_OUT_OF_BOUNDS 10
+#define CFI_ERROR_BASE_ADDR_NULL 11
+#define CFI_ERROR_BASE_ADDR_NOT_NULL 12
+#define CFI_INVALID_ELEM_LEN 13
+#define CFI_INVALID_RANK 14
+#define CFI_INVALID_TYPE 15
+#define CFI_INVALID_ATTRIBUTE 16
+#define CFI_INVALID_EXTENT 17
+#define CFI_INVALID_DESCRIPTOR 18
+#define CFI_ERROR_MEM_ALLOCATION 19
+#define CFI_ERROR_OUT_OF_BOUNDS 20
 
 /* 18.5.2 per-dimension information */
 typedef struct CFI_dim_t {

flang/include/flang/Runtime/command.h

@@ -44,7 +44,8 @@ std::int64_t RTNAME(ArgumentLength)(std::int32_t n);
 // Returns a STATUS as described in the standard.
 std::int32_t RTNAME(EnvVariableValue)(const Descriptor &name,
     const Descriptor *value = nullptr, bool trim_name = true,
-    const Descriptor *errmsg = nullptr);
+    const Descriptor *errmsg = nullptr, const char *sourceFile = nullptr,
+    int line = 0);
 
 // Try to get the significant length of the environment variable specified by
 // NAME. Returns 0 if it doesn't manage.

flang/include/flang/Runtime/magic-numbers.h

@@ -46,4 +46,10 @@ to be -1, the others must be positive.
 #define FORTRAN_RUNTIME_STAT_INVALID_ARG_NUMBER 107
 #define FORTRAN_RUNTIME_STAT_MISSING_ARG 108
 #define FORTRAN_RUNTIME_STAT_VALUE_TOO_SHORT -1
+
+#if 0
+Status codes for GET_ENVIRONMENT_VARIABLE. Values mandated by the standard.
+#endif
+#define FORTRAN_RUNTIME_STAT_MISSING_ENV_VAR 1
+#define FORTRAN_RUNTIME_STAT_ENV_VARS_UNSUPPORTED 2
 #endif

flang/runtime/command.cpp

@@ -24,9 +24,9 @@ std::int32_t RTNAME(ArgumentCount)() {
   return 0;
 }
 
-// Returns the length of the \p n'th argument. Assumes \p n is valid.
-static std::int64_t ArgumentLength(std::int32_t n) {
-  std::size_t length{std::strlen(executionEnvironment.argv[n])};
+// Returns the length of the \p string. Assumes \p string is valid.
+static std::int64_t StringLength(const char *string) {
+  std::size_t length{std::strlen(string)};
   if constexpr (sizeof(std::size_t) <= sizeof(std::int64_t)) {
     return static_cast<std::int64_t>(length);
   } else {
@@ -37,11 +37,12 @@ static std::int64_t ArgumentLength(std::int32_t n) {
 }
 
 std::int64_t RTNAME(ArgumentLength)(std::int32_t n) {
-  if (n < 0 || n >= executionEnvironment.argc) {
+  if (n < 0 || n >= executionEnvironment.argc ||
+      !executionEnvironment.argv[n]) {
     return 0;
   }
 
-  return ArgumentLength(n);
+  return StringLength(executionEnvironment.argv[n]);
 }
 
 static bool IsValidCharDescriptor(const Descriptor *value) {
@@ -54,6 +55,20 @@ static void FillWithSpaces(const Descriptor *value) {
   std::memset(value->OffsetElement(), ' ', value->ElementBytes());
 }
 
+static std::int32_t CopyToDescriptor(const Descriptor &value,
+    const char *rawValue, std::int64_t rawValueLength,
+    const Descriptor *errmsg) {
+  std::int64_t toCopy{std::min(
+      rawValueLength, static_cast<std::int64_t>(value.ElementBytes()))};
+  std::memcpy(value.OffsetElement(), rawValue, toCopy);
+
+  if (rawValueLength > toCopy) {
+    return ToErrmsg(errmsg, StatValueTooShort);
+  }
+
+  return StatOk;
+}
+
 std::int32_t RTNAME(ArgumentValue)(
     std::int32_t n, const Descriptor *value, const Descriptor *errmsg) {
   if (IsValidCharDescriptor(value)) {
@@ -65,18 +80,13 @@ std::int32_t RTNAME(ArgumentValue)(
   }
 
   if (IsValidCharDescriptor(value)) {
-    std::int64_t argLen{ArgumentLength(n)};
+    const char *arg{executionEnvironment.argv[n]};
+    std::int64_t argLen{StringLength(arg)};
     if (argLen <= 0) {
       return ToErrmsg(errmsg, StatMissingArgument);
     }
 
-    std::int64_t toCopy{
-        std::min(argLen, static_cast<std::int64_t>(value->ElementBytes()))};
-    std::memcpy(value->OffsetElement(), executionEnvironment.argv[n], toCopy);
-
-    if (argLen > toCopy) {
-      return ToErrmsg(errmsg, StatValueTooShort);
-    }
+    return CopyToDescriptor(*value, arg, argLen, errmsg);
   }
 
   return StatOk;
@@ -90,20 +100,45 @@ static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
   return s + 1;
 }
 
-std::int64_t RTNAME(EnvVariableLength)(
+static const char *GetEnvVariableValue(
     const Descriptor &name, bool trim_name, const char *sourceFile, int line) {
   std::size_t nameLength{
       trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()};
   if (nameLength == 0) {
-    return 0;
+    return nullptr;
   }
 
   Terminator terminator{sourceFile, line};
   const char *value{executionEnvironment.GetEnv(
       name.OffsetElement(), nameLength, terminator)};
+  return value;
+}
+
+std::int32_t RTNAME(EnvVariableValue)(const Descriptor &name,
+    const Descriptor *value, bool trim_name, const Descriptor *errmsg,
+    const char *sourceFile, int line) {
+  if (IsValidCharDescriptor(value)) {
+    FillWithSpaces(value);
+  }
+
+  const char *rawValue{GetEnvVariableValue(name, trim_name, sourceFile, line)};
+  if (!rawValue) {
+    return ToErrmsg(errmsg, StatMissingEnvVariable);
+  }
+
+  if (IsValidCharDescriptor(value)) {
+    return CopyToDescriptor(*value, rawValue, StringLength(rawValue), errmsg);
+  }
+
+  return StatOk;
+}
+
+std::int64_t RTNAME(EnvVariableLength)(
+    const Descriptor &name, bool trim_name, const char *sourceFile, int line) {
+  const char *value{GetEnvVariableValue(name, trim_name, sourceFile, line)};
   if (!value) {
     return 0;
   }
-  return std::strlen(value);
+  return StringLength(value);
 }
 } // namespace Fortran::runtime

flang/runtime/stat.cpp

@@ -57,6 +57,9 @@ const char *StatErrorString(int stat) {
   case StatValueTooShort:
     return "Value too short";
 
+  case StatMissingEnvVariable:
+    return "Missing environment variable";
+
   default:
     return nullptr;
   }

flang/runtime/stat.h

@@ -39,6 +39,7 @@ enum Stat {
   StatFailedImage = FORTRAN_RUNTIME_STAT_FAILED_IMAGE,
   StatLocked = FORTRAN_RUNTIME_STAT_LOCKED,
   StatLockedOtherImage = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE,
+  StatMissingEnvVariable = FORTRAN_RUNTIME_STAT_MISSING_ENV_VAR,
   StatStoppedImage = FORTRAN_RUNTIME_STAT_STOPPED_IMAGE,
   StatUnlocked = FORTRAN_RUNTIME_STAT_UNLOCKED,
   StatUnlockedFailedImage = FORTRAN_RUNTIME_STAT_UNLOCKED_FAILED_IMAGE,

flang/unittests/Runtime/CommandTest.cpp

@@ -53,17 +53,66 @@ class CommandFixture : public ::testing::Test {
       const Descriptor *value, const std::string &expected) const {
     EXPECT_EQ(std::strncmp(value->OffsetElement(), expected.c_str(),
                   value->ElementBytes()),
-        0);
+        0)
+        << "expected: " << expected << "\n"
+        << "value: "
+        << std::string{value->OffsetElement(), value->ElementBytes()};
   }
 
-  void CheckArgumentValue(int n, const char *argv) const {
+  template <typename RuntimeCall>
+  void CheckValue(RuntimeCall F, const char *expectedValue,
+      std::int32_t expectedStatus = 0,
+      const char *expectedErrMsg = "shouldn't change") const {
     OwningPtr<Descriptor> value{CreateEmptyCharDescriptor()};
     ASSERT_NE(value, nullptr);
 
-    std::string expected{GetPaddedStr(argv, value->ElementBytes())};
+    OwningPtr<Descriptor> errmsg{CharDescriptor(expectedErrMsg)};
 
-    EXPECT_EQ(RTNAME(ArgumentValue)(n, value.get(), nullptr), 0);
-    CheckDescriptorEqStr(value.get(), expected);
+    std::string expectedValueStr{
+        GetPaddedStr(expectedValue, value->ElementBytes())};
+
+    EXPECT_EQ(F(value.get(), errmsg.get()), expectedStatus);
+    CheckDescriptorEqStr(value.get(), expectedValueStr);
+    CheckDescriptorEqStr(errmsg.get(), expectedErrMsg);
+  }
+
+  void CheckArgumentValue(const char *expectedValue, int n) const {
+    SCOPED_TRACE(n);
+    SCOPED_TRACE("Checking argument:");
+    CheckValue(
+        [&](const Descriptor *value, const Descriptor *errmsg) {
+          return RTNAME(ArgumentValue)(n, value, errmsg);
+        },
+        expectedValue);
+  }
+
+  void CheckEnvVarValue(
+      const char *expectedValue, const char *name, bool trimName = true) const {
+    SCOPED_TRACE(name);
+    SCOPED_TRACE("Checking environment variable");
+    CheckValue(
+        [&](const Descriptor *value, const Descriptor *errmsg) {
+          return RTNAME(EnvVariableValue)(*CharDescriptor(name), value,
+              trimName, errmsg, /*sourceFile=*/nullptr, /*line=*/0);
+        },
+        expectedValue);
+  }
+
+  void CheckMissingEnvVarValue(const char *name, bool trimName = true) const {
+    SCOPED_TRACE(name);
+    SCOPED_TRACE("Checking missing environment variable");
+
+    ASSERT_EQ(nullptr, std::getenv(name))
+        << "Environment variable " << name << " not expected to exist";
+
+    OwningPtr<Descriptor> nameDescriptor{CharDescriptor(name)};
+    EXPECT_EQ(0, RTNAME(EnvVariableLength)(*nameDescriptor, trimName));
+    CheckValue(
+        [&](const Descriptor *value, const Descriptor *errmsg) {
+          return RTNAME(EnvVariableValue)(*nameDescriptor, value, trimName,
+              errmsg, /*sourceFile=*/nullptr, /*line=*/0);
+        },
+        "", 1, "Missing environment variable");
   }
 
   void CheckMissingArgumentValue(int n, const char *errStr = nullptr) const {
@@ -99,7 +148,7 @@ TEST_F(ZeroArguments, ArgumentLength) {
 }
 
 TEST_F(ZeroArguments, ArgumentValue) {
-  CheckArgumentValue(0, commandOnlyArgv[0]);
+  CheckArgumentValue(commandOnlyArgv[0], 0);
 }
 
 static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"};
@@ -118,8 +167,8 @@ TEST_F(OneArgument, ArgumentLength) {
 }
 
 TEST_F(OneArgument, ArgumentValue) {
-  CheckArgumentValue(0, oneArgArgv[0]);
-  CheckArgumentValue(1, oneArgArgv[1]);
+  CheckArgumentValue(oneArgArgv[0], 0);
+  CheckArgumentValue(oneArgArgv[1], 1);
 }
 
 static const char *severalArgsArgv[]{
@@ -146,10 +195,10 @@ TEST_F(SeveralArguments, ArgumentLength) {
 }
 
 TEST_F(SeveralArguments, ArgumentValue) {
-  CheckArgumentValue(0, severalArgsArgv[0]);
-  CheckArgumentValue(1, severalArgsArgv[1]);
-  CheckArgumentValue(3, severalArgsArgv[3]);
-  CheckArgumentValue(4, severalArgsArgv[4]);
+  CheckArgumentValue(severalArgsArgv[0], 0);
+  CheckArgumentValue(severalArgsArgv[1], 1);
+  CheckArgumentValue(severalArgsArgv[3], 3);
+  CheckArgumentValue(severalArgsArgv[4], 4);
 }
 
 TEST_F(SeveralArguments, NoArgumentValue) {
@@ -192,6 +241,7 @@ class EnvironmentVariables : public CommandFixture {
 protected:
   EnvironmentVariables() : CommandFixture(0, nullptr) {
     SetEnv("NAME", "VALUE");
+    SetEnv("EMPTY", "");
   }
 
   // If we have access to setenv, we can run some more fine-grained tests.
@@ -211,23 +261,79 @@ class EnvironmentVariables : public CommandFixture {
   bool canSetEnv{false};
 };
 
-TEST_F(EnvironmentVariables, Length) {
-  EXPECT_EQ(0, RTNAME(EnvVariableLength)(*CharDescriptor("DOESNT_EXIST")));
+TEST_F(EnvironmentVariables, Nonexistent) {
+  CheckMissingEnvVarValue("DOESNT_EXIST");
 
-  EXPECT_EQ(0, RTNAME(EnvVariableLength)(*CharDescriptor("     ")));
-  EXPECT_EQ(0, RTNAME(EnvVariableLength)(*CharDescriptor("")));
+  CheckMissingEnvVarValue("      ");
+  CheckMissingEnvVarValue("");
+}
 
+TEST_F(EnvironmentVariables, Basic) {
   // Test a variable that's expected to exist in the environment.
   char *path{std::getenv("PATH")};
   auto expectedLen{static_cast<int64_t>(std::strlen(path))};
   EXPECT_EQ(expectedLen, RTNAME(EnvVariableLength)(*CharDescriptor("PATH")));
+}
 
+TEST_F(EnvironmentVariables, Trim) {
   if (EnableFineGrainedTests()) {
-    EXPECT_EQ(5, RTNAME(EnvVariableLength)(*CharDescriptor("NAME")));
+    EXPECT_EQ(5, RTNAME(EnvVariableLength)(*CharDescriptor("NAME   ")));
+    CheckEnvVarValue("VALUE", "NAME   ");
+  }
+}
 
-    EXPECT_EQ(5, RTNAME(EnvVariableLength)(*CharDescriptor("NAME  ")));
-    EXPECT_EQ(0,
-        RTNAME(EnvVariableLength)(
-            *CharDescriptor("NAME "), /*trim_name=*/false));
+TEST_F(EnvironmentVariables, NoTrim) {
+  if (EnableFineGrainedTests()) {
+    CheckMissingEnvVarValue("NAME      ", /*trim_name=*/false);
   }
 }
+
+TEST_F(EnvironmentVariables, Empty) {
+  if (EnableFineGrainedTests()) {
+    EXPECT_EQ(0, RTNAME(EnvVariableLength)(*CharDescriptor("EMPTY")));
+    CheckEnvVarValue("", "EMPTY");
+  }
+}
+
+TEST_F(EnvironmentVariables, NoValueOrErrmsg) {
+  ASSERT_EQ(std::getenv("DOESNT_EXIST"), nullptr)
+      << "Environment variable DOESNT_EXIST actually exists";
+  EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("DOESNT_EXIST")), 1);
+
+  if (EnableFineGrainedTests()) {
+    EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("NAME")), 0);
+  }
+}
+
+TEST_F(EnvironmentVariables, ValueTooShort) {
+  if (EnableFineGrainedTests()) {
+    OwningPtr<Descriptor> tooShort{CreateEmptyCharDescriptor<2>()};
+    ASSERT_NE(tooShort, nullptr);
+    EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("NAME"), tooShort.get(),
+                  /*trim_name=*/true, nullptr),
+        -1);
+    CheckDescriptorEqStr(tooShort.get(), "VALUE");
+
+    OwningPtr<Descriptor> errMsg{CreateEmptyCharDescriptor()};
+    ASSERT_NE(errMsg, nullptr);
+
+    EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("NAME"), tooShort.get(),
+                  /*trim_name=*/true, errMsg.get()),
+        -1);
+
+    std::string expectedErrMsg{
+        GetPaddedStr("Value too short", errMsg->ElementBytes())};
+    CheckDescriptorEqStr(errMsg.get(), expectedErrMsg);
+  }
+}
+
+TEST_F(EnvironmentVariables, ErrMsgTooShort) {
+  ASSERT_EQ(std::getenv("DOESNT_EXIST"), nullptr)
+      << "Environment variable DOESNT_EXIST actually exists";
+
+  OwningPtr<Descriptor> errMsg{CreateEmptyCharDescriptor<3>()};
+  EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("DOESNT_EXIST"), nullptr,
+                /*trim_name=*/true, errMsg.get()),
+      1);
+  CheckDescriptorEqStr(errMsg.get(), "Mis");
+}