[flang-commits] [flang] e2b896a - [flang] Add EXECUTE_COMMAND_LINE runtime and lowering intrinsics implementation (#74077)
via flang-commits
flang-commits at lists.llvm.org
Wed Jan 10 02:02:52 PST 2024
Author: Yi Wu
Date: 2024-01-10T10:02:48Z
New Revision: e2b896aa640fec25f68d283948c1b44711087f0f
URL: https://github.com/llvm/llvm-project/commit/e2b896aa640fec25f68d283948c1b44711087f0f
DIFF: https://github.com/llvm/llvm-project/commit/e2b896aa640fec25f68d283948c1b44711087f0f.diff
LOG: [flang] Add EXECUTE_COMMAND_LINE runtime and lowering intrinsics implementation (#74077)
This patch add support of intrinsics Fortran 2008 EXECUTE_COMMAND_LINE.
The patch contains both the lowering and the runtime code and works on
both Windows and Linux. The patch contains a list of commits, to convey
the authorship and the history of changes. Some implementation specifics
or status has been added to `flang/docs/Intrinsics.md`.
I have provided a summary of the usage and the options required for the
`EXECUTE_COMMAND_LINE intrinsic`. The intrinsic supports both a
synchronous
(by default) and an asynchronous option.
| System | Mode | Implemention |
|---------|-------|---------------------------|
| Linux | Sync | std::system() |
| Windows | Sync | std::system() |
| Linux | Async | fork() |
| Windows | Async | CreateProcess |
Support for the SYSTEM GNU extension will be added in a separate PR.
Co-authored with @jeffhammond
---------
Signed-off-by: Jeff Hammond <jeff.science at gmail.com>
Co-authored-by: Jeff Hammond <jeff.science at gmail.com>
Co-authored-by: Yi Wu <yiwu02 at wdev-yiwu02.arm.com>
Added:
flang/include/flang/Optimizer/Builder/Runtime/Execute.h
flang/include/flang/Runtime/execute.h
flang/lib/Optimizer/Builder/Runtime/Execute.cpp
flang/runtime/execute.cpp
flang/test/Lower/Intrinsics/execute_command_line-optional.f90
flang/test/Lower/Intrinsics/execute_command_line.f90
Modified:
flang/docs/Intrinsics.md
flang/include/flang/Optimizer/Builder/IntrinsicCall.h
flang/lib/Optimizer/Builder/CMakeLists.txt
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
flang/runtime/CMakeLists.txt
flang/runtime/command.cpp
flang/runtime/tools.cpp
flang/runtime/tools.h
flang/unittests/Runtime/CommandTest.cpp
Removed:
################################################################################
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 189920a0881b27..f5705eb440a750 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -841,3 +841,48 @@ TRIM, UBOUND, UNPACK, VERIFY.
Coarray, non standard, IEEE and ISO_C_BINDINGS intrinsic functions that can be
used in constant expressions have currently no folding support at all.
+
+### Standard Intrinsics: EXECUTE_COMMAND_LINE
+
+#### Usage and Info
+
+- **Standard:** Fortran 2008 and later, specified in 16.9.73
+- **Class:** Subroutine
+- **Syntax:** `CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])`
+- **Arguments:**
+
+ | Argument | Description |
+ |-----------|--------------------------------------------------------------|
+ | `COMMAND` | Shall be a default CHARACTER scalar. |
+ | `WAIT` | (Optional) Shall be a default LOGICAL scalar. |
+ | `EXITSTAT`| (Optional) Shall be an INTEGER of the default kind. |
+ | `CMDSTAT` | (Optional) Shall be an INTEGER of the default kind. |
+ | `CMDMSG` | (Optional) Shall be a CHARACTER scalar of the default kind. |
+
+#### Implementation Specifics
+
+- **`COMMAND`:**
+ - Must be preset.
+
+- **`WAIT`:**
+ - If set to `false`, the command is executed asynchronously. If not preset or set to `false`, it is executed synchronously.
+ - Sync: achieved by passing command into `std::system` on all systems.
+ - Async: achieved by calling a `fork()` on POSIX-compatible systems, or `CreateProcess()` on Windows.
+
+- **`CMDSTAT`:**
+ - -2: No error condition occurs, but `WAIT` is present with the value `false`, and the processor does not support asynchronous execution.
+ - -1: The processor does not support command line execution.
+ - \+ (positive value): An error condition occurs.
+ - 1: Fork Error, where `pid_t < 0`, would only occur on POSIX-compatible systems.
+ - 2: Execution Error, a command exits with status -1.
+ - 3: Invalid Command Error, determined by the exit code depending on the system.
+ - On Windows, if the exit code is 1.
+ - On POSIX-compatible systems, if the exit code is 127 or 126.
+ - 4: Signal error, either it is stopped or killed by signal, would only occur on POSIX-compatible systems.
+ - 0: Otherwise.
+
+- **`CMDMSG`:**
+ - If an error condition occurs, it is assigned an explanatory message. Otherwise, it remains unchanged.
+ - If a condition occurs that would assign a nonzero value to `CMDSTAT` but the `CMDSTAT` variable is not present, error termination is initiated.
+ - On POSIX-compatible systems, this applies to both synchronous and asynchronous error termination. When the execution mode is set to async with error termination, the child process (async process) will be terminated with no effect on the parent process (continues).
+ - On Windows, this only applies to synchronous error termination.
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index dba946975e1928..80f79d42fc2b75 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -214,6 +214,7 @@ struct IntrinsicLibrary {
mlir::Value genDshiftr(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genExit(llvm::ArrayRef<fir::ExtendedValue>);
+ void genExecuteCommandLine(mlir::ArrayRef<fir::ExtendedValue> args);
mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genExtendsTypeOf(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
new file mode 100644
index 00000000000000..a1e6ef20876049
--- /dev/null
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
@@ -0,0 +1,35 @@
+//===-- Command.cpp -- generate command line runtime API calls ------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXECUTE_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXECUTE_H
+
+namespace mlir {
+class Value;
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+} // namespace fir
+
+namespace fir::runtime {
+
+/// Generate a call to the ExecuteCommandLine runtime function which implements
+/// the GET_EXECUTE_ARGUMENT intrinsic.
+/// \p wait must be bool that can be absent.
+/// \p exitstat, \p cmdstat and \p cmdmsg must be fir.box that can be
+/// absent (but not null mlir values). The status exitstat and cmdstat are
+/// returned, along with the message cmdmsg.
+void genExecuteCommandLine(fir::FirOpBuilder &, mlir::Location,
+ mlir::Value command, mlir::Value wait,
+ mlir::Value exitstat, mlir::Value cmdstat,
+ mlir::Value cmdmsg);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXECUTE_H
diff --git a/flang/include/flang/Runtime/execute.h b/flang/include/flang/Runtime/execute.h
new file mode 100644
index 00000000000000..ca137b9d1823c4
--- /dev/null
+++ b/flang/include/flang/Runtime/execute.h
@@ -0,0 +1,29 @@
+//===-- include/flang/Runtime/command.h -------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_EXECUTE_H_
+#define FORTRAN_RUNTIME_EXECUTE_H_
+
+#include "flang/Runtime/entry-names.h"
+
+namespace Fortran::runtime {
+class Descriptor;
+
+extern "C" {
+
+// 16.9.83 EXECUTE_COMMAND_LINE
+// Execute a command line.
+// Returns a EXITSTAT, CMDSTAT, and CMDMSG as described in the standard.
+void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait = true,
+ const Descriptor *exitstat = nullptr, const Descriptor *cmdstat = nullptr,
+ const Descriptor *cmdmsg = nullptr, const char *sourceFile = nullptr,
+ int line = 0);
+}
+} // namespace Fortran::runtime
+
+#endif // FORTRAN_RUNTIME_EXECUTE_H_
diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt
index 9877c6b5379236..06339b116cd899 100644
--- a/flang/lib/Optimizer/Builder/CMakeLists.txt
+++ b/flang/lib/Optimizer/Builder/CMakeLists.txt
@@ -20,6 +20,7 @@ add_flang_library(FIRBuilder
Runtime/Derived.cpp
Runtime/EnvironmentDefaults.cpp
Runtime/Exceptions.cpp
+ Runtime/Execute.cpp
Runtime/Inquiry.cpp
Runtime/Intrinsics.cpp
Runtime/Numeric.cpp
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index c8057fbdd475af..ac7d4fbe23e673 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -26,6 +26,7 @@
#include "flang/Optimizer/Builder/Runtime/Command.h"
#include "flang/Optimizer/Builder/Runtime/Derived.h"
#include "flang/Optimizer/Builder/Runtime/Exceptions.h"
+#include "flang/Optimizer/Builder/Runtime/Execute.h"
#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"
#include "flang/Optimizer/Builder/Runtime/Numeric.h"
@@ -213,6 +214,14 @@ static constexpr IntrinsicHandler handlers[]{
{"boundary", asBox, handleDynamicOptional},
{"dim", asValue}}},
/*isElemental=*/false},
+ {"execute_command_line",
+ &I::genExecuteCommandLine,
+ {{{"command", asBox},
+ {"wait", asValue, handleDynamicOptional},
+ {"exitstat", asBox, handleDynamicOptional},
+ {"cmdstat", asBox, handleDynamicOptional},
+ {"cmdmsg", asBox, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"exit",
&I::genExit,
{{{"status", asValue, handleDynamicOptional}}},
@@ -2901,6 +2910,40 @@ IntrinsicLibrary::genEoshift(mlir::Type resultType,
return readAndAddCleanUp(resultMutableBox, resultType, "EOSHIFT");
}
+// EXECUTE_COMMAND_LINE
+void IntrinsicLibrary::genExecuteCommandLine(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 5);
+ mlir::Value command = fir::getBase(args[0]);
+ const fir::ExtendedValue &wait = args[1];
+ const fir::ExtendedValue &exitstat = args[2];
+ const fir::ExtendedValue &cmdstat = args[3];
+ const fir::ExtendedValue &cmdmsg = args[4];
+
+ if (!command)
+ fir::emitFatalError(loc, "expected COMMAND parameter");
+
+ mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+
+ mlir::Value waitBool = isStaticallyPresent(wait)
+ ? fir::getBase(wait)
+ : builder.createBool(loc, true);
+ mlir::Value exitstatBox =
+ isStaticallyPresent(exitstat)
+ ? fir::getBase(exitstat)
+ : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+ mlir::Value cmdstatBox =
+ isStaticallyPresent(cmdstat)
+ ? fir::getBase(cmdstat)
+ : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+ mlir::Value cmdmsgBox =
+ isStaticallyPresent(cmdmsg)
+ ? fir::getBase(cmdmsg)
+ : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+ fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,
+ exitstatBox, cmdstatBox, cmdmsgBox);
+}
+
// EXIT
void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 1);
diff --git a/flang/lib/Optimizer/Builder/Runtime/Execute.cpp b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
new file mode 100644
index 00000000000000..71ee3996ac0da7
--- /dev/null
+++ b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
@@ -0,0 +1,44 @@
+//===-- Execute.cpp -- generate command line runtime API calls ------------===//
+//
+// 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/Optimizer/Builder/Runtime/Execute.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Runtime/execute.h"
+
+using namespace Fortran::runtime;
+
+// Certain runtime intrinsics should only be run when select parameters of the
+// intrisic are supplied. In certain cases one of these parameters may not be
+// given, however the intrinsic needs to be run due to another required
+// parameter being supplied. In this case the missing parameter is assigned to
+// have an "absent" value. This typically happens in IntrinsicCall.cpp. For this
+// reason the extra indirection with `isAbsent` is needed for testing whether a
+// given parameter is actually present (so that parameters with "value" absent
+// are not considered as present).
+inline bool isAbsent(mlir::Value val) {
+ return mlir::isa_and_nonnull<fir::AbsentOp>(val.getDefiningOp());
+}
+
+void fir::runtime::genExecuteCommandLine(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ mlir::Value command, mlir::Value wait,
+ mlir::Value exitstat,
+ mlir::Value cmdstat,
+ mlir::Value cmdmsg) {
+ auto runtimeFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(ExecuteCommandLine)>(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(6));
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, runtimeFuncTy, command, wait, exitstat, cmdstat, cmdmsg,
+ sourceFile, sourceLine);
+ builder.create<fir::CallOp>(loc, runtimeFunc, args);
+}
diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index d6df15b7f6e078..dfa9da502db0a8 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -105,6 +105,7 @@ set(sources
edit-output.cpp
environment.cpp
exceptions.cpp
+ execute.cpp
extensions.cpp
extrema.cpp
file.cpp
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index 8e6135b5487c05..7c44890545bd3f 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -51,20 +51,6 @@ static std::int64_t StringLength(const char *string) {
}
}
-static bool IsValidCharDescriptor(const Descriptor *value) {
- return value && value->IsAllocated() &&
- value->type() == TypeCode(TypeCategory::Character, 1) &&
- value->rank() == 0;
-}
-
-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(
@@ -72,26 +58,7 @@ static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
}
}
-static std::int32_t CopyToDescriptor(const Descriptor &value,
- 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);
- }
-
- return StatOk;
-}
-
-static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
+static std::int32_t CheckAndCopyCharsToDescriptor(const Descriptor *value,
const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
bool haveValue{IsValidCharDescriptor(value)};
@@ -105,21 +72,13 @@ static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
std::int32_t stat{StatOk};
if (haveValue) {
- stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
+ stat = CopyCharsToDescriptor(*value, rawValue, len, errmsg, offset);
}
offset += len;
return stat;
}
-static void StoreLengthToDescriptor(
- const Descriptor *length, std::int64_t value, Terminator &terminator) {
- auto typeCode{length->type().GetCategoryAndKind()};
- int kind{typeCode->second};
- Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, void>(
- kind, terminator, *length, /* atIndex = */ 0, value);
-}
-
template <int KIND> struct FitsInIntegerKind {
bool operator()([[maybe_unused]] std::int64_t value) {
if constexpr (KIND >= 8) {
@@ -152,7 +111,7 @@ std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
// Store 0 in case we error out later on.
if (length) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
- StoreLengthToDescriptor(length, 0, terminator);
+ StoreIntToDescriptor(length, 0, terminator);
}
if (n < 0 || n >= executionEnvironment.argc) {
@@ -166,11 +125,11 @@ std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
}
if (length && FitsInDescriptor(length, argLen, terminator)) {
- StoreLengthToDescriptor(length, argLen, terminator);
+ StoreIntToDescriptor(length, argLen, terminator);
}
if (value) {
- return CopyToDescriptor(*value, arg, argLen, errmsg);
+ return CopyCharsToDescriptor(*value, arg, argLen, errmsg);
}
return StatOk;
@@ -188,7 +147,7 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
// Store 0 in case we error out later on.
if (length) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
- StoreLengthToDescriptor(length, 0, terminator);
+ StoreIntToDescriptor(length, 0, terminator);
}
auto shouldContinue = [&](std::int32_t stat) -> bool {
@@ -200,11 +159,11 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
std::size_t offset{0};
if (executionEnvironment.argc == 0) {
- return CheckAndCopyToDescriptor(value, "", errmsg, offset);
+ return CheckAndCopyCharsToDescriptor(value, "", errmsg, offset);
}
// value = argv[0]
- std::int32_t stat{CheckAndCopyToDescriptor(
+ std::int32_t stat{CheckAndCopyCharsToDescriptor(
value, executionEnvironment.argv[0], errmsg, offset)};
if (!shouldContinue(stat)) {
return stat;
@@ -212,12 +171,12 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
// value += " " + argv[1:n]
for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
- stat = CheckAndCopyToDescriptor(value, " ", errmsg, offset);
+ stat = CheckAndCopyCharsToDescriptor(value, " ", errmsg, offset);
if (!shouldContinue(stat)) {
return stat;
}
- stat = CheckAndCopyToDescriptor(
+ stat = CheckAndCopyCharsToDescriptor(
value, executionEnvironment.argv[i], errmsg, offset);
if (!shouldContinue(stat)) {
return stat;
@@ -225,7 +184,7 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
}
if (length && FitsInDescriptor(length, offset, terminator)) {
- StoreLengthToDescriptor(length, offset, terminator);
+ StoreIntToDescriptor(length, offset, terminator);
}
// value += spaces for padding
@@ -257,7 +216,7 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
// Store 0 in case we error out later on.
if (length) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
- StoreLengthToDescriptor(length, 0, terminator);
+ StoreIntToDescriptor(length, 0, terminator);
}
const char *rawValue{nullptr};
@@ -273,11 +232,11 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
std::int64_t varLen{StringLength(rawValue)};
if (length && FitsInDescriptor(length, varLen, terminator)) {
- StoreLengthToDescriptor(length, varLen, terminator);
+ StoreIntToDescriptor(length, varLen, terminator);
}
if (value) {
- return CopyToDescriptor(*value, rawValue, varLen, errmsg);
+ return CopyCharsToDescriptor(*value, rawValue, varLen, errmsg);
}
return StatOk;
}
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
new file mode 100644
index 00000000000000..48773ae8114b0b
--- /dev/null
+++ b/flang/runtime/execute.cpp
@@ -0,0 +1,206 @@
+//===-- runtime/execute.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/execute.h"
+#include "environment.h"
+#include "stat.h"
+#include "terminator.h"
+#include "tools.h"
+#include "flang/Runtime/descriptor.h"
+#include <cstdlib>
+#include <future>
+#include <limits>
+#ifdef _WIN32
+#define LEAN_AND_MEAN
+#define NOMINMAX
+#include <windows.h>
+#else
+#include <signal.h>
+#include <unistd.h>
+#endif
+
+namespace Fortran::runtime {
+
+// cmdstat specified in 16.9.73
+// −1 if the processor does not support command line execution,
+// a processor-dependent positive value if an error condition occurs
+// −2 if no error condition occurs but WAIT is present with the value false
+// and the processor does not support asynchronous execution. Otherwise it is
+// assigned the value 0
+enum CMD_STAT {
+ ASYNC_NO_SUPPORT_ERR = -2,
+ NO_SUPPORT_ERR = -1,
+ CMD_EXECUTED = 0,
+ FORK_ERR = 1,
+ EXECL_ERR = 2,
+ INVALID_CL_ERR = 3,
+ SIGNAL_ERR = 4
+};
+
+// Override CopyCharsToDescriptor in tools.h, pass string directly
+void CopyCharsToDescriptor(const Descriptor &value, const char *rawValue) {
+ CopyCharsToDescriptor(value, rawValue, std::strlen(rawValue));
+}
+
+void CheckAndCopyCharsToDescriptor(
+ const Descriptor *value, const char *rawValue) {
+ if (value) {
+ CopyCharsToDescriptor(*value, rawValue);
+ }
+}
+
+void CheckAndStoreIntToDescriptor(
+ const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
+ if (intVal) {
+ StoreIntToDescriptor(intVal, value, terminator);
+ }
+}
+
+// If a condition occurs that would assign a nonzero value to CMDSTAT but
+// the CMDSTAT variable is not present, error termination is initiated.
+int TerminationCheck(int status, const Descriptor *cmdstat,
+ const Descriptor *cmdmsg, Terminator &terminator) {
+ if (status == -1) {
+ if (!cmdstat) {
+ terminator.Crash("Execution error with system status code: %d", status);
+ } else {
+ CheckAndStoreIntToDescriptor(cmdstat, EXECL_ERR, terminator);
+ CopyCharsToDescriptor(*cmdmsg, "Execution error");
+ }
+ }
+#ifdef _WIN32
+ // On WIN32 API std::system returns exit status directly
+ int exitStatusVal{status};
+ if (exitStatusVal == 1) {
+#else
+ int exitStatusVal{WEXITSTATUS(status)};
+ if (exitStatusVal == 127 || exitStatusVal == 126) {
+#endif
+ if (!cmdstat) {
+ terminator.Crash(
+ "Invalid command quit with exit status code: %d", exitStatusVal);
+ } else {
+ CheckAndStoreIntToDescriptor(cmdstat, INVALID_CL_ERR, terminator);
+ CopyCharsToDescriptor(*cmdmsg, "Invalid command line");
+ }
+ }
+#if defined(WIFSIGNALED) && defined(WTERMSIG)
+ if (WIFSIGNALED(status)) {
+ if (!cmdstat) {
+ terminator.Crash("killed by signal: %d", WTERMSIG(status));
+ } else {
+ CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
+ CopyCharsToDescriptor(*cmdmsg, "killed by signal");
+ }
+ }
+#endif
+#if defined(WIFSTOPPED) && defined(WSTOPSIG)
+ if (WIFSTOPPED(status)) {
+ if (!cmdstat) {
+ terminator.Crash("stopped by signal: %d", WSTOPSIG(status));
+ } else {
+ CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
+ CopyCharsToDescriptor(*cmdmsg, "stopped by signal");
+ }
+ }
+#endif
+ return exitStatusVal;
+}
+
+void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
+ const Descriptor *exitstat, const Descriptor *cmdstat,
+ const Descriptor *cmdmsg, const char *sourceFile, int line) {
+ Terminator terminator{sourceFile, line};
+ const char *newCmd{EnsureNullTerminated(
+ command.OffsetElement(), command.ElementBytes(), terminator)};
+
+ if (exitstat) {
+ RUNTIME_CHECK(terminator, IsValidIntDescriptor(exitstat));
+ }
+
+ if (cmdstat) {
+ RUNTIME_CHECK(terminator, IsValidIntDescriptor(cmdstat));
+ // Assigned 0 as specifed in standard, if error then overwrite
+ StoreIntToDescriptor(cmdstat, CMD_EXECUTED, terminator);
+ }
+
+ if (cmdmsg) {
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(cmdmsg));
+ }
+
+ if (wait) {
+ // either wait is not specified or wait is true: synchronous mode
+ int status{std::system(newCmd)};
+ int exitStatusVal{TerminationCheck(status, cmdstat, cmdmsg, terminator)};
+ // If sync, assigned processor-dependent exit status. Otherwise unchanged
+ CheckAndStoreIntToDescriptor(exitstat, exitStatusVal, terminator);
+ } else {
+// Asynchronous mode
+#ifdef _WIN32
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+ ZeroMemory(&si, sizeof(si));
+ si.cb = sizeof(si);
+ ZeroMemory(&pi, sizeof(pi));
+
+ // add "cmd.exe /c " to the beginning of command
+ const char *prefix{"cmd.exe /c "};
+ char *newCmdWin{(char *)AllocateMemoryOrCrash(
+ terminator, std::strlen(prefix) + std::strlen(newCmd) + 1)};
+ std::strcpy(newCmdWin, prefix);
+ std::strcat(newCmdWin, newCmd);
+
+ // Convert the char to wide char
+ const size_t sizeNeeded{mbstowcs(NULL, newCmdWin, 0) + 1};
+ wchar_t *wcmd{(wchar_t *)AllocateMemoryOrCrash(
+ terminator, sizeNeeded * sizeof(wchar_t))};
+ if (std::mbstowcs(wcmd, newCmdWin, sizeNeeded) == static_cast<size_t>(-1)) {
+ terminator.Crash("Char to wide char failed for newCmd");
+ }
+ FreeMemory((void *)newCmdWin);
+
+ if (CreateProcess(nullptr, wcmd, nullptr, nullptr, FALSE, 0, nullptr,
+ nullptr, &si, &pi)) {
+ // Close handles so it will be removed when terminated
+ CloseHandle(pi.hProcess);
+ CloseHandle(pi.hThread);
+ } else {
+ if (!cmdstat) {
+ terminator.Crash(
+ "CreateProcess failed with error code: %lu.", GetLastError());
+ } else {
+ StoreIntToDescriptor(cmdstat, (uint32_t)GetLastError(), terminator);
+ CheckAndCopyCharsToDescriptor(cmdmsg, "CreateProcess failed.");
+ }
+ }
+ FreeMemory((void *)wcmd);
+#else
+ // terminated children do not become zombies
+ signal(SIGCHLD, SIG_IGN);
+ pid_t pid{fork()};
+ if (pid < 0) {
+ if (!cmdstat) {
+ terminator.Crash("Fork failed with pid: %d.", pid);
+ } else {
+ StoreIntToDescriptor(cmdstat, FORK_ERR, terminator);
+ CheckAndCopyCharsToDescriptor(cmdmsg, "Fork failed");
+ }
+ } else if (pid == 0) {
+ int status{std::system(newCmd)};
+ TerminationCheck(status, cmdstat, cmdmsg, terminator);
+ exit(status);
+ }
+#endif
+ }
+ // Deallocate memory if EnsureNullTerminated dynamically allocated memory
+ if (newCmd != command.OffsetElement()) {
+ FreeMemory((void *)newCmd);
+ }
+}
+
+} // namespace Fortran::runtime
diff --git a/flang/runtime/tools.cpp b/flang/runtime/tools.cpp
index b4e8f9bc890d53..6d2d86586c5fe6 100644
--- a/flang/runtime/tools.cpp
+++ b/flang/runtime/tools.cpp
@@ -173,5 +173,70 @@ RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from) {
ShallowCopy(to, from, to.IsContiguous(), from.IsContiguous());
}
+RT_API_ATTRS const char *EnsureNullTerminated(
+ const char *str, std::size_t length, Terminator &terminator) {
+ if (std::memchr(str, '\0', length) == nullptr) {
+ char *newCmd{(char *)AllocateMemoryOrCrash(terminator, length + 1)};
+ std::memcpy(newCmd, str, length);
+ newCmd[length] = '\0';
+ return newCmd;
+ } else {
+ return str;
+ }
+}
+
+RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value) {
+ return value && value->IsAllocated() &&
+ value->type() == TypeCode(TypeCategory::Character, 1) &&
+ value->rank() == 0;
+}
+
+RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *intVal) {
+ // Check that our descriptor is allocated and is a scalar integer with
+ // kind != 1 (i.e. with a large enough decimal exponent range).
+ return intVal && intVal->IsAllocated() && intVal->rank() == 0 &&
+ intVal->type().IsInteger() && intVal->type().GetCategoryAndKind() &&
+ intVal->type().GetCategoryAndKind()->second != 1;
+}
+
+RT_API_ATTRS std::int32_t CopyCharsToDescriptor(const Descriptor &value,
+ const char *rawValue, std::size_t rawValueLength, const Descriptor *errmsg,
+ std::size_t offset) {
+
+ const std::int64_t toCopy{std::min(static_cast<std::int64_t>(rawValueLength),
+ static_cast<std::int64_t>(value.ElementBytes() - offset))};
+ if (toCopy < 0) {
+ return ToErrmsg(errmsg, StatValueTooShort);
+ }
+
+ std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
+
+ if (static_cast<std::int64_t>(rawValueLength) > toCopy) {
+ return ToErrmsg(errmsg, StatValueTooShort);
+ }
+
+ return StatOk;
+}
+
+RT_API_ATTRS void StoreIntToDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator) {
+ auto typeCode{length->type().GetCategoryAndKind()};
+ int kind{typeCode->second};
+ ApplyIntegerKind<StoreIntegerAt, void>(
+ kind, terminator, *length, /* atIndex = */ 0, value);
+}
+
+template <int KIND> struct FitsInIntegerKind {
+ RT_API_ATTRS bool operator()([[maybe_unused]] std::int64_t value) {
+ if constexpr (KIND >= 8) {
+ return true;
+ } else {
+ return value <=
+ std::numeric_limits<
+ CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>>::max();
+ }
+ }
+};
+
RT_OFFLOAD_API_GROUP_END
} // namespace Fortran::runtime
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index d69079e43701d6..47398a910ce73d 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -10,6 +10,7 @@
#define FORTRAN_RUNTIME_TOOLS_H_
#include "freestanding-tools.h"
+#include "stat.h"
#include "terminator.h"
#include "flang/Runtime/cpp-type.h"
#include "flang/Runtime/descriptor.h"
@@ -436,6 +437,28 @@ RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from,
bool toIsContiguous, bool fromIsContiguous);
RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from);
+// Ensures that a character string is null-terminated, allocating a /p length +1
+// size memory for null-terminator if necessary. Returns the original or a newly
+// allocated null-terminated string (responsibility for deallocation is on the
+// caller).
+RT_API_ATTRS const char *EnsureNullTerminated(
+ const char *str, std::size_t length, Terminator &terminator);
+
+RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value);
+
+RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *intVal);
+
+// Copy a null-terminated character array \p rawValue to descriptor \p value.
+// The copy starts at the given \p offset, if not present then start at 0.
+// If descriptor `errmsg` is provided, error messages will be stored to it.
+// Returns stats specified in standard.
+RT_API_ATTRS std::int32_t CopyCharsToDescriptor(const Descriptor &value,
+ const char *rawValue, std::size_t rawValueLength,
+ const Descriptor *errmsg = nullptr, std::size_t offset = 0);
+
+RT_API_ATTRS void StoreIntToDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator);
+
// Defines a utility function for copying and padding characters
template <typename TO, typename FROM>
RT_API_ATTRS void CopyAndPad(
diff --git a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90 b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
new file mode 100644
index 00000000000000..e51c0e5fca3004
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
@@ -0,0 +1,51 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPall_args_optional(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command", fir.optional},
+! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "iswait", fir.optional},
+! CHECK-SAME: %[[exitstatArg:.*]]: !fir.ref<i32> {fir.bindc_name = "exitval", fir.optional},
+! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i32> {fir.bindc_name = "cmdval", fir.optional},
+! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "msg", fir.optional}) {
+subroutine all_args_optional(command, isWait, exitVal, cmdVal, msg)
+ CHARACTER(*), OPTIONAL :: command, msg
+ INTEGER, OPTIONAL :: exitVal, cmdVal
+ LOGICAL, OPTIONAL :: isWait
+ ! Note: command is not optional in execute_command_line and must be present
+ call execute_command_line(command, isWait, exitVal, cmdVal, msg)
+! CHECK: %[[cmdstatDeclare:.*]] = fir.declare %[[cmdstatArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEcmdval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandDeclare:.*]] = fir.declare %[[commandUnbox]]#0 typeparams %[[commandUnbox]]#1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEcommand"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>
+! CHECK-NEXT: %[[commandBoxTemp:.*]] = fir.emboxchar %[[commandDeclare]], %[[commandUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK-NEXT: %[[exitstatDeclare:.*]] = fir.declare %[[exitstatArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEexitval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %[[waitDeclare:.*]] = fir.declare %[[waitArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEiswait"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[cmdmsgDeclare:.*]] = fir.declare %[[cmdmsgUnbox]]#0 typeparams %[[cmdmsgUnbox]]#1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEmsg"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>
+! CHECK-NEXT: %[[cmdmsgBoxTemp:.*]] = fir.emboxchar %[[cmdmsgDeclare]], %[[cmdmsgUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK-NEXT: %[[waitIsPresent:.*]] = fir.is_present %[[waitDeclare]] : (!fir.ref<!fir.logical<4>>) -> i1
+! CHECK-NEXT: %[[exitstatIsPresent:.*]] = fir.is_present %[[exitstatDeclare]] : (!fir.ref<i32>) -> i1
+! CHECK-NEXT: %[[cmdstatIsPresent:.*]] = fir.is_present %[[cmdstatDeclare]] : (!fir.ref<i32>) -> i1
+! CHECK-NEXT: %[[cmdmsgIsPresent:.*]] = fir.is_present %[[cmdmsgBoxTemp]] : (!fir.boxchar<1>) -> i1
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclare]] typeparams %[[commandUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %[[waitLoaded:.*]] = fir.if %[[waitIsPresent]] -> (!fir.logical<4>) {
+! CHECK-NEXT: %[[VAL_31:.*]] = fir.load %[[waitDeclare]] : !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: fir.result %[[VAL_31]] : !fir.logical<4>
+! CHECK-NEXT: } else {
+! CHECK-NEXT: %[[VAL_31:.*]] = fir.convert %false : (i1) -> !fir.logical<4>
+! CHECK-NEXT: fir.result %[[VAL_31]] : !fir.logical<4>
+! CHECK-NEXT: }
+! CHECK-NEXT: %[[exitstatArgBox:.*]] = fir.embox %[[exitstatDeclare]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[absentBoxi32:.*]] = fir.absent !fir.box<i32>
+! CHECK-NEXT: %[[exitstatBox:.*]] = arith.select %[[exitstatIsPresent]], %[[exitstatArgBox]], %[[absentBoxi32]] : !fir.box<i32>
+! CHECK-NEXT: %[[cmdstatArgBox:.*]] = fir.embox %[[cmdstatDeclare]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[cmdstatBox:.*]] = arith.select %[[cmdstatIsPresent]], %[[cmdstatArgBox]], %[[absentBoxi32]] : !fir.box<i32>
+! CHECK-NEXT: %[[cmdmsgArgBox:.*]] = fir.embox %[[cmdmsgDeclare]] typeparams %[[cmdmsgUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %[[absentBox:.*]] = fir.absent !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %[[cmdmsgBox:.*]] = arith.select %[[cmdmsgIsPresent]], %[[cmdmsgArgBox]], %[[absentBox]] : !fir.box<!fir.char<1,?>>
+! CHECK: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitLoaded]] : (!fir.logical<4>) -> i1
+! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_30:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdstat]], %[[cmdmsg]], %[[VAL_29:.*]], %c14_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT: return
+end subroutine all_args_optional
diff --git a/flang/test/Lower/Intrinsics/execute_command_line.f90 b/flang/test/Lower/Intrinsics/execute_command_line.f90
new file mode 100644
index 00000000000000..1b65bbd5e1550c
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/execute_command_line.f90
@@ -0,0 +1,53 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPall_args(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command"},
+! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "iswait"},
+! CHECK-SAME: %[[exitstatArg:.*]]: !fir.ref<i32> {fir.bindc_name = "exitval"},
+! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i32> {fir.bindc_name = "cmdval"},
+! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "msg"}) {
+subroutine all_args(command, isWait, exitVal, cmdVal, msg)
+CHARACTER(30) :: command, msg
+INTEGER :: exitVal, cmdVal
+LOGICAL :: isWait
+call execute_command_line(command, isWait, exitVal, cmdVal, msg)
+! CHECK: %[[cmdstatsDeclear:.*]] = fir.declare %[[cmdstatArg]] {uniq_name = "_QFall_argsEcmdval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[commandDeclear:.*]] = fir.declare %[[commandCast]] typeparams %c30 {uniq_name = "_QFall_argsEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[exitstatDeclear:.*]] = fir.declare %[[exitstatArg]] {uniq_name = "_QFall_argsEexitval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %[[waitDeclear:.*]] = fir.declare %[[waitArg]] {uniq_name = "_QFall_argsEiswait"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[cmdmsgCast:.*]] = fir.convert %[[cmdmsgUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[cmdmsgDeclear:.*]] = fir.declare %[[cmdmsgCast]] typeparams %c30 {uniq_name = "_QFall_argsEmsg"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclear]] : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT: %[[waitLoaded:.*]] = fir.load %[[waitDeclear]] : !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %[[exitstatDeclear]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[cmdstatBox:.*]] = fir.embox %[[cmdstatsDeclear]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[cmdmsgBox:.*]] = fir.embox %[[cmdmsgDeclear]] : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitLoaded]] : (!fir.logical<4>) -> i1
+! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK: %[[VAL_21:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdstat]], %[[cmdmsg]], %[[VAL_20:.*]], %c13_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT: return
+end subroutine all_args
+
+! CHECK-LABEL: func.func @_QPonly_command_default_wait_true(
+! CHECK-SAME: %[[cmdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command"}) {
+subroutine only_command_default_wait_true(command)
+CHARACTER(30) :: command
+call execute_command_line(command)
+! CHECK-NEXT: %c41_i32 = arith.constant 41 : i32
+! CHECK-NEXT: %true = arith.constant true
+! CHECK-NEXT: %c30 = arith.constant 30 : index
+! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[cmdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[commandDeclare:.*]] = fir.declare %[[commandCast]] typeparams %c30 {uniq_name = "_QFonly_command_default_wait_trueEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclare]] : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT: %[[absent:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK: %[[VAL_21:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %true, %[[absent]], %[[absent]], %[[absent]], %[[VAL_7:.*]], %c41_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT: return
+end subroutine only_command_default_wait_true
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index dfc3ad68b3ab97..50b11d7fe8a0d5 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -10,6 +10,7 @@
#include "gmock/gmock.h"
#include "gtest/gtest.h"
#include "flang/Runtime/descriptor.h"
+#include "flang/Runtime/execute.h"
#include "flang/Runtime/extensions.h"
#include "flang/Runtime/main.h"
#include <cstddef>
@@ -52,6 +53,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[]) {
@@ -240,6 +252,102 @@ TEST_F(ZeroArguments, GetCommandArgument) {
TEST_F(ZeroArguments, GetCommand) { CheckCommandValue(commandOnlyArgv, 1); }
+TEST_F(ZeroArguments, ECLValidCommandAndPadSync) {
+ OwningPtr<Descriptor> command{CharDescriptor("echo hi")};
+ bool wait{true};
+ OwningPtr<Descriptor> exitStat{EmptyIntDescriptor()};
+ OwningPtr<Descriptor> cmdStat{EmptyIntDescriptor()};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
+
+ RTNAME(ExecuteCommandLine)
+ (*command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+
+ std::string spaces(cmdMsg->ElementBytes(), ' ');
+ CheckDescriptorEqInt(exitStat.get(), 0);
+ CheckDescriptorEqInt(cmdStat.get(), 0);
+ CheckDescriptorEqStr(cmdMsg.get(), "No change");
+}
+
+TEST_F(ZeroArguments, ECLValidCommandStatusSetSync) {
+ OwningPtr<Descriptor> command{CharDescriptor("echo hi")};
+ bool wait{true};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdStat{IntDescriptor(202)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
+
+ RTNAME(ExecuteCommandLine)
+ (*command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+
+ CheckDescriptorEqInt(exitStat.get(), 0);
+ CheckDescriptorEqInt(cmdStat.get(), 0);
+ CheckDescriptorEqStr(cmdMsg.get(), "No change");
+}
+
+TEST_F(ZeroArguments, ECLInvalidCommandErrorSync) {
+ OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
+ bool wait{true};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdStat{IntDescriptor(202)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("Message ChangedXXXXXXXXX")};
+
+ RTNAME(ExecuteCommandLine)
+ (*command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+#ifdef _WIN32
+ CheckDescriptorEqInt(exitStat.get(), 1);
+#else
+ CheckDescriptorEqInt(exitStat.get(), 127);
+#endif
+ CheckDescriptorEqInt(cmdStat.get(), 3);
+ CheckDescriptorEqStr(cmdMsg.get(), "Invalid command lineXXXX");
+}
+
+TEST_F(ZeroArguments, ECLInvalidCommandTerminatedSync) {
+ OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
+ bool wait{true};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No Change")};
+
+#ifdef _WIN32
+ EXPECT_DEATH(RTNAME(ExecuteCommandLine)(
+ *command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
+ "Invalid command quit with exit status code: 1");
+#else
+ EXPECT_DEATH(RTNAME(ExecuteCommandLine)(
+ *command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
+ "Invalid command quit with exit status code: 127");
+#endif
+ CheckDescriptorEqInt(exitStat.get(), 404);
+ CheckDescriptorEqStr(cmdMsg.get(), "No Change");
+}
+
+TEST_F(ZeroArguments, ECLValidCommandAndExitStatNoChangeAndCMDStatusSetAsync) {
+ OwningPtr<Descriptor> command{CharDescriptor("echo hi")};
+ bool wait{false};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdStat{IntDescriptor(202)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
+
+ RTNAME(ExecuteCommandLine)
+ (*command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+
+ CheckDescriptorEqInt(exitStat.get(), 404);
+ CheckDescriptorEqInt(cmdStat.get(), 0);
+ CheckDescriptorEqStr(cmdMsg.get(), "No change");
+}
+
+TEST_F(ZeroArguments, ECLInvalidCommandParentNotTerminatedAsync) {
+ OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
+ bool wait{false};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
+
+ EXPECT_NO_FATAL_FAILURE(RTNAME(ExecuteCommandLine)(
+ *command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()));
+
+ CheckDescriptorEqInt(exitStat.get(), 404);
+ CheckDescriptorEqStr(cmdMsg.get(), "No change");
+}
+
static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"};
class OneArgument : public CommandFixture {
protected:
More information about the flang-commits
mailing list