[flang-commits] [flang] [flang] GETLOG runtime and extension implementation: get login username (PR #74628)
via flang-commits
flang-commits at lists.llvm.org
Thu Dec 7 06:28:16 PST 2023
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Yi Wu (yi-wu-arm)
<details>
<summary>Changes</summary>
Get login username, ussage:
```
CHARACTER(32) :: login
CALL getlog(login)
WRITE(*,*) login
```
getlog is required for an exascale proxyapp.
https://proxyapps.exascaleproject.org/app/minismac2d/
https://github.com/Mantevo/miniSMAC/blob/f90446714226eeef650b78bce06ca4967792e74d/ref/smac2d.f#L615
https://github.com/Mantevo/miniSMAC/blob/f90446714226eeef650b78bce06ca4967792e74d/ref/smac2d.f#L1570
---
Full diff: https://github.com/llvm/llvm-project/pull/74628.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 (+6-1)
- (modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+22)
- (modified) flang/lib/Optimizer/Builder/Runtime/Command.cpp (+13)
- (modified) flang/runtime/command.cpp (+36)
- (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 fef2b4ea4dd8c8..871332399628e9 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 5065f11ae9e726..669d076c3e0e7d 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 976fb3aa0b6fbb..9d6a39639844fc 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 c67d171c8e2f1b..e477a2da1c5954 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,
+ 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 c5faf319fafb7d..98dd2b27a08ebf 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},
@@ -2937,7 +2942,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,
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 24fdbe97856b3a..8fded510a18012 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 1d719e7bbd9a2d..00af35a74bf871 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 8e6135b5487c05..709e1cb4904611 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -282,4 +282,40 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
return StatOk;
}
+const char *ensureNullTerminated(
+ const char *str, size_t length, Terminator &terminator) {
+ if (length < strlen(str)) {
+ char *newCmd{(char *)malloc(length + 1)};
+ if (newCmd == NULL) {
+ terminator.Crash("Command not null-terminated, memory allocation failed "
+ "for null-terminated newCmd.");
+ }
+
+ strncpy(newCmd, str, length);
+ newCmd[length] = '\0';
+ return newCmd;
+ } else {
+ return str;
+ }
+}
+
+void RTNAME(System)(const Descriptor &command, const Descriptor *exitstat,
+ const char *sourceFile, int line) {
+ Terminator terminator{sourceFile, line};
+
+ const char *newCmd{ensureNullTerminated(
+ command.OffsetElement(), command.ElementBytes(), terminator)};
+ int status{std::system(newCmd)};
+
+ 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 00000000000000..0c3e5fd63047c6
--- /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 9f66c7924c86e3..466e64cf65299e 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/74628
More information about the flang-commits
mailing list