[flang-commits] [flang] add SYSTEM runtime and lowering intrinsics support (PR #74309)

via flang-commits flang-commits at lists.llvm.org
Mon Dec 4 04:18:59 PST 2023


llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Yi Wu (yi-wu-arm)

<details>
<summary>Changes</summary>

Calls std::system() function and pass the command,
cmd on Windows or shell on Linux.
Command parameter is required, exitstatus is optional.
call system(command)
call system(command, exitstatus)

Once https://github.com/llvm/llvm-project/pull/74077 has been merged, this will be rebased on that change. Functions will move from `command.cpp` to `execute.cpp`

---
Full diff: https://github.com/llvm/llvm-project/pull/74309.diff


10 Files Affected:

- (modified) flang/docs/Intrinsics.md (+1-1) 
- (modified) flang/include/flang/Optimizer/Builder/IntrinsicCall.h (+1) 
- (modified) flang/include/flang/Optimizer/Builder/Runtime/Command.h (+5) 
- (modified) flang/include/flang/Runtime/command.h (+5) 
- (modified) flang/lib/Evaluate/intrinsics.cpp (+11-5) 
- (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+22) 
- (modified) flang/lib/Optimizer/Builder/Runtime/Command.cpp (+13) 
- (modified) flang/runtime/command.cpp (+19) 
- (added) flang/test/Lower/Intrinsics/system.f90 (+35) 
- (modified) flang/unittests/Runtime/CommandTest.cpp (+41) 


``````````diff
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index fef2b4ea4dd8c..871332399628e 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -751,7 +751,7 @@ This phase currently supports all the intrinsic procedures listed above but the
 | Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
 | Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
 | Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
-| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
+| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM, SYSTEM_CLOCK |
 | Atomic intrinsic subroutines | ATOMIC_ADD |
 | Collective intrinsic subroutines | CO_REDUCE |
 
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 5065f11ae9e72..669d076c3e0e7 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -321,6 +321,7 @@ struct IntrinsicLibrary {
   fir::ExtendedValue genStorageSize(mlir::Type,
                                     llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  void genSystem(mlir::ArrayRef<fir::ExtendedValue> args);
   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genTand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genTrailz(mlir::Type, llvm::ArrayRef<mlir::Value>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 976fb3aa0b6fb..9d6a39639844f 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -53,5 +53,10 @@ mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location,
                               mlir::Value length, mlir::Value trimName,
                               mlir::Value errmsg);
 
+/// Generate a call to System runtime function which implements
+/// the non-standard System GNU extension.
+void genSystem(fir::FirOpBuilder &, mlir::Location, mlir::Value command,
+               mlir::Value exitstat);
+
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H
diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index c67d171c8e2f1..f325faa7bd09f 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -55,6 +55,11 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
     const Descriptor *value = nullptr, const Descriptor *length = nullptr,
     bool trim_name = true, const Descriptor *errmsg = nullptr,
     const char *sourceFile = nullptr, int line = 0);
+
+// Calls std::system()
+void RTNAME(System)(const Descriptor *command = nullptr,
+    const Descriptor *exitstat = nullptr, const char *sourceFile = nullptr,
+    int line = 0);
 }
 } // namespace Fortran::runtime
 
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index c5faf319fafb7..bb6ac8ac7159a 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1387,6 +1387,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{
             {"get", DefaultInt, Rank::vector, Optionality::optional,
                 common::Intent::Out}},
         {}, Rank::elemental, IntrinsicClass::impureSubroutine},
