diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -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 @@ builder.getNamedGlobal(converter.mangleName(s) + suffix)) { descAddr = builder.create(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( + 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( + 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); diff --git a/flang/test/Lower/namelist-common-block.f90 b/flang/test/Lower/namelist-common-block.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/namelist-common-block.f90 @@ -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>>> { +! CHECK: %[[CB_ADDR:.*]] = fir.address_of(@_QBc) : !fir.ref> +! CHECK: %[[CB_CAST:.*]] = fir.convert %[[CB_ADDR]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[OFFSET:.*]] = arith.constant 8 : index +! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[CB_CAST]], %[[OFFSET]] : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[CAST_BOX:.*]] = fir.convert %[[COORD]] : (!fir.ref) -> !fir.ref>>> +! CHECK: %[[CAST_BOX_NONE:.*]] = fir.convert %[[CAST_BOX]] : (!fir.ref>>>) -> !fir.ref> +! CHECK: %[[RES:.*]] = fir.insert_value %{{.*}}, %[[CAST_BOX_NONE]], [1 : index, 1 : index] : (!fir.array<2xtuple, !fir.ref>>>, !fir.ref>) -> !fir.array<2xtuple, !fir.ref>>> +! CHECK: fir.has_value %[[RES]] : !fir.array<2xtuple, !fir.ref>>> +