[flang] REAL(KIND=3) and COMPLEX(KIND=3) descriptors

[vdonaldson]

Summary

Update descriptor generation to correctly set the type field for
REAL(3) and COMPLEX(3) objects.

[PeteSteinfeld]

All builds and tests correctly and looks good.

[vdonaldson]

I've moved function getTypeCode to file Optimizer/Dialect/FIRType.cpp.

[jeanPerier]

LGTM. Shared library builds works for me. Thanks!

[vdonaldson]

https://reviews.llvm.org/D148264

flang/include/flang/ISO_Fortran_binding.h

 typedef unsigned char CFI_attribute_t;
 #define CFI_attribute_pointer 1
 #define CFI_attribute_allocatable 2
 #define CFI_attribute_other 0 /* neither pointer nor allocatable */
 
 typedef signed char CFI_type_t;
 /* These codes are required to be macros (i.e., #ifdef will work).
  * They are not required to be distinct, but neither are they required
- * to have had their synonyms combined.  Codes marked as extensions may be
- * place holders for as yet unimplemented types.
+ * to have had their synonyms combined.
  */
 #define CFI_type_signed_char 1
 #define CFI_type_short 2
 #define CFI_type_int 3
 #define CFI_type_long 4
 #define CFI_type_long_long 5
 #define CFI_type_size_t 6
 #define CFI_type_int8_t 7
 #define CFI_type_int16_t 8
 #define CFI_type_int32_t 9
 #define CFI_type_int64_t 10
-#define CFI_type_int128_t 11 /* extension */
+#define CFI_type_int128_t 11 /* extension kind=16 */
 #define CFI_type_int_least8_t 12
 #define CFI_type_int_least16_t 13
 #define CFI_type_int_least32_t 14
 #define CFI_type_int_least64_t 15
 #define CFI_type_int_least128_t 16 /* extension */
 #define CFI_type_int_fast8_t 17
 #define CFI_type_int_fast16_t 18
 #define CFI_type_int_fast32_t 19

 #define CFI_type_double_Complex 35
 #define CFI_type_extended_double_Complex 36 /* extension: kind=10 */
 #define CFI_type_long_double_Complex 37
 #define CFI_type_float128_Complex 38 /* extension: kind=16 */
 #define CFI_type_Bool 39
 #define CFI_type_char 40
 #define CFI_type_cptr 41
 #define CFI_type_struct 42
-#define CFI_type_char16_t 43 /* extension */
-#define CFI_type_char32_t 44 /* extension */
+#define CFI_type_char16_t 43 /* extension kind=2 */
+#define CFI_type_char32_t 44 /* extension kind=4 */
 #define CFI_TYPE_LAST CFI_type_char32_t
 #define CFI_type_other (-1) // must be negative
 
 /* Error code macros - skip some of the small values to avoid conflicts with
  * other status codes mandated by the standard, e.g. those returned by
  * GET_ENVIRONMENT_VARIABLE (16.9.84) */
 #define CFI_SUCCESS 0 /* must be zero */
 #define CFI_ERROR_BASE_ADDR_NULL 11

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

 /// Does this function type has a result that requires binding the result value
 /// with a storage in a fir.save_result operation in order to use the result?
 bool hasAbstractResult(mlir::FunctionType ty);
 
 /// Convert llvm::Type::TypeID to mlir::Type
 mlir::Type fromRealTypeID(mlir::MLIRContext *context, llvm::Type::TypeID typeID,
                           fir::KindTy kind);
 
