[flang] GET_COMMAND_ARGUMENT(VALUE) runtime implementation

[rovka]

Summary

Partial implementation for the second entry point for
GET_COMMAND_ARGUMENT. It handles the VALUE and STATUS arguments, and
doesn't touch ERRMSG.

[rovka]

I've put ERRMSG handling in a different patch to make it easier to review, but we can also squash it into this one.

flang/runtime/command.cpp

57

We're silently ignoring 'value' if it's not allocated or not the right type - should we have an assert instead if it doesn't look the way we expect?

69

It's not very clear to me from the standard what's supposed to happen to 'value' if it's too short. I guess it could be helpful to write as much of the argument as we can fit into it, but then we'd also have to decide whether we should put a \0 at the end or not (*), and overall I don't know if it's worth the trouble. Thoughts?

(*) IIUC gfortran doesn't force a \0, which makes the code easier but the testing harder, because I think it's UB to call EXPECT_STREQ on a char string that's not null-terminated.

[klausler]

flang/runtime/command.cpp

14–15

If these types are used in the specifications of implementations of APIs then they should not be introduced here. Implementations of functions should match their prototypes in headers, apart from maybe adding names for arguments and removing any default values.

69

Truncate if short, pad if long, and never append a NUL byte.

[rovka]

Truncate or pad with spaces.

[rovka]

flang/runtime/command.cpp

14–15

Yeah, I introduced these as shorthand initially, but I guess it makes sense to have them in the header.

[rovka]

Ping.
Also https://reviews.llvm.org/D109227

[klausler]

flang/runtime/command.cpp

57

The value argument should be a reference, not a pointer, to a descriptor here (and in your IsValidCharDescriptor() utility above). It is not optional if ArgumentValue() is actually being called.

[rovka]

flang/runtime/command.cpp

57

Actually I was thinking it is optional. For instance a call to GET_COMMAND_ARGUMENT(NUMBER, LENGTH, STATUS, ERRMSG) would be lowered to a call to ArgumentLength() and one to ArgumentValue() without a descriptor for value, and the latter would just fill in the STATUS and ERRMSG. I guess lowering could skip the call to ArgumentValue and fill in STATUS and ERRMSG based on the return from ArgumentLength, but wouldn't that just be more complicated than necessary?

[klausler]

flang/runtime/command.cpp

57

Ok, SGTM. Please clean up the types and I'll approve.

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 "flang/Runtime/descriptor.h"
 #include <limits>
 
 namespace Fortran::runtime {
 CountType 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;
   }
   return 0;
 }
 
-LengthType RTNAME(ArgumentLength)(CountType n) {
-  if (n < 0 || n >= executionEnvironment.argc) {
-    return 0;
-  }
-
+// Returns the length of the \p n'th argument. Assumes \p n is valid.
+static LengthType ArgumentLength(CountType n) {
   std::size_t length{std::strlen(executionEnvironment.argv[n])};
   if constexpr (sizeof(std::size_t) <= sizeof(LengthType)) {
     return static_cast<LengthType>(length);
   } else {
     std::size_t max{std::numeric_limits<LengthType>::max()};
     return length > max ? 0 // Just fail.
                         : static_cast<LengthType>(length);
   }
 }
+
+LengthType RTNAME(ArgumentLength)(CountType n) {
+  if (n < 0 || n >= executionEnvironment.argc) {
+    return 0;
+  }
+
+  return ArgumentLength(n);
+}
+
+static bool IsValidCharDescriptor(const Descriptor *value) {
+  return value && value->IsAllocated() &&
+      value->type() == TypeCode(TypeCategory::Character, 1) &&
+      value->rank() == 0;
+}
+
+static void FillWithSpaces(const Descriptor *value) {
+  std::memset(value->OffsetElement(), ' ', value->ElementBytes());
+}
+
+CppTypeFor<TypeCategory::Integer, 4> RTNAME(ArgumentValue)(
+    CountType n, const Descriptor *value, const Descriptor *errmsg) {
+  if (IsValidCharDescriptor(value)) {
+    FillWithSpaces(value);
+  }
+
+  if (n < 0 || n >= executionEnvironment.argc) {
+    return 1;
+  }
+
+  if (IsValidCharDescriptor(value)) {
+    LengthType argLen{ArgumentLength(n)};
+    if (argLen <= 0) {
+      return 2;
+    }
+
+    LengthType toCopy{
+        std::min(argLen, static_cast<LengthType>(value->ElementBytes()))};
+    std::strncpy(value->OffsetElement(), executionEnvironment.argv[n], toCopy);
+
+    if (argLen > toCopy) {
+      return -1;
+    }
+  }
+  return 0;
+}
 } // namespace Fortran::runtime

flang/test/Runtime/no-cpp-dep.c

 C++ code that would explode here.
 */
 struct Descriptor;
 
 double RTNAME(CpuTime)();
 
 void RTNAME(ProgramStart)(int, const char *[], const char *[]);
 int32_t RTNAME(ArgumentCount)();
+int32_t RTNAME(ArgumentValue)(
+    int32_t, const struct Descriptor *, const struct Descriptor *);
 int64_t RTNAME(ArgumentLength)(int32_t);
 
 int main() {
   double x = RTNAME(CpuTime)();
   RTNAME(ProgramStart)(0, 0, 0);
   int32_t c = RTNAME(ArgumentCount)();
+  int32_t v = RTNAME(ArgumentValue)(0, 0, 0);
   int32_t l = RTNAME(ArgumentLength)(0);
   return x + c + l;
 }

flang/unittests/Runtime/CommandTest.cpp

 //===-- flang/unittests/RuntimeGTest/CommandTest.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 "gtest/gtest.h"
 #include "flang/Runtime/descriptor.h"
 #include "flang/Runtime/main.h"
 
 using namespace Fortran::runtime;
 
+template <std::size_t n = 64>
+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;
+}
+
 class CommandFixture : public ::testing::Test {
 protected:
   CommandFixture(int argc, const char *argv[]) {
     RTNAME(ProgramStart)(argc, argv, {});
   }
+
+  std::string GetPaddedString(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(
+      const Descriptor *value, const std::string &expected) const {
+    EXPECT_EQ(std::strncmp(value->OffsetElement(), expected.c_str(),
+                  value->ElementBytes()),
+        0);
+  }
+
+  void CheckArgumentValue(int n, const char *argv) const {
+    OwningPtr<Descriptor> value{CreateEmptyCharDescriptor()};
+    ASSERT_NE(value, nullptr);
+
+    std::string expected{GetPaddedString(argv, value->ElementBytes())};
+
+    EXPECT_EQ(RTNAME(ArgumentValue)(n, value.get(), nullptr), 0);
+    CheckDescriptorEqStr(value.get(), expected);
+  }
+
+  void CheckMissingArgumentValue(int n) const {
+    OwningPtr<Descriptor> value{CreateEmptyCharDescriptor()};
+    ASSERT_NE(value, nullptr);
+
+    EXPECT_GT(RTNAME(ArgumentValue)(n, value.get(), nullptr), 0);
+
+    std::string spaces(value->ElementBytes(), ' ');
+    CheckDescriptorEqStr(value.get(), spaces);
+  }
 };
 
 static const char *commandOnlyArgv[]{"aProgram"};
 class ZeroArguments : public CommandFixture {
 protected:
   ZeroArguments() : CommandFixture(1, commandOnlyArgv) {}
 };
 
 TEST_F(ZeroArguments, ArgumentCount) { EXPECT_EQ(0, RTNAME(ArgumentCount)()); }
 
 TEST_F(ZeroArguments, ArgumentLength) {
   EXPECT_EQ(0, RTNAME(ArgumentLength)(-1));
   EXPECT_EQ(8, RTNAME(ArgumentLength)(0));
   EXPECT_EQ(0, RTNAME(ArgumentLength)(1));
 }
 
+TEST_F(ZeroArguments, ArgumentValue) {
+  CheckArgumentValue(0, commandOnlyArgv[0]);
+}
+
 static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"};
 class OneArgument : public CommandFixture {
 protected:
   OneArgument() : CommandFixture(2, oneArgArgv) {}
 };
 
 TEST_F(OneArgument, ArgumentCount) { EXPECT_EQ(1, RTNAME(ArgumentCount)()); }
 
 TEST_F(OneArgument, ArgumentLength) {
   EXPECT_EQ(0, RTNAME(ArgumentLength)(-1));
   EXPECT_EQ(8, RTNAME(ArgumentLength)(0));
   EXPECT_EQ(20, RTNAME(ArgumentLength)(1));
   EXPECT_EQ(0, RTNAME(ArgumentLength)(2));
 }
 
+TEST_F(OneArgument, ArgumentValue) {
+  CheckArgumentValue(0, oneArgArgv[0]);
+  CheckArgumentValue(1, oneArgArgv[1]);
+}
+
 static const char *severalArgsArgv[]{
     "aProgram", "16-char-long-arg", "", "-22-character-long-arg", "o"};
 class SeveralArguments : public CommandFixture {
 protected:
   SeveralArguments()
       : CommandFixture(sizeof(severalArgsArgv) / sizeof(*severalArgsArgv),
             severalArgsArgv) {}
 };
 
 TEST_F(SeveralArguments, ArgumentCount) {
   EXPECT_EQ(4, RTNAME(ArgumentCount)());
 }
 
 TEST_F(SeveralArguments, ArgumentLength) {
   EXPECT_EQ(0, RTNAME(ArgumentLength)(-1));
   EXPECT_EQ(8, RTNAME(ArgumentLength)(0));
   EXPECT_EQ(16, RTNAME(ArgumentLength)(1));
   EXPECT_EQ(0, RTNAME(ArgumentLength)(2));
   EXPECT_EQ(22, RTNAME(ArgumentLength)(3));
   EXPECT_EQ(1, RTNAME(ArgumentLength)(4));
   EXPECT_EQ(0, RTNAME(ArgumentLength)(5));
 }
+
+TEST_F(SeveralArguments, ArgumentValue) {
+  CheckArgumentValue(0, severalArgsArgv[0]);
+  CheckArgumentValue(1, severalArgsArgv[1]);
+  CheckMissingArgumentValue(2);
+  CheckArgumentValue(3, severalArgsArgv[3]);
+  CheckArgumentValue(4, severalArgsArgv[4]);
+}
+
+TEST_F(SeveralArguments, NoArgumentValue) {
+  // Make sure we don't crash if the 'value' and 'error' parameters aren't
+  // passed.
+  EXPECT_EQ(RTNAME(ArgumentValue)(2, nullptr, nullptr), 0);
+  EXPECT_GT(RTNAME(ArgumentValue)(-1, nullptr, nullptr), 0);
+}
+
+TEST_F(SeveralArguments, ArgumentValueErrors) {
+  CheckMissingArgumentValue(-1);
+  CheckMissingArgumentValue(5);
+
+  OwningPtr<Descriptor> tooShort{CreateEmptyCharDescriptor<15>()};
+  ASSERT_NE(tooShort, nullptr);
+  EXPECT_EQ(RTNAME(ArgumentValue)(1, tooShort.get(), nullptr), -1);
+  CheckDescriptorEqStr(tooShort.get(), severalArgsArgv[1]);
+}