[flang] Add hlfir.declare operation

[jeanPerier]

Summary

This operation will be used to declare named variables in HLFIR.
See the added description in HLFIROpBase.td for more info about it.

The motivation behind this operation is described in https://reviews.llvm.org/D137634.

The FortranVariableInterface verifier is changed a bit. It used to
operate using the result type to verify the provided shape and length
parameters. This is a bit incorrect because what matters to verify the
information is the input address (This worked OK with fir.declare where
the input memref type is the same as the output result). Also, not all
operation defining variables will have an input memref with the same
meaning (hlfir.designate and hlfir.associate for instance).
Hence, this verifier is now optional and must be provided a memref to
operate.

[clementval]

LGTM

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

43

is there a , missing between address and bounds?

[jeanPerier]

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

43

Yes, thanks

flang/include/flang/Optimizer/Dialect/FIROps.td

def fir_DeclareOp : fir_Op<"declare", [AttrSizedOperandSegments,
   );
 
   let results = (outs AnyRefOrBox);
 
   let assemblyFormat = [{
     $memref (`(` $shape^ `)`)? (`typeparams` $typeparams^)?
      attr-dict `:` functional-type(operands, results)
   }];
+
+  let hasVerifier = 1;
 }
 
 #endif

flang/include/flang/Optimizer/Dialect/FIRType.h

 inline mlir::Type wrapInClassOrBoxType(mlir::Type eleTy,
                                        bool isPolymorphic = false,
                                        bool isAssumedType = false) {
   if (isPolymorphic && !isAssumedType)
     return fir::ClassType::get(eleTy);
   return fir::BoxType::get(eleTy);
 }
 
+/// Is `t` an address to fir.box or class type?
+inline bool isBoxAddress(mlir::Type t) {
+  return fir::isa_ref_type(t) && fir::unwrapRefType(t).isa<fir::BaseBoxType>();
+}
+
+/// Is `t` a fir.box or class address or value type?
+inline bool isBoxAddressOrValue(mlir::Type t) {
+  return fir::unwrapRefType(t).isa<fir::BaseBoxType>();
+}
+
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_DIALECT_FIRTYPE_H

flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td

let methods = [
     >,
   ];
 
   let extraClassDeclaration = [{
 
     /// Get the sequence type or scalar value type corresponding to this
     /// variable.
     mlir::Type getElementOrSequenceType() {
-      return fir::unwrapPassByRefType(fir::unwrapRefType(getBase().getType()));
+      mlir::Type type = fir::unwrapPassByRefType(fir::unwrapRefType(getBase().getType()));
+      if (auto boxCharType = type.dyn_cast<fir::BoxCharType>())
+        return boxCharType.getEleTy();
+      return type;
     }
 
     /// Get the scalar value type corresponding to this variable.
     mlir::Type getElementType() {
       return fir::unwrapSequenceType(getElementOrSequenceType());
     }
 
     /// Is the variable an array ?
let extraClassDeclaration = [{
 
     /// Is this variable represented as a fir.box or fir.class value ?
     bool isBoxValue() {
       return getBase().getType().isa<fir::BaseBoxType>();
     }
 
     /// Is this variable represented as a fir.box or fir.class address ?
     bool isBoxAddress() {
-      mlir::Type type = getBase().getType();
-      return fir::isa_ref_type(type) &&
-         fir::unwrapRefType(type).isa<fir::BaseBoxType>();
+      return fir::isBoxAddress(getBase().getType());
     }
 
     /// Is this variable represented as the value or address of a fir.box or
     /// fir.class ?
     bool isBox() {
-      return fir::unwrapRefType(getBase().getType()).isa<fir::BaseBoxType>();
+      return fir::isBoxAddressOrValue(getBase().getType());
     }
 
-    /// Interface verifier imlementation.
-    mlir::LogicalResult verifyImpl();
+    /// Interface verifier imlementation for declare operations
+    mlir::LogicalResult verifyDeclareLikeOpImpl(mlir::Value memRef);
 
   }];
 
   let cppNamespace = "fir";
 
-  let verify = [{
-    return ::mlir::cast<::fir::FortranVariableOpInterface>($_op).verifyImpl();
-  }];
 }
 
 #endif  // FORTRANVARIABLEINTERFACE

flang/include/flang/Optimizer/HLFIR/CMakeLists.txt

 set(LLVM_TARGET_DEFINITIONS HLFIROpBase.td)
 mlir_tablegen(HLFIRTypes.h.inc -gen-typedef-decls)
 mlir_tablegen(HLFIRTypes.cpp.inc -gen-typedef-defs)
 mlir_tablegen(HLFIRDialect.h.inc -gen-dialect-decls -dialect=hlfir)
 mlir_tablegen(HLFIRDialect.cpp.inc -gen-dialect-defs -dialect=hlfir)
 mlir_tablegen(HLFIRAttributes.h.inc -gen-attrdef-decls -attrdefs-dialect=hlfir)
 mlir_tablegen(HLFIRAttributes.cpp.inc -gen-attrdef-defs -attrdefs-dialect=hlfir)
+
+set(LLVM_TARGET_DEFINITIONS HLFIROps.td)
+mlir_tablegen(HLFIROps.h.inc -gen-op-decls)
+mlir_tablegen(HLFIROps.cpp.inc -gen-op-defs)
+
 add_public_tablegen_target(HLFIROpsIncGen)

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

 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H
 #define FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_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"
 
 #endif // FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H

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

let extraClassDeclaration = [{
     bool isArray() const { return !getShape().empty(); }
     bool isPolymorphic() const { return getPolymorphic(); }
   }];
 
   let hasCustomAssemblyFormat = 1;
 
 }
 
