[flang][hlfir] Support mold operand for hlfir.elemental.

[vzakhari]

Summary

To properly create temporary array for a polymorphic result
of hlfir.elemental we need to keep the mold as its operand.
This patch adds just the basic support.

[clementval]

LGTM

[vzakhari]

In D157315#4567079, @clementval wrote:

LGTM

Thank you for all the reviews!

[tblah]

LGTM, thanks for all of these

[DavidSpickett]

Yesterday we had a lot of changes to flang land in one build: https://lab.llvm.org/buildbot/#/builders/197/builds/8782

Which broke some llvm-test-suite tests:

FAIL: test-suite::gfortran-regression-compile-regression__allocate_with_mold_4_f90.test
FAIL: test-suite::gfortran-regression-compile-regression__c_ptr_tests_16_f90.test
FAIL: test-suite::gfortran-regression-compile-regression__init_flag_17_f90.test

This is the start of that series, with another set from @klausler . Could you co-ordinate investigating this?

I am bisecting to see if I can get specific commits to blame for each test, but I'm sure you will be able to work it out from the failure messages instead. I don't have the fortran knowledge for that.

In general please don't land so many changes in one go unless you know you will be around to deal with the potential failures. It leads to folks like myself being tempted to revert the entire series, as we don't have the specific knowledge needed to know which subset actually caused the issue.

(of course we can't always know what our colleagues are doing, so there's always a chance it can happen that way)

[DavidSpickett]

Actually, this bot got a much smaller change list: https://lab.llvm.org/buildbot/#/builders/176/builds/3786

This starts with Peter's changes, but I'll keep the discussion here for simplicity's sake.

[DavidSpickett]

This has been fixed by https://github.com/llvm/llvm-test-suite/commit/5942ca45a1036ace15b70e117d636ecf89224957, thanks!

flang/include/flang/Optimizer/Builder/HLFIRTools.h

 /// is like getVariableElementType, otherwise, this will return a value
 /// type (that may be an hlfir.expr type).
 mlir::Type getEntityElementType(hlfir::Entity entity);
 
 using ElementalKernelGenerator = std::function<hlfir::Entity(
     mlir::Location, fir::FirOpBuilder &, mlir::ValueRange)>;
 /// Generate an hlfir.elementalOp given call back to generate the element
 /// value at for each iteration.
-/// If exprType is specified, this will be the return type of the elemental op
-hlfir::ElementalOp genElementalOp(mlir::Location loc,
-                                  fir::FirOpBuilder &builder,
-                                  mlir::Type elementType, mlir::Value shape,
-                                  mlir::ValueRange typeParams,
-                                  const ElementalKernelGenerator &genKernel,
-                                  bool isUnordered = false,
-                                  mlir::Type exprType = mlir::Type{});
+/// If exprType is specified, this will be the return type of the elemental op.
+/// If exprType is not specified, the resulting expression type is computed
+/// from the given \p elementType and \p shape, and the type is polymorphic
+/// if \p polymorphicMold is present.
+hlfir::ElementalOp genElementalOp(
+    mlir::Location loc, fir::FirOpBuilder &builder, mlir::Type elementType,
+    mlir::Value shape, mlir::ValueRange typeParams,
+    const ElementalKernelGenerator &genKernel, bool isUnordered = false,
+    mlir::Value polymorphicMold = {}, mlir::Type exprType = mlir::Type{});
 
 /// Structure to describe a loop nest.
 struct LoopNest {
   fir::DoLoopOp outerLoop;
   fir::DoLoopOp innerLoop;
   llvm::SmallVector<mlir::Value> oneBasedIndices;
 };
 

flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h

 bool isFortranNumericalArrayObject(mlir::Type);
 bool isFortranNumericalOrLogicalArrayObject(mlir::Type);
 bool isFortranArrayObject(mlir::Type);
 bool isFortranLogicalArrayObject(mlir::Type);
 bool isPassByRefOrIntegerType(mlir::Type);
 bool isI1Type(mlir::Type);
 // scalar i1 or logical, or sequence of logical (via (boxed?) array or expr)
 bool isMaskArgument(mlir::Type);
+bool isPolymorphicObject(mlir::Type);
 
 /// If an expression's extents are known at compile time, generate a fir.shape
 /// for this expression. Otherwise return {}
 mlir::Value genExprShape(mlir::OpBuilder &builder, const mlir::Location &loc,
                          const hlfir::ExprType &expr);
 
 } // namespace hlfir
 
 #endif // FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H

