[flang] Add runtime support for GET_COMMAND

Implement the GET_COMMAND intrinsic.
Add 2 new parameters (sourceFile and line) so we can create a terminator
for RUNTIME_CHECKs.

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

flang/include/flang/Runtime/command.h

@@ -28,7 +28,8 @@ std::int32_t RTNAME(ArgumentCount)();
 // optional.
 // Return a STATUS as described in the standard.
 std::int32_t RTNAME(GetCommand)(const Descriptor *command = nullptr,
-    const Descriptor *length = nullptr, const Descriptor *errmsg = nullptr);
+    const Descriptor *length = nullptr, const Descriptor *errmsg = nullptr,
+    const char *sourceFile = nullptr, int line = 0);
 
 // 16.9.83 GET_COMMAND_ARGUMENT
 // We're breaking up the interface into several different functions, since most

flang/runtime/command.cpp

@@ -10,6 +10,7 @@
 #include "environment.h"
 #include "stat.h"
 #include "terminator.h"
+#include "tools.h"
 #include "flang/Runtime/descriptor.h"
 #include <cstdlib>
 #include <limits>
@@ -51,16 +52,32 @@ static bool IsValidCharDescriptor(const Descriptor *value) {
       value->rank() == 0;
 }
 
-static void FillWithSpaces(const Descriptor *value) {
-  std::memset(value->OffsetElement(), ' ', value->ElementBytes());
+static bool IsValidIntDescriptor(const Descriptor *length) {
+  auto typeCode{length->type().GetCategoryAndKind()};
+  // Check that our descriptor is allocated and is a scalar integer with
+  // kind != 1 (i.e. with a large enough decimal exponent range).
+  return length->IsAllocated() && length->rank() == 0 &&
+      length->type().IsInteger() && typeCode && typeCode->second != 1;
+}
+
+static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
+  if (offset < value.ElementBytes()) {
+    std::memset(
+        value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
+  }
 }
 
 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);
+    const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
+    std::size_t offset = 0) {
+
+  std::int64_t toCopy{std::min(rawValueLength,
+      static_cast<std::int64_t>(value.ElementBytes() - offset))};
+  if (toCopy < 0) {
+    return ToErrmsg(errmsg, StatValueTooShort);
+  }
+
+  std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
 
   if (rawValueLength > toCopy) {
     return ToErrmsg(errmsg, StatValueTooShort);
@@ -69,10 +86,31 @@ static std::int32_t CopyToDescriptor(const Descriptor &value,
   return StatOk;
 }
 
+static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
+    const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
+  bool haveValue{IsValidCharDescriptor(value)};
+
+  std::int64_t len{StringLength(rawValue)};
+  if (len <= 0) {
+    if (haveValue) {
+      FillWithSpaces(*value);
+    }
+    return ToErrmsg(errmsg, StatMissingArgument);
+  }
+
+  std::int32_t stat{StatOk};
+  if (haveValue) {
+    stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
+  }
+
+  offset += len;
+  return stat;
+}
+
 std::int32_t RTNAME(ArgumentValue)(
     std::int32_t n, const Descriptor *value, const Descriptor *errmsg) {
   if (IsValidCharDescriptor(value)) {
-    FillWithSpaces(value);
+    FillWithSpaces(*value);
   }
 
   if (n < 0 || n >= executionEnvironment.argc) {
@@ -92,6 +130,87 @@ std::int32_t RTNAME(ArgumentValue)(
   return StatOk;
 }
 
+template <int KIND> struct FitsInIntegerKind {
+  bool operator()(std::int64_t value) {
+    return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
+                        Fortran::common::TypeCategory::Integer, KIND>>::max();
+  }
+};
+
+std::int32_t RTNAME(GetCommand)(const Descriptor *value,
+    const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
+    int line) {
+  Terminator terminator{sourceFile, line};
+
+  auto storeLength = [&](std::int64_t value) {
+    auto typeCode{length->type().GetCategoryAndKind()};
+    int kind{typeCode->second};
+    Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, void>(
+        kind, terminator, *length, /* atIndex = */ 0, value);
+  };
+
+  if (value) {
+    RUNTIME_CHECK(terminator, IsValidCharDescriptor(value));
+  }
+
+  // Store 0 in case we error out later on.
+  if (length) {
+    RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
+    storeLength(0);
+  }
+
+  auto shouldContinue = [&](std::int32_t stat) -> bool {
+    // We continue as long as everything is ok OR the value descriptor is
+    // too short, but we still need to compute the length.
+    return stat == StatOk || (length && stat == StatValueTooShort);
+  };
+
+  std::size_t offset{0};
+
+  if (executionEnvironment.argc == 0) {
+    return CheckAndCopyToDescriptor(value, "", errmsg, offset);
+  }
+
+  // value = argv[0]
+  std::int32_t stat{CheckAndCopyToDescriptor(
+      value, executionEnvironment.argv[0], errmsg, offset)};
+  if (!shouldContinue(stat)) {
+    return stat;
+  }
+
+  // value += " " + argv[1:n]
+  for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
+    stat = CheckAndCopyToDescriptor(value, " ", errmsg, offset);
+    if (!shouldContinue(stat)) {
+      return stat;
+    }
+
+    stat = CheckAndCopyToDescriptor(
+        value, executionEnvironment.argv[i], errmsg, offset);
+    if (!shouldContinue(stat)) {
+      return stat;
+    }
+  }
+
+  auto fitsInLength = [&](std::int64_t value) -> bool {
+    auto typeCode{length->type().GetCategoryAndKind()};
+    int kind{typeCode->second};
+    return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
+        kind, terminator, value);
+  };
+
+  if (length && fitsInLength(offset)) {
+    storeLength(offset);
+  }
+
+  // value += spaces for padding
+  if (value) {
+    FillWithSpaces(*value, offset);
+  }
+
+  return stat;
+}
+
 static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
   std::size_t s{d.ElementBytes() - 1};
   while (*d.OffsetElement(s) == ' ') {
@@ -118,7 +237,7 @@ 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);
+    FillWithSpaces(*value);
   }
 
   const char *rawValue{GetEnvVariableValue(name, trim_name, sourceFile, line)};

