diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index e83d1a42e3413..19c623cc1ec00 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -395,7 +395,8 @@ struct IntrinsicLibrary { fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef); void genSignalSubroutine(llvm::ArrayRef); void genSleep(llvm::ArrayRef); - void genSystem(mlir::ArrayRef args); + fir::ExtendedValue genSystem(std::optional, + 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 1e27c0ae4216c..f9096a8e3f110 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -884,6 +884,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ IntrinsicClass::transformationalFunction}, {"sum", {{"array", SameNumeric, Rank::array}, MissingDIM, OptionalMASK}, SameNumeric, Rank::scalar, IntrinsicClass::transformationalFunction}, + {"system", {{"command", DefaultChar, Rank::scalar}}, DefaultInt, + Rank::scalar}, {"tan", {{"x", SameFloating}}, SameFloating}, {"tand", {{"x", SameFloating}}, SameFloating}, {"tanh", {{"x", SameFloating}}, SameFloating}, @@ -2640,7 +2642,7 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic( // Collection for some intrinsics with function and subroutine form, // in order to pass the semantic check. static const std::string dualIntrinsic[]{ - {"etime"s}, {"getcwd"s}, {"rename"s}, {"second"s}}; + {"etime"s}, {"getcwd"s}, {"rename"s}, {"second"s}, {"system"s}}; return llvm::is_contained(dualIntrinsic, name); } diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index a2b327f45c693..08ca71699396f 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -7280,12 +7280,22 @@ IntrinsicLibrary::genSum(mlir::Type resultType, } // SYSTEM -void IntrinsicLibrary::genSystem(llvm::ArrayRef args) { - assert(args.size() == 2); +fir::ExtendedValue +IntrinsicLibrary::genSystem(std::optional resultType, + llvm::ArrayRef args) { + assert((!resultType && (args.size() == 2)) || + (resultType && (args.size() == 1))); mlir::Value command = fir::getBase(args[0]); - const fir::ExtendedValue &exitstat = args[1]; assert(command && "expected COMMAND parameter"); + fir::ExtendedValue exitstat; + if (resultType) { + mlir::Value tmp = builder.createTemporary(loc, *resultType); + exitstat = builder.createBox(loc, tmp); + } else { + exitstat = args[1]; + } + mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); mlir::Value waitBool = builder.createBool(loc, true); @@ -7307,6 +7317,12 @@ void IntrinsicLibrary::genSystem(llvm::ArrayRef args) { fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool, exitstatBox, cmdstatBox, cmdmsgBox); + + if (resultType) { + mlir::Value exitstatAddr = builder.create(loc, exitstatBox); + return builder.create(loc, fir::getBase(exitstatAddr)); + } + return {}; } // SYSTEM_CLOCK diff --git a/flang/test/Lower/Intrinsics/system.f90 b/flang/test/Lower/Intrinsics/system.f90 index 71655938113f7..87ac8d9c7e6f9 100644 --- a/flang/test/Lower/Intrinsics/system.f90 +++ b/flang/test/Lower/Intrinsics/system.f90 @@ -51,3 +51,35 @@ subroutine only_command(command) ! CHECK-NEXT: return ! CHECK-NEXT: } end subroutine only_command + +! CHECK-LABEL: func.func @_QPas_function( +! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command"} +subroutine as_function(command) +CHARACTER(*) :: command +INTEGER :: exitstat +exitstat = system(command) +end subroutine +! CHECK-NEXT: %[[cmdstatVal:.*]] = fir.alloca i16 +! CHECK-NEXT: %[[RETVAL:.*]] = fir.alloca i32 +! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope +! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[commandDeclare:.*]]:2 = hlfir.declare %[[commandUnbox]]#0 typeparams %[[commandUnbox]]#1 dummy_scope %[[DSCOPE]] {uniq_name = "_QFas_functionEcommand"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK-NEXT: %[[EXITSTAT_ALLOC:.*]] = fir.alloca i32 +! CHECK-NEXT: %[[exitstatDeclare:.*]]:2 = hlfir.declare %[[EXITSTAT_ALLOC]] {uniq_name = "_QFas_functionEexitstat"} : (!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 %[[RETVAL]] : (!fir.ref) -> !fir.box +! CHECK-NEXT: %[[true:.*]] = arith.constant true +! CHECK-NEXT: %[[c0_i16:.*]] = arith.constant 0 : 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: %[[LINE_NO:.*]] = arith.constant {{.*}} : 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:.*]], %[[LINE_NO]]) fastmath : (!fir.box, i1, !fir.box, !fir.box, !fir.box, !fir.ref, i32) -> none +! CHECK-NEXT: %[[RET_ADDR:.*]] = fir.box_addr %[[exitstatBox]] : (!fir.box) -> !fir.ref +! CHECK-NEXT: %[[RET:.*]] = fir.load %[[RET_ADDR]] : !fir.ref +! CHECK-NEXT: hlfir.assign %[[RET]] to %[[exitstatDeclare]]#0 : i32, !fir.ref +! CHECK-NEXT: return +! CHECK-NEXT: }