flang/include/flang/Optimizer/HLFIR/HLFIROpBase.td

 def AnyFortranLogicalOrI1ArrayObject : Type<IsMaskArgumentPred,
     "A scalar i1 or logical or an array-like object containing logicals">;
 
 def IsFortranLogicalArrayPred
         : CPred<"::hlfir::isFortranLogicalArrayObject($_self)">;
 def AnyFortranLogicalArrayObject : Type<IsFortranLogicalArrayPred,
     "any array-like object containing logicals">;
 
+def IsPolymorphicObjectPred
+        : CPred<"::hlfir::isPolymorphicObject($_self)">;
+def AnyPolymorphicObject : Type<IsPolymorphicObjectPred,
+    "any polymorphic object">;
+
 def hlfir_CharExtremumPredicateAttr : I32EnumAttr<
     "CharExtremumPredicate", "",
     [
       I32EnumAttrCase<"min", 0>,
       I32EnumAttrCase<"max", 1>
     ]> {
   let cppNamespace = "hlfir";
 }
 #endif // FORTRAN_DIALECT_HLFIR_OP_BASE

flang/include/flang/Optimizer/HLFIR/HLFIROps.td

InterfaceMethod<
       /*args=*/(ins),
       /*methodBody=*/[{}]
     >,
   ];
 
   let cppNamespace = "hlfir";
 }
 