flang/unittests/Runtime/CommandTest.cpp

@@ -36,6 +36,16 @@ static OwningPtr<Descriptor> CharDescriptor(const char *value) {
   return descriptor;
 }
 
+template <int kind = sizeof(std::int64_t)>
+static OwningPtr<Descriptor> EmptyIntDescriptor() {
+  OwningPtr<Descriptor> descriptor{Descriptor::Create(TypeCategory::Integer,
+      kind, nullptr, 0, nullptr, CFI_attribute_allocatable)};
+  if (descriptor->Allocate() != 0) {
+    return nullptr;
+  }
+  return descriptor;
+}
+
 class CommandFixture : public ::testing::Test {
 protected:
   CommandFixture(int argc, const char *argv[]) {
@@ -51,6 +61,7 @@ protected:
 
   void CheckDescriptorEqStr(
       const Descriptor *value, const std::string &expected) const {
+    ASSERT_NE(value, nullptr);
     EXPECT_EQ(std::strncmp(value->OffsetElement(), expected.c_str(),
                   value->ElementBytes()),
         0)
@@ -59,20 +70,34 @@ protected:
         << std::string{value->OffsetElement(), value->ElementBytes()};
   }
 
+  template <typename INT_T = std::int64_t>
+  void CheckDescriptorEqInt(
+      const Descriptor *value, const INT_T expected) const {
+    if (expected != -1) {
+      ASSERT_NE(value, nullptr);
+      EXPECT_EQ(*value->OffsetElement<INT_T>(), expected);
+    }
+  }
+
   template <typename RuntimeCall>
   void CheckValue(RuntimeCall F, const char *expectedValue,
-      std::int32_t expectedStatus = 0,
+      std::int64_t expectedLength = -1, std::int32_t expectedStatus = 0,
       const char *expectedErrMsg = "shouldn't change") const {
     OwningPtr<Descriptor> value{CreateEmptyCharDescriptor()};
     ASSERT_NE(value, nullptr);
 
+    OwningPtr<Descriptor> length{
+        expectedLength == -1 ? nullptr : EmptyIntDescriptor()};
+
     OwningPtr<Descriptor> errmsg{CharDescriptor(expectedErrMsg)};
+    ASSERT_NE(errmsg, nullptr);
 
     std::string expectedValueStr{
         GetPaddedStr(expectedValue, value->ElementBytes())};
 
-    EXPECT_EQ(F(value.get(), errmsg.get()), expectedStatus);
+    EXPECT_EQ(F(value.get(), length.get(), errmsg.get()), expectedStatus);
     CheckDescriptorEqStr(value.get(), expectedValueStr);
+    CheckDescriptorEqInt(length.get(), expectedLength);
     CheckDescriptorEqStr(errmsg.get(), expectedErrMsg);
   }
 
@@ -80,18 +105,35 @@ protected:
     SCOPED_TRACE(n);
     SCOPED_TRACE("Checking argument:");
     CheckValue(
-        [&](const Descriptor *value, const Descriptor *errmsg) {
+        [&](const Descriptor *value, const Descriptor *,
+            const Descriptor *errmsg) {
           return RTNAME(ArgumentValue)(n, value, errmsg);
         },
         expectedValue);
   }
 
+  void CheckCommandValue(const char *args[], int n) const {
+    SCOPED_TRACE("Checking command:");
+    ASSERT_GE(n, 1);
+    std::string expectedValue{args[0]};
+    for (int i = 1; i < n; i++) {
+      expectedValue += " " + std::string{args[i]};
+    }
+    CheckValue(
+        [&](const Descriptor *value, const Descriptor *length,
+            const Descriptor *errmsg) {
+          return RTNAME(GetCommand)(value, length, errmsg);
+        },
+        expectedValue.c_str(), expectedValue.size());
+  }
+
   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) {
+        [&](const Descriptor *value, const Descriptor *,
+            const Descriptor *errmsg) {
           return RTNAME(EnvVariableValue)(*CharDescriptor(name), value,
               trimName, errmsg, /*sourceFile=*/nullptr, /*line=*/0);
         },
@@ -108,11 +150,12 @@ protected:
     OwningPtr<Descriptor> nameDescriptor{CharDescriptor(name)};
     EXPECT_EQ(0, RTNAME(EnvVariableLength)(*nameDescriptor, trimName));
     CheckValue(
-        [&](const Descriptor *value, const Descriptor *errmsg) {
+        [&](const Descriptor *value, const Descriptor *,
+            const Descriptor *errmsg) {
           return RTNAME(EnvVariableValue)(*nameDescriptor, value, trimName,
               errmsg, /*sourceFile=*/nullptr, /*line=*/0);
         },
-        "", 1, "Missing environment variable");
+        "", -1, 1, "Missing environment variable");
   }
 
   void CheckMissingArgumentValue(int n, const char *errStr = nullptr) const {
@@ -131,8 +174,39 @@ protected:
       CheckDescriptorEqStr(err.get(), paddedErrStr);
     }
   }