+    {"system",
+        {{"command", DefaultChar, Rank::scalar},
+            {"exitstat", AnyInt, Rank::scalar, Optionality::optional,
+                common::Intent::InOut}},
+        {}, Rank::elemental, IntrinsicClass::impureSubroutine},
     {"system_clock",
         {{"count", AnyInt, Rank::scalar, Optionality::optional,
              common::Intent::Out},
@@ -1885,7 +1890,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
   int elementalRank{0};
   for (std::size_t j{0}; j < dummies; ++j) {
     const IntrinsicDummyArgument &d{dummy[std::min(j, dummyArgPatterns - 1)]};
-    if (const ActualArgument *arg{actualForDummy[j]}) {
+    if (const ActualArgument * arg{actualForDummy[j]}) {
       bool isAssumedRank{IsAssumedRank(*arg)};
       if (isAssumedRank && d.rank != Rank::anyOrAssumedRank &&
           d.rank != Rank::arrayOrAssumedRank) {
@@ -2222,7 +2227,8 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
     case Rank::locReduced:
     case Rank::scalarIfDim:
       if (dummy[*dimArg].optionality == Optionality::required) {
-        if (const Symbol *whole{
+        if (const Symbol *
+            whole{
                 UnwrapWholeSymbolOrComponentDataRef(actualForDummy[*dimArg])}) {
           if (IsOptional(*whole) || IsAllocatableOrObjectPointer(whole)) {
             if (context.languageFeatures().ShouldWarn(
@@ -2300,7 +2306,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
   // Rearrange the actual arguments into dummy argument order.
   ActualArguments rearranged(dummies);
   for (std::size_t j{0}; j < dummies; ++j) {
-    if (ActualArgument *arg{actualForDummy[j]}) {
+    if (ActualArgument * arg{actualForDummy[j]}) {
       rearranged[j] = std::move(*arg);
     }
   }
@@ -2937,7 +2943,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
     ok &= CheckForCoindexedObject(context, call.arguments[3], name, "errmsg");
     if (call.arguments[0] && call.arguments[1]) {
       for (int j{0}; j < 2; ++j) {
-        if (const Symbol *last{GetLastSymbol(call.arguments[j])};
+        if (const Symbol * last{GetLastSymbol(call.arguments[j])};
             last && !IsAllocatable(last->GetUltimate())) {
           context.messages().Say(call.arguments[j]->sourceLocation(),
               "Argument #%d to MOVE_ALLOC must be allocatable"_err_en_US,
@@ -2957,7 +2963,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
     const auto &arg{call.arguments[0]};
     if (arg) {
       if (const auto *expr{arg->UnwrapExpr()}) {
-        if (const Symbol *symbol{UnwrapWholeSymbolDataRef(*expr)}) {
+        if (const Symbol * symbol{UnwrapWholeSymbolDataRef(*expr)}) {
           ok = symbol->attrs().test(semantics::Attr::OPTIONAL);
         }
       }
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 24fdbe97856b3..8fded510a1801 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -508,6 +508,10 @@ static constexpr IntrinsicHandler handlers[]{
        {"dim", asValue},
        {"mask", asBox, handleDynamicOptional}}},
      /*isElemental=*/false},
+    {"system",
+     &I::genSystem,
+     {{{"command", asBox}, {"exitstat", asBox, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"system_clock",
      &I::genSystemClock,
      {{{"count", asAddr}, {"count_rate", asAddr}, {"count_max", asAddr}}},
@@ -5316,6 +5320,24 @@ IntrinsicLibrary::genSum(mlir::Type resultType,
                       resultType, args);
 }
 
+// SYSTEM
+void IntrinsicLibrary::genSystem(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() >= 1);
+  mlir::Value command = fir::getBase(args[0]);
+  const fir::ExtendedValue &exitstat = args[1];
+
+  if (!command)
+    fir::emitFatalError(loc, "expected COMMAND parameter");
+
+  mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+
+  mlir::Value exitstatBox =
+      isStaticallyPresent(exitstat)
+          ? fir::getBase(exitstat)
+          : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+
+  fir::runtime::genSystem(builder, loc, command, exitstatBox);
+}
 // SYSTEM_CLOCK
 void IntrinsicLibrary::genSystemClock(llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 3);
diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index 1d719e7bbd9a2..00af35a74bf87 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -88,3 +88,16 @@ mlir::Value fir::runtime::genGetEnvVariable(fir::FirOpBuilder &builder,
       sourceFile, sourceLine);
   return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
 }
+
+void fir::runtime::genSystem(fir::FirOpBuilder &builder, mlir::Location loc,
+                             mlir::Value command, mlir::Value exitstat) {
+  auto runtimeFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(System)>(loc, builder);
+  mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
+  mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+  mlir::Value sourceLine =
+      fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(3));
+  llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+      builder, loc, runtimeFuncTy, command, exitstat, sourceFile, sourceLine);
+  builder.create<fir::CallOp>(loc, runtimeFunc, args);
+}
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index 8e6135b5487c0..a0f71147275fd 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -282,4 +282,23 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
   return StatOk;
 }
 
+void RTNAME(System)(const Descriptor *command, const Descriptor *exitstat,
+    const char *sourceFile, int line) {
+  Terminator terminator{sourceFile, line};
+
+  if (command) {
+    RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
+    int status{std::system(command->OffsetElement())};
+    if (exitstat) {
+      RUNTIME_CHECK(terminator, IsValidIntDescriptor(exitstat));
+#ifdef _WIN32
+      StoreLengthToDescriptor(exitstat, status, terminator);
+#else
+      int exitstatVal{WEXITSTATUS(status)};
+      StoreLengthToDescriptor(exitstat, exitstatVal, terminator);
+#endif
+    }
+  }
+}
+
 } // namespace Fortran::runtime
diff --git a/flang/test/Lower/Intrinsics/system.f90 b/flang/test/Lower/Intrinsics/system.f90
new file mode 100644
index 0000000000000..0c3e5fd63047c
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/system.f90
@@ -0,0 +1,35 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPall_args() {
+! CHECK:         %0 = fir.alloca !fir.char<1,30> {bindc_name = "command", uniq_name = "_QFall_argsEcommand"}
+! CHECK-NEXT:    %1:2 = hlfir.declare %0 typeparams %c30 {uniq_name = "_QFall_argsEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> (!fir.ref<!fir.char<1,30>>, !fir.ref<!fir.char<1,30>>)
+! CHECK-NEXT:    %2 = fir.alloca i32 {bindc_name = "exitval", uniq_name = "_QFall_argsEexitval"}
+! CHECK-NEXT:    %3:2 = hlfir.declare %2 {uniq_name = "_QFall_argsEexitval"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK-NEXT:    %4 = fir.embox %1#1 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT:    %5 = fir.embox %3#1 : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK:         %c19_i32 = arith.constant 19 : i32
+! CHECK-NEXT:    %7 = fir.convert %4 : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK-NEXT:    %8 = fir.convert %5 : (!fir.box<i32>) -> !fir.box<none>
+! CHECK:         %10 = fir.call @_FortranASystem(%7, %8, %9, %c19_i32) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT:    return
+! CHECK-NEXT:    }
+subroutine all_args()
+CHARACTER(30) :: command
+INTEGER :: exitVal
+call system(command, exitVal)
+end subroutine all_args
+
+! CHECK-LABEL: func.func @_QPonly_command() {
+! CHECK:         %0 = fir.alloca !fir.char<1,30> {bindc_name = "command", uniq_name = "_QFonly_commandEcommand"}
+! CHECK-NEXT:    %1:2 = hlfir.declare %0 typeparams %c30 {uniq_name = "_QFonly_commandEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> (!fir.ref<!fir.char<1,30>>, !fir.ref<!fir.char<1,30>>)
+! CHECK-NEXT:    %2 = fir.embox %1#1 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT:    %3 = fir.absent !fir.box<none>
+! CHECK:         %c34_i32 = arith.constant 34 : i32
+! CHECK-NEXT:    %5 = fir.convert %2 : (!fir.box<!fir.char<1,30>>) -> !fir.box<none> 
+! CHECK:         %7 = fir.call @_FortranASystem(%5, %3, %6, %c34_i32) fastmath<contract> : (!fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT:    return
+! CHECK-NEXT:   }
+subroutine only_command()
+CHARACTER(30) :: command
+call system(command)
+end subroutine only_command
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index 9f66c7924c86e..f0bbc721a6707 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -46,6 +46,17 @@ static OwningPtr<Descriptor> EmptyIntDescriptor() {
   return descriptor;
 }
 
+template <int kind = sizeof(std::int64_t)>
+static OwningPtr<Descriptor> IntDescriptor(const int &value) {
+  OwningPtr<Descriptor> descriptor{Descriptor::Create(TypeCategory::Integer,
+      kind, nullptr, 0, nullptr, CFI_attribute_allocatable)};
+  if (descriptor->Allocate() != 0) {
+    return nullptr;
+  }
+  std::memcpy(descriptor->OffsetElement<int>(), &value, sizeof(int));
+  return descriptor;
+}
+
 class CommandFixture : public ::testing::Test {
 protected:
   CommandFixture(int argc, const char *argv[]) {
@@ -227,6 +238,36 @@ TEST_F(ZeroArguments, GetCommandArgument) {
 
 TEST_F(ZeroArguments, GetCommand) { CheckCommandValue(commandOnlyArgv, 1); }
 
+TEST_F(ZeroArguments, SystemValidCommandExitStat) {
+  OwningPtr<Descriptor> command{CharDescriptor("echo hi")};
+  OwningPtr<Descriptor> exitStat{EmptyIntDescriptor()};
+
+  RTNAME(System)(command.get(), exitStat.get());
+  CheckDescriptorEqInt(exitStat.get(), 0);
+}
+
+TEST_F(ZeroArguments, SystemInvalidCommandExitStat) {
+  OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
+  OwningPtr<Descriptor> exitStat{EmptyIntDescriptor()};
+
+  RTNAME(System)(command.get(), exitStat.get());
+#ifdef _WIN32
+  CheckDescriptorEqInt(exitStat.get(), 1);
+#else
+  CheckDescriptorEqInt(exitStat.get(), 127);
+#endif
+}
+
+TEST_F(ZeroArguments, SystemValidCommandOptionalExitStat) {
+  OwningPtr<Descriptor> command{CharDescriptor("echo hi")};
+  EXPECT_NO_FATAL_FAILURE(RTNAME(System)(command.get(), nullptr));
+}
+
+TEST_F(ZeroArguments, SystemInvalidCommandOptionalExitStat) {
+  OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
+  EXPECT_NO_FATAL_FAILURE(RTNAME(System)(command.get(), nullptr));
+}
+
 static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"};
 class OneArgument : public CommandFixture {
 protected:

``````````

</details>


https://github.com/llvm/llvm-project/pull/74309


More information about the flang-commits mailing list