diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index ac1fe7f68a9a6..48f2baa2e4f4e 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()) + if (fir::unwrapPassByRefType(type).isa()) return getIORuntimeFunc(loc, builder); if (!isFormatted) return getIORuntimeFunc(loc, builder); @@ -737,7 +737,7 @@ static void genOutputItemList( if (argType.isa()) { mlir::Value box = fir::getBase(converter.genExprBox(loc, *expr, stmtCtx)); outputFuncArgs.push_back(builder.createConvert(loc, argType, box)); - if (itemTy.isa()) + if (fir::unwrapPassByRefType(itemTy).isa()) 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()) + if (fir::unwrapPassByRefType(type).isa()) return getIORuntimeFunc(loc, builder); if (!isFormatted) return getIORuntimeFunc(loc, builder); @@ -834,7 +834,7 @@ createIoRuntimeCallForItem(Fortran::lower::AbstractConverter &converter, auto boxTy = box.getType().dyn_cast(); assert(boxTy && "must be previously emboxed"); inputFuncArgs.push_back(builder.createConvert(loc, argType, box)); - if (boxTy.getEleTy().isa()) + if (fir::unwrapPassByRefType(boxTy).isa()) 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 0000000000000..c2f1ff1850725 --- /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 : (!fir.ref, !fir.box, !fir.ref) -> 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 : (!fir.ref, !fir.box, !fir.ref) -> 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 : (!fir.ref, !fir.box, !fir.ref) -> 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 : (!fir.ref, !fir.box, !fir.ref) -> i1 +end module p + diff --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90 index ba605476638e3..1dc945c1c3c42 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>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_polymorphic_ioEp"} ! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref>>> ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LOAD_P]] : (!fir.class>>) -> !fir.box -! CHECK: %{{.*}} = fir.call @_FortranAioInputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref, !fir.box) -> i1 +! CHECK: %{{.*}} = fir.call @_FortranAioInputDerivedType(%{{.*}}, %[[BOX_NONE]], %{{.*}}) {{.*}} : (!fir.ref, !fir.box, !fir.ref) -> i1 function unlimited_polymorphic_alloc_array_ret() class(*), allocatable :: unlimited_polymorphic_alloc_array_ret(:)