+
+  void CheckMissingCommandValue(const char *errStr = nullptr) const {
+    OwningPtr<Descriptor> value{CreateEmptyCharDescriptor()};
+    ASSERT_NE(value, nullptr);
+
+    OwningPtr<Descriptor> length{EmptyIntDescriptor()};
+    ASSERT_NE(length, nullptr);
+
+    OwningPtr<Descriptor> err{errStr ? CreateEmptyCharDescriptor() : nullptr};
+
+    EXPECT_GT(RTNAME(GetCommand)(value.get(), length.get(), err.get()), 0);
+
+    std::string spaces(value->ElementBytes(), ' ');
+    CheckDescriptorEqStr(value.get(), spaces);
+
+    CheckDescriptorEqInt(length.get(), 0);
+
+    if (errStr) {
+      std::string paddedErrStr(GetPaddedStr(errStr, err->ElementBytes()));
+      CheckDescriptorEqStr(err.get(), paddedErrStr);
+    }
+  }
 };
 
+class NoArgv : public CommandFixture {
+protected:
+  NoArgv() : CommandFixture(0, nullptr) {}
+};
+
+// TODO: Test other intrinsics with this fixture.
+
+TEST_F(NoArgv, GetCommand) { CheckMissingCommandValue(); }
+
 static const char *commandOnlyArgv[]{"aProgram"};
 class ZeroArguments : public CommandFixture {
 protected:
@@ -151,6 +225,8 @@ TEST_F(ZeroArguments, ArgumentValue) {
   CheckArgumentValue(commandOnlyArgv[0], 0);
 }
 
+TEST_F(ZeroArguments, GetCommand) { CheckCommandValue(commandOnlyArgv, 1); }
+
 static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"};
 class OneArgument : public CommandFixture {
 protected:
@@ -171,6 +247,8 @@ TEST_F(OneArgument, ArgumentValue) {
   CheckArgumentValue(oneArgArgv[1], 1);
 }
 
+TEST_F(OneArgument, GetCommand) { CheckCommandValue(oneArgArgv, 2); }
+
 static const char *severalArgsArgv[]{
     "aProgram", "16-char-long-arg", "", "-22-character-long-arg", "o"};
 class SeveralArguments : public CommandFixture {
@@ -215,7 +293,7 @@ TEST_F(SeveralArguments, MissingArguments) {
   CheckMissingArgumentValue(5);
 }
 
-TEST_F(SeveralArguments, ValueTooShort) {
+TEST_F(SeveralArguments, ArgValueTooShort) {
   OwningPtr<Descriptor> tooShort{CreateEmptyCharDescriptor<15>()};
   ASSERT_NE(tooShort, nullptr);
   EXPECT_EQ(RTNAME(ArgumentValue)(1, tooShort.get(), nullptr), -1);
@@ -231,12 +309,94 @@ TEST_F(SeveralArguments, ValueTooShort) {
   CheckDescriptorEqStr(errMsg.get(), expectedErrMsg);
 }
 
-TEST_F(SeveralArguments, ErrMsgTooShort) {
+TEST_F(SeveralArguments, ArgErrMsgTooShort) {
   OwningPtr<Descriptor> errMsg{CreateEmptyCharDescriptor<3>()};
   EXPECT_GT(RTNAME(ArgumentValue)(-1, nullptr, errMsg.get()), 0);
   CheckDescriptorEqStr(errMsg.get(), "Inv");
 }
 
+TEST_F(SeveralArguments, GetCommand) {
+  CheckMissingCommandValue();
+  CheckMissingCommandValue("Missing argument");
+}
+
+TEST_F(SeveralArguments, CommandErrMsgTooShort) {
+  OwningPtr<Descriptor> value{CreateEmptyCharDescriptor()};
+  OwningPtr<Descriptor> length{EmptyIntDescriptor()};
+  OwningPtr<Descriptor> errMsg{CreateEmptyCharDescriptor<3>()};
+
+  EXPECT_GT(RTNAME(GetCommand)(value.get(), length.get(), errMsg.get()), 0);
+
+  std::string spaces(value->ElementBytes(), ' ');
+  CheckDescriptorEqStr(value.get(), spaces);
+  CheckDescriptorEqInt(length.get(), 0);
+  CheckDescriptorEqStr(errMsg.get(), "Mis");
+}
+
+TEST_F(SeveralArguments, GetCommandCanTakeNull) {
+  EXPECT_GT(RTNAME(GetCommand)(nullptr, nullptr, nullptr), 0);
+}
+
+static const char *onlyValidArgsArgv[]{
+    "aProgram", "-f", "has/a/few/slashes", "has\\a\\few\\backslashes"};
+class OnlyValidArguments : public CommandFixture {
+protected:
+  OnlyValidArguments()
+      : CommandFixture(sizeof(onlyValidArgsArgv) / sizeof(*onlyValidArgsArgv),
+            onlyValidArgsArgv) {}
+};
+
+TEST_F(OnlyValidArguments, GetCommand) {
+  CheckCommandValue(onlyValidArgsArgv, 4);
+}
+
+TEST_F(OnlyValidArguments, CommandValueTooShort) {
+  OwningPtr<Descriptor> tooShort{CreateEmptyCharDescriptor<50>()};
+  ASSERT_NE(tooShort, nullptr);
+  OwningPtr<Descriptor> length{EmptyIntDescriptor()};
+  ASSERT_NE(length, nullptr);
+
+  EXPECT_EQ(RTNAME(GetCommand)(tooShort.get(), length.get(), nullptr), -1);
+
+  CheckDescriptorEqStr(
+      tooShort.get(), "aProgram -f has/a/few/slashes has\\a\\few\\backslashe");
+  CheckDescriptorEqInt(length.get(), 51);
+
+  OwningPtr<Descriptor> errMsg{CreateEmptyCharDescriptor()};
+  ASSERT_NE(errMsg, nullptr);
+
+  EXPECT_EQ(-1, RTNAME(GetCommand)(tooShort.get(), nullptr, errMsg.get()));
+
+  std::string expectedErrMsg{
+      GetPaddedStr("Value too short", errMsg->ElementBytes())};
+  CheckDescriptorEqStr(errMsg.get(), expectedErrMsg);
+}
+
+TEST_F(OnlyValidArguments, GetCommandCanTakeNull) {
+  EXPECT_EQ(0, RTNAME(GetCommand)(nullptr, nullptr, nullptr));
+
+  OwningPtr<Descriptor> value{CreateEmptyCharDescriptor()};
+  ASSERT_NE(value, nullptr);
+  OwningPtr<Descriptor> length{EmptyIntDescriptor()};
+  ASSERT_NE(length, nullptr);
+
+  EXPECT_EQ(0, RTNAME(GetCommand)(value.get(), nullptr, nullptr));
+  CheckDescriptorEqStr(value.get(),
+      GetPaddedStr("aProgram -f has/a/few/slashes has\\a\\few\\backslashes",
+          value->ElementBytes()));
+
+  EXPECT_EQ(0, RTNAME(GetCommand)(nullptr, length.get(), nullptr));
+  CheckDescriptorEqInt(length.get(), 51);
+}
+
+TEST_F(OnlyValidArguments, GetCommandShortLength) {
+  OwningPtr<Descriptor> length{EmptyIntDescriptor<sizeof(short)>()};
+  ASSERT_NE(length, nullptr);
+
+  EXPECT_EQ(0, RTNAME(GetCommand)(nullptr, length.get(), nullptr));
+  CheckDescriptorEqInt<short>(length.get(), 51);
+}
+
 class EnvironmentVariables : public CommandFixture {
 protected:
   EnvironmentVariables() : CommandFixture(0, nullptr) {