[flang] Support lowering of intrinsic GET_COMMAND

As Fortran 2018 16.9.82, all the arguments of GET_COMMAND are optional.
When they are all absent, do nothing so to be consistent with gfortran
and ifort. The semantic analysis and runtime have been supported.

This intrinsic was introduced from F2003, and this supports the lowering
of it.

Reviewed By: PeteSteinfeld, jeanPerier

Differential Revision: https://reviews.llvm.org/D137887

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 7df67c1..d94bac4 100644 (file)
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -23,6 +23,14 @@ namespace fir::runtime {
 /// Generate call to COMMAND_ARGUMENT_COUNT intrinsic runtime routine.
 mlir::Value genCommandArgumentCount(fir::FirOpBuilder &, mlir::Location);
 
+/// Generate a call to the GetCommand runtime function which implements the
+/// GET_COMMAND intrinsic.
+/// \p command, \p length and \p errmsg must be fir.box that can be absent (but
+/// not null mlir values). The status value is returned.
+mlir::Value genGetCommand(fir::FirOpBuilder &, mlir::Location,
+                          mlir::Value command, mlir::Value length,
+                          mlir::Value errmsg);
+
 /// Generate a call to the GetCommandArgument runtime function which implements
 /// the GET_COMMAND_ARGUMENT intrinsic.
 /// \p value, \p length and \p errmsg must be fir.box that can be absent (but

diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 87f144d..2401dbb 100644 (file)
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -505,6 +505,7 @@ struct IntrinsicLibrary {
   mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genFraction(mlir::Type resultType,
                           mlir::ArrayRef<mlir::Value> args);
+  void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetCommandArgument(mlir::ArrayRef<fir::ExtendedValue> args);
   void genGetEnvironmentVariable(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genIall(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -802,6 +803,13 @@ static constexpr IntrinsicHandler handlers[]{
     {"exponent", &I::genExponent},
     {"floor", &I::genFloor},
     {"fraction", &I::genFraction},
+    {"get_command",
+     &I::genGetCommand,
+     {{{"command", asBox, handleDynamicOptional},
+       {"length", asBox, handleDynamicOptional},
+       {"status", asAddr, handleDynamicOptional},
+       {"errmsg", asBox, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"get_command_argument",
      &I::genGetCommandArgument,
      {{{"number", asValue},
@@ -3188,6 +3196,44 @@ mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
       fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
 }
 
+// GET_COMMAND
+void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 4);
+  const fir::ExtendedValue &command = args[0];
+  const fir::ExtendedValue &length = args[1];
+  const fir::ExtendedValue &status = args[2];
+  const fir::ExtendedValue &errmsg = args[3];
+
+  // If none of the optional parameters are present, do nothing.
+  if (!isStaticallyPresent(command) && !isStaticallyPresent(length) &&
+      !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
+    return;
+
+  mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+  mlir::Value commandBox =
+      isStaticallyPresent(command)
+          ? fir::getBase(command)
+          : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+  mlir::Value lenBox =
+      isStaticallyPresent(length)
+          ? fir::getBase(length)
+          : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+  mlir::Value errBox =
+      isStaticallyPresent(errmsg)
+          ? fir::getBase(errmsg)
+          : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+  mlir::Value stat =
+      fir::runtime::genGetCommand(builder, loc, commandBox, lenBox, errBox);
+  if (isStaticallyPresent(status)) {
+    mlir::Value statAddr = fir::getBase(status);
+    mlir::Value statIsPresentAtRuntime =
+        builder.genIsNotNullAddr(loc, statAddr);
+    builder.genIfThen(loc, statIsPresentAtRuntime)
+        .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
+        .end();
+  }
+}
+
 // GET_COMMAND_ARGUMENT
 void IntrinsicLibrary::genGetCommandArgument(
     llvm::ArrayRef<fir::ExtendedValue> args) {

diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index 6227013..fe848ee 100644 (file)
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -32,6 +32,22 @@ mlir::Value fir::runtime::genCommandArgumentCount(fir::FirOpBuilder &builder,
   return builder.create<fir::CallOp>(loc, argumentCountFunc).getResult(0);
 }
 
+mlir::Value fir::runtime::genGetCommand(fir::FirOpBuilder &builder,
+                                        mlir::Location loc, mlir::Value command,
+                                        mlir::Value length,
+                                        mlir::Value errmsg) {
+  auto runtimeFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(GetCommand)>(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(4));
+  llvm::SmallVector<mlir::Value> args =
+      fir::runtime::createArguments(builder, loc, runtimeFuncTy, command,
+                                    length, errmsg, sourceFile, sourceLine);
+  return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
+}
+
 mlir::Value fir::runtime::genGetCommandArgument(
     fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value number,
     mlir::Value value, mlir::Value length, mlir::Value errmsg) {

diff --git a/flang/test/Lower/Intrinsics/get_command.f90 b/flang/test/Lower/Intrinsics/get_command.f90
new file mode 100644 (file)
index 0000000..3816706
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/get_command.f90
@@ -0,0 +1,123 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPcommand_only() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFcommand_onlyEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_2:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_8:.*]] = fir.call @_FortranAGetCommand(%[[VAL_6]], %[[VAL_2]], %[[VAL_3]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         return
+! CHECK:       }
+
+subroutine command_only()
+  character(10) :: cmd
+  call get_command(cmd)
+end
+
+! CHECK-LABEL: func.func @_QPlength_only() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca i32 {bindc_name = "len", uniq_name = "_QFlength_onlyElen"}
+! CHECK:         %[[VAL_1:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_2:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_1]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK:         %[[VAL_8:.*]] = fir.call @_FortranAGetCommand(%[[VAL_2]], %[[VAL_6]], %[[VAL_3]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         return
+! CHECK:       }
+
+subroutine length_only()
+  integer :: len
+  call get_command(length=len)
+end
+
+! CHECK-LABEL: func.func @_QPstatus_only() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFstatus_onlyEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFstatus_onlyEstat"}
+! CHECK:         %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_4:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_9:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_11:.*]] = arith.constant 0 : i64
+! CHECK:         %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64
+! CHECK:         fir.if %[[VAL_12]] {
+! CHECK:           fir.store %[[VAL_9]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         }
+! CHECK:         return
+! CHECK:       }
+
+subroutine status_only()
+  character(10) :: cmd
+  integer :: stat
+  call get_command(cmd, status=stat)
+end
+
+! CHECK-LABEL: func.func @_QPerrmsg_only() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFerrmsg_onlyEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.char<1,50> {bindc_name = "err", uniq_name = "_QFerrmsg_onlyEerr"}
+! CHECK:         %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_3:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.char<1,50>>) -> !fir.box<!fir.char<1,50>>
+! CHECK:         %[[VAL_4:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.char<1,50>>) -> !fir.box<none>
+! CHECK:         %[[VAL_10:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_4]], %[[VAL_8]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         return
+! CHECK:       }
+
+subroutine errmsg_only()
+  character(10) :: cmd
+  character(50) :: err
+  call get_command(cmd, errmsg=err)
+end
+
+! CHECK-LABEL: func.func @_QPcommand_status() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFcommand_statusEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFcommand_statusEstat"}
+! CHECK:         %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_3:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_4:.*]] = fir.absent !fir.box<none>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_9:.*]] = fir.call @_FortranAGetCommand(%[[VAL_7]], %[[VAL_3]], %[[VAL_4]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_11:.*]] = arith.constant 0 : i64
+! CHECK:         %[[VAL_12:.*]] = arith.cmpi ne, %[[VAL_10]], %[[VAL_11]] : i64
+! CHECK:         fir.if %[[VAL_12]] {
+! CHECK:           fir.store %[[VAL_9]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         }
+! CHECK:         return
+! CHECK:       }
+
+subroutine command_status()
+  character(10) :: cmd
+  integer :: stat
+  call get_command(cmd, status=stat)
+end
+
+! CHECK-LABEL: func.func @_QPall_args() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.char<1,10> {bindc_name = "cmd", uniq_name = "_QFall_argsEcmd"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.char<1,50> {bindc_name = "err", uniq_name = "_QFall_argsEerr"}
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {bindc_name = "len", uniq_name = "_QFall_argsElen"}
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i32 {bindc_name = "stat", uniq_name = "_QFall_argsEstat"}
+! CHECK:         %[[VAL_4:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.char<1,10>>
+! CHECK:         %[[VAL_5:.*]] = fir.embox %[[VAL_2]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_6:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.char<1,50>>) -> !fir.box<!fir.char<1,50>>
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_4]] : (!fir.box<!fir.char<1,10>>) -> !fir.box<none>
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_5]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.char<1,50>>) -> !fir.box<none>
+! CHECK:         %[[VAL_13:.*]] = fir.call @_FortranAGetCommand(%[[VAL_9]], %[[VAL_10]], %[[VAL_11]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_15:.*]] = arith.constant 0 : i64
+! CHECK:         %[[VAL_16:.*]] = arith.cmpi ne, %[[VAL_14]], %[[VAL_15]] : i64
+! CHECK:         fir.if %[[VAL_16]] {
+! CHECK:           fir.store %[[VAL_13]] to %[[VAL_3]] : !fir.ref<i32>
+! CHECK:         }
+! CHECK:         return
+! CHECK:       }
+
+subroutine all_args()
+  character(10) :: cmd
+  character(50) :: err
+  integer :: len, stat
+  call get_command(cmd, len, stat, err)
+end