[flang] Load allocatable or pointer box of namelist item from common block

If a namelist item is an allocatable or pointer and is also part of a common
block, the box should be loaded from the common block ref.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D134470
This commit is contained in:
Valentin Clement 2022-09-23 07:06:33 +02:00
parent 3fe71809a5
commit c0185c8d29
No known key found for this signature in database
GPG Key ID: 086D54783C928776
2 changed files with 50 additions and 0 deletions

View File

@ -12,6 +12,7 @@
#include "flang/Lower/IO.h"
#include "flang/Common/uint128.h"
#include "flang/Evaluate/tools.h"
#include "flang/Lower/Allocatable.h"
#include "flang/Lower/Bridge.h"
#include "flang/Lower/ConvertExpr.h"
@ -321,6 +322,26 @@ getNamelistGroup(Fortran::lower::AbstractConverter &converter,
builder.getNamedGlobal(converter.mangleName(s) + suffix)) {
descAddr = builder.create<fir::AddrOfOp>(loc, desc.resultType(),
desc.getSymbol());
} else if (Fortran::semantics::FindCommonBlockContaining(s) &&
IsAllocatableOrPointer(s)) {
mlir::Type symType = converter.genType(s);
const Fortran::semantics::Symbol *commonBlockSym =
Fortran::semantics::FindCommonBlockContaining(s);
std::string commonBlockName = converter.mangleName(*commonBlockSym);
fir::GlobalOp commonGlobal = builder.getNamedGlobal(commonBlockName);
mlir::Value commonBlockAddr = builder.create<fir::AddrOfOp>(
loc, commonGlobal.resultType(), commonGlobal.getSymbol());
mlir::IntegerType i8Ty = builder.getIntegerType(8);
mlir::Type i8Ptr = builder.getRefType(i8Ty);
mlir::Type seqTy = builder.getRefType(builder.getVarLenSeqTy(i8Ty));
mlir::Value base = builder.createConvert(loc, seqTy, commonBlockAddr);
std::size_t byteOffset = s.GetUltimate().offset();
mlir::Value offs = builder.createIntegerConstant(
loc, builder.getIndexType(), byteOffset);
mlir::Value varAddr = builder.create<fir::CoordinateOp>(
loc, i8Ptr, base, mlir::ValueRange{offs});
descAddr =
builder.createConvert(loc, builder.getRefType(symType), varAddr);
} else {
const auto expr = Fortran::evaluate::AsGenericExpr(s);
fir::ExtendedValue exv = converter.genExprAddr(*expr, stmtCtx);

View File

@ -0,0 +1,29 @@
! RUN: bbc -emit-fir -o - %s | FileCheck %s
! Test that allocatable or pointer item from namelist are retrieved correctly
! if they are part of a common block as well.
program nml_common
integer :: i
real, pointer :: p(:)
namelist /t/i,p
common /c/i,p
allocate(p(2))
call print_t()
contains
subroutine print_t()
write(*,t)
end subroutine
end
! CHECK-LABEL: fir.global linkonce @_QFGt.list constant : !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>> {
! CHECK: %[[CB_ADDR:.*]] = fir.address_of(@_QBc) : !fir.ref<!fir.array<56xi8>>
! CHECK: %[[CB_CAST:.*]] = fir.convert %[[CB_ADDR]] : (!fir.ref<!fir.array<56xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[OFFSET:.*]] = arith.constant 8 : index
! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[CB_CAST]], %[[OFFSET]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[CAST_BOX:.*]] = fir.convert %[[COORD]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
! CHECK: %[[CAST_BOX_NONE:.*]] = fir.convert %[[CAST_BOX]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %[[RES:.*]] = fir.insert_value %{{.*}}, %[[CAST_BOX_NONE]], [1 : index, 1 : index] : (!fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>, !fir.ref<!fir.box<none>>) -> !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
! CHECK: fir.has_value %[[RES]] : !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>