[flang] Add hlfir.designate definition

[jeanPerier]

Summary

Add hlfir.designate operation definition. This is the HLFIR building
blocks to represent Fortran designator. An hlfir.designator is a
Fortran "part-ref" and an optional susbstring or part ref.
See the operation added description for more detail, and
https://github.com/llvm/llvm-project/blob/main/flang/docs/HighLevelFIR.md
for the rational of this operation.

[PeteSteinfeld]

Things build OK and generally look good, but when I run tests, I get failures in the tests for .../HLFIR/designate.fir and .../HLFIR/invalid.fir. Here's the relevant excerpts from the log file:

******************** TEST 'Flang :: HLFIR/designate.fir' FAILED ********************
Script:
--
: 'RUN: at line 3';   fir-opt /local/home/psteinfeld/main/designate/flang/test/HLFIR/designate.fir | fir-opt | /local/home/psteinfeld/main/designate/build/bin/FileCheck /local/home/psteinfeld/main/designate/flang/test/HLFIR/designate.fir
--
Exit Code: 1

Command Output (stderr):
--
/local/home/psteinfeld/main/designate/flang/test/HLFIR/designate.fir:68:8: error: 'hlfir.designate' op result type rank is not consistent with operands, expected rank 21867
  %0 = hlfir.designate %arg0 substr %c3, %c4 typeparams %c2:  (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1>
       ^
/local/home/psteinfeld/main/designate/flang/test/HLFIR/designate.fir:68:8: note: see current operation: %3 = "hlfir.designate"(%arg0, %1, %2, %0) {is_triplet = array<i1>, operand_segment_sizes = array<i32: 1, 0, 0, 2, 0, 1>} : (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1>
/local/home/psteinfeld/main/designate/flang/test/HLFIR/designate.fir:11:17: error: CHECK-LABEL: expected string not found in input
// CHECK-LABEL: func.func @array_ref(
                ^
<stdin>:1:1: note: scanning from here
module {
^

Input file: <stdin>
Check file: /local/home/psteinfeld/main/designate/flang/test/HLFIR/designate.fir

-dump-input=help explains the following input dump.

Input was:
<<<<<<
          1: module { 
label:11     X~~~~~~~~ error: no match found
          2: } 
label:11     ~~
          3:  
label:11     ~
>>>>>>

--

********************

  ....

******************** TEST 'Flang :: HLFIR/invalid.fir' FAILED ********************
Script:
--
: 'RUN: at line 3';   fir-opt -split-input-file -verify-diagnostics /local/home/psteinfeld/main/designate/flang/test/HLFIR/invalid.fir
--
Exit Code: 1

Command Output (stdout):
--

// -----

// -----

// -----
module {
  func.func @bad_array_declare(%arg0: !fir.ref<!fir.array<?x?xf32>>) {
    %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
    return
  }
}


// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

// -----

--
Command Output (stderr):
--
within split at /local/home/psteinfeld/main/designate/flang/test/HLFIR/invalid.fir:204 offset :4:8: error: unexpected error: 'hlfir.designate' op result type rank is not consistent with operands, expected rank 21981
  %0 = hlfir.designate %arg0 imag:  (!fir.ref<!fir.complex<4>>) -> !fir.ref<!fir.complex<4>>
       ^
within split at /local/home/psteinfeld/main/designate/flang/test/HLFIR/invalid.fir:204 offset :3:6: error: expected error "'hlfir.designate' op result element type is not consistent with operands, expected '!fir.real<4>'" was not produced
  // expected-error@+1 {{'hlfir.designate' op result element type is not consistent with operands, expected '!fir.real<4>'}}
     ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
within split at /local/home/psteinfeld/main/designate/flang/test/HLFIR/invalid.fir:211 offset :4:8: error: unexpected error: 'hlfir.designate' op result type rank is not consistent with operands, expected rank 21981
  %0 = hlfir.designate %arg0 imag:  (!fir.ref<!fir.box<!fir.complex<4>>>) -> !fir.ref<!fir.box<!fir.real<4>>>
       ^
within split at /local/home/psteinfeld/main/designate/flang/test/HLFIR/invalid.fir:211 offset :3:6: error: expected error "'hlfir.designate' op result type must only be a box address type if it designates a component that is a fir.box or fir.class and if there are no indices, substrings, and complex part" was not produced
  // expected-error@+1 {{'hlfir.designate' op result type must only be a box address type if it designates a component that is a fir.box or fir.class and if there are no indices, substrings, and complex part}}
     ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
within split at /local/home/psteinfeld/main/designate/flang/test/HLFIR/invalid.fir:235 offset :5:8: error: unexpected error: 'hlfir.designate' op result type rank is not consistent with operands, expected rank 21981
  %0 = hlfir.designate %arg0 substr %c1, %c1:  (!fir.ref<!fir.char<1,10>>, index, index) -> !fir.boxchar<1>
       ^
within split at /local/home/psteinfeld/main/designate/flang/test/HLFIR/invalid.fir:235 offset :4:6: error: expected error "'hlfir.designate' op must be provided one length parameter when the result is a character" was not produced
  // expected-error@+1 {{'hlfir.designate' op must be provided one length parameter when the result is a character}}
     ^~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

--

********************

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

45

Should read "If this is the type..."

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

141

Should read "This operation represents ..."

142

Should read "a substring or ..."

[jeanPerier]

Fix uninitialized variable in DesignateOp verifier and fix
a couple typos in comments and descriptions.

[jeanPerier]

In D138121#3930956, @PeteSteinfeld wrote:

Things build OK and generally look good, but when I run tests, I get failures in the tests for .../HLFIR/designate.fir and .../HLFIR/invalid.fir.

Thanks @PeteSteinfeld, that should be fixed now. I did not set the expected output rank to 0 when there is not component ref and the base is not an array. Serves me right for not initializing my variables.

[vzakhari]

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

202

Just curious if it is possible to use llvm::ArrayRef<Subscript> here.

[jeanPerier]

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

202

That would have been nice, but the "extraClassDeclaration" definitions are emitted after the builder declarations (I guess this could be changed by modifying MLIR tablegen processor, but I think it is not worth it just for this).

[PeteSteinfeld]

Thanks, Jean.

All builds and tests correctly and looks good.

[vzakhari]

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

202

I see. Thank you for checking!

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

public:
   explicit Entity(mlir::Value value) : mlir::Value(value) {
     assert(isFortranEntity(value) &&
            "must be a value representing a Fortran value or variable like");
   }
   Entity(fir::FortranVariableOpInterface variable)
       : mlir::Value(variable.getBase()) {}
   bool isValue() const { return isFortranValue(*this); }
   bool isVariable() const { return !isValue(); }
-  bool isMutableBox() const {
-    mlir::Type type = fir::dyn_cast_ptrEleTy(getType());
-    return type && type.isa<fir::BaseBoxType>();
-  }
+  bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); }
   bool isArray() const {
     mlir::Type type = fir::unwrapPassByRefType(fir::unwrapRefType(getType()));
     if (type.isa<fir::SequenceType>())
       return true;
     if (auto exprType = type.dyn_cast<hlfir::ExprType>())
       return exprType.isArray();
     return false;
   }
   bool isScalar() const { return !isArray(); }
 
   mlir::Type getFortranElementType() const {
-    mlir::Type type = fir::unwrapSequenceType(
-        fir::unwrapPassByRefType(fir::unwrapRefType(getType())));
-    if (auto exprType = type.dyn_cast<hlfir::ExprType>())
-      return exprType.getEleTy();
-    return type;
+    return hlfir::getFortranElementType(getType());
   }
 
   bool hasLengthParameters() const {
     mlir::Type eleTy = getFortranElementType();
     return eleTy.isa<fir::CharacterType>() ||
            fir::isRecordWithTypeParameters(eleTy);
   }
 

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

 //===- HLFIRDialect.h - High Level Fortran IR dialect -----------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // This file defines the HLFIR dialect that models Fortran expressions and
 // assignments without requiring storage allocation and manipulations.
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H
 #define FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H
 
+#include "flang/Optimizer/Dialect/FIRType.h"
 #include "mlir/IR/Dialect.h"
 
 namespace hlfir {
 /// Is this a type that can be used for an HLFIR variable ?
 bool isFortranVariableType(mlir::Type);
 } // namespace hlfir
 
 #include "flang/Optimizer/HLFIR/HLFIRDialect.h.inc"
 
 #define GET_TYPEDEF_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIRTypes.h.inc"
 
 #define GET_ATTRDEF_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIRAttributes.h.inc"
 
+namespace hlfir {
+/// Get the element type of a Fortran entity type.
+inline mlir::Type getFortranElementType(mlir::Type type) {
+  type = fir::unwrapSequenceType(
+      fir::unwrapPassByRefType(fir::unwrapRefType(type)));
+  if (auto exprType = type.dyn_cast<hlfir::ExprType>())
+    return exprType.getEleTy();
+  if (auto boxCharType = type.dyn_cast<fir::BoxCharType>())
+    return boxCharType.getEleTy();
+  return type;
+}
+
+/// If this the type of a Fortran array entity, get the related
+/// fir.array type. Otherwise, returns the Fortran element typeof the entity.
+inline mlir::Type getFortranElementOrSequenceType(mlir::Type type) {
+  type = fir::unwrapPassByRefType(fir::unwrapRefType(type));
+  if (auto exprType = type.dyn_cast<hlfir::ExprType>()) {
+    if (exprType.isArray())
+      return fir::SequenceType::get(exprType.getShape(), exprType.getEleTy());
+    return exprType.getEleTy();
+  }
+  if (auto boxCharType = type.dyn_cast<fir::BoxCharType>())
+    return boxCharType.getEleTy();
+  return type;
+}
+
+/// Is this a fir.box or fir.class address type?
+inline bool isBoxAddressType(mlir::Type type) {
+  type = fir::dyn_cast_ptrEleTy(type);
+  return type && type.isa<fir::BaseBoxType>();
+}
+
+} // namespace hlfir
+
 #endif // FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H

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

def fir_AssignOp : hlfir_Op<"assign", [MemoryEffects<[MemWrite]>]> {
   let arguments = (ins AnyFortranEntity:$rhs,
                    Arg<AnyFortranVariable, "", [MemWrite]>:$lhs);
 
   let assemblyFormat = [{
     $rhs `to` $lhs attr-dict `:` type(operands)
   }];
 }
 
+def hlfir_DesignateOp : hlfir_Op<"designate", [AttrSizedOperandSegments,
+    DeclareOpInterfaceMethods<fir_FortranVariableOpInterface>]> {
+  let summary = "Designate a Fortran variable";
+
+  let description = [{
+    This operations represents a Fortran "part-ref", except that it can embed
+    substring or complex part directly, and that vector subscripts cannot be used.
+    It returns a Fortran variable that is a part of the input variable.
+
+    The operands are as follow:
+      - memref is the variable being designated.
+      - component may be provided if the memref is a derived type to
+        represent a reference to a component. It must be the name of a
+        component of memref derived type.
+      - component_shape represents the shape of the component and must be
+        provided if and only if both component and indices appear.
+      - indices can be provided to index arrays. The indices may be simple
+        indices or triplets.
+        If indices are provided and there is a component, the component must be
+        an array component and the indices index the array component.
+        If memref is an array, and component is provided and is an array
+        component, indices must be provided and must not be triplets. This
+        ensures hlfir.designate does not create arrays of arrays (which is not
+        possible in Fortran).
+      - substring may contain two values to represent a substring lower and
+        upper bounds.
+      - complex_part may be provided to represent a complex part (true
+        represents the imaginary part, and false the real part).
+      - shape represents the shape of the result and must be provided if the
+        result is an array that is not a box address.
+      - typeparams represents the length parameters of the result and must be
+        provided if the result type has length parameters and is not a box
+        address.
+  }];
+
+  let arguments = (ins AnyFortranVariable:$memref,
+                   OptionalAttr<Builtin_StringAttr>:$component,
+                   Optional<AnyShapeOrShiftType>:$component_shape,
+                   Variadic<AnyIntegerType>:$indices,
+                   DenseBoolArrayAttr:$is_triplet,
+                   Variadic<AnyIntegerType>:$substring,
+                   OptionalAttr<BoolAttr>:$complex_part,
+                   Optional<AnyShapeOrShiftType>:$shape,
+                   Variadic<AnyIntegerType>:$typeparams,
+                   OptionalAttr<fir_FortranVariableFlagsAttr>:$fortran_attrs
+                );
+
+  let results = (outs AnyFortranVariable);
+
+  let assemblyFormat = [{
+    $memref (`{` $component^ `}`)? (`<` $component_shape^ `>`)?
+    custom<DesignatorIndices>($indices, $is_triplet)
+    (`substr` $substring^)?
+    custom<DesignatorComplexPart>($complex_part)
+    (`shape` $shape^)? (`typeparams` $typeparams^)?
+    attr-dict `:` functional-type(operands, results)
+  }];
+
+  let extraClassDeclaration = [{
+    using Triplet = std::tuple<mlir::Value, mlir::Value, mlir::Value>;
+    using Subscript = std::variant<mlir::Value, Triplet>;
+  }];
+
+  let builders = [
+    OpBuilder<(ins "mlir::Type":$result_type, "mlir::Value":$memref,
+      "llvm::StringRef":$component, "mlir::Value":$component_shape,
+      "llvm::ArrayRef<std::variant<mlir::Value, std::tuple<mlir::Value, mlir::Value, mlir::Value>>>":$subscripts,
+      CArg<"mlir::ValueRange", "{}">:$substring,
+      CArg<"llvm::Optional<bool>", "{}">:$complex_part,
+      CArg<"mlir::Value", "{}">:$shape, CArg<"mlir::ValueRange", "{}">:$typeparams,
+      CArg<"fir::FortranVariableFlagsAttr", "{}">:$fortran_attrs)>];
+
+  let hasVerifier = 1;
+}
+
 #endif // FORTRAN_DIALECT_HLFIR_OPS

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

return emitOpError("first result type is inconsistent with variable "
            << hlfirVariableType;
   // The rest of the argument verification is done by the
   // FortranVariableInterface verifier.
   auto fortranVar =
       mlir::cast<fir::FortranVariableOpInterface>(this->getOperation());
   return fortranVar.verifyDeclareLikeOpImpl(getMemref());
 }
 
+//===----------------------------------------------------------------------===//
+// DesignateOp
+//===----------------------------------------------------------------------===//
+
+void hlfir::DesignateOp::build(
+    mlir::OpBuilder &builder, mlir::OperationState &result,
+    mlir::Type result_type, mlir::Value memref, llvm::StringRef component,
+    mlir::Value component_shape, llvm::ArrayRef<Subscript> subscripts,
+    mlir::ValueRange substring, llvm::Optional<bool> complex_part,
+    mlir::Value shape, mlir::ValueRange typeparams,
+    fir::FortranVariableFlagsAttr fortran_attrs) {
+  auto componentAttr =
+      component.empty() ? mlir::StringAttr{} : builder.getStringAttr(component);
+  llvm::SmallVector<mlir::Value> indices;
+  llvm::SmallVector<bool> isTriplet;
+  for (auto subscript : subscripts) {
+    if (auto *triplet = std::get_if<Triplet>(&subscript)) {
+      isTriplet.push_back(true);
+      indices.push_back(std::get<0>(*triplet));
+      indices.push_back(std::get<1>(*triplet));
+      indices.push_back(std::get<2>(*triplet));
+    } else {
+      isTriplet.push_back(false);
+      indices.push_back(std::get<mlir::Value>(subscript));
+    }
+  }
+  auto isTripletAttr =
+      mlir::DenseBoolArrayAttr::get(builder.getContext(), isTriplet);
+  auto complexPartAttr =
+      complex_part.has_value()
+          ? mlir::BoolAttr::get(builder.getContext(), *complex_part)
+          : mlir::BoolAttr{};
+  build(builder, result, result_type, memref, componentAttr, component_shape,
+        indices, isTripletAttr, substring, complexPartAttr, shape, typeparams,
+        fortran_attrs);
+}
+
+static mlir::ParseResult parseDesignatorIndices(
+    mlir::OpAsmParser &parser,
+    llvm::SmallVectorImpl<mlir::OpAsmParser::UnresolvedOperand> &indices,
+    mlir::DenseBoolArrayAttr &isTripletAttr) {
+  llvm::SmallVector<bool> isTriplet;
+  if (mlir::succeeded(parser.parseOptionalLParen())) {
+    do {
+      mlir::OpAsmParser::UnresolvedOperand i1, i2, i3;
+      if (parser.parseOperand(i1))
+        return mlir::failure();
+      indices.push_back(i1);
+      if (mlir::succeeded(parser.parseOptionalColon())) {
+        if (parser.parseOperand(i2) || parser.parseColon() ||
+            parser.parseOperand(i3))
+          return mlir::failure();
+        indices.push_back(i2);
+        indices.push_back(i3);
+        isTriplet.push_back(true);
+      } else {
+        isTriplet.push_back(false);
+      }
+    } while (mlir::succeeded(parser.parseOptionalComma()));
+    if (parser.parseRParen())
+      return mlir::failure();
+  }
+  isTripletAttr = mlir::DenseBoolArrayAttr::get(parser.getContext(), isTriplet);
+  return mlir::success();
+}
+
+static void
+printDesignatorIndices(mlir::OpAsmPrinter &p, hlfir::DesignateOp designateOp,
+                       mlir::OperandRange indices,
+                       const mlir::DenseBoolArrayAttr &isTripletAttr) {
+  if (!indices.empty()) {
+    p << '(';
+    unsigned i = 0;
+    for (auto isTriplet : isTripletAttr.asArrayRef()) {
+      if (isTriplet) {
+        assert(i + 2 < indices.size() && "ill-formed indices");
+        p << indices[i] << ":" << indices[i + 1] << ":" << indices[i + 2];
+        i += 3;
+      } else {
+        p << indices[i++];
+      }
+      if (i != indices.size())
+        p << ", ";
+    }
+    p << ')';
+  }
+}
+
+static mlir::ParseResult
+parseDesignatorComplexPart(mlir::OpAsmParser &parser,
+                           mlir::BoolAttr &complexPart) {
+  if (mlir::succeeded(parser.parseOptionalKeyword("imag")))
+    complexPart = mlir::BoolAttr::get(parser.getContext(), true);
+  else if (mlir::succeeded(parser.parseOptionalKeyword("real")))
+    complexPart = mlir::BoolAttr::get(parser.getContext(), false);
+  return mlir::success();
+}
+
+static void printDesignatorComplexPart(mlir::OpAsmPrinter &p,
+                                       hlfir::DesignateOp designateOp,
+                                       mlir::BoolAttr complexPartAttr) {
+  if (complexPartAttr) {
+    if (complexPartAttr.getValue())
+      p << "imag";
+    else
+      p << "real";
+  }
+}
+
+mlir::LogicalResult hlfir::DesignateOp::verify() {
+  mlir::Type memrefType = getMemref().getType();
+  mlir::Type baseType = getFortranElementOrSequenceType(memrefType);
+  mlir::Type baseElementType = fir::unwrapSequenceType(baseType);
+  unsigned numSubscripts = getIsTriplet().size();
+  unsigned subscriptsRank =
+      llvm::count_if(getIsTriplet(), [](bool isTriplet) { return isTriplet; });
+  unsigned outputRank;
+  mlir::Type outputElementType;
+  bool hasBoxComponent;
+  if (getComponent()) {
+    auto component = getComponent().value();
+    auto recType = baseElementType.dyn_cast<fir::RecordType>();
+    if (!recType)
+      return emitOpError(
+          "component must be provided only when the memref is a derived type");
+    unsigned fieldIdx = recType.getFieldIndex(component);
+    if (fieldIdx > recType.getNumFields()) {
+      return emitOpError("component ")
+             << component << " is not a component of memref element type "
+             << recType;
+    }
+    mlir::Type fieldType = recType.getType(fieldIdx);
+    mlir::Type componentBaseType = getFortranElementOrSequenceType(fieldType);
+    hasBoxComponent = fieldType.isa<fir::BaseBoxType>();
+    if (componentBaseType.isa<fir::SequenceType>() &&
+        baseType.isa<fir::SequenceType>() &&
+        (numSubscripts == 0 || subscriptsRank > 0))
+      return emitOpError("indices must be provided and must not contain "
+                         "triplets when both memref and component are arrays");
+    if (numSubscripts != 0) {
+      if (!componentBaseType.isa<fir::SequenceType>())
+        return emitOpError("indices must not be provided if component appears "
+                           "and is not an array component");
+      if (!getComponentShape())
+        return emitOpError(
+            "component_shape must be provided when indexing a component");
+      mlir::Type compShapeType = getComponentShape().getType();
+      unsigned componentRank =
+          componentBaseType.cast<fir::SequenceType>().getDimension();
+      auto shapeType = compShapeType.dyn_cast<fir::ShapeType>();
+      auto shapeShiftType = compShapeType.dyn_cast<fir::ShapeShiftType>();
+      if (!((shapeType && shapeType.getRank() == componentRank) ||
+            (shapeShiftType && shapeShiftType.getRank() == componentRank)))
+        return emitOpError("component_shape must be a fir.shape or "
+                           "fir.shapeshift with the rank of the component");
+      if (numSubscripts > componentRank)
+        return emitOpError("indices number must match array component rank");
+    }
+    if (auto baseSeqType = baseType.dyn_cast<fir::SequenceType>())
+      // This case must come first to cover "array%array_comp(i, j)" that has
+      // subscripts for the component but whose rank come from the base.
+      outputRank = baseSeqType.getDimension();
+    else if (numSubscripts != 0)
+      outputRank = subscriptsRank;
+    else if (auto componentSeqType =
+                 componentBaseType.dyn_cast<fir::SequenceType>())
+      outputRank = componentSeqType.getDimension();
+    else
+      outputRank = 0;
+    outputElementType = fir::unwrapSequenceType(componentBaseType);
+  } else {
+    outputElementType = baseElementType;
+    unsigned baseTypeRank =
+        baseType.isa<fir::SequenceType>()
+            ? baseType.cast<fir::SequenceType>().getDimension()
+            : 0;
+    if (numSubscripts != 0) {
+      if (baseTypeRank != numSubscripts)
+        return emitOpError("indices number must match memref rank");
+      outputRank = subscriptsRank;
+    } else if (auto baseSeqType = baseType.dyn_cast<fir::SequenceType>()) {
+      outputRank = baseSeqType.getDimension();
+    }
+  }
+
+  if (!getSubstring().empty()) {
+    if (!outputElementType.isa<fir::CharacterType>())
+      return emitOpError("memref or component must have character type if "
+                         "substring indices are provided");
+    if (getSubstring().size() != 2)
+      return emitOpError("substring must contain 2 indices when provided");
+  }
+  if (getComplexPart()) {
+    if (!fir::isa_complex(outputElementType))
+      return emitOpError("memref or component must have complex type if "
+                         "complex_part is provided");
+    if (auto firCplx = outputElementType.dyn_cast<fir::ComplexType>())
+      outputElementType = firCplx.getElementType();
+    else
+      outputElementType =
+          outputElementType.cast<mlir::ComplexType>().getElementType();
+  }
+  mlir::Type resultBaseType =
+      getFortranElementOrSequenceType(getResult().getType());
+  unsigned resultRank = 0;
+  if (auto resultSeqType = resultBaseType.dyn_cast<fir::SequenceType>())
+    resultRank = resultSeqType.getDimension();
+  if (resultRank != outputRank)
+    return emitOpError("result type rank is not consistent with operands, "
+                       "expected rank ")
+           << outputRank;
+  mlir::Type resultElementType = fir::unwrapSequenceType(resultBaseType);
+  // result type must match the one that was inferred here, except the character
+  // length may differ because of substrings.
+  if (resultElementType != outputElementType &&
+      !(resultElementType.isa<fir::CharacterType>() &&
+        outputElementType.isa<fir::CharacterType>()))
+    return emitOpError(
+               "result element type is not consistent with operands, expected ")
+           << outputElementType;
+
+  if (isBoxAddressType(getResult().getType())) {
+    if (!hasBoxComponent || numSubscripts != 0 || !getSubstring().empty() ||
+        getComplexPart())
+      return emitOpError(
+          "result type must only be a box address type if it designates a "
+          "component that is a fir.box or fir.class and if there are no "
+          "indices, substrings, and complex part");
+
+  } else {
+    if ((resultRank == 0) != !getShape())
+      return emitOpError("shape must be provided if and only if the result is "
+                         "an array that is not a box address");
+    if (resultRank != 0) {
+      auto shapeType = getShape().getType().dyn_cast<fir::ShapeType>();
+      auto shapeShiftType =
+          getShape().getType().dyn_cast<fir::ShapeShiftType>();
+      if (!((shapeType && shapeType.getRank() == resultRank) ||
+            (shapeShiftType && shapeShiftType.getRank() == resultRank)))
+        return emitOpError("shape must be a fir.shape or fir.shapeshift with "
+                           "the rank of the result");
+    }
+    auto numLenParam = getTypeparams().size();
+    if (outputElementType.isa<fir::CharacterType>()) {
+      if (numLenParam != 1)
+        return emitOpError("must be provided one length parameter when the "
+                           "result is a character");
+    } else if (fir::isRecordWithTypeParameters(outputElementType)) {
+      if (numLenParam !=
+          outputElementType.cast<fir::RecordType>().getNumLenParams())
+        return emitOpError("must be provided the same number of length "
+                           "parameters as in the result derived type");
+    } else if (numLenParam != 0) {
+      return emitOpError("must not be provided length parameters if the result "
+                         "type does not have length parameters");
+    }
+  }
+  return mlir::success();
+}
+
 #define GET_OP_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"

flang/test/HLFIR/designate.fir

+// Test hlfir.designate operation parse, verify (no errors), and unparse.
+
+// RUN: fir-opt %s | fir-opt | FileCheck %s
+
+// array(1)
+func.func @array_ref(%arg0 : !fir.ref<!fir.array<10xi32>>) {
+  %c1 = arith.constant 1 : index
+  %0 = hlfir.designate %arg0 (%c1) :  (!fir.ref<!fir.array<10xi32>>, index) -> !fir.ref<i32>
+  return
+}
+// CHECK-LABEL: func.func @array_ref(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<10xi32>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_0]] (%[[VAL_1]]) :  (!fir.ref<!fir.array<10xi32>>, index) -> !fir.ref<i32>
+
+// array(1, 2:3:4, 5)
+func.func @array_section(%arg0 : !fir.box<!fir.array<10x?x30xi32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %c5 = arith.constant 5 : index
+  %shape = fir.undefined !fir.shape<1>
+  %0 = hlfir.designate %arg0 (%c1, %c2:%c3:%c4, %c5) shape %shape:  (!fir.box<!fir.array<10x?x30xi32>>, index, index, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<?xi32>>
+  return
+}
+// CHECK-LABEL: func.func @array_section(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<10x?x30xi32>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_4:.*]] = arith.constant 4 : index
+// CHECK:  %[[VAL_5:.*]] = arith.constant 5 : index
+// CHECK:  %[[VAL_6:.*]] = fir.undefined !fir.shape<1>
+// CHECK:  %[[VAL_7:.*]] = hlfir.designate %[[VAL_0]] (%[[VAL_1]], %[[VAL_2]]:%[[VAL_3]]:%[[VAL_4]], %[[VAL_5]]) shape %[[VAL_6]] : (!fir.box<!fir.array<10x?x30xi32>>, index, index, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<?xi32>>
+
+// array%comp
+func.func @component_ref(%arg0 : !fir.box<!fir.array<10x!fir.type<t{i:i32}>>>) {
+  %shape = fir.undefined !fir.shape<1>
+  %0 = hlfir.designate %arg0 {"i"} shape %shape:  (!fir.box<!fir.array<10x!fir.type<t{i:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<10xi32>>
+  return
+}
+// CHECK-LABEL: func.func @component_ref(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<10x!fir.type<t{i:i32}>>>) {
+// CHECK:  %[[VAL_1:.*]] = fir.undefined !fir.shape<1>
+// CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_0]]{"i"} shape %[[VAL_1]] : (!fir.box<!fir.array<10x!fir.type<t{i:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<10xi32>>
+
+// array%array_comp(1)
+func.func @component_array_ref(%arg0 : !fir.box<!fir.array<10x!fir.type<t2{array_comp:!fir.array<100xi32>}>>>) {
+  %c1 = arith.constant 1 : index
+  %component_shape = fir.undefined !fir.shapeshift<1>
+  %result_shape = fir.undefined !fir.shape<1>
+  %0 = hlfir.designate %arg0 {"array_comp"}<%component_shape>(%c1) shape %result_shape : (!fir.box<!fir.array<10x!fir.type<t2{array_comp:!fir.array<100xi32>}>>>, !fir.shapeshift<1>, index, !fir.shape<1>) -> !fir.box<!fir.array<10xi32>>
+  return
+}
+// CHECK-LABEL: func.func @component_array_ref(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<10x!fir.type<t2{array_comp:!fir.array<100xi32>}>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = fir.undefined !fir.shapeshift<1>
+// CHECK:  %[[VAL_3:.*]] = fir.undefined !fir.shape<1>
+// CHECK:  %[[VAL_4:.*]] = hlfir.designate %[[VAL_0]]{"array_comp"} <%[[VAL_2]]> (%[[VAL_1]]) shape %[[VAL_3]] : (!fir.box<!fir.array<10x!fir.type<t2{array_comp:!fir.array<100xi32>}>>>, !fir.shapeshift<1>, index, !fir.shape<1>) -> !fir.box<!fir.array<10xi32>>
+
+// char(3:4)
+func.func @substring(%arg0 : !fir.boxchar<1>) {
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %0 = hlfir.designate %arg0 substr %c3, %c4 typeparams %c2:  (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1>
+  return
+}
+// CHECK-LABEL: func.func @substring(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 4 : index
+// CHECK:  %[[VAL_4:.*]] = hlfir.designate %[[VAL_0]] substr %[[VAL_2]], %[[VAL_3]] typeparams %[[VAL_1]] : (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1>
+
+// char_array(3:4)
+func.func @array_substring(%arg0 : !fir.box<!fir.array<10x!fir.char<1,?>>>) {
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %shape = fir.undefined !fir.shape<1>
+  %0 = hlfir.designate %arg0 substr %c3, %c4 shape %shape typeparams %c2 : (!fir.box<!fir.array<10x!fir.char<1,?>>>, index, index, !fir.shape<1>, index) -> !fir.box<!fir.array<10x!fir.char<1,?>>>
+  return
+}
+// CHECK-LABEL: func.func @array_substring(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<10x!fir.char<1,?>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 4 : index
+// CHECK:  %[[VAL_4:.*]] = fir.undefined !fir.shape<1>
+// CHECK:  %[[VAL_5:.*]] = hlfir.designate %[[VAL_0]] substr %[[VAL_2]], %[[VAL_3]] shape %[[VAL_4]] typeparams %[[VAL_1]] : (!fir.box<!fir.array<10x!fir.char<1,?>>>, index, index, !fir.shape<1>, index) -> !fir.box<!fir.array<10x!fir.char<1,?>>>
+
+func.func @real_part(%arg0 : !fir.ref<!fir.complex<4>>) {
+  %0 = hlfir.designate %arg0 real :  (!fir.ref<!fir.complex<4>>) -> !fir.ref<!fir.real<4>>
+  return
+}
+// CHECK-LABEL: func.func @real_part(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.complex<4>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.designate %[[VAL_0]] real :  (!fir.ref<!fir.complex<4>>) -> !fir.ref<!fir.real<4>>
+
+func.func @imag_part_mlir_complex(%arg0 : !fir.ref<complex<f32>>) {
+  %0 = hlfir.designate %arg0 imag :  (!fir.ref<complex<f32>>) -> !fir.ref<f32>
+  return
+}
+// CHECK-LABEL: func.func @imag_part_mlir_complex(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<complex<f32>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.designate %[[VAL_0]] imag :  (!fir.ref<complex<f32>>) -> !fir.ref<f32>
+
+// array%array_complex_comp(1)%im
+func.func @component_array_ref_cplx_part(%arg0 : !fir.box<!fir.array<10x!fir.type<t3{array_comp:!fir.array<100x!fir.complex<8>>}>>>) {
+  %c1 = arith.constant 1 : index
+  %component_shape = fir.undefined !fir.shapeshift<1>
+  %result_shape = fir.undefined !fir.shape<1>
+  %0 = hlfir.designate %arg0 {"array_comp"}<%component_shape>(%c1) imag shape %result_shape : (!fir.box<!fir.array<10x!fir.type<t3{array_comp:!fir.array<100x!fir.complex<8>>}>>>, !fir.shapeshift<1>, index, !fir.shape<1>) -> !fir.box<!fir.array<10x!fir.real<8>>>
+  return
+}
+// CHECK-LABEL: func.func @component_array_ref_cplx_part(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<10x!fir.type<t3{array_comp:!fir.array<100x!fir.complex<8>>}>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = fir.undefined !fir.shapeshift<1>
+// CHECK:  %[[VAL_3:.*]] = fir.undefined !fir.shape<1>
+// CHECK:  %[[VAL_4:.*]] = hlfir.designate %[[VAL_0]]{"array_comp"} <%[[VAL_2]]> (%[[VAL_1]]) imag shape %[[VAL_3]] : (!fir.box<!fir.array<10x!fir.type<t3{array_comp:!fir.array<100x!fir.complex<8>>}>>>, !fir.shapeshift<1>, index, !fir.shape<1>) -> !fir.box<!fir.array<10x!fir.real<8>>>
+
+// pdt_array(1)
+func.func @pdt(%arg0 : !fir.box<!fir.array<?x!fir.type<pdt(param:i32){field:i32}>>>) {
+  %c1 = arith.constant 1 : index
+  %0 = hlfir.designate %arg0(%c1) typeparams %c1 :  (!fir.box<!fir.array<?x!fir.type<pdt(param:i32){field:i32}>>>, index, index) -> !fir.box<!fir.type<pdt(param:i32){field:i32}>>
+  return
+}
+// CHECK-LABEL: func.func @pdt(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<pdt(param:i32){field:i32}>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = hlfir.designate %[[VAL_0]] (%[[VAL_1]]) typeparams %[[VAL_1]] : (!fir.box<!fir.array<?x!fir.type<pdt(param:i32){field:i32}>>>, index, index) -> !fir.box<!fir.type<pdt(param:i32){field:i32}>>

flang/test/HLFIR/invalid.fir

 }
 
 // -----
 func.func @bad_assign_array_2(%arg0: !fir.ref<!fir.array<10xi32>>, %arg1: !hlfir.expr<?xi32>) {
   // expected-error@+1 {{'hlfir.assign' op operand #1 must be any HLFIR variable type, but got '!hlfir.expr<?xi32>'}}
   hlfir.assign %arg0 to %arg1 : !fir.ref<!fir.array<10xi32>>, !hlfir.expr<?xi32>
   return
 }
+
+// -----
+func.func @bad_designate_component(%arg0 : !fir.ref<i32>) {
+  // expected-error@+1 {{'hlfir.designate' op component must be provided only when the memref is a derived type}}
+  %0 = hlfir.designate %arg0 {"some_component"} :  (!fir.ref<i32>) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_component_2(%arg0 : !fir.ref<!fir.type<t{i:i32}>>) {
+  // expected-error@+1 {{'hlfir.designate' op component "bad_comp" is not a component of memref element type '!fir.type<t{i:i32}>'}}
+  %0 = hlfir.designate %arg0 {"bad_comp"} :  (!fir.ref<!fir.type<t{i:i32}>>) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_component_3(%arg0 : !fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>) {
+  // expected-error@+1 {{'hlfir.designate' op indices must be provided and must not contain triplets when both memref and component are arrays}}
+  %0 = hlfir.designate %arg0 {"i"} :  (!fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_component_4(%arg0 : !fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>) {
+  %component_shape = fir.undefined !fir.shape<1>
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op indices must be provided and must not contain triplets when both memref and component are arrays}}
+  %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1:%c1:%c1):  (!fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>, !fir.shape<1>, index, index, index) -> !fir.ref<!fir.array<20xi32>>
+  return
+}
+
+// -----
+func.func @bad_designate_component_5(%arg0 : !fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>) {
+  %component_shape = fir.undefined !fir.shape<2>
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op component_shape must be a fir.shape or fir.shapeshift with the rank of the component}}
+  %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1):  (!fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>, !fir.shape<2>, index) -> !fir.ref<!fir.array<20xi32>>
+  return
+}
+
+// -----
+func.func @bad_designate_component_6(%arg0 : !fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>) {
+  %component_shape = fir.undefined !fir.shift<1>
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op component_shape must be a fir.shape or fir.shapeshift with the rank of the component}}
+  %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1):  (!fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>, !fir.shift<1>, index) -> !fir.ref<!fir.array<20xi32>>
+  return
+}
+
+// -----
+func.func @bad_designate_component_7(%arg0 : !fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>) {
+  %component_shape = fir.undefined !fir.shapeshift<2>
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op component_shape must be a fir.shape or fir.shapeshift with the rank of the component}}
+  %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1):  (!fir.ref<!fir.array<20x!fir.type<t{i:!fir.array<100xi32>}>>>, !fir.shapeshift<2>, index) -> !fir.ref<!fir.array<20xi32>>
+  return
+}
+
+// -----
+func.func @bad_designate_component_8(%arg0 : !fir.ref<!fir.type<t{i:!fir.array<100xi32>}>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op component_shape must be provided when indexing a component}}
+  %0 = hlfir.designate %arg0 {"i"}(%c1):  (!fir.ref<!fir.type<t{i:!fir.array<100xi32>}>>, index) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_component_9(%arg0 : !fir.ref<!fir.array<20x!fir.type<t{i:i32}>>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op indices must not be provided if component appears and is not an array component}}
+  %0 = hlfir.designate %arg0 {"i"}(%c1):  (!fir.ref<!fir.array<20x!fir.type<t{i:i32}>>>, index) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_component_10(%arg0 : !fir.ref<!fir.type<t{i:!fir.array<100xi32>}>>) {
+  %component_shape = fir.undefined !fir.shapeshift<1>
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op indices number must match array component rank}}
+  %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1, %c1):  (!fir.ref<!fir.type<t{i:!fir.array<100xi32>}>>, !fir.shapeshift<1>, index, index) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_substring_1(%arg0 : !fir.ref<!fir.char<1,20>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op substring must contain 2 indices when provided}}
+  %0 = hlfir.designate %arg0 substr %c1, %c1, %c1:  (!fir.ref<!fir.char<1,20>>, index, index, index) -> !fir.boxchar<1>
+  return
+}
+
+// -----
+func.func @bad_designate_indices_1(%arg0 : !fir.ref<i32>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op indices number must match memref rank}}
+  %0 = hlfir.designate %arg0 (%c1, %c1):  (!fir.ref<i32>, index, index) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_indices_2(%arg0 : !fir.ref<!fir.array<10xi32>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op indices number must match memref rank}}
+  %0 = hlfir.designate %arg0 (%c1, %c1):  (!fir.ref<!fir.array<10xi32>>, index, index) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_substring_2(%arg0 : !fir.ref<i32>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op memref or component must have character type if substring indices are provided}}
+  %0 = hlfir.designate %arg0 substr %c1, %c1:  (!fir.ref<i32>, index, index) -> !fir.boxchar<1>
+  return
+}
+
+// -----
+func.func @bad_designate_cmplx_part(%arg0 : !fir.ref<!fir.array<10xi32>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op memref or component must have complex type if complex_part is provided}}
+  %0 = hlfir.designate %arg0 (%c1) imag:  (!fir.ref<!fir.array<10xi32>>, index) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_out_rank(%arg0 : !fir.ref<!fir.array<10xi32>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op result type rank is not consistent with operands, expected rank 1}}
+  %0 = hlfir.designate %arg0 (%c1:%c1:%c1):  (!fir.ref<!fir.array<10xi32>>, index, index, index) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_out_type(%arg0 : !fir.ref<!fir.complex<4>>) {
+  // expected-error@+1 {{'hlfir.designate' op result element type is not consistent with operands, expected '!fir.real<4>'}}
+  %0 = hlfir.designate %arg0 imag:  (!fir.ref<!fir.complex<4>>) -> !fir.ref<!fir.complex<4>>
+  return
+}
+
+// -----
+func.func @bad_designate_out_type(%arg0 : !fir.ref<!fir.box<!fir.complex<4>>>) {
+  // expected-error@+1 {{'hlfir.designate' op result type must only be a box address type if it designates a component that is a fir.box or fir.class and if there are no indices, substrings, and complex part}}
+  %0 = hlfir.designate %arg0 imag:  (!fir.ref<!fir.box<!fir.complex<4>>>) -> !fir.ref<!fir.box<!fir.real<4>>>
+  return
+}
+
+// -----
+func.func @bad_designate_shape(%arg0 : !fir.ref<!fir.array<10xi32>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op shape must be provided if and only if the result is an array that is not a box address}}
+  %0 = hlfir.designate %arg0 (%c1:%c1:%c1):  (!fir.ref<!fir.array<10xi32>>, index, index, index) -> !fir.box<!fir.array<?xi32>>
+  return
+}
+
+// -----
+func.func @bad_designate_shape_2(%arg0 : !fir.ref<!fir.array<10xi32>>) {
+  %c1 = arith.constant 1 : index
+  %shape = fir.undefined !fir.shape<1>
+  // expected-error@+1 {{'hlfir.designate' op shape must be provided if and only if the result is an array that is not a box address}}
+  %0 = hlfir.designate %arg0 (%c1) shape %shape:  (!fir.ref<!fir.array<10xi32>>, index, !fir.shape<1>) -> !fir.ref<i32>
+  return
+}
+
+// -----
+func.func @bad_designate_len_params(%arg0 : !fir.ref<!fir.char<1,10>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op must be provided one length parameter when the result is a character}}
+  %0 = hlfir.designate %arg0 substr %c1, %c1:  (!fir.ref<!fir.char<1,10>>, index, index) -> !fir.boxchar<1>
+  return
+}
+
+// -----
+func.func @bad_designate_len_params_2(%arg0 : !fir.box<!fir.array<?x!fir.type<pdt(param:i32){field:i32}>>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op must be provided the same number of length parameters as in the result derived type}}
+  %0 = hlfir.designate %arg0(%c1) typeparams %c1, %c1 :  (!fir.box<!fir.array<?x!fir.type<pdt(param:i32){field:i32}>>>, index, index, index) -> !fir.box<!fir.type<pdt(param:i32){field:i32}>>
+  return
+}
+
+// -----
+func.func @bad_designate_len_params_3(%arg0 : !fir.box<!fir.array<?xi32>>) {
+  %c1 = arith.constant 1 : index
+  // expected-error@+1 {{'hlfir.designate' op must not be provided length parameters if the result type does not have length parameters}}
+  %0 = hlfir.designate %arg0(%c1) typeparams %c1 :  (!fir.box<!fir.array<?xi32>>, index, index) -> !fir.ref<i32>
+  return
+}