[flang] Use the namelist item descriptor if it is local polymorphic entity.

[DanielCChen]

This patch is to use the namelist item descriptor instead of creating a temporary one when the item is a local polymorphic entity so it's dynamic type is preserved.

Fixes #152527
Fixes #154130

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

Author: Daniel Chen (DanielCChen)

Changes

This patch is to use the namelist item descriptor instead of creating a temporary one when the item is a local polymorphic entity so it's dynamic type is preserved.

Fixes #152527

---

Full diff: https://github.com/llvm/llvm-project/pull/162701.diff

2 Files Affected:

• (modified) flang/lib/Lower/IO.cpp (+13-8)
• (modified) flang/test/Lower/namelist.f90 (+52)

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 98dc78f625b9e..8be5f7c8af115 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -526,14 +526,19 @@ getNamelistGroup(Fortran::lower::AbstractConverter &converter,
       } else {
         const auto expr = Fortran::evaluate::AsGenericExpr(s);
         fir::ExtendedValue exv = converter.genExprAddr(*expr, stmtCtx);
-        mlir::Type type = fir::getBase(exv).getType();
-        if (mlir::Type baseTy = fir::dyn_cast_ptrOrBoxEleTy(type))
-          type = baseTy;
-        fir::BoxType boxType = fir::BoxType::get(fir::PointerType::get(type));
-        descAddr = builder.createTemporary(loc, boxType);
-        fir::MutableBoxValue box = fir::MutableBoxValue(descAddr, {}, {});
-        fir::factory::associateMutableBox(builder, loc, box, exv,
-                                          /*lbounds=*/{});
+        descAddr = fir::getBase(exv);
+        mlir::Type type = descAddr.getType();
+
+        // Don't need temp descriptor if the namelist item is polymorphic.
+        if (!mlir::isa<fir::ClassType>(type)) {
+          if (mlir::Type baseTy = fir::dyn_cast_ptrOrBoxEleTy(type))
+            type = baseTy;
+          fir::BoxType boxType = fir::BoxType::get(fir::PointerType::get(type));
+          descAddr = builder.createTemporary(loc, boxType);
+          fir::MutableBoxValue box = fir::MutableBoxValue(descAddr, {}, {});
+          fir::factory::associateMutableBox(builder, loc, box, exv,
+                                            /*lbounds=*/{});
+        }
       }
       descAddr = builder.createConvert(loc, descRefTy, descAddr);
       list = fir::InsertValueOp::create(builder, loc, listTy, list, descAddr,
diff --git a/flang/test/Lower/namelist.f90 b/flang/test/Lower/namelist.f90
index 770af46eea744..e7baa527faa52 100644
--- a/flang/test/Lower/namelist.f90
+++ b/flang/test/Lower/namelist.f90
@@ -123,6 +123,57 @@ subroutine global_pointer
   write(10, nml=mygroup)
 end
 
+module m
+  type base
+    real :: r1
+  end type
+  interface write(formatted)
+    subroutine writeformatted(dtv, unit, iotype, v_list, iostat, iomsg )
+      import base
+        class(base), intent(in) :: dtv
+        integer,  intent(in) :: unit
+        character(*), intent(in) :: iotype
+        integer, intent(in)     :: v_list(:)
+        integer,  intent(out) :: iostat
+        character(*),  intent(inout) :: iomsg
+     end subroutine
+  end interface
+end module
+
+! CHECK-LABEL: c.func @_QPlocal_poly_namelist
+subroutine local_poly_namelist
+  use m
+  class(base), allocatable :: b1
+  ! CHECK:     %[[V_1:[0-9]+]]  = fir.alloca !fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>> {bindc_name = "b1", uniq_name = "_QFlocal_poly_namelistEb1"}
+  ! CHECK:     %[[V_4:[0-9]+]]  = fir.declare %[[V_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFlocal_poly_namelistEb1"} : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>>) -> !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>>
+  ! CHECK:     %[[V_7:[0-9]+]]  = fir.call @_FortranAioBeginExternalListOutput
+  ! CHECK:     %[[V_8:[0-9]+]]  = fir.alloca !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
+  ! CHECK:     %[[V_9:[0-9]+]]  = fir.undefined !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
+  ! CHECK:     %[[V_10:[0-9]+]] = fir.address_of(@_QQclX623100) : !fir.ref<!fir.char<1,3>>
+  ! CHECK:     %[[V_11:[0-9]+]] = fir.convert %[[V_10]] : (!fir.ref<!fir.char<1,3>>) -> !fir.ref<i8>
+  ! CHECK:     %[[V_12:[0-9]+]] = fir.insert_value %[[V_9]], %[[V_11]], [0 : index, 0 : index] : (!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>, !fir.ref<i8>) -> !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
+  ! CHECK:     %[[V_13:[0-9]+]] = fir.load %[[V_4]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>>
+  ! CHECK:     %[[V_14:[0-9]+]] = fir.convert %[[V_13]] : (!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>) -> !fir.ref<!fir.box<none>>
+  ! CHECK:     %[[V_15:[0-9]+]] = fir.insert_value %[[V_12]], %[[V_14]], [0 : index, 1 : index] : (!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>, !fir.ref<!fir.box<none>>) -> !fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
+  ! CHECK:     fir.store %[[V_15]] to %[[V_8]] : !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>
+  ! CHECK:     %[[V_16:[0-9]+]] = fir.alloca tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>
+  ! CHECK:     %[[V_17:[0-9]+]] = fir.undefined tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>
+  ! CHECK:     %[[V_18:[0-9]+]] = fir.address_of(@_QQclX6D7967726F757000) : !fir.ref<!fir.char<1,8>>
+  ! CHECK:     %[[V_19:[0-9]+]] = fir.convert %[[V_18]] : (!fir.ref<!fir.char<1,8>>) -> !fir.ref<i8>
+  ! CHECK:     %[[V_20:[0-9]+]] = fir.insert_value %[[V_17]], %[[V_19]], [0 : index] : (tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>, !fir.ref<i8>) -> tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>
+  ! CHECK:     %[[V_21:[0-9]+]] = fir.insert_value %[[V_20]], %c1_i64, [1 : index] : (tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>, i64) -> tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>
+  ! CHECK:     %[[V_22:[0-9]+]] = fir.insert_value %[[V_21]], %[[V_8]], [2 : index] : (tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>) -> tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>
+  ! CHECK:     %[[V_23:[0-9]+]] = fir.address_of(@_QQFlocal_poly_namelist.nonTbpDefinedIoTable) : !fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i8>>>, i1>>
+  ! CHECK:     %[[V_24:[0-9]+]] = fir.convert %[[V_23]] : (!fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i8>>>, i1>>) -> !fir.ref<none>
+  ! CHECK:     %[[V_25:[0-9]+]] = fir.insert_value %[[V_22]], %[[V_24]], [3 : index] : (tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>, !fir.ref<none>) -> tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>
+  ! CHECK:     fir.store %[[V_25]] to %[[V_16]] : !fir.ref<tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>>
+  ! CHECK:     %[[V_26:[0-9]+]] = fir.convert %[[V_16]] : (!fir.ref<tuple<!fir.ref<i8>, i64, !fir.ref<!fir.array<1xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>>, !fir.ref<none>>>) -> !fir.ref<tuple<>>
+  ! CHECK:     %[[V_27:[0-9]+]] = fir.call @_FortranAioOutputNamelist(%[[V_7]], %[[V_26]]) fastmath<contract> : (!fir.ref<i8>, !fir.ref<tuple<>>) -> i1
+  ! CHECK:     %[[V_28:[0-9]+]] = fir.call @_FortranAioEndIoStatement(%[[V_7]]) fastmath<contract> : (!fir.ref<i8>) -> i32
+  namelist/mygroup/b1
+  write(10, nml=mygroup)
+end subroutine
+
 module mmm
   real rrr
   namelist /aaa/ rrr
@@ -142,3 +193,4 @@ subroutine rename_sub
 
 ! CHECK-NOT:   ggg
 ! CHECK:       fir.string_lit "aaa\00"(4) : !fir.char<1,4>
+

[jeanPerier]

Thanks for working on this!

! CHECK: %[[V_14:[0-9]+]] = fir.convert %[[V_13]] : (!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>) -> !fir.ref<!fir.box<none>>

That is a very suspicious cast that only happens to work because of the current fir.box codegen. I'll need to check why this is allowed.

I would rather not rely on this. The fix I think is to update the: fir::BoxType boxType = fir::BoxType::get(fir::PointerType::get(type)); to something like fir::BaseBoxType boxType = mlir::isa<fir::ClassType>(type) ? fir::ClassType::get(fir::PointerType::get(type)) : fir::BoxType::get(fir::PointerType::get(type)); (this is not correct C++, just to illustrate).

The point is that the created temporary pointer should be a polymorphic pointer so that is correctly associated.

[DanielCChen]

Thanks for working on this!

! CHECK: %[[V_14:[0-9]+]] = fir.convert %[[V_13]] : (!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>) -> !fir.ref<!fir.box<none>>

That is a very suspicious cast that only happens to work because of the current fir.box codegen. I'll need to check why this is allowed.

I would rather not rely on this. The fix I think is to update the: fir::BoxType boxType = fir::BoxType::get(fir::PointerType::get(type)); to something like fir::BaseBoxType boxType = mlir::isa<fir::ClassType>(type) ? fir::ClassType::get(fir::PointerType::get(type)) : fir::BoxType::get(fir::PointerType::get(type)); (this is not correct C++, just to illustrate).

The point is that the created temporary pointer should be a polymorphic pointer so that is correctly associated.

Thanks for the quick review!

The suspicious cast is also happening for the non-namelist I/O.
If I changed the write statement to write(10, *) b1, I also got

    %8 = fir.load %4 : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>>
    %9 = fir.convert %8 : (!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>) -> !fir.box<none>

Update: It seems the non-namelist cast is to the box type rather than the reference to the box type.

[jeanPerier]

The suspicious cast is also happening for the non-namelist I/O. If I changed the write statement to write(10, *) b1, I also got

    %8 = fir.load %4 : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>>
    %9 = fir.convert %8 : (!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>) -> !fir.box<none>

Here the conversion is between different fir.box types, and that is OK for now/very common. Converting a fir.box value into the address of a fir.box is a lot more odd. It may have been allowed to deal with some OpenMP cases, but I do not want to generalize its usage.

[DanielCChen]

I have updated the patch and now it generates

%[[V_14:[0-9]+]] = fir.convert %[[V_13]] : (!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>) -> !fir.box<none>

[jeanPerier]

I have updated the patch and now it generates

%[[V_14:[0-9]+]] = fir.convert %[[V_13]] : (!fir.class<!fir.heap<!fir.type<_QMmTbase{r1:f32}>>>) -> !fir.box<none>

Thanks for the update. You should still call createTemporary/associateMutableBox for polymorphic pointers. What needs to be changed is boxType, not descRefTy.

Changing the type inside the tuple from a fir.ref<fir.box> into a fir.box<none> should change the runtime struct to contain a descriptor instdead of the address of a descriptor and that is not what the IO runtime expect I think.