-def hlfir_ElementalOp : hlfir_Op<"elemental", [RecursiveMemoryEffects, hlfir_ElementalOpInterface]> {
+def hlfir_ElementalOp : hlfir_Op<"elemental", [RecursiveMemoryEffects, hlfir_ElementalOpInterface, AttrSizedOperandSegments]> {
   let summary = "elemental expression";
   let description = [{
     Represent an elemental expression as a function of the indices.
     This operation contain a region whose block arguments are one
     based indices iterating over the elemental expression shape.
     Given these indices, the element value for the given iteration
     can be computed in the region and yielded with the hlfir.yield_element
     operation.
 
     The shape and typeparams operands represent the extents and type
     parameters of the resulting array value.
 
+    The optional mold is an entity carrying the information about
+    the dynamic type of the polymorphic result. Note that the shape
+    of the mold does not necessarily match the shape of the result,
+    for example, the result of `merge(poly_scalar1, poly_scalar2, mask_array)`
+    will have the shape of `mask_array` and the dynamic type of `poly_scalar*`.
+
     The unordered attribute can be set to allow out of order processing
     of the indices. This is safe only if the operations in the body
     of the elemental do not have side effects.
 
 
     Example: Y + X,  with Integer :: X(10, 20), Y(10,20)
     ```
       %0 = fir.shape %c10, %c20 : (index, index) -> !fir.shape<2>
       %5 = hlfir.elemental %0 : (!fir.shape<2>) -> !hlfir.expr<10x20xi32> {
       ^bb0(%i: index, %j: index):
         %6 = hlfir.designate %x (%i, %j)  : (!fir.ref<!fir.array<10x20xi32>>, index, index) -> !fir.ref<i32>
         %7 = hlfir.designate %y (%i, %j)  : (!fir.ref<!fir.array<10x20xi32>>, index, index) -> !fir.ref<i32>
         %8 = fir.load %6 : !fir.ref<i32>
         %9 = fir.load %7 : !fir.ref<i32>
         %10 = arith.addi %8, %9 : i32
         hlfir.yield_element %10 : i32
       }
     ```
   }];
 
   let arguments = (ins
     AnyShapeType:$shape,
+    Optional<AnyPolymorphicObject>:$mold,
     Variadic<AnyIntegerType>:$typeparams,
     OptionalAttr<UnitAttr>:$unordered
   );
 
   let results = (outs hlfir_ExprType);
   let regions = (region SizedRegion<1>:$region);
 
   let assemblyFormat = [{
-    $shape (`typeparams` $typeparams^)? (`unordered` $unordered^)?
+    $shape (`mold` $mold^)? (`typeparams` $typeparams^)?
+    (`unordered` $unordered^)?
     attr-dict `:` functional-type(operands, results)
     $region
     }];
 
   let extraClassDeclaration = [{
       mlir::Block *getBody() { return &getRegion().front(); }
 
       /// Get the indices iterating over the shape.
       mlir::Block::BlockArgListType getIndices() {
        return getBody()->getArguments();
       }
       /// ElementalOpInterface implementation.
 
       mlir::Region& getElementalRegion() { return getRegion(); }
       mlir::Value getElementEntity();
       mlir::Region* getElementCleanup() { return nullptr; }
 
       /// Must this elemental be evaluated in order?
       bool isOrdered() { return !getUnordered(); }
   }];
 
   let skipDefaultBuilders = 1;
   let builders = [
     OpBuilder<(ins "mlir::Type":$result_type, "mlir::Value":$shape,
+      CArg<"mlir::Value", "{}">:$mold,
       CArg<"mlir::ValueRange", "{}">:$typeparams,
       CArg<"bool", "false">:$isUnordered)>
   ];
 
+  let hasVerifier = 1;
 }
 
 def hlfir_YieldElementOp : hlfir_Op<"yield_element", [Terminator, HasParent<"ElementalOp">, Pure]> {
   let summary = "Yield the elemental value in an ElementalOp";
   let description = [{
     Yield the element value of the current elemental expression iteration
     in an hlfir.elemental region. See hlfir.elemental description for an
     example.

flang/lib/Lower/ConvertArrayConstructor.cpp

public:
   /// Create the hlfir.elemental and compute the ac-implied-do-index value
   /// given the lower bound and stride (compute "%i" in the illustration above).
   mlir::Value startImpliedDo(mlir::Location loc, fir::FirOpBuilder &builder,
                              mlir::Value lower, mlir::Value upper,
                              mlir::Value stride) {
     assert(!elementalOp && "expected only one implied-do");
     mlir::Value one =
         builder.createIntegerConstant(loc, builder.getIndexType(), 1);
-    elementalOp =
-        builder.create<hlfir::ElementalOp>(loc, exprType, shape, lengthParams,
-                                           /*isUnordered=*/true);
+    elementalOp = builder.create<hlfir::ElementalOp>(
+        loc, exprType, shape,
+        /*mold=*/nullptr, lengthParams, /*isUnordered=*/true);
     builder.setInsertionPointToStart(elementalOp.getBody());
     // implied-do-index = lower+((i-1)*stride)
     mlir::Value diff = builder.create<mlir::arith::SubIOp>(
         loc, elementalOp.getIndices()[0], one);
     mlir::Value mul = builder.create<mlir::arith::MulIOp>(loc, diff, stride);
     mlir::Value add = builder.create<mlir::arith::AddIOp>(loc, lower, mul);
     return add;
   }

flang/lib/Optimizer/Builder/HLFIRTools.cpp

static hlfir::ExprType getArrayExprType(mlir::Type elementType,
   if (auto shapeOp = shape.getDefiningOp<fir::ShapeOp>())
     for (auto extent : llvm::enumerate(shapeOp.getExtents()))
       if (auto cstExtent = fir::getIntIfConstant(extent.value()))
         typeShape[extent.index()] = *cstExtent;
   return hlfir::ExprType::get(elementType.getContext(), typeShape, elementType,
                               isPolymorphic);
 }
 
-hlfir::ElementalOp
-hlfir::genElementalOp(mlir::Location loc, fir::FirOpBuilder &builder,
-                      mlir::Type elementType, mlir::Value shape,
-                      mlir::ValueRange typeParams,
-                      const ElementalKernelGenerator &genKernel,
-                      bool isUnordered, mlir::Type exprType) {
+hlfir::ElementalOp hlfir::genElementalOp(
+    mlir::Location loc, fir::FirOpBuilder &builder, mlir::Type elementType,
+    mlir::Value shape, mlir::ValueRange typeParams,
+    const ElementalKernelGenerator &genKernel, bool isUnordered,
+    mlir::Value polymorphicMold, mlir::Type exprType) {
   if (!exprType)
-    exprType = getArrayExprType(elementType, shape, false);
+    exprType = getArrayExprType(elementType, shape, !!polymorphicMold);
   auto elementalOp = builder.create<hlfir::ElementalOp>(
-      loc, exprType, shape, typeParams, isUnordered);
+      loc, exprType, shape, polymorphicMold, typeParams, isUnordered);
   auto insertPt = builder.saveInsertionPoint();
   builder.setInsertionPointToStart(elementalOp.getBody());
   mlir::Value elementResult = genKernel(loc, builder, elementalOp.getIndices());
   // Numerical and logical scalars may be lowered to another type than the
   // Fortran expression type (e.g i1 instead of fir.logical). Array expression
   // values are typed according to their Fortran type. Insert a cast if needed
   // here.
   if (fir::isa_trivial(elementResult.getType()))

flang/lib/Optimizer/HLFIR/IR/HLFIRDialect.cpp

bool hlfir::isMaskArgument(mlir::Type type) {
   if (unwrappedType != elementType)
     // input type is an array
     return mlir::isa<fir::LogicalType>(elementType);
 
   // input is a scalar, so allow i1 too
   return mlir::isa<fir::LogicalType>(elementType) || isI1Type(elementType);
 }
 
+bool hlfir::isPolymorphicObject(mlir::Type type) {
+  if (auto exprType = mlir::dyn_cast<hlfir::ExprType>(type))
+    return exprType.isPolymorphic();
+
+  return fir::isPolymorphicType(type);
+}
+
 mlir::Value hlfir::genExprShape(mlir::OpBuilder &builder,
                                 const mlir::Location &loc,
                                 const hlfir::ExprType &expr) {
   mlir::IndexType indexTy = builder.getIndexType();
   llvm::SmallVector<mlir::Value> extents;
   extents.reserve(expr.getRank());
 
   for (std::int64_t extent : expr.getShape()) {

flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp

 
 //===----------------------------------------------------------------------===//
 // ElementalOp
 //===----------------------------------------------------------------------===//
 
 void hlfir::ElementalOp::build(mlir::OpBuilder &builder,
                                mlir::OperationState &odsState,
                                mlir::Type resultType, mlir::Value shape,
-                               mlir::ValueRange typeparams, bool isUnordered) {
+                               mlir::Value mold, mlir::ValueRange typeparams,
+                               bool isUnordered) {
   odsState.addOperands(shape);
+  if (mold)
+    odsState.addOperands(mold);
   odsState.addOperands(typeparams);
   odsState.addTypes(resultType);
+  odsState.addAttribute(
+      getOperandSegmentSizesAttrName(odsState.name),
+      builder.getDenseI32ArrayAttr({/*shape=*/1, (mold ? 1 : 0),
+                                    static_cast<int32_t>(typeparams.size())}));
   if (isUnordered)
     odsState.addAttribute(getUnorderedAttrName(odsState.name),
                           isUnordered ? builder.getUnitAttr() : nullptr);
   mlir::Region *bodyRegion = odsState.addRegion();
   bodyRegion->push_back(new mlir::Block{});
   if (auto exprType = resultType.dyn_cast<hlfir::ExprType>()) {
     unsigned dim = exprType.getRank();
     mlir::Type indexType = builder.getIndexType();
     for (unsigned d = 0; d < dim; ++d)
       bodyRegion->front().addArgument(indexType, odsState.location);
   }
 }
 
 mlir::Value hlfir::ElementalOp::getElementEntity() {
   return mlir::cast<hlfir::YieldElementOp>(getBody()->back()).getElementValue();
 }
 
+mlir::LogicalResult hlfir::ElementalOp::verify() {
+  mlir::Value mold = getMold();
+  hlfir::ExprType resultType = mlir::cast<hlfir::ExprType>(getType());
+  if (!!mold != resultType.isPolymorphic())
+    return emitOpError("result must be polymorphic when mold is present "
+                       "and vice versa");
+
+  return mlir::success();
+}
+
 //===----------------------------------------------------------------------===//
 // ApplyOp
 //===----------------------------------------------------------------------===//
 
 void hlfir::ApplyOp::build(mlir::OpBuilder &builder,
                            mlir::OperationState &odsState, mlir::Value expr,
                            mlir::ValueRange indices,
                            mlir::ValueRange typeparams) {

flang/lib/Optimizer/HLFIR/Transforms/SimplifyHLFIRIntrinsics.cpp

auto genKernel = [&array](mlir::Location loc, fir::FirOpBuilder &builder,
       mlir::ValueRange transposedIndices{{inputIndices[1], inputIndices[0]}};
       hlfir::Entity element =
           hlfir::getElementAt(loc, builder, array, transposedIndices);
       hlfir::Entity val = hlfir::loadTrivialScalar(loc, builder, element);
       return val;
     };
     hlfir::ElementalOp elementalOp = hlfir::genElementalOp(
         loc, builder, elementType, resultShape, typeParams, genKernel,
-        /*isUnordered=*/true, transpose.getResult().getType());
+        /*isUnordered=*/true, /*polymorphicMold=*/nullptr,
+        transpose.getResult().getType());
 
     // it wouldn't be safe to replace block arguments with a different
     // hlfir.expr type. Types can differ due to differing amounts of shape
     // information
     assert(elementalOp.getResult().getType() ==
            transpose.getResult().getType());
 
     rewriter.replaceOp(transpose, elementalOp);

flang/test/HLFIR/elemental.fir

 // CHECK:           %[[VAL_2:.*]] = fir.shape %[[VAL_0]], %[[VAL_1]] : (index, index) -> !fir.shape<2>
 // CHECK:           %[[VAL_3:.*]] = hlfir.elemental %[[VAL_2]] unordered : (!fir.shape<2>) -> !hlfir.expr<10x20xi32> {
 // CHECK:           ^bb0(%[[VAL_4:.*]]: index, %[[VAL_5:.*]]: index):
 // CHECK:             %[[VAL_6:.*]] = arith.constant 0 : i32
 // CHECK:             hlfir.yield_element %[[VAL_6]] : i32
 // CHECK:           }
 // CHECK:           return
 // CHECK:         }
+
+func.func @polymorphic_mold_var(%arg0: !fir.class<!fir.array<?x!fir.type<_QMtypesTt>>>, %shape : index) {
+  %3 = fir.shape %shape : (index) -> !fir.shape<1>
+  %4 = hlfir.elemental %3 mold %arg0 unordered : (!fir.shape<1>, !fir.class<!fir.array<?x!fir.type<_QMtypesTt>>>) -> !hlfir.expr<?x!fir.type<_QMtypesTt>?> {
+  ^bb0(%arg2: index):
+    %6 = fir.undefined !hlfir.expr<!fir.type<_QMtypesTt>?>
+    hlfir.yield_element %6 : !hlfir.expr<!fir.type<_QMtypesTt>?>
+  }
+  return
+}
+// CHECK-LABEL:   func.func @polymorphic_mold_var(
+// CHECK-SAME:        %[[VAL_0:.*]]: !fir.class<!fir.array<?x!fir.type<_QMtypesTt>>>,                   %[[VAL_1:.*]]: index) {
+// CHECK:           %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_3:.*]] = hlfir.elemental %[[VAL_2]] mold %[[VAL_0]] unordered : (!fir.shape<1>, !fir.class<!fir.array<?x!fir.type<_QMtypesTt>>>) -> !hlfir.expr<?x!fir.type<_QMtypesTt>?> {
+// CHECK:           ^bb0(%[[VAL_4:.*]]: index):
+// CHECK:             %[[VAL_5:.*]] = fir.undefined !hlfir.expr<!fir.type<_QMtypesTt>?>
+// CHECK:             hlfir.yield_element %[[VAL_5]] : !hlfir.expr<!fir.type<_QMtypesTt>?>
+// CHECK:           }
+// CHECK:           return
+// CHECK:         }
+
+func.func @polymorphic_mold_expr(%shape : index) {
+  %3 = fir.shape %shape : (index) -> !fir.shape<1>
+  %mold = fir.undefined !hlfir.expr<?x!fir.type<_QMtypesTt>?>
+  %4 = hlfir.elemental %3 mold %mold unordered : (!fir.shape<1>, !hlfir.expr<?x!fir.type<_QMtypesTt>?>) -> !hlfir.expr<?x!fir.type<_QMtypesTt>?> {
+  ^bb0(%arg2: index):
+    %6 = fir.undefined !hlfir.expr<!fir.type<_QMtypesTt>?>
+    hlfir.yield_element %6 : !hlfir.expr<!fir.type<_QMtypesTt>?>
+  }
+  return
+}
+// CHECK-LABEL:   func.func @polymorphic_mold_expr(
+// CHECK-SAME:        %[[VAL_0:.*]]: index) {
+// CHECK:           %[[VAL_1:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_2:.*]] = fir.undefined !hlfir.expr<?x!fir.type<_QMtypesTt>?>
+// CHECK:           %[[VAL_3:.*]] = hlfir.elemental %[[VAL_1]] mold %[[VAL_2]] unordered : (!fir.shape<1>, !hlfir.expr<?x!fir.type<_QMtypesTt>?>) -> !hlfir.expr<?x!fir.type<_QMtypesTt>?> {
+// CHECK:           ^bb0(%[[VAL_4:.*]]: index):
+// CHECK:             %[[VAL_5:.*]] = fir.undefined !hlfir.expr<!fir.type<_QMtypesTt>?>
+// CHECK:             hlfir.yield_element %[[VAL_5]] : !hlfir.expr<!fir.type<_QMtypesTt>?>
+// CHECK:           }
+// CHECK:           return
+// CHECK:         }

flang/test/HLFIR/invalid.fir

 }
 
 // -----
 func.func @bad_get_length_3(%arg0: !hlfir.expr<!fir.boxchar<1>>) {
   // expected-error@+1 {{'hlfir.get_length' op operand #0 must be any character scalar or array expression type, but got '!hlfir.expr<!fir.boxchar<1>>'}}
   %1 = hlfir.get_length %arg0 : (!hlfir.expr<!fir.boxchar<1>>) -> index
   return
 }
+
+// -----
+func.func @elemental_poly_1(%arg0: !fir.box<!fir.array<?x!fir.type<_QMtypesTt>>>, %shape : index) {
+  %3 = fir.shape %shape : (index) -> !fir.shape<1>
+  // expected-error@+1 {{'hlfir.elemental' op operand #1 must be any polymorphic object, but got '!fir.box<!fir.array<?x!fir.type<_QMtypesTt>>>'}}
+  %4 = hlfir.elemental %3 mold %arg0 unordered : (!fir.shape<1>, !fir.box<!fir.array<?x!fir.type<_QMtypesTt>>>) -> !hlfir.expr<?x!fir.type<_QMtypesTt>?> {
+  ^bb0(%arg2: index):
+    %6 = fir.undefined !hlfir.expr<!fir.type<_QMtypesTt>?>
+    hlfir.yield_element %6 : !hlfir.expr<!fir.type<_QMtypesTt>?>
+  }
+  return
+}
+
+// -----
+func.func @elemental_poly_2(%arg0: !hlfir.expr<?x!fir.type<_QMtypesTt>>, %shape : index) {
+  %3 = fir.shape %shape : (index) -> !fir.shape<1>
+  // expected-error@+1 {{'hlfir.elemental' op operand #1 must be any polymorphic object, but got '!hlfir.expr<?x!fir.type<_QMtypesTt>>'}}
+  %4 = hlfir.elemental %3 mold %arg0 unordered : (!fir.shape<1>, !hlfir.expr<?x!fir.type<_QMtypesTt>>) -> !hlfir.expr<?x!fir.type<_QMtypesTt>?> {
+  ^bb0(%arg2: index):
+    %6 = fir.undefined !hlfir.expr<!fir.type<_QMtypesTt>?>
+    hlfir.yield_element %6 : !hlfir.expr<!fir.type<_QMtypesTt>?>
+  }
+  return
+}
+
+// -----
+func.func @elemental_poly_3(%arg0: !hlfir.expr<?x!fir.type<_QMtypesTt>?>, %shape : index) {
+  %3 = fir.shape %shape : (index) -> !fir.shape<1>
+// expected-error@+1 {{'hlfir.elemental' op result must be polymorphic when mold is present and vice versa}}
+  %4 = hlfir.elemental %3 mold %arg0 unordered : (!fir.shape<1>, !hlfir.expr<?x!fir.type<_QMtypesTt>?>) -> !hlfir.expr<?x!fir.type<_QMtypesTt>> {
+  ^bb0(%arg2: index):
+    %6 = fir.undefined !hlfir.expr<!fir.type<_QMtypesTt>>
+    hlfir.yield_element %6 : !hlfir.expr<!fir.type<_QMtypesTt>>
+  }
+  return
+}
+
+// -----
+func.func @elemental_poly_4(%shape : index) {
+  %3 = fir.shape %shape : (index) -> !fir.shape<1>
+// expected-error@+1 {{'hlfir.elemental' op result must be polymorphic when mold is present and vice versa}}
+  %4 = hlfir.elemental %3 unordered : (!fir.shape<1>) -> !hlfir.expr<?x!fir.type<_QMtypesTt>?> {
+  ^bb0(%arg2: index):
+    %6 = fir.undefined !hlfir.expr<!fir.type<_QMtypesTt>?>
+    hlfir.yield_element %6 : !hlfir.expr<!fir.type<_QMtypesTt>?>
+  }
+  return
+}