From c0185c8d296d6bc8cdcf211fdc19a89afa8e3222 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval@gmail.com>
Date: Fri, 23 Sep 2022 07:06:33 +0200
Subject: [PATCH] [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
---
 flang/lib/Lower/IO.cpp                     | 21 ++++++++++++++++
 flang/test/Lower/namelist-common-block.f90 | 29 ++++++++++++++++++++++
 2 files changed, 50 insertions(+)
 create mode 100644 flang/test/Lower/namelist-common-block.f90

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 505a2d748628..e207b50f7957 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 000000000000..f0362d7f6143
--- /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>>>>
+