[flang] MERGE result is polymorphic only if TSOURCE and FSOURCE are polymorphic

16.9.129 point 4: the result is polymorphic if and only if both TSOURCE and
FSOURCE are polymorphic.

If neither TSOURCE and FSOURCE are polymorphic then the current behavior is
preserved.

Depends on D145058

Reviewed By: jeanPerier

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

Author: clementval

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

@@ -3925,14 +3925,29 @@ IntrinsicLibrary::genMerge(mlir::Type,
   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(), 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);
+
+  // The result is polymorphic if and only if both TSOURCE and FSOURCE are
+  // polymorphic. TSOURCE and FSOURCE are required to have the same type
+  // (for both declared and dynamic types) so a simple convert op can be
+  // used.
+  mlir::Value tsourceCast = tsource;
+  mlir::Value fsourceCast = fsource;
+  if (fir::isPolymorphicType(tsource.getType()) &&
+      !fir::isPolymorphicType(fsource.getType())) {
+    tsourceCast = builder.createConvert(loc, fsource.getType(), tsource);
+  } else if (!fir::isPolymorphicType(tsource.getType()) &&
+             fir::isPolymorphicType(fsource.getType())) {
+    fsourceCast = builder.createConvert(loc, tsource.getType(), fsource);
+  } else {
+    // FSOURCE and TSOURCE are not polymorphic.
+    // 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.
+    fsourceCast = builder.createConvert(loc, tsource.getType(), fsource);
+  }
+  auto rslt = builder.create<mlir::arith::SelectOp>(loc, mask, tsourceCast,
+                                                    fsourceCast);
   if (isCharRslt) {
     // Need a CharBoxValue for character results
     const fir::CharBoxValue *charBox = args[0].getCharBox();

flang/test/Lower/polymorphic-temp.f90

@@ -215,15 +215,14 @@ subroutine test_merge_intrinsic2(a, b, i)
     call check_scalar(merge(a, b, i==1))
   end subroutine
 
-
 ! CHECK-LABEL: func.func @_QMpoly_tmpPtest_merge_intrinsic2(
 ! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>> {fir.bindc_name = "a"}, %[[B:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>> {fir.bindc_name = "b"}, %[[I:.*]]: !fir.ref<i32> {fir.bindc_name = "i"}) {
 ! CHECK: %[[LOAD_A:.*]] = fir.load %[[A]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>>
 ! CHECK: %[[LOAD_B:.*]] = fir.load %[[B]] : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>>
 ! CHECK: %[[LOAD_I:.*]] = fir.load %[[I]] : !fir.ref<i32>
 ! CHECK: %[[C1:.*]] = arith.constant 1 : i32
 ! CHECK: %[[CMPI:.*]] = arith.cmpi eq, %[[LOAD_I]], %[[C1]] : i32
-! CHECK: %[[B_CONV:.*]] = fir.convert %[[LOAD_B]] : (!fir.box<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>) -> !fir.class<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>
-! CHECK: %{{.*}} = arith.select %[[CMPI]], %[[LOAD_A]], %[[B_CONV]] : !fir.class<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>
+! CHECK: %[[A_CONV:.*]] = fir.convert %[[LOAD_A]] : (!fir.class<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>) -> !fir.box<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>
+! CHECK: %{{.*}} = arith.select %[[CMPI]], %[[A_CONV]], %[[LOAD_B]] : !fir.box<!fir.heap<!fir.type<_QMpoly_tmpTp1{a:i32}>>>
 
 end module