Skip to content

Commit

Permalink
[flang][hlfir] Fix c_null_ptr lowering in structure constructors (#68321
Browse files Browse the repository at this point in the history
)

Lowering handles C_PTR initial values that are designators or NULL()
inside structure constructors as an extension to support. This extension
is used by initial values generated for runtime derived type info.

But c_null_ptr wrongly fell into this extension path with HLFIR, causing
the initial value to be set to some (non null) address containing
c_null_ptr instead of c_null_ptr itself...

This was caused by the FIR lowering relying on genExtAddrInInitializer
to not place c_null_ptr inside an address. Fix this by only falling
through into the extension handling code if this is an extension: i.e,
the expression is some designated symbol or NULL().
  • Loading branch information
jeanPerier committed Oct 6, 2023
1 parent ff5e2ba commit e91a4be
Show file tree
Hide file tree
Showing 2 changed files with 49 additions and 29 deletions.
59 changes: 30 additions & 29 deletions flang/lib/Lower/ConvertConstant.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -388,37 +388,38 @@ static mlir::Value genInlinedStructureCtorLitImpl(

// Special handling for scalar c_ptr/c_funptr constants. The array constant
// must fall through to genConstantValue() below.
if (Fortran::semantics::IsBuiltinCPtr(sym) && sym->Rank() == 0) {
// Builtin c_ptr and c_funptr have special handling because initial
// values are handled for them as an extension.
if (Fortran::semantics::IsBuiltinCPtr(sym) && sym->Rank() == 0 &&
(Fortran::evaluate::GetLastSymbol(expr.value()) ||
Fortran::evaluate::IsNullPointer(expr.value()))) {
// Builtin c_ptr and c_funptr have special handling because designators
// and NULL() are handled as initial values for them as an extension
// (otherwise only c_ptr_null/c_funptr_null are allowed and these are
// replaced by structure constructors by semantics, so GetLastSymbol
// returns nothing).

// The Ev::Expr is an initializer that is a pointer target (e.g., 'x' or
// NULL()) that must be inserted into an intermediate cptr record value's
// address field, which ought to be an intptr_t on the target.
mlir::Value addr = fir::getBase(Fortran::lower::genExtAddrInInitializer(
converter, loc, expr.value()));
if (addr.getType() == componentTy) {
// Do nothing. The Ev::Expr was returned as a value that can be
// inserted directly to the component without an intermediary.
} else {
// The Ev::Expr returned is an initializer that is a pointer (e.g.,
// null) that must be inserted into an intermediate cptr record
// value's address field, which ought to be an intptr_t on the target.
if (addr.getType().isa<fir::BoxProcType>())
addr = builder.create<fir::BoxAddrOp>(loc, addr);
assert((fir::isa_ref_type(addr.getType()) ||
addr.getType().isa<mlir::FunctionType>()) &&
"expect reference type for address field");
assert(fir::isa_derived(componentTy) &&
"expect C_PTR, C_FUNPTR to be a record");
auto cPtrRecTy = componentTy.cast<fir::RecordType>();
llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName;
mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName);
auto addrField = builder.create<fir::FieldIndexOp>(
loc, fieldTy, addrFieldName, componentTy,
/*typeParams=*/mlir::ValueRange{});
mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr);
auto undef = builder.create<fir::UndefOp>(loc, componentTy);
addr = builder.create<fir::InsertValueOp>(
loc, componentTy, undef, castAddr,
builder.getArrayAttr(addrField.getAttributes()));
}
if (addr.getType().isa<fir::BoxProcType>())
addr = builder.create<fir::BoxAddrOp>(loc, addr);
assert((fir::isa_ref_type(addr.getType()) ||
addr.getType().isa<mlir::FunctionType>()) &&
"expect reference type for address field");
assert(fir::isa_derived(componentTy) &&
"expect C_PTR, C_FUNPTR to be a record");
auto cPtrRecTy = componentTy.cast<fir::RecordType>();
llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName;
mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName);
auto addrField = builder.create<fir::FieldIndexOp>(
loc, fieldTy, addrFieldName, componentTy,
/*typeParams=*/mlir::ValueRange{});
mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr);
auto undef = builder.create<fir::UndefOp>(loc, componentTy);
addr = builder.create<fir::InsertValueOp>(
loc, componentTy, undef, castAddr,
builder.getArrayAttr(addrField.getAttributes()));
res = builder.create<fir::InsertValueOp>(
loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes()));
continue;
Expand Down
19 changes: 19 additions & 0 deletions flang/test/HLFIR/c-null-ptr-init.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
! Test lowering of C_NULL_PTR in structure constructor initial value.
! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
subroutine test
use, intrinsic :: iso_c_binding, only : c_ptr, c_null_ptr
type t
type(c_ptr) :: ptr
end type t
type(t) :: x = t(c_null_ptr)
end subroutine
! CHECK-LABEL: fir.global internal @_QFtestEx : !fir.type<_QFtestTt{ptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}> {
! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.type<_QFtestTt{ptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>
! CHECK: %[[VAL_1:.*]] = fir.field_index ptr, !fir.type<_QFtestTt{ptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>
! CHECK: %[[VAL_2:.*]] = fir.undefined !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
! CHECK: %[[VAL_3:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64
! CHECK: %[[VAL_5:.*]] = fir.insert_value %[[VAL_2]], %[[VAL_4]], ["__address", !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>] : (!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>, i64) -> !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
! CHECK: %[[VAL_6:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_5]], ["ptr", !fir.type<_QFtestTt{ptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>] : (!fir.type<_QFtestTt{ptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>) -> !fir.type<_QFtestTt{ptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>
! CHECK: fir.has_value %[[VAL_6]] : !fir.type<_QFtestTt{ptr:!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>}>
! CHECK: }

0 comments on commit e91a4be

Please sign in to comment.