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

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2022-09-23T08:30:02+02:00
New Revision: c0185c8d296d6bc8cdcf211fdc19a89afa8e3222

URL: https://github.com/llvm/llvm-project/commit/c0185c8d296d6bc8cdcf211fdc19a89afa8e3222
DIFF: https://github.com/llvm/llvm-project/commit/c0185c8d296d6bc8cdcf211fdc19a89afa8e3222.diff

LOG: [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

Added: 
    flang/test/Lower/namelist-common-block.f90

Modified: 
    flang/lib/Lower/IO.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 505a2d7486288..e207b50f79572 100644
--- 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 @@ 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);

diff  --git a/flang/test/Lower/namelist-common-block.f90 b/flang/test/Lower/namelist-common-block.f90
new file mode 100644
index 0000000000000..f0362d7f61434
--- /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<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>>>>
+