+int getTypeCode(mlir::Type ty, KindMapping &kindMap);
+
 inline bool BaseBoxType::classof(mlir::Type type) {
   return type.isa<fir::BoxType, fir::ClassType>();
 }
 
 /// Return true iff `ty` is none or fir.array<none>.
 inline bool isNoneOrSeqNone(mlir::Type type) {
   if (auto seqTy = type.dyn_cast<fir::SequenceType>())
     return seqTy.getEleTy().isa<mlir::NoneType>();

flang/lib/Optimizer/CodeGen/CodeGen.cpp

static int getCFIAttr(fir::BaseBoxType boxTy) {
     return CFI_attribute_other;
   }
 
   // Get the element size and CFI type code of the boxed value.
   std::tuple<mlir::Value, mlir::Value> getSizeAndTypeCode(
       mlir::Location loc, mlir::ConversionPatternRewriter &rewriter,
       mlir::Type boxEleTy, mlir::ValueRange lenParams = {}) const {
     auto i64Ty = mlir::IntegerType::get(rewriter.getContext(), 64);
-    auto getKindMap = [&]() -> fir::KindMapping & {
-      return this->lowerTy().getKindMap();
-    };
-    auto doInteger =
-        [&](mlir::Type type,
-            unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
-      int typeCode = fir::integerBitsToTypeCode(width);
-      return {
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type)),
-          this->genConstantOffset(loc, rewriter, typeCode)};
-    };
-    auto doLogical =
-        [&](mlir::Type type,
-            unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
-      int typeCode = fir::logicalBitsToTypeCode(width);
-      return {
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type)),
-          this->genConstantOffset(loc, rewriter, typeCode)};
-    };
-    auto doFloat = [&](mlir::Type type,
-                       unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
-      int typeCode = fir::realBitsToTypeCode(width);
-      return {
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type)),
-          this->genConstantOffset(loc, rewriter, typeCode)};
-    };
-    auto doComplex =
-        [&](mlir::Type type,
-            unsigned width) -> std::tuple<mlir::Value, mlir::Value> {
-      auto typeCode = fir::complexBitsToTypeCode(width);
-      return {
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type)),
-          this->genConstantOffset(loc, rewriter, typeCode)};
-    };
-    auto doCharacter = [&](fir::CharacterType type, mlir::ValueRange lenParams)
-        -> std::tuple<mlir::Value, mlir::Value> {
-      unsigned bitWidth = getKindMap().getCharacterBitsize(type.getFKind());
-      auto typeCode = fir::characterBitsToTypeCode(bitWidth);
-      auto typeCodeVal = this->genConstantOffset(loc, rewriter, typeCode);
-
-      bool lengthIsConst = (type.getLen() != fir::CharacterType::unknownLen());
-      mlir::Value eleSize =
-          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(type));
-
-      if (!lengthIsConst) {
-        // If length is constant, then the fir::CharacterType will be
-        // represented as an array of known size of elements having
-        // the corresponding LLVM type. In this case eleSize already
-        // holds correct memory size. If length is not constant, then
-        // the fir::CharacterType will decay to a scalar type,
-        // so we have to multiply it by the non-constant length
-        // to get its size in memory.
-        assert(!lenParams.empty());
-        auto len64 = FIROpConversion<OP>::integerCast(loc, rewriter, i64Ty,
-                                                      lenParams.back());
-        eleSize =
-            rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, eleSize, len64);
-      }
-      return {eleSize, typeCodeVal};
-    };
-    // Pointer-like types.
     if (auto eleTy = fir::dyn_cast_ptrEleTy(boxEleTy))
       boxEleTy = eleTy;
-    // Integer types.
-    if (fir::isa_integer(boxEleTy)) {
-      if (auto ty = boxEleTy.dyn_cast<mlir::IntegerType>())
-        return doInteger(ty, ty.getWidth());
-      auto ty = boxEleTy.cast<fir::IntegerType>();
-      return doInteger(ty, getKindMap().getIntegerBitsize(ty.getFKind()));
-    }
-    // Floating point types.
-    if (fir::isa_real(boxEleTy)) {
-      if (auto ty = boxEleTy.dyn_cast<mlir::FloatType>())
-        return doFloat(ty, ty.getWidth());
-      auto ty = boxEleTy.cast<fir::RealType>();
-      return doFloat(ty, getKindMap().getRealBitsize(ty.getFKind()));
-    }
-    // Complex types.
-    if (fir::isa_complex(boxEleTy)) {
-      if (auto ty = boxEleTy.dyn_cast<mlir::ComplexType>())
-        return doComplex(
-            ty, ty.getElementType().cast<mlir::FloatType>().getWidth());
-      auto ty = boxEleTy.cast<fir::ComplexType>();
-      return doComplex(ty, getKindMap().getRealBitsize(ty.getFKind()));
-    }
-    // Character types.
-    if (auto ty = boxEleTy.dyn_cast<fir::CharacterType>())
-      return doCharacter(ty, lenParams);
-    // Logical type.
-    if (auto ty = boxEleTy.dyn_cast<fir::LogicalType>())
-      return doLogical(ty, getKindMap().getLogicalBitsize(ty.getFKind()));
-    // Array types.
     if (auto seqTy = boxEleTy.dyn_cast<fir::SequenceType>())
       return getSizeAndTypeCode(loc, rewriter, seqTy.getEleTy(), lenParams);
