[flang][hlfir] Support parenthesized polymorphic arrays.

The parenthesis' operand is used as a mold for the generated hlfir.elemental. Depends on D157316 Reviewed By: tblah, clementval Differential Revision: https://reviews.llvm.org/D157318
llvm · Aug 8, 2023 · 5a4c5c8 · 5a4c5c8
1 parent 7c9d3d5
commit 5a4c5c8
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 9 deletions.
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1525,11 +1525,6 @@ class HlfirBuilder {
     // Elemental expression.
     mlir::Type elementType;
     if constexpr (R::category == Fortran::common::TypeCategory::Derived) {
-      // TODO: need to pass a mold to hlfir.elemental for polymorphic arrays
-      // if using hlfir.elemental here so that it can get the dynamic type
-      // info.
-      if (left.isPolymorphic())
-        TODO(loc, "parenthesized polymorphic arrays in HLFIR");
       elementType = Fortran::lower::translateDerivedTypeToFIRType(
           getConverter(), op.derived().GetType().GetDerivedTypeSpec());
     } else {
@@ -1545,9 +1540,9 @@ class HlfirBuilder {
       auto leftVal = hlfir::loadTrivialScalar(l, b, leftElement);
       return unaryOp.gen(l, b, op.derived(), leftVal);
     };
-    mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType,
-                                                  shape, typeParams, genKernel,
-                                                  /*isUnordered=*/true);
+    mlir::Value elemental = hlfir::genElementalOp(
+        loc, builder, elementType, shape, typeParams, genKernel,
+        /*isUnordered=*/true, left.isPolymorphic() ? left : mlir::Value{});
     fir::FirOpBuilder *bldr = &builder;
     getStmtCtx().attachCleanup(
         [=]() { bldr->create<hlfir::DestroyOp>(loc, elemental); });

diff --git a/flang/test/Lower/HLFIR/elemental-array-ops.f90 b/flang/test/Lower/HLFIR/elemental-array-ops.f90
@@ -1,5 +1,5 @@
 ! Test lowering of elemental intrinsic operations with array arguments to HLFIR
-! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s
+! RUN: bbc -emit-hlfir --polymorphic-type -I nowhere -o - %s 2>&1 | FileCheck %s
 
 subroutine binary(x, y)
   integer :: x(100), y(100)
@@ -212,3 +212,29 @@ end subroutine char_return
 ! CHECK:           hlfir.destroy %[[VAL_47:.*]] : !hlfir.expr<?x!fir.char<1,3>>
 ! CHECK:           return
 ! CHECK:         }
+
+subroutine polymorphic_parenthesis(x, y)
+  type t
+  end type t
+  class(t), allocatable :: x(:)
+  class(t), intent(in) :: y(:)
+  x = (y)
+end subroutine polymorphic_parenthesis
+! CHECK-LABEL:   func.func @_QPpolymorphic_parenthesis(
+! CHECK-SAME:        %[[VAL_0:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>>> {fir.bindc_name = "x"},
+! CHECK-SAME:        %[[VAL_1:.*]]: !fir.class<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>> {fir.bindc_name = "y"}) {
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFpolymorphic_parenthesisEx"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>>>)
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFpolymorphic_parenthesisEy"} : (!fir.class<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>) -> (!fir.class<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>, !fir.class<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>)
+! CHECK:           %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK:           %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]]#0, %[[VAL_4]] : (!fir.class<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>, index) -> (index, index, index)
+! CHECK:           %[[VAL_6:.*]] = fir.shape %[[VAL_5]]#1 : (index) -> !fir.shape<1>
+! CHECK:           %[[VAL_7:.*]] = hlfir.elemental %[[VAL_6]] mold %[[VAL_3]]#0 unordered : (!fir.shape<1>, !fir.class<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>) -> !hlfir.expr<?x!fir.type<_QFpolymorphic_parenthesisTt>?> {
+! CHECK:           ^bb0(%[[VAL_8:.*]]: index):
+! CHECK:             %[[VAL_9:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_8]])  : (!fir.class<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>, index) -> !fir.class<!fir.type<_QFpolymorphic_parenthesisTt>>
+! CHECK:             %[[VAL_10:.*]] = hlfir.as_expr %[[VAL_9]] : (!fir.class<!fir.type<_QFpolymorphic_parenthesisTt>>) -> !hlfir.expr<!fir.type<_QFpolymorphic_parenthesisTt>?>
+! CHECK:             hlfir.yield_element %[[VAL_10]] : !hlfir.expr<!fir.type<_QFpolymorphic_parenthesisTt>?>
+! CHECK:           }
+! CHECK:           hlfir.assign %[[VAL_7]] to %[[VAL_2]]#0 realloc : !hlfir.expr<?x!fir.type<_QFpolymorphic_parenthesisTt>?>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QFpolymorphic_parenthesisTt>>>>>
+! CHECK:           hlfir.destroy %[[VAL_7]] : !hlfir.expr<?x!fir.type<_QFpolymorphic_parenthesisTt>?>
+! CHECK:           return
+! CHECK:         }