+def IsFortranVariablePred
+        : CPred<"::hlfir::isFortranVariableType($_self)">;
+
+def AnyFortranVariableLike : Type<IsFortranVariablePred, "any HLFIR variable type">;
+
 #endif // FORTRAN_DIALECT_HLFIR_OP_BASE

flang/include/flang/Optimizer/HLFIR/HLFIROps.h

+//===-- HLFIROps.h - FIR operations -----------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_HLFIR_HLFIROPS_H
+#define FORTRAN_OPTIMIZER_HLFIR_HLFIROPS_H
+
+#include "flang/Optimizer/Dialect/FIRAttr.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Optimizer/Dialect/FortranVariableInterface.h"
+#include "flang/Optimizer/HLFIR/HLFIRDialect.h"
+#include "mlir/Interfaces/SideEffectInterfaces.h"
+
+#define GET_OP_CLASSES
+#include "flang/Optimizer/HLFIR/HLFIROps.h.inc"
+
+#endif // FORTRAN_OPTIMIZER_HLFIR_HLFIROPS_H

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

+//===-- HLFIROps.td - HLFIR operation definitions ----------*- tablegen -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+///
+/// \file
+/// Definition of the HLFIR dialect operations
+///
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_DIALECT_HLFIR_OPS
+#define FORTRAN_DIALECT_HLFIR_OPS
+
+include "flang/Optimizer/HLFIR/HLFIROpBase.td"
+include "flang/Optimizer/Dialect/FIRTypes.td"
+include "flang/Optimizer/Dialect/FIRAttr.td"
+include "flang/Optimizer/Dialect/FortranVariableInterface.td"
+include "mlir/IR/BuiltinAttributes.td"
+
+// Base class for FIR operations.
+// All operations automatically get a prefix of "hlfir.".
+class hlfir_Op<string mnemonic, list<Trait> traits>
+  : Op<hlfir_Dialect, mnemonic, traits>;
+
+
+
+def hlfir_DeclareOp : hlfir_Op<"declare", [AttrSizedOperandSegments,
+    DeclareOpInterfaceMethods<fir_FortranVariableOpInterface>]> {
+  let summary = "declare a variable and produce an SSA value that can be used as a variable in HLFIR operations";
+
+  let description = [{
+    Tie the properties of a Fortran variable to an address. The properties
+    include bounds, length parameters, and Fortran attributes.
+
+    The arguments are the same as for fir.declare.
+
+    The main difference with fir.declare is that hlfir.declare returns two
+    values:
+      - the first one is an SSA value that allows retrieving the variable
+        address bounds, and type parameters at any point without requiring
+        access to the defining operation. This may be:
+        - for scalar numerical, logical, or derived type without length
+          parameters: a fir.ref<T> (e.g. fir.ref<i32>)
+        - for scalar characters: a fir.boxchar<kind> or fir.ref<fir.char<kind,
+          cst_len>>
+        - for arrays of types without length parameters, without lower bounds,
+          that are not polymorphic and with a constant shape:
+          fir.ref<fir.array<cst_shapexT>>
+        - for all non pointer/non allocatable entities: fir.box<T>, and
+          fir.class<T> for polymorphic entities.
+        - for all pointers/allocatables:
+          fir.ref<fir.box<fir.ptr<T>>>/fir.ref<fir.box<fir.heap<T>>>
+      - the second value has the same type as the input memref, and is the
+        same. If it is a fir.box or fir.class, it may not contain accurate
+        local lower bound values. It is intended to be used when generating FIR
+        from HLFIR in order to avoid descriptor creation for simple entities.
+
+    Example:
+
+    CHARACTER(n) :: c(10:n, 20:n)
+
+    Can be represented as:
+    ```
+    func.func @foo(%arg0: !fir.ref<!fir.array<?x?x!fir.char<1,?>>>, %arg1: !fir.ref<i64>) {
+      %c10 = arith.constant 10 : index
+      %c20 = arith.constant 20 : index
+      %1 = fir.load %ag1 : fir.ref<i64>
+      %2 = fir.shape_shift %c10, %1, %c20, %1 : (index, index, index, index) -> !fir.shapeshift<2>
+      %3 = hfir.declare %arg0(%2) typeparams %1 {uniq_name = "c"} (fir.ref<!fir.array<?x?x!fir.char<1,?>>>, fir.shapeshift<2>, index) -> (fir.box<!fir.array<?x?x!fir.char<1,?>>>, fir.ref<!fir.array<?x?x!fir.char<1,?>>>) 
+      // ... uses %3#0 as "c"
+    }
+   ```
+  }];
+
+  let arguments = (ins
+    AnyRefOrBox:$memref,
+    Optional<AnyShapeOrShiftType>:$shape,
+    Variadic<AnyIntegerType>:$typeparams,
+    Builtin_StringAttr:$uniq_name,
+    OptionalAttr<fir_FortranVariableFlagsAttr>:$fortran_attrs
+  );
+
+  let results = (outs AnyFortranVariableLike, AnyRefOrBoxLike);
+
+  let assemblyFormat = [{
+    $memref (`(` $shape^ `)`)? (`typeparams` $typeparams^)?
+     attr-dict `:` functional-type(operands, results)
+  }];
+
+  let builders = [
+    OpBuilder<(ins "mlir::Value":$memref, "llvm::StringRef":$uniq_name,
+      CArg<"mlir::Value", "{}">:$shape, CArg<"mlir::ValueRange", "{}">:$typeparams,
+      CArg<"fir::FortranVariableFlagsAttr", "{}">:$fortran_attrs)>];
+
+  let extraClassDeclaration = [{
+    /// Get the variable original base (same as input). It lacks
+    /// any explicit lower bounds and the extents might not be retrievable
+    /// from it. This matches what is used as a "base" in FIR.
+    mlir::Value getOriginalBase() {
+      return getResult(1);
+    }
+
+    /// Override FortranVariableInterface default implementation
+    mlir::Value getBase() {
+      return getResult(0);
+    }
+
+    /// Given a FIR memory type, and information about non default lower
+    /// bounds, get the related HLFIR variable type.
+    static mlir::Type getHLFIRVariableType(mlir::Type type, bool hasLowerBounds);
+  }];
+
+  let hasVerifier = 1;
+}
+
+#endif // FORTRAN_DIALECT_HLFIR_OPS