-    // Derived-type types.
-    if (boxEleTy.isa<fir::RecordType>()) {
-      auto eleSize = genTypeStrideInBytes(loc, i64Ty, rewriter,
-                                          this->convertType(boxEleTy));
-      return {eleSize,
-              this->genConstantOffset(loc, rewriter, fir::derivedToTypeCode())};
+    if (boxEleTy.isa<mlir::NoneType>()) // unlimited polymorphic or assumed type
+      return {rewriter.create<mlir::LLVM::ConstantOp>(loc, i64Ty, 0),
+              this->genConstantOffset(loc, rewriter, CFI_type_other)};
+    mlir::Value typeCodeVal = this->genConstantOffset(
+        loc, rewriter,
+        fir::getTypeCode(boxEleTy, this->lowerTy().getKindMap()));
+    if (fir::isa_integer(boxEleTy) || boxEleTy.dyn_cast<fir::LogicalType>() ||
+        fir::isa_real(boxEleTy) || fir::isa_complex(boxEleTy))
+      return {genTypeStrideInBytes(loc, i64Ty, rewriter,
+                                   this->convertType(boxEleTy)),
+              typeCodeVal};
+    if (auto charTy = boxEleTy.dyn_cast<fir::CharacterType>()) {
+      mlir::Value size =
+          genTypeStrideInBytes(loc, i64Ty, rewriter, this->convertType(charTy));
+      if (charTy.getLen() == fir::CharacterType::unknownLen()) {
+        // Multiply the single character size by the length.
+        assert(!lenParams.empty());
+        auto len64 = FIROpConversion<OP>::integerCast(loc, rewriter, i64Ty,
+                                                      lenParams.back());
+        size = rewriter.create<mlir::LLVM::MulOp>(loc, i64Ty, size, len64);
       }
-    // Reference type.
+      return {size, typeCodeVal};
+    };
     if (fir::isa_ref_type(boxEleTy)) {
       auto ptrTy = mlir::LLVM::LLVMPointerType::get(
           mlir::LLVM::LLVMVoidType::get(rewriter.getContext()));
-      mlir::Value size = genTypeStrideInBytes(loc, i64Ty, rewriter, ptrTy);
-      return {size, this->genConstantOffset(loc, rewriter, CFI_type_cptr)};
+      return {genTypeStrideInBytes(loc, i64Ty, rewriter, ptrTy), typeCodeVal};
     }
-    // Unlimited polymorphic or assumed type. Use 0 and CFI_type_other since the
-    // information is not none at this point.
-    if (boxEleTy.isa<mlir::NoneType>())
-      return {rewriter.create<mlir::LLVM::ConstantOp>(loc, i64Ty, 0),
-              this->genConstantOffset(loc, rewriter, CFI_type_other)};
+    if (boxEleTy.isa<fir::RecordType>())
+      return {genTypeStrideInBytes(loc, i64Ty, rewriter,
+                                   this->convertType(boxEleTy)),
+              typeCodeVal};
     fir::emitFatalError(loc, "unhandled type in fir.box code generation");
   }
 
   /// Basic pattern to write a field in the descriptor
   mlir::Value insertField(mlir::ConversionPatternRewriter &rewriter,
                           mlir::Location loc, mlir::Value dest,
                           llvm::ArrayRef<std::int64_t> fldIndexes,
                           mlir::Value value, bool bitcast = false) const {

flang/lib/Optimizer/Dialect/FIRType.cpp

 //===-- FIRType.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/FIRType.h"
+#include "flang/ISO_Fortran_binding.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/Support/KindMapping.h"
 #include "flang/Tools/PointerModels.h"
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinDialect.h"
 #include "mlir/IR/Diagnostics.h"
 #include "mlir/IR/DialectImplementation.h"
 #include "llvm/ADT/SmallPtrSet.h"
mlir::Type unwrapSeqOrBoxedSeqType(mlir::Type ty) {
   if (auto boxTy = ty.dyn_cast<fir::BoxType>()) {
     auto eleTy = unwrapRefType(boxTy.getEleTy());
     if (auto seqTy = eleTy.dyn_cast<fir::SequenceType>())
       return seqTy.getEleTy();
   }
   return ty;
 }
 
+/// Return the ISO_C_BINDING intrinsic module value of type \p ty.
+int getTypeCode(mlir::Type ty, fir::KindMapping &kindMap) {
+  unsigned width = 0;
+  if (mlir::IntegerType intTy = ty.dyn_cast<mlir::IntegerType>()) {
+    switch (intTy.getWidth()) {
+    case 8:
+      return CFI_type_int8_t;
+    case 16:
+      return CFI_type_int16_t;
+    case 32:
+      return CFI_type_int32_t;
+    case 64:
+      return CFI_type_int64_t;
+    case 128:
+      return CFI_type_int128_t;
+    }
+    llvm_unreachable("unsupported integer type");
+  }
+  if (fir::LogicalType logicalTy = ty.dyn_cast<fir::LogicalType>()) {
+    switch (kindMap.getLogicalBitsize(logicalTy.getFKind())) {
+    case 8:
+      return CFI_type_Bool;
+    case 16:
+      return CFI_type_int_least16_t;
+    case 32:
+      return CFI_type_int_least32_t;
+    case 64:
+      return CFI_type_int_least64_t;
+    }
+    llvm_unreachable("unsupported logical type");
+  }
+  if (mlir::FloatType floatTy = ty.dyn_cast<mlir::FloatType>()) {
+    switch (floatTy.getWidth()) {
+    case 16:
+      return floatTy.isBF16() ? CFI_type_bfloat : CFI_type_half_float;
+    case 32:
+      return CFI_type_float;
+    case 64:
+      return CFI_type_double;
+    case 80:
+      return CFI_type_extended_double;
+    case 128:
+      return CFI_type_float128;
+    }
+    llvm_unreachable("unsupported real type");
+  }
+  if (fir::isa_complex(ty)) {
+    if (mlir::ComplexType complexTy = ty.dyn_cast<mlir::ComplexType>()) {
+      mlir::FloatType floatTy =
+          complexTy.getElementType().cast<mlir::FloatType>();
+      if (floatTy.isBF16())
+        return CFI_type_bfloat_Complex;
+      width = floatTy.getWidth();
+    } else if (fir::ComplexType complexTy = ty.dyn_cast<fir::ComplexType>()) {
+      auto FKind = complexTy.getFKind();
+      if (FKind == 3)
+        return CFI_type_bfloat_Complex;
+      width = kindMap.getRealBitsize(FKind);
+    }
+    switch (width) {
+    case 16:
+      return CFI_type_half_float_Complex;
+    case 32:
+      return CFI_type_float_Complex;
+    case 64:
+      return CFI_type_double_Complex;
+    case 80:
+      return CFI_type_extended_double_Complex;
+    case 128:
+      return CFI_type_float128_Complex;
+    }
+    llvm_unreachable("unsupported complex size");
+  }
+  if (fir::CharacterType charTy = ty.dyn_cast<fir::CharacterType>()) {
+    switch (kindMap.getCharacterBitsize(charTy.getFKind())) {
+    case 8:
+      return CFI_type_char;
+    case 16:
+      return CFI_type_char16_t;
+    case 32:
+      return CFI_type_char32_t;
+    }
+    llvm_unreachable("unsupported character type");
+  }
+  if (fir::isa_ref_type(ty))
+    return CFI_type_cptr;
+  if (ty.isa<fir::RecordType>())
+    return CFI_type_struct;
+  llvm_unreachable("unsupported type");
+}
+
 } // namespace fir
 
 namespace {
 
 static llvm::SmallPtrSet<detail::RecordTypeStorage const *, 4>
     recordTypeVisited;
 
 } // namespace

