From ed05dcc57bf9eb9efb44605ee97d7ba4b736e183 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval@gmail.com>
Date: Wed, 1 Mar 2023 15:43:34 +0100
Subject: [PATCH] [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
---
 flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 31 ++++++++++++++++++++-------
 flang/test/Lower/polymorphic-temp.f90         |  5 ++---
 2 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 5227fdf..14081b7 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/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();
diff --git a/flang/test/Lower/polymorphic-temp.f90 b/flang/test/Lower/polymorphic-temp.f90
index 5dfd36a..16b629a 100644
--- a/flang/test/Lower/polymorphic-temp.f90
+++ b/flang/test/Lower/polymorphic-temp.f90
@@ -215,7 +215,6 @@ contains
     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}>>>>
@@ -223,7 +222,7 @@ contains
 ! 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
-- 
2.7.4