[flang] Support lowering of intrinsic GET_COMMAND

[peixin]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

Thanks for implementing this!

[jeanPerier]

LGTM, thanks

[peixin]

Rebase to fix the FIR FileCheck fail caused by fastmath problem.

flang/include/flang/Optimizer/Builder/Runtime/Command.h

 /// 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

flang/lib/Lower/IntrinsicCall.cpp

   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>);

     {"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},

       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) {

flang/lib/Optimizer/Builder/Runtime/Command.cpp

   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) {

flang/test/Lower/Intrinsics/get_command.f90

+! 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