From e91a4bec0b3dd5d7c5d745fe1c7791fdc008e07a Mon Sep 17 00:00:00 2001 From: jeanPerier Date: Fri, 6 Oct 2023 09:20:13 +0200 Subject: [PATCH] [flang][hlfir] Fix c_null_ptr lowering in structure constructors (#68321) 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(). --- flang/lib/Lower/ConvertConstant.cpp | 59 ++++++++++++++-------------- flang/test/HLFIR/c-null-ptr-init.f90 | 19 +++++++++ 2 files changed, 49 insertions(+), 29 deletions(-) create mode 100644 flang/test/HLFIR/c-null-ptr-init.f90 diff --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp index 940e70da511c22..6e7a60e42abfe6 100644 --- a/flang/lib/Lower/ConvertConstant.cpp +++ b/flang/lib/Lower/ConvertConstant.cpp @@ -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()) - addr = builder.create(loc, addr); - assert((fir::isa_ref_type(addr.getType()) || - addr.getType().isa()) && - "expect reference type for address field"); - assert(fir::isa_derived(componentTy) && - "expect C_PTR, C_FUNPTR to be a record"); - auto cPtrRecTy = componentTy.cast(); - llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName; - mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName); - auto addrField = builder.create( - loc, fieldTy, addrFieldName, componentTy, - /*typeParams=*/mlir::ValueRange{}); - mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr); - auto undef = builder.create(loc, componentTy); - addr = builder.create( - loc, componentTy, undef, castAddr, - builder.getArrayAttr(addrField.getAttributes())); - } + if (addr.getType().isa()) + addr = builder.create(loc, addr); + assert((fir::isa_ref_type(addr.getType()) || + addr.getType().isa()) && + "expect reference type for address field"); + assert(fir::isa_derived(componentTy) && + "expect C_PTR, C_FUNPTR to be a record"); + auto cPtrRecTy = componentTy.cast(); + llvm::StringRef addrFieldName = Fortran::lower::builtin::cptrFieldName; + mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName); + auto addrField = builder.create( + loc, fieldTy, addrFieldName, componentTy, + /*typeParams=*/mlir::ValueRange{}); + mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr); + auto undef = builder.create(loc, componentTy); + addr = builder.create( + loc, componentTy, undef, castAddr, + builder.getArrayAttr(addrField.getAttributes())); res = builder.create( loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes())); continue; diff --git a/flang/test/HLFIR/c-null-ptr-init.f90 b/flang/test/HLFIR/c-null-ptr-init.f90 new file mode 100644 index 00000000000000..379b8ccbe855c8 --- /dev/null +++ b/flang/test/HLFIR/c-null-ptr-init.f90 @@ -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: }