flang/lib/Optimizer/Dialect/FIROps.cpp

eleTy = llvm::TypeSwitch<mlir::Type, mlir::Type>(eleTy)
                     return ty.getElementType();
                   return mlir::Type{};
                 })
                 .Default([&](const auto &) { return mlir::Type{}; });
   }
   return eleTy;
 }
 
+mlir::LogicalResult fir::DeclareOp::verify() {
+  auto fortranVar =
+      mlir::cast<fir::FortranVariableOpInterface>(this->getOperation());
+  return fortranVar.verifyDeclareLikeOpImpl(getMemref());
+}
+
 // Tablegen operators
 
 #define GET_OP_CLASSES
 #include "flang/Optimizer/Dialect/FIROps.cpp.inc"

flang/lib/Optimizer/Dialect/FortranVariableInterface.cpp

 //===-- FortranVariableInterface.cpp.cpp ----------------------------------===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Dialect/FortranVariableInterface.h"
 
 #include "flang/Optimizer/Dialect/FortranVariableInterface.cpp.inc"
 
-mlir::LogicalResult fir::FortranVariableOpInterface::verifyImpl() {
+mlir::LogicalResult
+fir::FortranVariableOpInterface::verifyDeclareLikeOpImpl(mlir::Value memref) {
   const unsigned numExplicitTypeParams = getExplicitTypeParams().size();
+  mlir::Type memType = memref.getType();
+  const bool sourceIsBoxValue = memType.isa<fir::BaseBoxType>();
+  const bool sourceIsBoxAddress = fir::isBoxAddress(memType);
+  const bool sourceIsBox = sourceIsBoxValue || sourceIsBoxAddress;
   if (isCharacter()) {
     if (numExplicitTypeParams > 1)
       return emitOpError(
           "of character entity must have at most one length parameter");
-    if (numExplicitTypeParams == 0 && !isBox())
+    if (numExplicitTypeParams == 0 && !sourceIsBox)
       return emitOpError("must be provided exactly one type parameter when its "
                          "base is a character that is not a box");
 
   } else if (auto recordType = getElementType().dyn_cast<fir::RecordType>()) {
-    if (numExplicitTypeParams < recordType.getNumLenParams() && !isBox())
+    if (numExplicitTypeParams < recordType.getNumLenParams() && !sourceIsBox)
       return emitOpError("must be provided all the derived type length "
                          "parameters when the base is not a box");
     if (numExplicitTypeParams > recordType.getNumLenParams())
       return emitOpError("has too many length parameters");
   } else if (numExplicitTypeParams != 0) {
     return emitOpError("of numeric, logical, or assumed type entity must not "
                        "have length parameters");
   }
 
   if (isArray()) {
     if (mlir::Value shape = getShape()) {
-      if (isBoxAddress())
+      if (sourceIsBoxAddress)
         return emitOpError("for box address must not have a shape operand");
       unsigned shapeRank = 0;
       if (auto shapeType = shape.getType().dyn_cast<fir::ShapeType>()) {
         shapeRank = shapeType.getRank();
       } else if (auto shapeShiftType =
                      shape.getType().dyn_cast<fir::ShapeShiftType>()) {
         shapeRank = shapeShiftType.getRank();
       } else {
-        if (!isBoxValue())
+        if (!sourceIsBoxValue)
           emitOpError("of array entity with a raw address base must have a "
                       "shape operand that is a shape or shapeshift");
         shapeRank = shape.getType().cast<fir::ShiftType>().getRank();
       }
 
       llvm::Optional<unsigned> rank = getRank();
       if (!rank || *rank != shapeRank)
         return emitOpError("has conflicting shape and base operand ranks");
-    } else if (!isBox()) {
+    } else if (!sourceIsBox) {
       emitOpError("of array entity with a raw address base must have a shape "
                   "operand that is a shape or shapeshift");
     }
   }
   return mlir::success();
 }

flang/lib/Optimizer/HLFIR/IR/CMakeLists.txt

 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(HLFIRDialect
   HLFIRDialect.cpp
+  HLFIROps.cpp
 
   DEPENDS
   FIRDialect
   HLFIROpsIncGen
   ${dialect_libs}
 
   LINK_LIBS
   FIRDialect
   MLIRIR
   ${dialect_libs}
 
   LINK_COMPONENTS
   AsmParser
   AsmPrinter
   Remarks
 )

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

 //===-- HLFIRDialect.cpp --------------------------------------------------===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/HLFIR/HLFIRDialect.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinTypes.h"
 #include "mlir/IR/DialectImplementation.h"
 #include "mlir/IR/Matchers.h"
 #include "mlir/IR/OpImplementation.h"
 #include "llvm/ADT/TypeSwitch.h"
 
 #include "flang/Optimizer/HLFIR/HLFIRDialect.cpp.inc"
 
 #define GET_TYPEDEF_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIRTypes.cpp.inc"
 
 #define GET_ATTRDEF_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIRAttributes.cpp.inc"
 
 void hlfir::hlfirDialect::initialize() {
   addTypes<
 #define GET_TYPEDEF_LIST
 #include "flang/Optimizer/HLFIR/HLFIRTypes.cpp.inc"
       >();
+  addOperations<
+#define GET_OP_LIST
+#include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"
+      >();
 }
 
 // `expr` `<` `*` | bounds (`x` bounds)* `:` type [`?`] `>`
 // bounds ::= `?` | int-lit
 mlir::Type hlfir::ExprType::parse(mlir::AsmParser &parser) {
   if (parser.parseLess())
     return {};
   ExprType::Shape shape;
for (const auto &b : shape) {
         printer << "?x";
     }
   }
   printer << getEleTy();
   if (isPolymorphic())
     printer << '?';
   printer << '>';
 }
