diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index ff79765375212..55d06ab8995ae 100644 --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -757,7 +757,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, SIGNAL, SLEEP, 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, SIGNAL, SLEEP, SYSTEM, SYSTEM_CLOCK | | Atomic intrinsic subroutines | ATOMIC_ADD | | Collective intrinsic subroutines | CO_REDUCE | | Library subroutines | FDATE, GETLOG | diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index a2d2f4ccad048..8149cdd383ae6 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -343,6 +343,7 @@ struct IntrinsicLibrary { fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef); void genSignalSubroutine(llvm::ArrayRef); void genSleep(llvm::ArrayRef); + void genSystem(mlir::ArrayRef args); void genSystemClock(llvm::ArrayRef); mlir::Value genTand(mlir::Type, llvm::ArrayRef); mlir::Value genTrailz(mlir::Type, llvm::ArrayRef); diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 10e66d7d8ae7b..d822413df77f0 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1396,6 +1396,11 @@ static const IntrinsicInterface intrinsicSubroutine[]{ {"get", DefaultInt, Rank::vector, Optionality::optional, common::Intent::Out}}, {}, Rank::elemental, IntrinsicClass::impureSubroutine}, + {"system", + {{"command", DefaultChar, Rank::scalar}, + {"exitstat", DefaultInt, Rank::scalar, Optionality::optional, + common::Intent::Out}}, + {}, Rank::elemental, IntrinsicClass::impureSubroutine}, {"system_clock", {{"count", AnyInt, Rank::scalar, Optionality::optional, common::Intent::Out}, diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index b4ac7f5bd52b8..a9edabf014faf 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -578,6 +578,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}}}, @@ -5966,6 +5970,38 @@ IntrinsicLibrary::genSum(mlir::Type resultType, resultType, args); } +// SYSTEM +void IntrinsicLibrary::genSystem(llvm::ArrayRef args) { + assert(args.size() == 2); + mlir::Value command = fir::getBase(args[0]); + const fir::ExtendedValue &exitstat = args[1]; + assert(command && "expected COMMAND parameter"); + + mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); + + mlir::Value waitBool = builder.createBool(loc, true); + mlir::Value exitstatBox = + isStaticallyPresent(exitstat) + ? fir::getBase(exitstat) + : builder.create(loc, boxNoneTy).getResult(); + + // Create a dummmy cmdstat to prevent EXECUTE_COMMAND_LINE terminate itself + // when cmdstat is assigned with a non-zero value but not present + mlir::Value tempValue = + builder.createIntegerConstant(loc, builder.getI2Type(), 0); + mlir::Value temp = builder.createTemporary(loc, builder.getI16Type()); + mlir::Value castVal = + builder.createConvert(loc, builder.getI16Type(), tempValue); + builder.create(loc, castVal, temp); + mlir::Value cmdstatBox = builder.createBox(loc, temp); + + mlir::Value cmdmsgBox = + builder.create(loc, boxNoneTy).getResult(); + + fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool, + exitstatBox, cmdstatBox, cmdmsgBox); +} + // SYSTEM_CLOCK void IntrinsicLibrary::genSystemClock(llvm::ArrayRef args) { assert(args.size() == 3); diff --git a/flang/test/Lower/Intrinsics/system-optional.f90 b/flang/test/Lower/Intrinsics/system-optional.f90 new file mode 100644 index 0000000000000..5047437c5c3ca --- /dev/null +++ b/flang/test/Lower/Intrinsics/system-optional.f90 @@ -0,0 +1,34 @@ +! RUN: bbc -emit-hlfir %s -o - | FileCheck %s + +! CHECK-LABEL: func.func @_QPall_args( +! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command", fir.optional}, +! CHECK-SAME: %[[exitstatArg:.*]]: !fir.ref {fir.bindc_name = "exitstat", fir.optional}) { +subroutine all_args(command, exitstat) +CHARACTER(*), OPTIONAL :: command +INTEGER, OPTIONAL :: exitstat +call system(command, exitstat) + +! CHECK-NEXT: %[[cmdstatVal:.*]] = fir.alloca i16 +! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[commandDeclare:.*]]:2 = hlfir.declare %[[commandUnbox]]#0 typeparams %[[commandUnbox]]#1 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFall_argsEcommand"} : (!fir.ref>, index) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK-NEXT: %[[exitstatDeclare:.*]]:2 = hlfir.declare %[[exitstatArg]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFall_argsEexitstat"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK-NEXT: %[[exitstatIsPresent:.*]] = fir.is_present %[[exitstatDeclare]]#0 : (!fir.ref) -> i1 +! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclare]]#1 typeparams %[[commandUnbox]]#1 : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %[[exitstatDeclare]]#1 : (!fir.ref) -> !fir.box +! CHECK-NEXT: %[[absentIntBox:.*]] = fir.absent !fir.box +! CHECK-NEXT: %[[exitstatRealBox:.*]] = arith.select %[[exitstatIsPresent]], %[[exitstatBox]], %[[absentIntBox]] : !fir.box +! CHECK-NEXT: %[[true:.*]] = arith.constant true +! CHECK-NEXT: %[[c0_i2:.*]] = arith.constant 0 : i2 +! CHECK-NEXT: %[[c0_i16:.*]] = fir.convert %[[c0_i2]] : (i2) -> i16 +! CHECK-NEXT: fir.store %[[c0_i16]] to %[[cmdstatVal]] : !fir.ref +! CHECK-NEXT: %[[cmdstatBox:.*]] = fir.embox %[[cmdstatVal]] : (!fir.ref) -> !fir.box +! CHECK-NEXT: %[[absentBox:.*]] = fir.absent !fir.box +! CHECK: %[[c9_i32:.*]] = arith.constant 9 : i32 +! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatRealBox]] : (!fir.box) -> !fir.box +! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box) -> !fir.box +! CHECK: %[[VAL_16:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[true]], %[[exitstat]], %[[cmdstat]], %[[absentBox]], %[[VAL_15:.*]], %[[c9_i32]]) fastmath : (!fir.box, i1, !fir.box, !fir.box, !fir.box, !fir.ref, i32) -> none +! CHECK-NEXT: return +! CHECK-NEXT: } + +end subroutine all_args diff --git a/flang/test/Lower/Intrinsics/system.f90 b/flang/test/Lower/Intrinsics/system.f90 new file mode 100644 index 0000000000000..0cafc0b2a9cf1 --- /dev/null +++ b/flang/test/Lower/Intrinsics/system.f90 @@ -0,0 +1,53 @@ +! RUN: bbc -emit-hlfir %s -o - | FileCheck %s + +! CHECK-LABEL: func.func @_QPall_args( +! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command"}, +! CHECK-SAME: %[[exitstatArg:.*]]: !fir.ref {fir.bindc_name = "exitstat"}) { +subroutine all_args(command, exitstat) +CHARACTER(*) :: command +INTEGER :: exitstat +call system(command, exitstat) +! CHECK-NEXT: %[[cmdstatVal:.*]] = fir.alloca i16 +! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[commandDeclare:.*]]:2 = hlfir.declare %[[commandUnbox]]#0 typeparams %[[commandUnbox]]#1 {uniq_name = "_QFall_argsEcommand"} : (!fir.ref>, index) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK-NEXT: %[[exitstatDeclare:.*]]:2 = hlfir.declare %[[exitstatArg]] {uniq_name = "_QFall_argsEexitstat"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclare]]#1 typeparams %[[commandUnbox]]#1 : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %[[exitstatDeclare]]#1 : (!fir.ref) -> !fir.box +! CHECK-NEXT: %[[true:.*]] = arith.constant true +! CHECK-NEXT: %[[c0_i2:.*]] = arith.constant 0 : i2 +! CHECK-NEXT: %[[c0_i16:.*]] = fir.convert %[[c0_i2]] : (i2) -> i16 +! CHECK-NEXT: fir.store %[[c0_i16]] to %[[cmdstatVal]] : !fir.ref +! CHECK-NEXT: %[[cmdstatBox:.*]] = fir.embox %[[cmdstatVal]] : (!fir.ref) -> !fir.box +! CHECK-NEXT: %[[absentBox:.*]] = fir.absent !fir.box +! CHECK: %[[c9_i32:.*]] = arith.constant 9 : i32 +! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box) -> !fir.box +! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box) -> !fir.box +! CHECK: %[[VAL_13:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[true]], %[[exitstat]], %[[cmdstat]], %[[absentBox]], %[[VAL_12:.*]], %[[c9_i32]]) fastmath : (!fir.box, i1, !fir.box, !fir.box, !fir.box, !fir.ref, i32) -> none +! CHECK-NEXT: return +! CHECK-NEXT: } +end subroutine all_args + +! CHECK-LABEL: func.func @_QPonly_command( +! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command"}) { +subroutine only_command(command) +CHARACTER(*) :: command +call system(command) +! CHECK-NEXT: %[[cmdstatVal:.*]] = fir.alloca i16 +! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[commandDeclare:.*]]:2 = hlfir.declare %[[commandUnbox]]#0 typeparams %[[commandUnbox]]#1 {uniq_name = "_QFonly_commandEcommand"} : (!fir.ref>, index) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclare]]#1 typeparams %[[commandUnbox]]#1 : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[true:.*]] = arith.constant true +! CHECK-NEXT: %[[absentBox:.*]] = fir.absent !fir.box +! CHECK-NEXT: %[[c0_i2:.*]] = arith.constant 0 : i2 +! CHECK-NEXT: %[[c0_i16:.*]] = fir.convert %[[c0_i2]] : (i2) -> i16 +! CHECK-NEXT: fir.store %[[c0_i16]] to %[[cmdstatVal]] : !fir.ref +! CHECK-NEXT: %[[cmdstatBox:.*]] = fir.embox %[[cmdstatVal]] : (!fir.ref) -> !fir.box +! CHECK-NEXT: %[[absentBox2:.*]] = fir.absent !fir.box +! CHECK: %[[c35_i32:.*]] = arith.constant 35 : i32 +! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box) -> !fir.box +! CHECK: %[[VAL_12:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[true]], %[[absentBox]], %[[cmdstat]], %[[absentBox2]], %[[VAL_11:.*]], %[[c35_i32]]) fastmath : (!fir.box, i1, !fir.box, !fir.box, !fir.box, !fir.ref, i32) -> none +! CHECK-NEXT: return +! CHECK-NEXT: } +end subroutine only_command diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp index b2f6fe6177ed5..08daa4ba37f26 100644 --- a/flang/unittests/Runtime/CommandTest.cpp +++ b/flang/unittests/Runtime/CommandTest.cpp @@ -422,6 +422,60 @@ TEST_F(ZeroArguments, ECLInvalidCommandAsyncDontAffectAsync) { *command.get(), false, nullptr, nullptr, nullptr)); } +TEST_F(ZeroArguments, SystemValidCommandExitStat) { + // envrionment setup for SYSTEM from EXECUTE_COMMAND_LINE runtime + OwningPtr cmdStat{IntDescriptor(202)}; + bool wait{true}; + // setup finished + + OwningPtr command{CharDescriptor("echo hi")}; + OwningPtr exitStat{EmptyIntDescriptor()}; + + RTNAME(ExecuteCommandLine) + (*command.get(), wait, exitStat.get(), cmdStat.get(), nullptr); + CheckDescriptorEqInt(exitStat.get(), 0); +} + +TEST_F(ZeroArguments, SystemInvalidCommandExitStat) { + // envrionment setup for SYSTEM from EXECUTE_COMMAND_LINE runtime + OwningPtr cmdStat{IntDescriptor(202)}; + bool wait{true}; + // setup finished + + OwningPtr command{CharDescriptor("InvalidCommand")}; + OwningPtr exitStat{EmptyIntDescriptor()}; + + RTNAME(ExecuteCommandLine) + (*command.get(), wait, exitStat.get(), cmdStat.get(), nullptr); +#ifdef _WIN32 + CheckDescriptorEqInt(exitStat.get(), 1); +#else + CheckDescriptorEqInt(exitStat.get(), 127); +#endif +} + +TEST_F(ZeroArguments, SystemValidCommandOptionalExitStat) { + // envrionment setup for SYSTEM from EXECUTE_COMMAND_LINE runtime + OwningPtr cmdStat{IntDescriptor(202)}; + bool wait{true}; + // setup finished + + OwningPtr command{CharDescriptor("echo hi")}; + EXPECT_NO_FATAL_FAILURE(RTNAME(ExecuteCommandLine)( + *command.get(), wait, nullptr, cmdStat.get(), nullptr)); +} + +TEST_F(ZeroArguments, SystemInvalidCommandOptionalExitStat) { + // envrionment setup for SYSTEM from EXECUTE_COMMAND_LINE runtime + OwningPtr cmdStat{IntDescriptor(202)}; + bool wait{true}; + // setup finished + + OwningPtr command{CharDescriptor("InvalidCommand")}; + EXPECT_NO_FATAL_FAILURE(RTNAME(ExecuteCommandLine)( + *command.get(), wait, nullptr, cmdStat.get(), nullptr);); +} + static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"}; class OneArgument : public CommandFixture { protected: