[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

Author: rovka

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)};