+
+bool hlfir::isFortranVariableType(mlir::Type type) {
+  return llvm::TypeSwitch<mlir::Type, bool>(type)
+      .Case<fir::ReferenceType, fir::PointerType, fir::HeapType>([](auto p) {
+        mlir::Type eleType = p.getEleTy();
+        return eleType.isa<fir::BaseBoxType>() || !fir::hasDynamicSize(eleType);
+      })
+      .Case<fir::BaseBoxType, fir::BoxCharType>([](auto) { return true; })
+      .Default([](mlir::Type) { return false; });
+}

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

+//===-- HLFIROps.cpp ------------------------------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
+#include "mlir/IR/Builders.h"
+#include "mlir/IR/BuiltinTypes.h"
+#include "mlir/IR/DialectImplementation.h"
+#include "mlir/IR/Matchers.h"
+#include "mlir/IR/OpImplementation.h"
+#include "llvm/ADT/TypeSwitch.h"
+#include <tuple>
+
+//===----------------------------------------------------------------------===//
+// DeclareOp
+//===----------------------------------------------------------------------===//
+
+/// Given a FIR memory type, and information about non default lower bounds, get
+/// the related HLFIR variable type.
+mlir::Type hlfir::DeclareOp::getHLFIRVariableType(mlir::Type inputType,
+                                                  bool hasExplicitLowerBounds) {
+  mlir::Type type = fir::unwrapRefType(inputType);
+  if (type.isa<fir::BaseBoxType>())
+    return inputType;
+  if (auto charType = type.dyn_cast<fir::CharacterType>())
+    if (charType.hasDynamicLen())
+      return fir::BoxCharType::get(charType.getContext(), charType.getFKind());
+
+  auto seqType = type.dyn_cast<fir::SequenceType>();
+  bool hasDynamicExtents =
+      seqType && fir::sequenceWithNonConstantShape(seqType);
+  mlir::Type eleType = seqType ? seqType.getEleTy() : type;
+  bool hasDynamicLengthParams = fir::characterWithDynamicLen(eleType) ||
+                                fir::isRecordWithTypeParameters(eleType);
+  if (hasExplicitLowerBounds || hasDynamicExtents || hasDynamicLengthParams)
+    return fir::BoxType::get(type);
+  return inputType;
+}
+
+static bool hasExplicitLowerBounds(mlir::Value shape) {
+  return shape && shape.getType().isa<fir::ShapeShiftType, fir::ShiftType>();
+}
+
+void hlfir::DeclareOp::build(mlir::OpBuilder &builder,
+                             mlir::OperationState &result, mlir::Value memref,
+                             llvm::StringRef uniq_name, mlir::Value shape,
+                             mlir::ValueRange typeparams,
+                             fir::FortranVariableFlagsAttr fortran_attrs) {
+  auto nameAttr = builder.getStringAttr(uniq_name);
+  mlir::Type inputType = memref.getType();
+  bool hasExplicitLbs = hasExplicitLowerBounds(shape);
+  mlir::Type hlfirVariableType =
+      getHLFIRVariableType(inputType, hasExplicitLbs);
+  build(builder, result, {hlfirVariableType, inputType}, memref, shape,
+        typeparams, nameAttr, fortran_attrs);
+}
+
+mlir::LogicalResult hlfir::DeclareOp::verify() {
+  if (getMemref().getType() != getResult(1).getType())
+    return emitOpError("second result type must match input memref type");
+  mlir::Type hlfirVariableType = getHLFIRVariableType(
+      getMemref().getType(), hasExplicitLowerBounds(getShape()));
+  if (hlfirVariableType != getResult(0).getType())
+    return emitOpError("first result type is inconsistent with variable "
+                       "properties: expected ")
+           << 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());
+}
+
+#define GET_OP_CLASSES
+#include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"

