[flang][lowering] handle MERGE with different FSOURCE and TSOURCE types

[clementval]

Summary

In merge FSOURCE and TSOURCE must have the same Fortran dynamic types,
but this does not imply that FSOURCE and TSOURCE will be lowered to the
same MLIR types. For instance, TSOURCE may be a character expression
with a compile type constant length (!fir.char<1,4>) while FSOURCE may
have dynamic length (!fir.char<1,?>).

Cast FSOURCE to TSOURCE MLIR types to handle these cases.

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

Co-authored-by: Jean Perier <[e-mail]>

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/IntrinsicCall.cpp

 /// and interface. The interface may not be a perfect match in which case
 /// the caller is responsible to insert argument and return value conversions.
 /// If nothing is found, the mlir::func::FuncOp will contain a nullptr.
 static mlir::func::FuncOp getRuntimeFunction(mlir::Location loc,
                                              fir::FirOpBuilder &builder,
                                              llvm::StringRef name,
                                              mlir::FunctionType funcType) {
   const RuntimeFunction *bestNearMatch = nullptr;
-  FunctionDistance bestMatchDistance{};
+  FunctionDistance bestMatchDistance;
   mlir::func::FuncOp match;
   using RtMap = Fortran::common::StaticMultimapView<RuntimeFunction>;
   static constexpr RtMap pgmathF(pgmathFast);
   static_assert(pgmathF.Verify() && "map must be sorted");
   static constexpr RtMap pgmathR(pgmathRelaxed);
   static_assert(pgmathR.Verify() && "map must be sorted");
   static constexpr RtMap pgmathP(pgmathPrecise);
   static_assert(pgmathP.Verify() && "map must be sorted");
if (!extents.empty())
     return fir::ArrayBoxValue{base, extents};
   return base;
 }
 
 mlir::Value toValue(const fir::ExtendedValue &val, fir::FirOpBuilder &builder,
                     mlir::Location loc) {
   if (const fir::CharBoxValue *charBox = val.getCharBox()) {
     mlir::Value buffer = charBox->getBuffer();
-    if (buffer.getType().isa<fir::BoxCharType>())
+    auto buffTy = buffer.getType();
+    if (buffTy.isa<mlir::FunctionType>())
+      fir::emitFatalError(
+          loc, "A character's buffer type cannot be a function type.");
+    if (buffTy.isa<fir::BoxCharType>())
       return buffer;
     return fir::factory::CharacterExprHelper{builder, loc}.createEmboxChar(
         buffer, charBox->getLen());
   }
 
   // FIXME: need to access other ExtendedValue variants and handle them
   // properly.
   return fir::getBase(val);
return readAndAddCleanUp(resultMutableBox, resultType,
                            "unexpected result for MATMUL");
 }
 
 // MERGE
 fir::ExtendedValue
 IntrinsicLibrary::genMerge(mlir::Type,
                            llvm::ArrayRef<fir::ExtendedValue> args) {
   assert(args.size() == 3);
-  mlir::Value arg0 = fir::getBase(args[0]);
-  mlir::Value arg1 = fir::getBase(args[1]);
-  mlir::Value arg2 = fir::getBase(args[2]);
-  mlir::Type type0 = fir::unwrapRefType(arg0.getType());
+  mlir::Value tsource = fir::getBase(args[0]);
+  mlir::Value fsource = fir::getBase(args[1]);
+  mlir::Value rawMask = fir::getBase(args[2]);
+  mlir::Type type0 = fir::unwrapRefType(tsource.getType());
   bool isCharRslt = fir::isa_char(type0); // result is same as first argument
-  mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), arg2);
-  auto rslt = builder.create<mlir::arith::SelectOp>(loc, mask, arg0, arg1);
+  mlir::Value mask = builder.createConvert(loc, builder.getI1Type(), rawMask);
+  // FSOURCE has the same type as TSOURCE, but they may not have the same MLIR
+  // types (one can have dynamic length while the other has constant lengths,
+  // or one may be a fir.logical<> while the other is an i1). Insert a cast to
+  // fulfill mlir::SelectOp constraint that the MLIR types must be the same.
+  mlir::Value fsourceCast =
+      builder.createConvert(loc, tsource.getType(), fsource);
+  auto rslt =
+      builder.create<mlir::arith::SelectOp>(loc, mask, tsource, fsourceCast);
   if (isCharRslt) {
     // Need a CharBoxValue for character results
     const fir::CharBoxValue *charBox = args[0].getCharBox();
     fir::CharBoxValue charRslt(rslt, charBox->getLen());
     return charRslt;
   }
   return rslt;
 }

flang/test/Lower/Intrinsics/merge.f90

 end type
 type(t) :: result(10), o1, o2
 logical :: mask
 result = merge(o1, o2, mask)
 ! CHECK:  %[[mask:.*]] = fir.load %[[arg3]] : !fir.ref<!fir.logical<4>>
 ! CHECK:  %[[mask_cast:.*]] = fir.convert %[[mask]] : (!fir.logical<4>) -> i1
 ! CHECK:  = arith.select %[[mask_cast]], %[[arg1]], %[[arg2]] : !fir.ref<!fir.type<_QFmerge_test3Tt{i:i32}>>
 end
+
+! CHECK-LABEL: func @_QPmerge_logical_var_and_expr(
+subroutine merge_logical_var_and_expr(l1, l2)
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "l1"},
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "l2"}) {
+  logical :: l1, l2
+  call bar(merge(l1, .true., l2))
+! CHECK:  %[[VAL_2:.*]] = fir.alloca !fir.logical<4>
+! CHECK:  %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.logical<4>>
+! CHECK:  %[[VAL_4:.*]] = arith.constant true
+! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.logical<4>>
+! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.logical<4>) -> i1
+! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (i1) -> !fir.logical<4>
+! CHECK:  %[[VAL_8:.*]] = arith.select %[[VAL_6]], %[[VAL_3]], %[[VAL_7]] : !fir.logical<4>
+! CHECK:  fir.store %[[VAL_8]] to %[[VAL_2]] : !fir.ref<!fir.logical<4>>
+! CHECK:  fir.call @_QPbar(%[[VAL_2]]) : (!fir.ref<!fir.logical<4>>) -> ()
+end subroutine
+
+! CHECK-LABEL: func @_QPmerge_cst_and_dyn_char(
+subroutine merge_cst_and_dyn_char(dyn, l)
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "dyn"},
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "l"}) {
+  character(4) :: cst = "abcde"
+  character(*) :: dyn
+  logical :: l
+  print *,  merge(cst, dyn, l)
+! CHECK:  %[[VAL_2:.*]] = fir.address_of(@_QFmerge_cst_and_dyn_charEcst) : !fir.ref<!fir.char<1,4>>
+! CHECK:  %[[VAL_3:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_4:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:  %[[VAL_10:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.logical<4>>
+! CHECK:  %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.logical<4>) -> i1
+! CHECK:  %[[VAL_12:.*]] = fir.convert %[[VAL_4]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,4>>
+! CHECK:  %[[VAL_13:.*]] = arith.select %[[VAL_11]], %[[VAL_2]], %[[VAL_12]] : !fir.ref<!fir.char<1,4>>
+! CHECK:  %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (!fir.ref<!fir.char<1,4>>) -> !fir.ref<i8>
+! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_3]] : (index) -> i64
+! CHECK:  fir.call @_FortranAioOutputAscii(%{{.*}}, %[[VAL_14]], %[[VAL_15]]) : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
+end subroutine