flang/lib/Optimizer/Transforms/PolymorphicOpConversion.cpp

matchAndRewrite(fir::SelectTypeOp selectType, OpAdaptor adaptor,
                   mlir::ConversionPatternRewriter &rewriter) const override;
 
 private:
   // Generate comparison of type descriptor addresses.
   mlir::Value genTypeDescCompare(mlir::Location loc, mlir::Value selector,
                                  mlir::Type ty, mlir::ModuleOp mod,
                                  mlir::PatternRewriter &rewriter) const;
 
-  static int getTypeCode(mlir::Type ty, fir::KindMapping &kindMap);
-
   mlir::LogicalResult genTypeLadderStep(mlir::Location loc,
                                         mlir::Value selector,
                                         mlir::Attribute attr, mlir::Block *dest,
                                         std::optional<mlir::ValueRange> destOps,
                                         mlir::ModuleOp mod,
                                         mlir::PatternRewriter &rewriter,
                                         fir::KindMapping &kindMap) const;
 
mlir::LogicalResult SelectTypeConv::genTypeLadderStep(
     fir::KindMapping &kindMap) const {
   mlir::Value cmp;
   // TYPE IS type guard comparison are all done inlined.
   if (auto a = attr.dyn_cast<fir::ExactTypeAttr>()) {
     if (fir::isa_trivial(a.getType()) ||
         a.getType().isa<fir::CharacterType>()) {
       // For type guard statement with Intrinsic type spec the type code of
       // the descriptor is compared.
-      int code = getTypeCode(a.getType(), kindMap);
+      int code = fir::getTypeCode(a.getType(), kindMap);
       if (code == 0)
         return mlir::emitError(loc)
                << "type code unavailable for " << a.getType();
       mlir::Value typeCode = rewriter.create<mlir::arith::ConstantOp>(
           loc, rewriter.getI8IntegerAttr(code));
       mlir::Value selectorTypeCode = rewriter.create<fir::BoxTypeCodeOp>(
           loc, rewriter.getI8Type(), selector);
       cmp = rewriter.create<mlir::arith::CmpIOp>(
SelectTypeConv::genTypeDescCompare(mlir::Location loc, mlir::Value selector,
   auto typeDescInt =
       rewriter.create<fir::ConvertOp>(loc, intPtrTy, typeDescAddr);
   auto selectorTdescInt =
       rewriter.create<fir::ConvertOp>(loc, intPtrTy, selectorTdescAddr);
   return rewriter.create<mlir::arith::CmpIOp>(
       loc, mlir::arith::CmpIPredicate::eq, typeDescInt, selectorTdescInt);
 }
 
-int SelectTypeConv::getTypeCode(mlir::Type ty, fir::KindMapping &kindMap) {
-  if (auto intTy = ty.dyn_cast<mlir::IntegerType>())
-    return fir::integerBitsToTypeCode(intTy.getWidth());
-  if (auto floatTy = ty.dyn_cast<mlir::FloatType>())
-    return fir::realBitsToTypeCode(floatTy.getWidth());
-  if (auto logicalTy = ty.dyn_cast<fir::LogicalType>())
-    return fir::logicalBitsToTypeCode(
-        kindMap.getLogicalBitsize(logicalTy.getFKind()));
-  if (fir::isa_complex(ty)) {
-    if (auto cmplxTy = ty.dyn_cast<mlir::ComplexType>())
-      return fir::complexBitsToTypeCode(
-          cmplxTy.getElementType().cast<mlir::FloatType>().getWidth());
-    auto cmplxTy = ty.cast<fir::ComplexType>();
-    return fir::complexBitsToTypeCode(
-        kindMap.getRealBitsize(cmplxTy.getFKind()));
-  }
-  if (auto charTy = ty.dyn_cast<fir::CharacterType>())
-    return fir::characterBitsToTypeCode(
-        kindMap.getCharacterBitsize(charTy.getFKind()));
-  return 0;
-}
-
 llvm::SmallSet<llvm::StringRef, 4>
 SelectTypeConv::collectAncestors(fir::DispatchTableOp dt,
                                  mlir::ModuleOp mod) const {
   llvm::SmallSet<llvm::StringRef, 4> ancestors;
   if (!dt.getParent().has_value())
     return ancestors;
   while (dt.getParent().has_value()) {
     ancestors.insert(*dt.getParent());
     dt = mod.lookupSymbol<fir::DispatchTableOp>(*dt.getParent());
   }
   return ancestors;
 }
 
 std::unique_ptr<mlir::Pass> fir::createPolymorphicOpConversionPass() {
   return std::make_unique<PolymorphicOpConversion>();
 }

flang/test/Fir/convert-to-llvm.fir

func.func @embox0(%arg0: !fir.ref<!fir.array<100xi32>>) {
   %0 = fir.embox %arg0() : (!fir.ref<!fir.array<100xi32>>) -> !fir.box<!fir.array<100xi32>>
   return
 }
 
 // CHECK-LABEL: func @embox0(
 // CHECK-SAME:               %[[ARG0:.*]]: !llvm.ptr<array<100 x i32>>
 // CHECK:         %[[C1:.*]] = llvm.mlir.constant(1 : i32) : i32
 // CHECK:         %[[ALLOCA:.*]] = llvm.alloca %[[C1]] x !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})> {alignment = 8 : i64} : (i32) -> !llvm.ptr<struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>>
+// CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(9 : i32) : i32
 // CHECK:         %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr<i32>
 // CHECK:         %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1]
 // CHECK:         %[[I64_ELEM_SIZE:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr<i32> to i64
-// CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(9 : i32) : i32
 // CHECK:         %[[DESC:.*]] = llvm.mlir.undef : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
 // CHECK:         %[[DESC0:.*]] = llvm.insertvalue %[[I64_ELEM_SIZE]], %[[DESC]][1] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
 // CHECK:         %[[CFI_VERSION:.*]] = llvm.mlir.constant(20180515 : i32) : i32
 // CHECK:         %[[DESC1:.*]] = llvm.insertvalue %[[CFI_VERSION]], %[[DESC0]][2] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
 // CHECK:         %[[RANK:.*]] = llvm.mlir.constant(0 : i32) : i32
 // CHECK:         %[[RANK_I8:.*]] = llvm.trunc %[[RANK]] : i32 to i8
 // CHECK:         %[[DESC2:.*]] = llvm.insertvalue %[[RANK_I8]], %[[DESC1]][3] : !llvm.struct<(ptr<array<100 x i32>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>
 // CHECK:         %[[TYPE_CODE_I8:.*]] = llvm.trunc %[[TYPE_CODE]] : i32 to i8
func.func @xembox0(%arg0: !fir.ref<!fir.array<?xi32>>) {
   return
 }
 
 // CHECK-LABEL: llvm.func @xembox0(
 // CHECK-SAME:                     %[[ARG0:.*]]: !llvm.ptr<i32>
 // CHECK:         %[[ALLOCA_SIZE:.*]] = llvm.mlir.constant(1 : i32) : i32
 // CHECK:         %[[ALLOCA:.*]] = llvm.alloca %[[ALLOCA_SIZE]] x !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)> {alignment = 8 : i64} : (i32) -> !llvm.ptr<struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>>
 // CHECK:         %[[C0:.*]] = llvm.mlir.constant(0 : i64) : i64
+// CHECK:         %[[TYPE:.*]] = llvm.mlir.constant(9 : i32) : i32
 // CHECK:         %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr<i32>
 // CHECK:         %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1]
 // CHECK:         %[[ELEM_LEN_I64:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr<i32> to i64
-// CHECK:         %[[TYPE:.*]] = llvm.mlir.constant(9 : i32) : i32
 // CHECK:         %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>
 // CHECK:         %[[BOX1:.*]] = llvm.insertvalue %[[ELEM_LEN_I64]], %[[BOX0]][1] : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>
 // CHECK:         %[[VERSION:.*]] = llvm.mlir.constant(20180515 : i32) : i32
 // CHECK:         %[[BOX2:.*]] = llvm.insertvalue %[[VERSION]], %[[BOX1]][2] : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>
 // CHECK:         %[[RANK:.*]] = llvm.mlir.constant(1 : i32) : i32
 // CHECK:         %[[RANK_I8:.*]] = llvm.trunc %[[RANK]] : i32 to i8
 // CHECK:         %[[BOX3:.*]] = llvm.insertvalue %[[RANK_I8]], %[[BOX2]][3] : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>
 // CHECK:         %[[TYPE_I8:.*]] = llvm.trunc %[[TYPE]] : i32 to i8

 // CHECK:         %[[N1_TMP:.*]] = llvm.sub %[[N]], %[[SH1]]  : i64
 // CHECK:         %[[N1:.*]] = llvm.add %[[N1_TMP]], %[[C1]]  : i64
 // CHECK:         %[[N2_TMP:.*]] = llvm.sub %[[N]], %[[SH2]]  : i64
 // CHECK:         %[[N2:.*]] = llvm.add %[[N2_TMP]], %[[C1]]  : i64
 // CHECK:         %[[C1_0:.*]] = llvm.mlir.constant(1 : i64) : i64
 // CHECK:         %[[ARR_SIZE_TMP1:.*]] = llvm.mul %[[C1_0]], %[[N1]]  : i64
 // CHECK:         %[[ARR_SIZE:.*]] = llvm.mul %[[ARR_SIZE_TMP1]], %[[N2]]  : i64
 // CHECK:         %[[ARR:.*]] = llvm.alloca %[[ARR_SIZE]] x f64 {bindc_name = "arr", in_type = !fir.array<?x?xf64>, operand_segment_sizes = array<i32: 0, 2>, uniq_name = "_QFsbEarr"} : (i64) -> !llvm.ptr<f64>
+// CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(28 : i32) : i32
 // CHECK:         %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr<f64>
 // CHECK:         %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1]
 // CHECK:         %[[ELEM_LEN_I64:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr<f64> to i64
-// CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(28 : i32) : i32
 // CHECK:         %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr<f64>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<2 x array<3 x i64>>)>
 // CHECK:         %[[BOX1:.*]] = llvm.insertvalue %[[ELEM_LEN_I64]], %[[BOX0]][1] : !llvm.struct<(ptr<f64>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<2 x array<3 x i64>>)>
 // CHECK:         %[[VERSION:.*]] = llvm.mlir.constant(20180515 : i32) : i32
 // CHECK:         %[[BOX2:.*]] = llvm.insertvalue %[[VERSION]], %[[BOX1]][2] : !llvm.struct<(ptr<f64>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<2 x array<3 x i64>>)>
 // CHECK:         %[[RANK:.*]] = llvm.mlir.constant(2 : i32) : i32
 // CHECK:         %[[RANK_I8:.*]] = llvm.trunc %[[RANK]] : i32 to i8
 // CHECK:         %[[BOX3:.*]] = llvm.insertvalue %[[RANK_I8]], %[[BOX2]][3] : !llvm.struct<(ptr<f64>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<2 x array<3 x i64>>)>
 // CHECK:         %[[TYPE_I8:.*]] = llvm.trunc %[[TYPE_CODE]] : i32 to i8

 // CHECK:         %[[C20:.*]] = llvm.mlir.constant(20 : index) : i64
 // CHECK:         %[[C1:.*]] = llvm.mlir.constant(1 : i64) : i64
 // CHECK:         %[[C10:.*]] = llvm.mlir.constant(10 : i64) : i64
 // CHECK:         %[[C2:.*]] = llvm.mlir.constant(2 : i64) : i64
 // CHECK:         %[[ALLOCA_SIZE_V:.*]] = llvm.mlir.constant(1 : i64) : i64
 // CHECK:         %[[V:.*]] = llvm.alloca %[[ALLOCA_SIZE_V]] x i32 {bindc_name = "v", in_type = i32, operand_segment_sizes = array<i32: 0, 0>, uniq_name = "_QFtest_dt_sliceEv"} : (i64) -> !llvm.ptr<i32>
 // CHECK:         %[[ALLOCA_SIZE_X:.*]] = llvm.mlir.constant(1 : i64) : i64
 // CHECK:         %[[X:.*]] = llvm.alloca %[[ALLOCA_SIZE_X]] x !llvm.array<20 x struct<"_QFtest_dt_sliceTt", (i32, i32)>> {bindc_name = "x", in_type = !fir.array<20x!fir.type<_QFtest_dt_sliceTt{i:i32,j:i32}>>, operand_segment_sizes = array<i32: 0, 0>, uniq_name = "_QFtest_dt_sliceEx"} : (i64) -> !llvm.ptr<array<20 x struct<"_QFtest_dt_sliceTt", (i32, i32)>>>
+// CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(9 : i32) : i32
 // CHECK:         %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr<i32>
 // CHECK:         %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1]
 // CHECK:         %[[ELEM_LEN_I64:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr<i32> to i64
-// CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(9 : i32) : i32
 // CHECK:         %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>
 // CHECK:         %[[BOX1:.*]] = llvm.insertvalue %[[ELEM_LEN_I64]], %[[BOX0]][1] : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>
 // CHECK:         %[[VERSION:.*]] = llvm.mlir.constant(20180515 : i32) : i32
 // CHECK:         %[[BOX2:.*]] = llvm.insertvalue %[[VERSION]], %[[BOX1]][2] : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>
 // CHECK:         %[[RANK:.*]] = llvm.mlir.constant(1 : i32) : i32
 // CHECK:         %[[RANK_I8:.*]] = llvm.trunc %[[RANK]] : i32 to i8
 // CHECK:         %[[BOX3:.*]] = llvm.insertvalue %[[RANK_I8]], %[[BOX2]][3] : !llvm.struct<(ptr<i32>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>
 // CHECK:         %[[TYPE_CODE_I8:.*]] = llvm.trunc %[[TYPE_CODE]] : i32 to i8

 //CHECK-SAME:   %[[ARG0:.*]]: !llvm.ptr<struct<(ptr<f32>, i64, i32, i8, i8, i8, i8, array<2 x array<3 x i64>>)>>
 //CHECK:    %[[ONE_1:.*]] = llvm.mlir.constant(1 : i32) : i32
 //CHECK:    %[[RESULT_BOX_REF:.*]] = llvm.alloca %[[ONE_1]] x !llvm.struct<(ptr<f32>, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)> {alignment = 8 : i64} : (i32) -> !llvm.ptr<struct<(ptr<f32>, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)>>
 //CHECK:    %[[THREE:.*]] = llvm.mlir.constant(3 : index) : i64
 //CHECK:    %[[FOUR:.*]] = llvm.mlir.constant(4 : index) : i64
 //CHECK:    %[[FIVE:.*]] = llvm.mlir.constant(5 : index) : i64
 //CHECK:    %[[SIX:.*]] = llvm.mlir.constant(6 : index) : i64
 //CHECK:    %[[EIGHTY:.*]] = llvm.mlir.constant(80 : index) : i64
+//CHECK:    %[[FLOAT_TYPE:.*]] = llvm.mlir.constant(27 : i32) : i32
 //CHECK:    %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr<f32>
 //CHECK:    %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1]
 //CHECK:    %[[ELEM_SIZE_I64:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr<f32> to i64
-//CHECK:    %[[FLOAT_TYPE:.*]] = llvm.mlir.constant(27 : i32) : i32
 //CHECK:    %[[RBOX:.*]] = llvm.mlir.undef : !llvm.struct<(ptr<f32>, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)>
 //CHECK:    %[[RBOX_TMP1:.*]] = llvm.insertvalue %[[ELEM_SIZE_I64]], %[[RBOX]][1] : !llvm.struct<(ptr<f32>, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)>
 //CHECK:    %[[CFI_VERSION:.*]] = llvm.mlir.constant(20180515 : i32) : i32
 //CHECK:    %[[RBOX_TMP2:.*]] = llvm.insertvalue %[[CFI_VERSION]], %[[RBOX_TMP1]][2] : !llvm.struct<(ptr<f32>, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)>
 //CHECK:    %[[RANK:.*]] = llvm.mlir.constant(1 : i32) : i32
 //CHECK:    %[[RANK_I8:.*]] = llvm.trunc %[[RANK]] : i32 to i8
 //CHECK:    %[[RBOX_TMP3:.*]] = llvm.insertvalue %[[RANK_I8]], %[[RBOX_TMP2]][3] : !llvm.struct<(ptr<f32>, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)>
 //CHECK:    %[[FLOAT_TYPE_I8:.*]] = llvm.trunc %[[FLOAT_TYPE]] : i32 to i8

flang/test/Lower/real-descriptors.f90

+! RUN: bbc %s -o - | tco | FileCheck %s
+
+! CHECK-LABEL: define void @_QQmain()
+program p
+  ! CHECK-DAG:  alloca { ptr, i64, i32, i8, i8, i8, i8 }, align 8
+  ! CHECK-DAG:  alloca { ptr, i64, i32, i8, i8, i8, i8 }, align 8
+  ! CHECK-DAG:  alloca { ptr, i64, i32, i8, i8, i8, i8 }, align 8
+  ! CHECK-DAG:  alloca { ptr, i64, i32, i8, i8, i8, i8 }, align 8
+  ! CHECK-DAG:  alloca { ptr, i64, i32, i8, i8, i8, i8 }, align 8
+  ! CHECK-DAG:  alloca { ptr, i64, i32, i8, i8, i8, i8 }, align 8
+  ! CHECK-DAG:  alloca { ptr, i64, i32, i8, i8, i8, i8 }, align 8
+  ! CHECK-DAG:  alloca { ptr, i64, i32, i8, i8, i8, i8 }, align 8
+  ! CHECK-DAG:  alloca { x86_fp80, x86_fp80 }, i64 1, align 16
+  ! CHECK-DAG:  alloca { fp128, fp128 }, i64 1, align 16
+  ! CHECK-DAG:  alloca { half, half }, i64 1, align 8
+  ! CHECK-DAG:  alloca { bfloat, bfloat }, i64 1, align 8
+  ! CHECK-DAG:  alloca { float, float }, i64 1, align 8
+  ! CHECK-DAG:  alloca { double, double }, i64 1, align 8
+  ! CHECK-DAG:  alloca x86_fp80, i64 1, align 16
+  ! CHECK-DAG:  alloca fp128, i64 1, align 16
+  ! CHECK-DAG:  alloca half, i64 1, align 2
+  ! CHECK-DAG:  alloca bfloat, i64 1, align 2
+  ! CHECK-DAG:  alloca float, i64 1, align 4
+  ! CHECK-DAG:  alloca double, i64 1, align 8
+
+  character(10) :: in = 'NaN NaN'
+
+  real(kind=2)  :: x2
+  real(kind=3)  :: x3
+  real(kind=4)  :: x4
+  real(kind=8)  :: x8
+  real(kind=10) :: x10
+  real(kind=16) :: x16
+
+  complex(kind=2)  :: c2
+  complex(kind=3)  :: c3
+  complex(kind=4)  :: c4
+  complex(kind=8)  :: c8
+  complex(kind=10) :: c10
+  complex(kind=16) :: c16
+
+  read(in,*) x2
+  ! CHECK:      insertvalue { ptr, i64, i32, i8, i8, i8, i8 } { ptr undef, i64 ptrtoint (ptr getelementptr (half, ptr null, i32 1) to i64), i32 {{[0-9]*}}, i8 0, i8 25, i8 0, i8 0 }, ptr %{{[0-9]*}}, 0
+  ! CHECK:      call i1 @_FortranAioOutputDescriptor(ptr %{{[0-9]*}}, ptr %{{[0-9]*}})
+  print "(z4)", x2
+
+  read(in,*) x3
+  ! CHECK:      insertvalue { ptr, i64, i32, i8, i8, i8, i8 } { ptr undef, i64 ptrtoint (ptr getelementptr (bfloat, ptr null, i32 1) to i64), i32 {{[0-9]*}}, i8 0, i8 26, i8 0, i8 0 }, ptr %{{[0-9]*}}, 0
+  ! CHECK:      call i1 @_FortranAioOutputDescriptor(ptr %{{[0-9]*}}, ptr %{{[0-9]*}})
+  print "(z4)", x3
+
+  read(in,*) x4
+  ! CHECK:      call i1 @_FortranAioOutputReal32(ptr %{{[0-9]*}}, float %{{[0-9]*}})
+  print "(z8)", x4
+
+  read(in,*) x8
+  ! CHECK:      call i1 @_FortranAioOutputReal64(ptr %{{[0-9]*}}, double %{{[0-9]*}})
+  print "(z16)", x8
+
+  read(in,*) x10
+  ! CHECK:      insertvalue { ptr, i64, i32, i8, i8, i8, i8 } { ptr undef, i64 ptrtoint (ptr getelementptr (x86_fp80, ptr null, i32 1) to i64), i32 {{[0-9]*}}, i8 0, i8 29, i8 0, i8 0 }, ptr %{{[0-9]*}}, 0
+  ! CHECK:      call i1 @_FortranAioOutputDescriptor(ptr %{{[0-9]*}}, ptr %{{[0-9]*}})
+  print "(z20)", x10
+
+  read(in,*) x16
+  ! CHECK:      insertvalue { ptr, i64, i32, i8, i8, i8, i8 } { ptr undef, i64 ptrtoint (ptr getelementptr (fp128, ptr null, i32 1) to i64), i32 {{[0-9]*}}, i8 0, i8 31, i8 0, i8 0 }, ptr %{{[0-9]*}}, 0
+  ! CHECK:      call i1 @_FortranAioOutputDescriptor(ptr %{{[0-9]*}}, ptr %{{[0-9]*}})
+  print "(z32)", x16
+
+  print*
+  read(in,*) c2
+  ! CHECK:      insertvalue { ptr, i64, i32, i8, i8, i8, i8 } { ptr undef, i64 ptrtoint (ptr getelementptr ({ half, half }, ptr null, i32 1) to i64), i32 {{[0-9]*}}, i8 0, i8 32, i8 0, i8 0 }, ptr %{{[0-9]*}}, 0
+  ! CHECK:      call i1 @_FortranAioOutputDescriptor(ptr %{{[0-9]*}}, ptr %{{[0-9]*}})
+  print "(z4,' ',z4)", c2
+
+  read(in,*) c3
+  ! CHECK:      insertvalue { ptr, i64, i32, i8, i8, i8, i8 } { ptr undef, i64 ptrtoint (ptr getelementptr ({ bfloat, bfloat }, ptr null, i32 1) to i64), i32 {{[0-9]*}}, i8 0, i8 33, i8 0, i8 0 }, ptr %{{[0-9]*}}, 0
+  ! CHECK:      call i1 @_FortranAioOutputDescriptor(ptr %{{[0-9]*}}, ptr %{{[0-9]*}})
+  print "(z4,' ',z4)", c3
+
+  read(in,*) c4
+  ! CHECK:      call i1 @_FortranAioOutputComplex32(ptr %{{[0-9]*}}, float %{{[0-9]*}}, float %{{[0-9]*}})
+  print "(z8,' ',z8)", c4
+
+  read(in,*) c8
+  ! CHECK:      call i1 @_FortranAioOutputComplex64(ptr %{{[0-9]*}}, double %{{[0-9]*}}, double %{{[0-9]*}})
+  print "(z16,' ',z16)", c8
+
+  read(in,*) c10
+  ! CHECK:      insertvalue { ptr, i64, i32, i8, i8, i8, i8 } { ptr undef, i64 ptrtoint (ptr getelementptr ({ x86_fp80, x86_fp80 }, ptr null, i32 1) to i64), i32 {{[0-9]*}}, i8 0, i8 36, i8 0, i8 0 }, ptr %{{[0-9]*}}, 0
+  ! CHECK:      call i1 @_FortranAioOutputDescriptor(ptr %{{[0-9]*}}, ptr %{{[0-9]*}})
+  print "(z20,' ',z20)", c10
+
+  read(in,*) c16
+  ! CHECK:      insertvalue { ptr, i64, i32, i8, i8, i8, i8 } { ptr undef, i64 ptrtoint (ptr getelementptr ({ fp128, fp128 }, ptr null, i32 1) to i64), i32 {{[0-9]*}}, i8 0, i8 38, i8 0, i8 0 }, ptr %{{[0-9]*}}, 0
+  ! CHECK:      call i1 @_FortranAioOutputDescriptor(ptr %{{[0-9]*}}, ptr %{{[0-9]*}})
+  print "(z32,' ',z32)", c16
+end