[flang-commits] [flang] [flang] Select proper library APIs for derived type io. (PR #66327)
via flang-commits
flang-commits at lists.llvm.org
Wed Sep 13 22:02:36 PDT 2023
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-fir-hlfir
<details>
<summary>Changes</summary>
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)
<pre>
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(:)
</pre>
</details>
https://github.com/llvm/llvm-project/pull/66327
More information about the flang-commits
mailing list