diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -142,7 +142,9 @@ Fortran::common::TypeCategory category = dynamicType->category(); mlir::Type baseType; - if (category == Fortran::common::TypeCategory::Derived) { + if (dynamicType->IsUnlimitedPolymorphic()) { + baseType = mlir::NoneType::get(context); + } else if (category == Fortran::common::TypeCategory::Derived) { baseType = genDerivedType(dynamicType->GetDerivedTypeSpec()); } else { // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -1468,21 +1468,19 @@ /// Get the address of the type descriptor global variable that was created by /// lowering for derived type \p recType. - template - mlir::Value - getTypeDescriptor(BOX box, mlir::ConversionPatternRewriter &rewriter, - mlir::Location loc, fir::RecordType recType) const { + mlir::Value getTypeDescriptor(mlir::ModuleOp mod, + mlir::ConversionPatternRewriter &rewriter, + mlir::Location loc, + fir::RecordType recType) const { std::string name = fir::NameUniquer::getTypeDescriptorName(recType.getName()); - auto module = box->template getParentOfType(); - if (auto global = module.template lookupSymbol(name)) { + if (auto global = mod.template lookupSymbol(name)) { auto ty = mlir::LLVM::LLVMPointerType::get( this->lowerTy().convertType(global.getType())); return rewriter.create(loc, ty, global.getSymName()); } - if (auto global = - module.template lookupSymbol(name)) { + if (auto global = mod.template lookupSymbol(name)) { // The global may have already been translated to LLVM. auto ty = mlir::LLVM::LLVMPointerType::get(global.getType()); return rewriter.create(loc, ty, @@ -1496,31 +1494,21 @@ fir::emitFatalError( loc, "runtime derived type info descriptor was not generated"); return rewriter.create( - loc, ::getVoidPtrType(box.getContext())); + loc, ::getVoidPtrType(mod.getContext())); } - template - std::tuple - consDescriptorPrefix(BOX box, mlir::ConversionPatternRewriter &rewriter, - unsigned rank, mlir::ValueRange lenParams, - mlir::Value typeDesc = {}) const { - auto loc = box.getLoc(); - auto boxTy = box.getType().template dyn_cast(); + mlir::Value populateDescriptor(mlir::Location loc, mlir::ModuleOp mod, + fir::BaseBoxType boxTy, + mlir::ConversionPatternRewriter &rewriter, + unsigned rank, mlir::Value eleSize, + mlir::Value cfiTy, + mlir::Value typeDesc) const { auto convTy = this->lowerTy().convertBoxType(boxTy, rank); auto llvmBoxPtrTy = convTy.template cast(); auto llvmBoxTy = llvmBoxPtrTy.getElementType(); + bool isUnlimitedPolymorphic = fir::isUnlimitedPolymorphicType(boxTy); mlir::Value descriptor = rewriter.create(loc, llvmBoxTy); - - llvm::SmallVector typeparams = lenParams; - if constexpr (!std::is_same_v) { - if (!box.getSubstr().empty() && fir::hasDynamicSize(boxTy.getEleTy())) - typeparams.push_back(box.getSubstr()[1]); - } - - // Write each of the fields with the appropriate values - auto [eleSize, cfiTy] = - getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy(), typeparams); descriptor = insertField(rewriter, loc, descriptor, {kElemLenPosInBox}, eleSize); descriptor = insertField(rewriter, loc, descriptor, {kVersionPosInBox}, @@ -1531,20 +1519,80 @@ descriptor = insertField(rewriter, loc, descriptor, {kAttributePosInBox}, this->genI32Constant(loc, rewriter, getCFIAttr(boxTy))); - const bool hasAddendum = isDerivedType(boxTy); + const bool hasAddendum = isDerivedType(boxTy) || isUnlimitedPolymorphic; descriptor = insertField(rewriter, loc, descriptor, {kF18AddendumPosInBox}, this->genI32Constant(loc, rewriter, hasAddendum ? 1 : 0)); - if (hasAddendum) { + if (hasAddendum && !isUnlimitedPolymorphic) { unsigned typeDescFieldId = getTypeDescFieldId(boxTy); if (!typeDesc) typeDesc = - getTypeDescriptor(box, rewriter, loc, unwrapIfDerived(boxTy)); + getTypeDescriptor(mod, rewriter, loc, unwrapIfDerived(boxTy)); descriptor = insertField(rewriter, loc, descriptor, {typeDescFieldId}, typeDesc, /*bitCast=*/true); } + return descriptor; + } + + // Template used for fir::EmboxOp and fir::cg::XEmboxOp + template + std::tuple + consDescriptorPrefix(BOX box, mlir::Type inputType, + mlir::ConversionPatternRewriter &rewriter, unsigned rank, + mlir::ValueRange lenParams, + mlir::Value typeDesc = {}) const { + auto loc = box.getLoc(); + auto boxTy = box.getType().template dyn_cast(); + bool isUnlimitedPolymorphic = fir::isUnlimitedPolymorphicType(boxTy); + bool useInputType = + isUnlimitedPolymorphic && !fir::isUnlimitedPolymorphicType(inputType); + llvm::SmallVector typeparams = lenParams; + if constexpr (!std::is_same_v) { + if (!box.getSubstr().empty() && fir::hasDynamicSize(boxTy.getEleTy())) + typeparams.push_back(box.getSubstr()[1]); + } + + // Write each of the fields with the appropriate values. + // When emboxing an element to a unlimited polymorphic descriptor, use the + // input type since the destination descriptor type has no type information. + auto [eleSize, cfiTy] = getSizeAndTypeCode( + loc, rewriter, useInputType ? inputType : boxTy.getEleTy(), typeparams); + auto mod = box->template getParentOfType(); + mlir::Value descriptor = populateDescriptor(loc, mod, boxTy, rewriter, rank, + eleSize, cfiTy, typeDesc); + + return {boxTy, descriptor, eleSize}; + } + + std::tuple + consDescriptorPrefix(fir::cg::XReboxOp box, mlir::Value loweredBox, + mlir::ConversionPatternRewriter &rewriter, unsigned rank, + mlir::ValueRange lenParams, + mlir::Value typeDesc = {}) const { + auto loc = box.getLoc(); + auto boxTy = box.getType().dyn_cast(); + llvm::SmallVector typeparams = lenParams; + if (!box.getSubstr().empty() && fir::hasDynamicSize(boxTy.getEleTy())) + typeparams.push_back(box.getSubstr()[1]); + + auto [eleSize, cfiTy] = + getSizeAndTypeCode(loc, rewriter, boxTy.getEleTy(), typeparams); + + // Reboxing an unlimited polymorphic entity. eleSize and type code need to + // be retrived from the initial box. + if (fir::isUnlimitedPolymorphicType(boxTy) && + fir::isUnlimitedPolymorphicType(box.getBox().getType())) { + mlir::Type idxTy = this->lowerTy().indexType(); + eleSize = this->loadElementSizeFromBox(loc, idxTy, loweredBox, rewriter); + cfiTy = this->getValueFromBox(loc, loweredBox, cfiTy.getType(), rewriter, + kTypePosInBox); + } + + auto mod = box->template getParentOfType(); + mlir::Value descriptor = populateDescriptor(loc, mod, boxTy, rewriter, rank, + eleSize, cfiTy, typeDesc); return {boxTy, descriptor, eleSize}; } @@ -1674,7 +1722,7 @@ tdesc = operands[embox.getTdescOffset()]; assert(!embox.getShape() && "There should be no dims on this embox op"); auto [boxTy, dest, eleSize] = consDescriptorPrefix( - embox, rewriter, + embox, fir::unwrapRefType(embox.getMemref().getType()), rewriter, /*rank=*/0, /*lenParams=*/operands.drop_front(1), tdesc); dest = insertBaseAddress(rewriter, embox.getLoc(), dest, operands[0]); if (isDerivedTypeWithLenParams(boxTy)) { @@ -1699,9 +1747,9 @@ mlir::Value tdesc; if (xbox.getTdesc()) tdesc = operands[xbox.getTdescOffset()]; - auto [boxTy, dest, eleSize] = - consDescriptorPrefix(xbox, rewriter, xbox.getOutRank(), - operands.drop_front(xbox.lenParamOffset()), tdesc); + auto [boxTy, dest, eleSize] = consDescriptorPrefix( + xbox, fir::unwrapRefType(xbox.getMemref().getType()), rewriter, + xbox.getOutRank(), operands.drop_front(xbox.lenParamOffset()), tdesc); // Generate the triples in the dims field of the descriptor auto i64Ty = mlir::IntegerType::get(xbox.getContext(), 64); mlir::Value base = operands[0]; @@ -1908,8 +1956,9 @@ typeDescAddr = loadTypeDescAddress(loc, rebox.getBox().getType(), loweredBox, rewriter); - auto [boxTy, dest, eleSize] = consDescriptorPrefix( - rebox, rewriter, rebox.getOutRank(), lenParams, typeDescAddr); + auto [boxTy, dest, eleSize] = + consDescriptorPrefix(rebox, loweredBox, rewriter, rebox.getOutRank(), + lenParams, typeDescAddr); // Read input extents, strides, and base address llvm::SmallVector inputExtents; diff --git a/flang/lib/Optimizer/CodeGen/TypeConverter.h b/flang/lib/Optimizer/CodeGen/TypeConverter.h --- a/flang/lib/Optimizer/CodeGen/TypeConverter.h +++ b/flang/lib/Optimizer/CodeGen/TypeConverter.h @@ -244,7 +244,7 @@ dataDescFields.push_back(mlir::LLVM::LLVMArrayType::get(rowTy, rank)); } // opt-type-ptr: i8* (see fir.tdesc) - if (requiresExtendedDesc(ele)) { + if (requiresExtendedDesc(ele) || fir::isUnlimitedPolymorphicType(box)) { dataDescFields.push_back( getExtendedDescFieldTypeModel()(&getContext())); auto rowTy = diff --git a/flang/test/Fir/convert-to-llvm.fir b/flang/test/Fir/convert-to-llvm.fir --- a/flang/test/Fir/convert-to-llvm.fir +++ b/flang/test/Fir/convert-to-llvm.fir @@ -1514,11 +1514,11 @@ // CHECK-SAME: %[[ARG0:.*]]: !llvm.ptr> // CHECK: %[[C1:.*]] = llvm.mlir.constant(1 : i32) : i32 // CHECK: %[[ALLOCA:.*]] = llvm.alloca %[[C1]] x !llvm.struct<(ptr>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})> {alignment = 8 : i64} : (i32) -> !llvm.ptr>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})>> -// CHECK: %[[DESC:.*]] = llvm.mlir.undef : !llvm.struct<(ptr>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})> // CHECK: %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr // CHECK: %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1] // CHECK: %[[I64_ELEM_SIZE:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr to i64 // CHECK: %[[TYPE_CODE:.*]] = llvm.mlir.constant(9 : i32) : i32 +// CHECK: %[[DESC:.*]] = llvm.mlir.undef : !llvm.struct<(ptr>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})> // CHECK: %[[DESC0:.*]] = llvm.insertvalue %[[I64_ELEM_SIZE]], %[[DESC]][1] : !llvm.struct<(ptr>, 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>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}})> @@ -1737,11 +1737,11 @@ // CHECK: %[[ALLOCA_SIZE:.*]] = llvm.mlir.constant(1 : i32) : i32 // CHECK: %[[ALLOCA:.*]] = llvm.alloca %[[ALLOCA_SIZE]] x !llvm.struct<(ptr, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)> {alignment = 8 : i64} : (i32) -> !llvm.ptr, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)>> // CHECK: %[[C0:.*]] = llvm.mlir.constant(0 : i64) : i64 -// CHECK: %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)> // CHECK: %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr // CHECK: %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1] // CHECK: %[[ELEM_LEN_I64:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr to i64 // CHECK: %[[TYPE:.*]] = llvm.mlir.constant(9 : i32) : i32 +// CHECK: %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr, 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, 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, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)> @@ -1836,11 +1836,11 @@ // 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, operand_segment_sizes = array, uniq_name = "_QFsbEarr"} : (i64) -> !llvm.ptr -// CHECK: %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<2 x array<3 x i64>>)> // CHECK: %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr // CHECK: %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1] // CHECK: %[[ELEM_LEN_I64:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr to i64 // CHECK: %[[TYPE_CODE:.*]] = llvm.mlir.constant(28 : i32) : i32 +// CHECK: %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr, 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, 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, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<2 x array<3 x i64>>)> @@ -1915,11 +1915,11 @@ // CHECK: %[[V:.*]] = llvm.alloca %[[ALLOCA_SIZE_V]] x i32 {bindc_name = "v", in_type = i32, operand_segment_sizes = array, uniq_name = "_QFtest_dt_sliceEv"} : (i64) -> !llvm.ptr // 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, uniq_name = "_QFtest_dt_sliceEx"} : (i64) -> !llvm.ptr>> -// CHECK: %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)> // CHECK: %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr // CHECK: %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1] // CHECK: %[[ELEM_LEN_I64:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr to i64 // CHECK: %[[TYPE_CODE:.*]] = llvm.mlir.constant(9 : i32) : i32 +// CHECK: %[[BOX0:.*]] = llvm.mlir.undef : !llvm.struct<(ptr, 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, 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, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, array<1 x array<3 x i64>>)> @@ -2192,11 +2192,11 @@ //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: %[[RBOX:.*]] = llvm.mlir.undef : !llvm.struct<(ptr, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)> //CHECK: %[[NULL:.*]] = llvm.mlir.null : !llvm.ptr //CHECK: %[[GEP:.*]] = llvm.getelementptr %[[NULL]][1] //CHECK: %[[ELEM_SIZE_I64:.*]] = llvm.ptrtoint %[[GEP]] : !llvm.ptr to i64 //CHECK: %[[FLOAT_TYPE:.*]] = llvm.mlir.constant(27 : i32) : i32 +//CHECK: %[[RBOX:.*]] = llvm.mlir.undef : !llvm.struct<(ptr, 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, 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, i64, i32, i8, i8, i8, i8, array<1 x array<3 x i64>>)> diff --git a/flang/test/Fir/polymorphic.fir b/flang/test/Fir/polymorphic.fir --- a/flang/test/Fir/polymorphic.fir +++ b/flang/test/Fir/polymorphic.fir @@ -11,10 +11,81 @@ } // CHECK-LABEL: define void @_QMpolymorphic_testPtest_allocate_unlimited_polymorphic_non_derived() { -// CHECK: %[[MEM:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8 } -// CHECK: %[[DESC:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8 }, i64 1 -// CHECK: store { ptr, i64, i32, i8, i8, i8, i8 } { ptr null, i64 0, i32 20180515, i8 0, i8 -1, i8 1, i8 0 }, ptr %[[MEM]] -// CHECK: %[[LOADED:.*]] = load { ptr, i64, i32, i8, i8, i8, i8 }, ptr %[[MEM]], align 8 -// CHECK: store { ptr, i64, i32, i8, i8, i8, i8 } %[[LOADED]], ptr %[[DESC]] +// CHECK: %[[MEM:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } +// CHECK: %[[DESC:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, i64 1 +// CHECK: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } { ptr null, i64 0, i32 20180515, i8 0, i8 -1, i8 1, i8 1, ptr undef, [1 x i64] undef }, ptr %[[MEM]] +// CHECK: %[[LOADED:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[MEM]], align 8 +// CHECK: store { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOADED]], ptr %[[DESC]] // CHECK: ret void // CHECK: } + + +// Test rebox of unlimited polymoprhic descriptor + +func.func @_QMpolymorphic_testPtest_rebox() { + %0 = fir.address_of(@_QFEx) : !fir.ref>>> + %c-1_i32 = arith.constant -1 : i32 + %9 = fir.address_of(@_QQcl.2E2F64756D6D792E66393000) : !fir.ref> + %10 = fir.convert %9 : (!fir.ref>) -> !fir.ref + %c8_i32 = arith.constant 8 : i32 + %11 = fir.call @_FortranAioBeginExternalListOutput(%c-1_i32, %10, %c8_i32) fastmath : (i32, !fir.ref, i32) -> !fir.ref + %12 = fir.load %0 : !fir.ref>>> + %c0_1 = arith.constant 0 : index + %13:3 = fir.box_dims %12, %c0_1 : (!fir.class>>, index) -> (index, index, index) + %14 = fir.shift %13#0 : (index) -> !fir.shift<1> + %15 = fir.rebox %12(%14) : (!fir.class>>, !fir.shift<1>) -> !fir.class> + %16 = fir.convert %15 : (!fir.class>) -> !fir.box + %17 = fir.call @_FortranAioOutputDescriptor(%11, %16) fastmath : (!fir.ref, !fir.box) -> i1 + %18 = fir.call @_FortranAioEndIoStatement(%11) fastmath : (!fir.ref) -> i32 + return +} + +// CHECK-LABEL: @_QMpolymorphic_testPtest_rebox +// CHECK: %[[ELE_SIZE_GEP:.*]] = getelementptr { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] }, ptr %{{.*}}, i32 0, i32 1 +// CHECK: %[[ELE_SIZE:.*]] = load i64, ptr %[[ELE_SIZE_GEP]] +// CHECK: %[[TYPE_CODE_GEP:.*]] = getelementptr { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] }, ptr %{{.*}}, i32 0, i32 4 +// CHECK: %[[TYPE_CODE:.*]] = load i32, ptr %[[TYPE_CODE_GEP]] +// CHECK: %{{.*}} = insertvalue { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } undef, i64 %[[ELE_SIZE]], 1 +// CHECK: %[[TYPE_CODE_I8:.*]] = trunc i32 %[[TYPE_CODE]] to i8 +// CHECK: %{{.*}} = insertvalue { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %{{.*}}, i8 %[[TYPE_CODE_I8]], 4 + +// Test emboxing to a unlimited polymorphic descriptor + +func.func @_QMpolymorphic_testPtest_embox() { + %0 = fir.address_of(@_QFEx) : !fir.ref>>> + %1 = fir.address_of(@_QFEy) : !fir.ref> + %c1 = arith.constant 1 : index + %2 = fir.alloca i32 {bindc_name = "z", uniq_name = "_QFEz"} + %3 = fir.shape %c1 : (index) -> !fir.shape<1> + %4 = fir.embox %1(%3) : (!fir.ref>, !fir.shape<1>) -> !fir.class>> + fir.store %4 to %0 : !fir.ref>>> + return +} + +// CHECK-LABEL: @_QMpolymorphic_testPtest_embox() +// CHECK: %[[ALLOCA_DESC:.*]] = alloca { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } +// CHECK: store { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } { ptr @_QFEy, i64 ptrtoint (ptr getelementptr (i32, ptr null, i32 1) to i64), i32 20180515, i8 1, i8 9, {{.*}}, ptr %[[ALLOCA_DESC]] +// CHECK: %[[LOADED_DESC:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] }, ptr %[[ALLOCA_DESC]], align 8 +// CHECK: store { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %[[LOADED_DESC]], ptr @_QFEx, align 8 + + +fir.global internal @_QFEx : !fir.class>> { + %0 = fir.zero_bits !fir.ptr> + %c0 = arith.constant 0 : index + %1 = fir.shape %c0 : (index) -> !fir.shape<1> + %2 = fir.embox %0(%1) : (!fir.ptr>, !fir.shape<1>) -> !fir.class>> + fir.has_value %2 : !fir.class>> +} + +fir.global internal @_QFEy target : !fir.array<1xi32> { + %0 = fir.undefined !fir.array<1xi32> + fir.has_value %0 : !fir.array<1xi32> +} + +func.func private @_FortranAioBeginExternalListOutput(i32, !fir.ref, i32) -> !fir.ref attributes {fir.io, fir.runtime} +func.func private @_FortranAioOutputDescriptor(!fir.ref, !fir.box) -> i1 attributes {fir.io, fir.runtime} +func.func private @_FortranAioEndIoStatement(!fir.ref) -> i32 attributes {fir.io, fir.runtime} +fir.global linkonce @_QQcl.2E2F64756D6D792E66393000 constant : !fir.char<1,12> { + %0 = fir.string_lit "./dummy.f90\00"(12) : !fir.char<1,12> + fir.has_value %0 : !fir.char<1,12> +}