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

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);

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
+

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(:)