[flang] Select proper library APIs for derived type io.

[vzakhari]

This patch syncs the logic inside getInputFunc that selects
the library API and the logic in createIoRuntimeCallForItem
that creates the input arguments for the library call.
There were cases where we selected InputDerivedType API
and passed only two arguments, and also we selected InputDescriptor
and passed three arguments.
It turns out we also were incorrectly selecting OutputDescriptor
in getOutputFunc (test4 case in the new LIT test),
which caused runtime issues for output of a derived type
with descriptor components (due to the missing non-type-bound table).

[llvmbot]

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

Changes

This patch syncs the logic inside `getInputFunc` that selects the library API and the logic in `createIoRuntimeCallForItem` that creates the input arguments for the library call. There were cases where we selected `InputDerivedType` API and passed only two arguments, and also we selected `InputDescriptor` and passed three arguments. It turns out we also were incorrectly selecting `OutputDescriptor` in `getOutputFunc` (`test4` case in the new LIT test), which caused runtime issues for output of a derived type with descriptor components (due to the missing non-type-bound table).

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

3 Files Affected:

• (modified) flang/lib/Lower/IO.cpp (+4-4)
• (added) flang/test/Lower/io-derived-type-2.f90 (+70)
• (modified) flang/test/Lower/polymorphic.f90 (+1-1)

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index ac1fe7f68a9a665..48f2baa2e4f4ed2 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -655,7 +655,7 @@ static void genNamelistIO(Fortran::lower::AbstractConverter &converter,
 static mlir::func::FuncOp getOutputFunc(mlir::Location loc,
                                         fir::FirOpBuilder &builder,
                                         mlir::Type type, bool isFormatted) {
-  if (type.isa<fir::RecordType>())
+  if (fir::unwrapPassByRefType(type).isa<fir::RecordType>())
     return getIORuntimeFunc<mkIOKey(OutputDerivedType)>(loc, builder);
   if (!isFormatted)
     return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
@@ -737,7 +737,7 @@ static void genOutputItemList(
     if (argType.isa<fir::BoxType>()) {
       mlir::Value box = fir::getBase(converter.genExprBox(loc, *expr, stmtCtx));
       outputFuncArgs.push_back(builder.createConvert(loc, argType, box));
-      if (itemTy.isa<fir::RecordType>())
+      if (fir::unwrapPassByRefType(itemTy).isa<fir::RecordType>())
         outputFuncArgs.push_back(getNonTbpDefinedIoTableAddr(converter));
     } else if (helper.isCharacterScalar(itemTy)) {
       fir::ExtendedValue exv = converter.genExprAddr(loc, expr, stmtCtx);
@@ -772,7 +772,7 @@ static void genOutputItemList(
 static mlir::func::FuncOp getInputFunc(mlir::Location loc,
                                        fir::FirOpBuilder &builder,
                                        mlir::Type type, bool isFormatted) {
-  if (type.isa<fir::RecordType>())
+  if (fir::unwrapPassByRefType(type).isa<fir::RecordType>())
     return getIORuntimeFunc<mkIOKey(InputDerivedType)>(loc, builder);
   if (!isFormatted)
     return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
@@ -834,7 +834,7 @@ createIoRuntimeCallForItem(Fortran::lower::AbstractConverter &converter,
     auto boxTy = box.getType().dyn_cast<fir::BaseBoxType>();
     assert(boxTy && "must be previously emboxed");
     inputFuncArgs.push_back(builder.createConvert(loc, argType, box));
-    if (boxTy.getEleTy().isa<fir::RecordType>())
+    if (fir::unwrapPassByRefType(boxTy).isa<fir::RecordType>())
       inputFuncArgs.push_back(getNonTbpDefinedIoTableAddr(converter));
   } else {
     mlir::Value itemAddr = fir::getBase(item);
diff --git a/flang/test/Lower/io-derived-type-2.f90 b/flang/test/Lower/io-derived-type-2.f90
new file mode 100644
index 000000000000000..c2f1ff1850725da
--- /dev/null
+++ b/flang/test/Lower/io-derived-type-2.f90
@@ -0,0 +1,70 @@
+! Check that InputDerivedType/OutputDeriverType APIs are used
+! for io of derived types.
+! RUN: bbc -polymorphic-type -emit-fir -o - %s | FileCheck %s
+
+module p
+  type :: person
+     type(person), pointer :: next => null()
+  end type person
+  type :: club
+     class(person), allocatable :: membership(:)
+  end type club
+contains
+  subroutine pwf (dtv,unit,iotype,vlist,iostat,iomsg)
+    class(person), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character (len=*), intent(in) :: iotype
+    integer, intent(in) :: vlist(:)
+    integer, intent(out) :: iostat
+    character (len=*), intent(inout) :: iomsg
+    print *, 'write'
+  end subroutine pwf
+  subroutine prf (dtv,unit,iotype,vlist,iostat,iomsg)
+    class(person), intent(inout) :: dtv
+    integer, intent(in) :: unit
+    character (len=*), intent(in) :: iotype
+    integer, intent(in) :: vlist(:)
+    integer, intent(out) :: iostat
+    character (len=*), intent(inout) :: iomsg
+  end subroutine prf
+  subroutine test1(dtv)
+    interface read(formatted)
+       module procedure prf
+    end interface read(formatted)
+    class(person), intent(inout) :: dtv
+    read(7, fmt='(DT)') dtv%next
+  end subroutine test1
+! CHECK-LABEL:   func.func @_QMpPtest1(
+! CHECK:           %{{.*}} = fir.call @_FortranAioInputDerivedType(%{{.*}}, %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
+
+  subroutine test2(social_club)
+    interface read(formatted)
+       module procedure prf
+    end interface read(formatted)
+    class(club) :: social_club
+    read(7, fmt='(DT)') social_club%membership(0)
+  end subroutine test2
+! CHECK-LABEL:   func.func @_QMpPtest2(
+! CHECK:           %{{.*}} = fir.call @_FortranAioInputDerivedType(%{{.*}}, %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
+
+  subroutine test3(dtv)
+    interface write(formatted)
+       module procedure pwf
+    end interface write(formatted)
+    class(person), intent(inout) :: dtv
+    write(7, fmt='(DT)') dtv%next
+  end subroutine test3
+! CHECK-LABEL:   func.func @_QMpPtest3(
+! CHECK:           %{{.*}} = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
+
+  subroutine test4(social_club)
+    interface write(formatted)
+       module procedure pwf
+    end interface write(formatted)
+    class(club) :: social_club
+    write(7, fmt='(DT)') social_club%membership(0)
+  end subroutine test4
+! CHECK-LABEL:   func.func @_QMpPtest4(
+! CHECK:           %{{.*}} = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
+end module p
+
diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index ba605476638e395..1dc945c1c3c422d 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -766,7 +766,7 @@ subroutine test_polymorphic_io()
 ! CHECK: %[[P:.*]] = fir.alloca !fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_polymorphic_ioEp"}
 ! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
 ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
-! CHECK: %{{.*}} = fir.call @_FortranAioInputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref<i8>, !fir.box<none>) -> i1
+! CHECK: %{{.*}} = fir.call @_FortranAioInputDerivedType(%{{.*}}, %[[BOX_NONE]], %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
 
   function unlimited_polymorphic_alloc_array_ret()
     class(*), allocatable :: unlimited_polymorphic_alloc_array_ret(:)

[clementval]

LGTM