/// Get the KindMap.
virtual const fir::KindMapping &getKindMap() = 0;
+ virtual Fortran::lower::StatementContext &getFctCtx() = 0;
+
AbstractConverter(const Fortran::lower::LoweringOptions &loweringOptions)
: loweringOptions(loweringOptions) {}
virtual ~AbstractConverter() = default;
#include "flang/Lower/AbstractConverter.h"
#include "flang/Lower/EnvironmentDefault.h"
#include "flang/Lower/LoweringOptions.h"
+#include "flang/Lower/StatementContext.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Support/KindMapping.h"
#include "mlir/IR/BuiltinOps.h"
return semanticsContext;
}
+ Fortran::lower::StatementContext &fctCtx() { return functionContext; }
+
bool validModule() { return getModule(); }
//===--------------------------------------------------------------------===//
LoweringBridge(const LoweringBridge &) = delete;
Fortran::semantics::SemanticsContext &semanticsContext;
+ Fortran::lower::StatementContext functionContext;
const Fortran::common::IntrinsicTypeDefaultKinds &defaultKinds;
const Fortran::evaluate::IntrinsicProcTable &intrinsics;
const Fortran::evaluate::TargetCharacteristics &targetCharacteristics;
bool HasCoarray(const parser::Expr &);
bool IsAssumedType(const Symbol &);
bool IsPolymorphic(const Symbol &);
+bool IsUnlimitedPolymorphic(const Symbol &);
bool IsPolymorphicAllocatable(const Symbol &);
// Return an error if a symbol is not accessible from a scope
return bridge.getKindMap();
}
+ Fortran::lower::StatementContext &getFctCtx() override final {
+ return bridge.fctCtx();
+ }
+
mlir::Value hostAssocTupleValue() override final { return hostAssocTuple; }
/// Record a binding for the ssa-value of the tuple for this function.
///
/// Generate the cleanup block before the program exits
void genExitRoutine() {
+
if (blockIsUnterminated())
builder->create<mlir::func::ReturnOp>(toLocation());
}
resultRef = builder->createConvert(loc, resultRefType, resultRef);
return builder->create<fir::LoadOp>(loc, resultRef);
});
+ bridge.fctCtx().finalizeAndPop();
builder->create<mlir::func::ReturnOp>(loc, resultVal);
}
} else if (Fortran::semantics::HasAlternateReturns(symbol)) {
mlir::Value retval = builder->create<fir::LoadOp>(
toLocation(), getAltReturnResult(symbol));
+ bridge.fctCtx().finalizeAndPop();
builder->create<mlir::func::ReturnOp>(toLocation(), retval);
} else {
+ bridge.fctCtx().finalizeAndPop();
genExitRoutine();
}
}
std::optional<Fortran::evaluate::DynamicType> lhsType =
assign.lhs.GetType();
assert(lhsType && "lhs cannot be typeless");
+
// Assignment to polymorphic allocatables may require changing the
// variable dynamic type (See Fortran 2018 10.2.1.3 p3).
- if (lhsType->IsPolymorphic() &&
+ if ((lhsType->IsPolymorphic() ||
+ lhsType->IsUnlimitedPolymorphic()) &&
Fortran::lower::isWholeAllocatable(assign.lhs)) {
mlir::Value lhs = genExprMutableBox(loc, assign.lhs).getAddr();
mlir::Value rhs =
// the pointer variable.
if (assign.lhs.Rank() > 0 || explicitIterationSpace()) {
+ if (isDerivedCategory(lhsType->category()) &&
+ Fortran::semantics::IsFinalizable(
+ lhsType->GetDerivedTypeSpec()))
+ TODO(loc, "derived-type finalization with array assignment");
// Array assignment
// See Fortran 2018 10.2.1.3 p5, p6, and p7
genArrayAssignment(assign, stmtCtx);
Fortran::lower::isWholeAllocatable(assign.lhs);
std::optional<fir::factory::MutableBoxReallocation> lhsRealloc;
std::optional<fir::MutableBoxValue> lhsMutableBox;
+
+ // Finalize LHS on intrinsic assignment.
+ if (lhsType->IsPolymorphic() ||
+ lhsType->IsUnlimitedPolymorphic() ||
+ (isDerivedCategory(lhsType->category()) &&
+ Fortran::semantics::IsFinalizable(
+ lhsType->GetDerivedTypeSpec()))) {
+ if (lhsIsWholeAllocatable) {
+ lhsMutableBox = genExprMutableBox(loc, assign.lhs);
+ mlir::Value isAllocated =
+ fir::factory::genIsAllocatedOrAssociatedTest(
+ *builder, loc, *lhsMutableBox);
+ builder->genIfThen(loc, isAllocated)
+ .genThen([&]() {
+ fir::runtime::genDerivedTypeDestroy(
+ *builder, loc, fir::getBase(*lhsMutableBox));
+ })
+ .end();
+ } else {
+ fir::ExtendedValue exv = genExprBox(loc, assign.lhs, stmtCtx);
+ fir::runtime::genDerivedTypeDestroy(*builder, loc,
+ fir::getBase(exv));
+ }
+ }
+
auto lhs = [&]() -> fir::ExtendedValue {
if (lhsIsWholeAllocatable) {
lhsMutableBox = genExprMutableBox(loc, assign.lhs);
/// Start translation of a function.
void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
assert(!builder && "expected nullptr");
+ bridge.fctCtx().pushScope();
const Fortran::semantics::Scope &scope = funit.getScope();
LLVM_DEBUG(llvm::dbgs() << "\n[bridge - startNewFunction]";
if (auto *sym = scope.symbol()) llvm::dbgs() << " " << *sym;
/// Finish translation of a function.
void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
setCurrentPosition(Fortran::lower::pft::stmtSourceLoc(funit.endStmt));
- if (funit.isMainProgram())
+ if (funit.isMainProgram()) {
+ bridge.fctCtx().finalizeAndPop();
genExitRoutine();
- else
+ } else {
genFIRProcedureExit(funit, funit.getSubprogramSymbol());
+ }
funit.finalBlock = nullptr;
LLVM_DEBUG(llvm::dbgs() << "\n[bridge - endNewFunction";
if (auto *sym = funit.scope->symbol()) llvm::dbgs()
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/LowLevelIntrinsics.h"
#include "flang/Optimizer/Builder/MutableBox.h"
+#include "flang/Optimizer/Builder/Runtime/Derived.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
}
if (allocatedResult) {
+ // 7.5.6.3 point 5. Derived-type finalization.
+ // Check if the derived-type is finalizable if it is a monorphic
+ // derived-type.
+ // For polymorphic and unlimited polymorphic enities call the runtime
+ // in any cases.
+ std::optional<Fortran::evaluate::DynamicType> retTy =
+ caller.getCallDescription().proc().GetType();
+ if (retTy && (retTy->category() == Fortran::common::TypeCategory::Derived ||
+ retTy->IsPolymorphic() || retTy->IsUnlimitedPolymorphic())) {
+ if (retTy->IsPolymorphic() || retTy->IsUnlimitedPolymorphic()) {
+ auto *bldr = &converter.getFirOpBuilder();
+ stmtCtx.attachCleanup([bldr, loc, allocatedResult]() {
+ fir::runtime::genDerivedTypeDestroy(*bldr, loc,
+ fir::getBase(*allocatedResult));
+ });
+ } else {
+ const Fortran::semantics::DerivedTypeSpec &typeSpec =
+ retTy->GetDerivedTypeSpec();
+ if (Fortran::semantics::IsFinalizable(typeSpec)) {
+ auto *bldr = &converter.getFirOpBuilder();
+ stmtCtx.attachCleanup([bldr, loc, allocatedResult]() {
+ mlir::Value box = bldr->createBox(loc, *allocatedResult);
+ fir::runtime::genDerivedTypeDestroy(*bldr, loc, box);
+ });
+ }
+ }
+ }
allocatedResult->match(
[&](const fir::MutableBoxValue &box) {
if (box.isAllocatable()) {
if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol))
return ty;
- if (Fortran::semantics::IsFinalizable(tySpec))
- TODO(converter.genLocation(tySpec.name()), "derived type finalization");
-
auto rec = fir::RecordType::get(context,
Fortran::lower::mangle::mangleName(tySpec));
// Maintain the stack of types for recursive references.
return fir::getBase(Fortran::lower::createSomeExtendedExpression(
loc, converter, expr, symMap, context));
}
+
/// Does this variable have a default initialization?
static bool hasDefaultInitialization(const Fortran::semantics::Symbol &sym) {
if (sym.has<Fortran::semantics::ObjectEntityDetails>() && sym.size())
return false;
}
+// Does this variable have a finalization?
+static bool hasFinalization(const Fortran::semantics::Symbol &sym) {
+ if (sym.has<Fortran::semantics::ObjectEntityDetails>() && sym.size())
+ if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
+ if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
+ declTypeSpec->AsDerived())
+ return Fortran::semantics::IsFinalizable(*derivedTypeSpec);
+ return false;
+}
+
//===----------------------------------------------------------------===//
// Global variables instantiation (not for alias and common)
//===----------------------------------------------------------------===//
}
}
+/// Check whether a variable needs to be finalized according to clause 7.5.6.3
+/// point 3.
+/// Must be nonpointer, nonallocatable object that is not a dummy argument or
+/// function result.
+static bool needEndFinalization(const Fortran::lower::pft::Variable &var) {
+ if (!var.hasSymbol())
+ return false;
+ const Fortran::semantics::Symbol &sym = var.getSymbol();
+ if (!Fortran::semantics::IsPointer(sym) &&
+ !Fortran::semantics::IsAllocatable(sym) &&
+ !Fortran::semantics::IsDummy(sym) &&
+ !Fortran::semantics::IsFunctionResult(sym) &&
+ !Fortran::semantics::IsSaved(sym))
+ return hasFinalization(sym);
+ return false;
+}
+
+/// Check whether a variable needs the be finalized according to clause 7.5.6.3
+/// point 7.
+/// Must be nonpointer, nonallocatable, INTENT (OUT) dummy argument.
+static bool
+needDummyIntentoutFinalization(const Fortran::lower::pft::Variable &var) {
+ if (!var.hasSymbol())
+ return false;
+ const Fortran::semantics::Symbol &sym = var.getSymbol();
+ if (!Fortran::semantics::IsDummy(sym) ||
+ !Fortran::semantics::IsIntentOut(sym) ||
+ Fortran::semantics::IsAllocatable(sym) ||
+ Fortran::semantics::IsPointer(sym))
+ return false;
+ // Polymorphic and unlimited polymorphic intent(out) dummy argument might need
+ // finalization at runtime.
+ if (Fortran::semantics::IsPolymorphic(sym) ||
+ Fortran::semantics::IsUnlimitedPolymorphic(sym))
+ return true;
+ // Intent(out) dummies must be finalized at runtime if their type has a
+ // finalization.
+ return hasFinalization(sym);
+}
+
+/// Call default initialization runtime routine to initialize \p var.
+static void finalizeAtRuntime(Fortran::lower::AbstractConverter &converter,
+ const Fortran::lower::pft::Variable &var,
+ Fortran::lower::SymMap &symMap) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::Location loc = converter.getCurrentLocation();
+ const Fortran::semantics::Symbol &sym = var.getSymbol();
+ fir::ExtendedValue exv = symMap.lookupSymbol(sym).toExtendedValue();
+ if (Fortran::semantics::IsOptional(sym)) {
+ // Only finalize if present.
+ auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
+ fir::getBase(exv));
+ builder.genIfThen(loc, isPresent)
+ .genThen([&]() {
+ auto box = builder.createBox(loc, exv);
+ fir::runtime::genDerivedTypeDestroy(builder, loc, box);
+ })
+ .end();
+ } else {
+ mlir::Value box = builder.createBox(loc, exv);
+ fir::runtime::genDerivedTypeDestroy(builder, loc, box);
+ }
+}
+
// Fortran 2018 - 9.7.3.2 point 6
// When a procedure is invoked, any allocated allocatable object that is an
// actual argument corresponding to an INTENT(OUT) allocatable dummy argument
Fortran::lower::StatementContext stmtCtx;
mapSymbolAttributes(converter, var, symMap, stmtCtx);
deallocateIntentOut(converter, var, symMap);
+ if (needDummyIntentoutFinalization(var))
+ finalizeAtRuntime(converter, var, symMap);
if (mustBeDefaultInitializedAtRuntime(var))
defaultInitializeAtRuntime(converter, var, symMap);
+ if (needEndFinalization(var)) {
+ auto *builder = &converter.getFirOpBuilder();
+ mlir::Location loc = converter.getCurrentLocation();
+ fir::ExtendedValue exv =
+ symMap.lookupSymbol(var.getSymbol()).toExtendedValue();
+ converter.getFctCtx().attachCleanup([builder, loc, exv]() {
+ mlir::Value box = builder->createBox(loc, exv);
+ fir::runtime::genDerivedTypeDestroy(*builder, loc, box);
+ });
+ }
}
//===----------------------------------------------------------------===//
return false;
}
+bool IsUnlimitedPolymorphic(const Symbol &symbol) {
+ if (const DeclTypeSpec * type{symbol.GetType()}) {
+ return type->IsUnlimitedPolymorphic();
+ }
+ return false;
+}
+
bool IsPolymorphicAllocatable(const Symbol &symbol) {
return IsAllocatable(symbol) && IsPolymorphic(symbol);
}
--- /dev/null
+! Test derived type finalization
+! RUN: bbc -polymorphic-type -emit-fir %s -o - | FileCheck %s
+
+! Missing tests:
+! - finalization within BLOCK construct
+
+module derived_type_finalization
+
+ type :: t1
+ integer :: a
+ contains
+ final :: t1_final
+ end type
+
+contains
+
+ subroutine t1_final(this)
+ type(t1) :: this
+ end subroutine
+
+ ! 7.5.6.3 point 1. Finalization of LHS.
+ subroutine test_lhs()
+ type(t1) :: lhs, rhs
+ lhs = rhs
+ end subroutine
+
+ subroutine test_lhs_allocatable()
+ type(t1), allocatable :: lhs
+ type(t1) :: rhs
+ lhs = rhs
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_lhs() {
+! CHECK: %[[LHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "lhs", uniq_name = "_QMderived_type_finalizationFtest_lhsElhs"}
+! CHECK: %[[RHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "rhs", uniq_name = "_QMderived_type_finalizationFtest_lhsErhs"}
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[LHS]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_lhs_allocatable() {
+! CHECK: %[[LHS:.*]] = fir.alloca !fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = "lhs", uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableElhs"}
+! CHECK: %[[LHS_ADDR:.*]] = fir.alloca !fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>> {uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableElhs.addr"}
+! CHECK: %[[RHS:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "rhs", uniq_name = "_QMderived_type_finalizationFtest_lhs_allocatableErhs"}
+! CHECK: %[[LHS_ADDR_LOAD:.*]] = fir.load %[[LHS_ADDR]] : !fir.ref<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>
+! CHECK: %[[ADDR_I64:.*]] = fir.convert %[[LHS_ADDR_LOAD]] : (!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> i64
+! CHECK: %[[C0:.*]] = arith.constant 0 : i64
+! CHECK: %[[IS_NULL:.*]] = arith.cmpi ne, %[[ADDR_I64]], %[[C0]] : i64
+! CHECK: fir.if %[[IS_NULL]] {
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LHS]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
+! CHECK: }
+
+ ! 7.5.6.3 point 2. Finalization on explicit deallocation.
+ subroutine test_deallocate()
+ type(t1), allocatable :: t
+ allocate(t)
+ deallocate(t)
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_deallocate() {
+! CHECK: %[[LOCAL_T:.*]] = fir.alloca !fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = "t", uniq_name = "_QMderived_type_finalizationFtest_deallocateEt"}
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LOCAL_T]] : (!fir.ref<!fir.box<!fir.heap<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAAllocatableDeallocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+ ! 7.5.6.3 point 2. Finalization of disassociated target.
+ subroutine test_target_finalization()
+ type(t1), pointer :: p
+ allocate(p, source=t1(a=2))
+ deallocate(p)
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_target_finalization() {
+! CHECK: %[[P:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>> {bindc_name = "p", uniq_name = "_QMderived_type_finalizationFtest_target_finalizationEp"}
+! CHECK: fir.call @_FortranAInitialize
+! CHECK: fir.call @_FortranAPointerAllocateSource
+! CHECK: %[[P_BOX_NONE:.*]] = fir.convert %[[P]] : (!fir.ref<!fir.box<!fir.ptr<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %{{.*}} = fir.call @_FortranAPointerDeallocate(%[[P_BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+
+ ! 7.5.6.3 point 3. Finalize on END.
+ subroutine test_end_finalization()
+ type(t1) :: t
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_end_finalization() {
+! CHECK: %[[LOCAL_T:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "t", uniq_name = "_QMderived_type_finalizationFtest_end_finalizationEt"}
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[LOCAL_T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
+! CHECK: return
+
+ ! test with multiple return.
+ subroutine test_end_finalization2(a)
+ type(t1) :: t
+ logical :: a
+ if (a) return
+ t%a = 10
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_end_finalization2(
+! CHECK-SAME: %[[A:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "a"}) {
+! CHECK: %[[T:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = "t", uniq_name = "_QMderived_type_finalizationFtest_end_finalization2Et"}
+! CHECK: %[[LOAD_A:.*]] = fir.load %[[A]] : !fir.ref<!fir.logical<4>>
+! CHECK: %[[CONV_A:.*]] = fir.convert %[[LOAD_A]] : (!fir.logical<4>) -> i1
+! CHECK: cf.cond_br %[[CONV_A]], ^bb1, ^bb2
+! CHECK: ^bb1:
+! CHECK: cf.br ^bb3
+! CHECK: ^bb2:
+! CHECK: %[[C10:.*]] = arith.constant 10 : i32
+! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QMderived_type_finalizationTt1{a:i32}>
+! CHECK: %[[COORD_A:.*]] = fir.coordinate_of %[[T]], %[[FIELD_A]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>, !fir.field) -> !fir.ref<i32>
+! CHECK: fir.store %[[C10]] to %[[COORD_A]] : !fir.ref<i32>
+! CHECK: cf.br ^bb3
+! CHECK: ^bb3:
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
+! CHECK: return
+! CHECK: }
+
+ function ret_type() result(ty)
+ type(t1) :: ty
+ end function
+
+ ! 7.5.6.3 point 5. Finalization of a function reference on the RHS of an intrinsic assignment.
+ subroutine test_fct_ref()
+ type(t1), allocatable :: ty
+ ty = ret_type()
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_fct_ref() {
+! CHECK: %[[RESULT:.*]] = fir.alloca !fir.type<_QMderived_type_finalizationTt1{a:i32}> {bindc_name = ".result"}
+! CHECK: %[[CALL_RES:.*]] = fir.call @_QMderived_type_finalizationPret_type()
+! CHECK: fir.save_result %[[CALL_RES]] to %[[RESULT]] : !fir.type<_QMderived_type_finalizationTt1{a:i32}>, !fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[RESULT]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
+! CHECK: return
+
+ subroutine test_finalize_intent_out(t)
+ type(t1), intent(out) :: t
+ end subroutine
+
+! CHECK-LABEL: func.func @_QMderived_type_finalizationPtest_finalize_intent_out(
+! CHECK-SAME: %[[T:.*]]: !fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>> {fir.bindc_name = "t"}) {
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[T]] : (!fir.ref<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[EMBOX]] : (!fir.box<!fir.type<_QMderived_type_finalizationTt1{a:i32}>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}}: (!fir.box<none>) -> none
+! CHECK: return
+
+end module
! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_unlimited_polymorphic_intentout(
! CHECK-SAME: %[[ARG0:.*]]: !fir.class<none> {fir.bindc_name = "a"}) {
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<none>) -> !fir.box<none>
! CHECK: %{{.*}} = fir.call @_FortranAInitialize(%[[BOX_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.ref<i8>, i32) -> none
subroutine test_polymorphic_intentout(a)
! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_polymorphic_intentout(
! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranADestroy(%[[BOX_NONE]]) {{.*}} : (!fir.box<none>) -> none
+! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
! CHECK: %{{.*}} = fir.call @_FortranAInitialize(%[[BOX_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.box<none>, !fir.ref<i8>, i32) -> none
subroutine rebox_up_to_record_type(p)
projects / platform / upstream / llvm.git / commitdiff