flang/test/HLFIR/declare.fir

+// Test hlfir.declare operation parse, verify (no errors), and unparse.
+
+// RUN: fir-opt %s | fir-opt | FileCheck %s
+
+func.func @numeric_declare(%arg0: !fir.ref<f32>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+  return
+}
+// CHECK-LABEL:   func.func @numeric_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<f32>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+
+
+func.func @char_declare(%arg0: !fir.boxchar<1> ) {
+  %0:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+  %1:2 = hlfir.declare %0#0 typeparams %0#1 {uniq_name = "c"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+  return
+}
+// CHECK-LABEL:   func.func @char_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>) {
+// CHECK:  %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+// CHECK:  %[[VAL_2:.*]] = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 {uniq_name = "c"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+
+
+func.func @derived_declare(%arg0: !fir.ref<!fir.type<t{field:i32}>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<!fir.type<t{field:i32}>>) -> (!fir.ref<!fir.type<t{field:i32}>>, !fir.ref<!fir.type<t{field:i32}>>)
+  return
+}
+// CHECK-LABEL:   func.func @derived_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.type<t{field:i32}>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<!fir.type<t{field:i32}>>) -> (!fir.ref<!fir.type<t{field:i32}>>, !fir.ref<!fir.type<t{field:i32}>>)
+
+
+func.func @pdt_declare(%arg0: !fir.ref<!fir.type<pdt(param:i32){field:i32}>>) {
+  %c1 = arith.constant 1 : index
+  %0:2 = hlfir.declare %arg0 typeparams %c1 {uniq_name = "x"} : (!fir.ref<!fir.type<pdt(param:i32){field:i32}>>, index) -> (!fir.box<!fir.type<pdt(param:i32){field:i32}>>, !fir.ref<!fir.type<pdt(param:i32){field:i32}>>)
+  return
+}
+// CHECK-LABEL:   func.func @pdt_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.type<pdt(param:i32){field:i32}>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {uniq_name = "x"} : (!fir.ref<!fir.type<pdt(param:i32){field:i32}>>, index) -> (!fir.box<!fir.type<pdt(param:i32){field:i32}>>, !fir.ref<!fir.type<pdt(param:i32){field:i32}>>)
+
+
+func.func @array_declare(%arg0: !fir.ref<!fir.array<?x?xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %shape = fir.shape %c1, %c2 : (index, index) -> !fir.shape<2>
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<?x?xf32>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2>
+// CHECK:  %[[VAL_4:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_3]]) {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+
+
+func.func @array_declare_2(%arg0: !fir.ref<!fir.array<?x?xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %shape = fir.shape_shift %c1, %c2, %c3, %c4 : (index, index, index, index) -> !fir.shapeshift<2>
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_2(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<?x?xf32>>) {
+// 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:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2>
+// CHECK:  %[[VAL_6:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_5]]) {uniq_name = "x"} : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.ref<!fir.array<?x?xf32>>)
+
+func.func @array_declare_constant_extents_with_lower_bounds(%arg0: !fir.ref<!fir.array<2x4xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %shape = fir.shape_shift %c1, %c2, %c3, %c4 : (index, index, index, index) -> !fir.shapeshift<2>
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.ref<!fir.array<2x4xf32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<2x4xf32>>, !fir.ref<!fir.array<2x4xf32>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_constant_extents_with_lower_bounds(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<2x4xf32>>) {
+// 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:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2>
+// CHECK:  %[[VAL_6:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_5]]) {uniq_name = "x"} : (!fir.ref<!fir.array<2x4xf32>>, !fir.shapeshift<2>) -> (!fir.box<!fir.array<2x4xf32>>, !fir.ref<!fir.array<2x4xf32>>)
+
+
+func.func @array_declare_box(%arg0: !fir.box<!fir.array<?x?xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %shape = fir.shift %c1, %c2 : (index, index) -> !fir.shift<2>
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.box<!fir.array<?x?xf32>>, !fir.shift<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_box(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x?xf32>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = fir.shift %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shift<2>
+// CHECK:  %[[VAL_4:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_3]]) {uniq_name = "x"} : (!fir.box<!fir.array<?x?xf32>>, !fir.shift<2>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+
+
+func.func @array_declare_char_box(%arg0: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_char_box(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+
+
+func.func @array_declare_char_box_2(%arg0: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %shape = fir.shift %c1, %c2 : (index, index) -> !fir.shift<2>
+  %0:2 = hlfir.declare %arg0(%shape) typeparams %c3 {uniq_name = "x"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.shift<2>, index) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+  return
+}
+// CHECK-LABEL:   func.func @array_declare_char_box_2(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x?x!fir.char<1,?>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 1 : index
+// CHECK:  %[[VAL_2:.*]] = arith.constant 2 : index
+// CHECK:  %[[VAL_3:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_4:.*]] = fir.shift %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shift<2>
+// CHECK:  %[[VAL_5:.*]] = hlfir.declare %[[VAL_0]](%[[VAL_4]]) typeparams %[[VAL_3]] {uniq_name = "x"} : (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.shift<2>, index) -> (!fir.box<!fir.array<?x?x!fir.char<1,?>>>, !fir.box<!fir.array<?x?x!fir.char<1,?>>>)
+
+
+func.func @array_declare_char_boxaddr(%arg0: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>)
+  return
+}
+// CHECK-LABEL: func.func @array_declare_char_boxaddr(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>)
+
+
+func.func @array_declare_char_boxaddr_2(%arg0: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) {
+  %c3 = arith.constant 3 : index
+  %0:2 = hlfir.declare %arg0 typeparams %c3 {uniq_name = "x"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, index) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>)
+  return
+}
+// CHECK-LABEL: func.func @array_declare_char_boxaddr_2(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>) {
+// CHECK:  %[[VAL_1:.*]] = arith.constant 3 : index
+// CHECK:  %[[VAL_2:.*]] = hlfir.declare %[[VAL_0]] typeparams %[[VAL_1]] {uniq_name = "x"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, index) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>)
+
+func.func @array_declare_unlimited_polymorphic_boxaddr(%arg0: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) {
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) -> (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>, !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>)
+  return
+}
+// CHECK-LABEL: func.func @array_declare_unlimited_polymorphic_boxaddr(
+// CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) {
+// CHECK:  %[[VAL_1:.*]] = hlfir.declare %[[VAL_0]] {uniq_name = "x"} : (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>) -> (!fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>, !fir.ref<!fir.class<!fir.ptr<!fir.array<?x?xnone>>>>)

flang/test/HLFIR/invalid.fir

+// HLFIR ops diagnotic tests
+
+// RUN: fir-opt -split-input-file -verify-diagnostics %s
+
+func.func @bad_declare(%arg0: !fir.ref<f32>) {
+  // expected-error@+1 {{'hlfir.declare' op first result type is inconsistent with variable properties: expected '!fir.ref<f32>'}}
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<f32>) -> (!fir.box<f32>, !fir.ref<f32>)
+  return
+}
+
+// -----
+func.func @bad_declare_lower_bounds(%arg0: !fir.ref<!fir.array<2x4xf32>>) {
+  %c1 = arith.constant 1 : index
+  %c2 = arith.constant 2 : index
+  %c3 = arith.constant 3 : index
+  %c4 = arith.constant 4 : index
+  %shape = fir.shape_shift %c1, %c2, %c3, %c4 : (index, index, index, index) -> !fir.shapeshift<2>
+  // expected-error@+1 {{'hlfir.declare' op first result type is inconsistent with variable properties: expected '!fir.box<!fir.array<2x4xf32>>'}}
+  %0:2 = hlfir.declare %arg0(%shape) {uniq_name = "x"} : (!fir.ref<!fir.array<2x4xf32>>, !fir.shapeshift<2>) -> (!fir.ref<!fir.array<2x4xf32>>, !fir.ref<!fir.array<2x4xf32>>)
+  return
+}
+
+// -----
+func.func @bad_declare(%arg0: !fir.ref<f32>) {
+  // expected-error@+1 {{'hlfir.declare' op second result type must match input memref type}}
+  %0:2 = hlfir.declare %arg0 {uniq_name = "x"} : (!fir.ref<f32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+  return
+}
+
+// -----
+
+// Test that FortranVariableInterface verifier is kicking in. This verifier itself is already tested with fir.declare.
+func.func @bad_array_declare(%arg0: !fir.ref<!fir.array<?x?xf32>>) {
+  // expected-error@+1 {{'hlfir.declare' op of array entity with a raw address base must have a shape operand that is a shape or shapeshift}}
+  %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
+}