[flang] Lower character related intrinsics

[clementval]

Summary

This patch adds lowering for some character related
intrinsics:

• scan
• verify

This patch is part of the upstreaming effort from fir-dev branch.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
   void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genSetExponent(mlir::Type resultType,
                              llvm::ArrayRef<mlir::Value> args);
   fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genSystemClock(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genTransfer(mlir::Type,
                                  llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genVerify(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
 
   /// Define the different FIR generators that can be mapped to intrinsic to
   /// generate the related code.
   using ElementalGenerator = decltype(&IntrinsicLibrary::genAbs);
   using ExtendedGenerator = decltype(&IntrinsicLibrary::genSum);
   using SubroutineGenerator = decltype(&IntrinsicLibrary::genRandomInit);
   using Generator =
       std::variant<ElementalGenerator, ExtendedGenerator, SubroutineGenerator>;
static constexpr IntrinsicHandler handlers[]{
     {"random_number",
      &I::genRandomNumber,
      {{{"harvest", asBox}}},
      /*isElemental=*/false},
     {"random_seed",
      &I::genRandomSeed,
      {{{"size", asBox}, {"put", asBox}, {"get", asBox}}},
      /*isElemental=*/false},
+    {"scan",
+     &I::genScan,
+     {{{"string", asAddr},
+       {"set", asAddr},
+       {"back", asValue, handleDynamicOptional},
+       {"kind", asValue}}},
+     /*isElemental=*/true},
     {"set_exponent", &I::genSetExponent},
     {"size",
      &I::genSize,
      {{{"array", asBox},
        {"dim", asAddr, handleDynamicOptional},
        {"kind", asValue}}},
      /*isElemental=*/false},
     {"sum",
static constexpr IntrinsicHandler handlers[]{
     {"transfer",
      &I::genTransfer,
      {{{"source", asAddr}, {"mold", asAddr}, {"size", asValue}}},
      /*isElemental=*/false},
     {"ubound",
      &I::genUbound,
      {{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
      /*isElemental=*/false},
+    {"verify",
+     &I::genVerify,
+     {{{"string", asAddr},
+       {"set", asAddr},
+       {"back", asValue, handleDynamicOptional},
+       {"kind", asValue}}},
+     /*isElemental=*/true},
 };
 
 static const IntrinsicHandler *findIntrinsicHandler(llvm::StringRef name) {
   auto compare = [](const IntrinsicHandler &handler, llvm::StringRef name) {
     return name.compare(handler.name) > 0;
   };
   auto result =
       std::lower_bound(std::begin(handlers), std::end(handlers), name, compare);
void IntrinsicLibrary::genRandomSeed(llvm::ArrayRef<fir::ExtendedValue> args) {
   for (int i = 0; i < 3; ++i)
     if (isPresent(args[i])) {
       Fortran::lower::genRandomSeed(builder, loc, i, fir::getBase(args[i]));
       return;
     }
   Fortran::lower::genRandomSeed(builder, loc, -1, mlir::Value{});
 }
 
+// SCAN
+fir::ExtendedValue
+IntrinsicLibrary::genScan(mlir::Type resultType,
+                          llvm::ArrayRef<fir::ExtendedValue> args) {
+
+  assert(args.size() == 4);
+
+  if (isAbsent(args[3])) {
+    // Kind not specified, so call scan/verify runtime routine that is
+    // specialized on the kind of characters in string.
+
+    // Handle required string base arg
+    mlir::Value stringBase = fir::getBase(args[0]);
+
+    // Handle required set string base arg
+    mlir::Value setBase = fir::getBase(args[1]);
+
+    // Handle kind argument; it is the kind of character in this case
+    fir::KindTy kind =
+        fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
+            stringBase.getType());
+
+    // Get string length argument
+    mlir::Value stringLen = fir::getLen(args[0]);
+
+    // Get set string length argument
+    mlir::Value setLen = fir::getLen(args[1]);
+
+    // Handle optional back argument
+    mlir::Value back =
+        isAbsent(args[2])
+            ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
+            : fir::getBase(args[2]);
+
+    return builder.createConvert(loc, resultType,
+                                 fir::runtime::genScan(builder, loc, kind,
+                                                       stringBase, stringLen,
+                                                       setBase, setLen, back));
+  }
+  // else use the runtime descriptor version of scan/verify
+
+  // Handle optional argument, back
+  auto makeRefThenEmbox = [&](mlir::Value b) {
+    fir::LogicalType logTy = fir::LogicalType::get(
+        builder.getContext(), builder.getKindMap().defaultLogicalKind());
+    mlir::Value temp = builder.createTemporary(loc, logTy);
+    mlir::Value castb = builder.createConvert(loc, logTy, b);
+    builder.create<fir::StoreOp>(loc, castb, temp);
+    return builder.createBox(loc, temp);
+  };
+  mlir::Value back = fir::isUnboxedValue(args[2])
+                         ? makeRefThenEmbox(*args[2].getUnboxed())
+                         : builder.create<fir::AbsentOp>(
+                               loc, fir::BoxType::get(builder.getI1Type()));
+
+  // Handle required string argument
+  mlir::Value string = builder.createBox(loc, args[0]);
+
+  // Handle required set argument
+  mlir::Value set = builder.createBox(loc, args[1]);
+
+  // Handle kind argument
+  mlir::Value kind = fir::getBase(args[3]);
+
+  // Create result descriptor
+  fir::MutableBoxValue resultMutableBox =
+      fir::factory::createTempMutableBox(builder, loc, resultType);
+  mlir::Value resultIrBox =
+      fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
+
+  fir::runtime::genScanDescriptor(builder, loc, resultIrBox, string, set, back,
+                                  kind);
+
+  // Handle cleanup of allocatable result descriptor and return
+  return readAndAddCleanUp(resultMutableBox, resultType, "SCAN");
+}
+
 // SET_EXPONENT
 mlir::Value IntrinsicLibrary::genSetExponent(mlir::Type resultType,
                                              llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
 
   return builder.createConvert(
       loc, resultType,
       fir::runtime::genSetExponent(builder, loc, fir::getBase(args[0]),
if (args.size() == 3) {
     fir::runtime::genUbound(builder, loc, resultIrBox, fir::getBase(args[0]),
                             kind);
 
     return readAndAddCleanUp(resultMutableBox, resultType, "UBOUND");
   }
   return mlir::Value();
 }
 
+// VERIFY
+fir::ExtendedValue
+IntrinsicLibrary::genVerify(mlir::Type resultType,
+                            llvm::ArrayRef<fir::ExtendedValue> args) {
+
+  assert(args.size() == 4);
+
+  if (isAbsent(args[3])) {
+    // Kind not specified, so call scan/verify runtime routine that is
+    // specialized on the kind of characters in string.
+
+    // Handle required string base arg
+    mlir::Value stringBase = fir::getBase(args[0]);
+
+    // Handle required set string base arg
+    mlir::Value setBase = fir::getBase(args[1]);
+
+    // Handle kind argument; it is the kind of character in this case
+    fir::KindTy kind =
+        fir::factory::CharacterExprHelper{builder, loc}.getCharacterKind(
+            stringBase.getType());
+
+    // Get string length argument
+    mlir::Value stringLen = fir::getLen(args[0]);
+
+    // Get set string length argument
+    mlir::Value setLen = fir::getLen(args[1]);
+
+    // Handle optional back argument
+    mlir::Value back =
+        isAbsent(args[2])
+            ? builder.createIntegerConstant(loc, builder.getI1Type(), 0)
+            : fir::getBase(args[2]);
+
+    return builder.createConvert(
+        loc, resultType,
+        fir::runtime::genVerify(builder, loc, kind, stringBase, stringLen,
+                                setBase, setLen, back));
+  }
+  // else use the runtime descriptor version of scan/verify
+
+  // Handle optional argument, back
+  auto makeRefThenEmbox = [&](mlir::Value b) {
+    fir::LogicalType logTy = fir::LogicalType::get(
+        builder.getContext(), builder.getKindMap().defaultLogicalKind());
+    mlir::Value temp = builder.createTemporary(loc, logTy);
+    mlir::Value castb = builder.createConvert(loc, logTy, b);
+    builder.create<fir::StoreOp>(loc, castb, temp);
+    return builder.createBox(loc, temp);
+  };
+  mlir::Value back = fir::isUnboxedValue(args[2])
+                         ? makeRefThenEmbox(*args[2].getUnboxed())
+                         : builder.create<fir::AbsentOp>(
+                               loc, fir::BoxType::get(builder.getI1Type()));
+
+  // Handle required string argument
+  mlir::Value string = builder.createBox(loc, args[0]);
+
+  // Handle required set argument
+  mlir::Value set = builder.createBox(loc, args[1]);
+
+  // Handle kind argument
+  mlir::Value kind = fir::getBase(args[3]);
+
+  // Create result descriptor
+  fir::MutableBoxValue resultMutableBox =
+      fir::factory::createTempMutableBox(builder, loc, resultType);
+  mlir::Value resultIrBox =
+      fir::factory::getMutableIRBox(builder, loc, resultMutableBox);
+
+  fir::runtime::genVerifyDescriptor(builder, loc, resultIrBox, string, set,
+                                    back, kind);
+
+  // Handle cleanup of allocatable result descriptor and return
+  return readAndAddCleanUp(resultMutableBox, resultType, "VERIFY");
+}
+
 //===----------------------------------------------------------------------===//
 // Argument lowering rules interface
 //===----------------------------------------------------------------------===//
 
 const Fortran::lower::IntrinsicArgumentLoweringRules *
 Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef intrinsicName) {
   if (const IntrinsicHandler *handler = findIntrinsicHandler(intrinsicName))
     if (!handler->argLoweringRules.hasDefaultRules())

flang/test/Lower/Intrinsics/scan.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPscan_test(
+! CHECK-SAME: %[[s:[^:]+]]: !fir.boxchar<1>{{.*}}, %[[ss:[^:]+]]: !fir.boxchar<1>{{.*}}) -> i32
+integer function scan_test(s1, s2)
+character(*) :: s1, s2
+! CHECK: %[[tmpBox:.*]] = fir.alloca !fir.box<!fir.heap<i32>>
+! CHECK-DAG: %[[c:.*]]:2 = fir.unboxchar %[[s]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-DAG: %[[cBox:.*]] = fir.embox %[[c]]#0 typeparams %[[c]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK-DAG: %[[cBoxNone:.*]] = fir.convert %[[cBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK-DAG: %[[c2:.*]]:2 = fir.unboxchar %[[ss]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-DAG: %[[cBox2:.*]] = fir.embox %[[c2]]#0 typeparams %[[c2]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK-DAG: %[[cBoxNone2:.*]] = fir.convert %[[cBox2]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK-DAG: %[[backOptBox:.*]] = fir.absent !fir.box<i1>
+! CHECK-DAG: %[[backBox:.*]] = fir.convert %[[backOptBox]] : (!fir.box<i1>) -> !fir.box<none>
+! CHECK-DAG: %[[kindConstant:.*]] = arith.constant 4 : i32
+! CHECK-DAG: %[[resBox:.*]] = fir.convert %[[tmpBox:.*]] : (!fir.ref<!fir.box<!fir.heap<i32>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: fir.call @{{.*}}Scan(%[[resBox]], %[[cBoxNone]], %[[cBoxNone2]], %[[backBox]], %[[kindConstant]], {{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.box<none>, i32, !fir.ref<i8>, i32) -> none
+scan_test = scan(s1, s2, kind=4)
+! CHECK-DAG: %[[tmpAddr:.*]] = fir.box_addr
+! CHECK: fir.freemem %[[tmpAddr]]
+end function scan_test
+
+! CHECK-LABEL: func @_QPscan_test2(
+! CHECK-SAME: %[[s:[^:]+]]: !fir.boxchar<1>{{.*}},
+! CHECK-SAME: %[[ss:[^:]+]]: !fir.boxchar<1>{{.*}}) -> i32
+integer function scan_test2(s1, s2)
+character(*) :: s1, s2
+! CHECK: %[[st:[^:]*]]:2 = fir.unboxchar %[[s]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[sst:[^:]*]]:2 = fir.unboxchar %[[ss]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[a1:.*]] = fir.convert %[[st]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK: %[[a2:.*]] = fir.convert %[[st]]#1 : (index) -> i64
+! CHECK: %[[a3:.*]] = fir.convert %[[sst]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK: %[[a4:.*]] = fir.convert %[[sst]]#1 : (index) -> i64
+! CHECK: = fir.call @_FortranAScan1(%[[a1]], %[[a2]], %[[a3]], %[[a4]], %{{.*}}) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, i1) -> i64
+scan_test2 = scan(s1, s2, .true.)
+end function scan_test2
+
+! CHECK-LABEL: func @_QPtest_optional(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.boxchar<1>
+! CHECK-SAME:  %[[VAL_2:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>>
+subroutine test_optional(string, set, back)
+character (*) :: string(:), set
+logical, optional :: back(:)
+print *, scan(string, set, back)
+! CHECK:  %[[VAL_11:.*]] = fir.is_present %[[VAL_2]] : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> i1
+! CHECK:  %[[VAL_12:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.logical<4>>>
+! CHECK:  %[[VAL_13:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_14:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_15:.*]] = fir.embox %[[VAL_12]](%[[VAL_14]]) : (!fir.ref<!fir.array<?x!fir.logical<4>>>, !fir.shape<1>) -> !fir.box<!fir.array<?x!fir.logical<4>>>
+! CHECK:  %[[VAL_16:.*]] = arith.select %[[VAL_11]], %[[VAL_2]], %[[VAL_15]] : !fir.box<!fir.array<?x!fir.logical<4>>>
+! CHECK:  %[[VAL_17:.*]] = fir.array_load %[[VAL_16]] {fir.optional} : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> !fir.array<?x!fir.logical<4>>
+! CHECK:  fir.do_loop %[[VAL_25:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%{{.*}} = %{{.*}}) -> (!fir.array<?xi32>) {
+! CHECK:  %[[VAL_31:.*]] = fir.if %[[VAL_11]] -> (!fir.logical<4>) {
+  ! CHECK:  %[[VAL_32:.*]] = fir.array_fetch %[[VAL_17]], %[[VAL_25]] : (!fir.array<?x!fir.logical<4>>, index) -> !fir.logical<4>
+  ! CHECK:  fir.result %[[VAL_32]] : !fir.logical<4>
+! CHECK:  } else {
+  ! CHECK:  %[[VAL_33:.*]] = arith.constant false
+  ! CHECK:  %[[VAL_34:.*]] = fir.convert %[[VAL_33]] : (i1) -> !fir.logical<4>
+  ! CHECK:  fir.result %[[VAL_34]] : !fir.logical<4>
+! CHECK:  }
+! CHECK:  %[[VAL_39:.*]] = fir.convert %[[VAL_31]] : (!fir.logical<4>) -> i1
+! CHECK:  fir.call @_FortranAScan1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[VAL_39]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, i1) -> i64
+! CHECK:  }
+! CHECK:  fir.array_merge_store
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_optional_scalar(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.boxchar<1>
+! CHECK-SAME:  %[[VAL_2:.*]]: !fir.ref<!fir.logical<4>>
+subroutine test_optional_scalar(string, set, back)
+character (*) :: string(:), set
+logical, optional :: back
+print *, scan(string, set, back)
+! CHECK:  %[[VAL_11:.*]] = fir.is_present %[[VAL_2]] : (!fir.ref<!fir.logical<4>>) -> i1
+! CHECK:  %[[VAL_12:.*]] = fir.if %[[VAL_11]] -> (!fir.logical<4>) {
+! CHECK:  %[[VAL_13:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.logical<4>>
+! CHECK:  fir.result %[[VAL_13]] : !fir.logical<4>
+! CHECK:  } else {
+! CHECK:  %[[VAL_14:.*]] = arith.constant false
+! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i1) -> !fir.logical<4>
+! CHECK:  fir.result %[[VAL_15]] : !fir.logical<4>
+! CHECK:  }
+! CHECK:  fir.do_loop %{{.*}} = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%{{.*}} = %{{.*}}) -> (!fir.array<?xi32>) {
+! CHECK:  %[[VAL_39:.*]] = fir.convert %[[VAL_12]] : (!fir.logical<4>) -> i1
+! CHECK:  fir.call @_FortranAScan1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[VAL_39]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, i1) -> i64
+! CHECK:  }
+! CHECK:  fir.array_merge_store
+end subroutine

flang/test/Lower/Intrinsics/verify.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPverify_test(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>{{.*}}, %[[VAL_1:.*]]: !fir.boxchar<1>{{.*}}) -> i32 {
+integer function verify_test(s1, s2)
+! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.heap<i32>>
+! CHECK: %[[VAL_3:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_4:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_5:.*]] = fir.alloca i32 {bindc_name = "verify_test", uniq_name = "_QFverify_testEverify_test"}
+! CHECK: %[[VAL_6:.*]] = arith.constant 4 : i32
+! CHECK: %[[VAL_7:.*]] = fir.absent !fir.box<i1>
+! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_3]]#0 typeparams %[[VAL_3]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_4]]#0 typeparams %[[VAL_4]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_10:.*]] = fir.zero_bits !fir.heap<i32>
+! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_10]] : (!fir.heap<i32>) -> !fir.box<!fir.heap<i32>>
+! CHECK: fir.store %[[VAL_11]] to %[[VAL_2]] : !fir.ref<!fir.box<!fir.heap<i32>>>
+! CHECK: %[[VAL_12:.*]] = fir.address_of(@_QQcl.{{[0-9a-z]+}}) : !fir.ref<!fir.char<1,{{[0-9]*}}>>
+! CHECK: %[[VAL_13:.*]] = arith.constant {{[0-9]+}} : i32
+! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.box<!fir.heap<i32>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_8]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_9]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_7]] : (!fir.box<i1>) -> !fir.box<none>
+! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_12]] : (!fir.ref<!fir.char<1,{{[0-9]*}}>>) -> !fir.ref<i8>
+! CHECK: %[[VAL_19:.*]] = fir.call @_FortranAVerify(%[[VAL_14]], %[[VAL_15]], %[[VAL_16]], %[[VAL_17]], %[[VAL_6]], %[[VAL_18]], %[[VAL_13]]) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.box<none>, !fir.box<none>, i32, !fir.ref<i8>, i32) -> none
+! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_2]] : !fir.ref<!fir.box<!fir.heap<i32>>>
+! CHECK: %[[VAL_21:.*]] = fir.box_addr %[[VAL_20]] : (!fir.box<!fir.heap<i32>>) -> !fir.heap<i32>
+! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.heap<i32>
+! CHECK: fir.store %[[VAL_22]] to %[[VAL_5]] : !fir.ref<i32>
+! CHECK: fir.freemem %[[VAL_21]]
+! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>
+! CHECK: return %[[VAL_23]] : i32
+  character(*) :: s1, s2
+  verify_test = verify(s1, s2, kind=4)
+end function verify_test
+
+! CHECK-LABEL: func @_QPverify_test2(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>{{.*}}, %[[VAL_1:.*]]: !fir.boxchar<1>{{.*}}) -> i32 {
+integer function verify_test2(s1, s2)
+! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_3:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "verify_test2", uniq_name = "_QFverify_test2Everify_test2"}
+! CHECK: %[[VAL_5:.*]] = arith.constant true
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]]#1 : (index) -> i64
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_3]]#1 : (index) -> i64
+! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAVerify1(%[[VAL_6]], %[[VAL_7]], %[[VAL_8]], %[[VAL_9]], %[[VAL_5]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, i1) -> i64
+! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> i32
+! CHECK: fir.store %[[VAL_11]] to %[[VAL_4]] : !fir.ref<i32>
+! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
+! CHECK: return %[[VAL_12]] : i32
+  character(*) :: s1, s2
+  verify_test2 = verify(s1, s2, .true.)
+end function verify_test2
+
+! CHECK-LABEL: func @_QPtest_optional(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.boxchar<1>
+! CHECK-SAME:  %[[VAL_2:.*]]: !fir.box<!fir.array<?x!fir.logical<4>>>
+subroutine test_optional(string, set, back)
+  character (*) :: string(:), set
+  logical, optional :: back(:)
+  print *, verify(string, set, back)
+! CHECK:  %[[VAL_11:.*]] = fir.is_present %[[VAL_2]] : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> i1
+! CHECK:  %[[VAL_12:.*]] = fir.zero_bits !fir.ref<!fir.array<?x!fir.logical<4>>>
+! CHECK:  %[[VAL_13:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_14:.*]] = fir.shape %[[VAL_13]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_15:.*]] = fir.embox %[[VAL_12]](%[[VAL_14]]) : (!fir.ref<!fir.array<?x!fir.logical<4>>>, !fir.shape<1>) -> !fir.box<!fir.array<?x!fir.logical<4>>>
+! CHECK:  %[[VAL_16:.*]] = arith.select %[[VAL_11]], %[[VAL_2]], %[[VAL_15]] : !fir.box<!fir.array<?x!fir.logical<4>>>
+! CHECK:  %[[VAL_17:.*]] = fir.array_load %[[VAL_16]] {fir.optional} : (!fir.box<!fir.array<?x!fir.logical<4>>>) -> !fir.array<?x!fir.logical<4>>
+! CHECK:  %[[VAL_24:.*]] = fir.do_loop %[[VAL_25:.*]] = %{{.*}} to %{{.*}} step %{{.*}} unordered iter_args(%[[VAL_26:.*]] = %{{.*}}) -> (!fir.array<?xi32>) {
+  ! CHECK:  %[[VAL_31:.*]] = fir.if %[[VAL_11]] -> (!fir.logical<4>) {
+    ! CHECK:  %[[VAL_32:.*]] = fir.array_fetch %[[VAL_17]], %[[VAL_25]] : (!fir.array<?x!fir.logical<4>>, index) -> !fir.logical<4>
+    ! CHECK:  fir.result %[[VAL_32]] : !fir.logical<4>
+  ! CHECK:  } else {
+    ! CHECK:  %[[VAL_33:.*]] = arith.constant false
+    ! CHECK:  %[[VAL_34:.*]] = fir.convert %[[VAL_33]] : (i1) -> !fir.logical<4>
+    ! CHECK:  fir.result %[[VAL_34]] : !fir.logical<4>
+  ! CHECK:  }
+  ! CHECK:  %[[VAL_39:.*]] = fir.convert %[[VAL_31]] : (!fir.logical<4>) -> i1
+  ! CHECK:  fir.call @_FortranAVerify1(%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %[[VAL_39]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, i1) -> i64
+! CHECK:  }
+! CHECK:  fir.array_merge_store
+end subroutine
+
+! CHECK: func private @{{.*}}Verify(
+! CHECK: func private @{{.*}}Verify1(