Skip to content

Commit 0c489e1

Browse files
vzakharikstoimenov
vzakhari
authored and
kstoimenov
committed
[flang] Select proper library APIs for derived type io. (llvm#66327)
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).
1 parent 9238d2f commit 0c489e1

File tree

3 files changed

+75
-5
lines changed

3 files changed

+75
-5
lines changed

‎flang/lib/Lower/IO.cpp

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -655,7 +655,7 @@ static void genNamelistIO(Fortran::lower::AbstractConverter &converter,
655655
static mlir::func::FuncOp getOutputFunc(mlir::Location loc,
656656
fir::FirOpBuilder &builder,
657657
mlir::Type type, bool isFormatted) {
658-
if (type.isa<fir::RecordType>())
658+
if (fir::unwrapPassByRefType(type).isa<fir::RecordType>())
659659
return getIORuntimeFunc<mkIOKey(OutputDerivedType)>(loc, builder);
660660
if (!isFormatted)
661661
return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
@@ -737,7 +737,7 @@ static void genOutputItemList(
737737
if (argType.isa<fir::BoxType>()) {
738738
mlir::Value box = fir::getBase(converter.genExprBox(loc, *expr, stmtCtx));
739739
outputFuncArgs.push_back(builder.createConvert(loc, argType, box));
740-
if (itemTy.isa<fir::RecordType>())
740+
if (fir::unwrapPassByRefType(itemTy).isa<fir::RecordType>())
741741
outputFuncArgs.push_back(getNonTbpDefinedIoTableAddr(converter));
742742
} else if (helper.isCharacterScalar(itemTy)) {
743743
fir::ExtendedValue exv = converter.genExprAddr(loc, expr, stmtCtx);
@@ -772,7 +772,7 @@ static void genOutputItemList(
772772
static mlir::func::FuncOp getInputFunc(mlir::Location loc,
773773
fir::FirOpBuilder &builder,
774774
mlir::Type type, bool isFormatted) {
775-
if (type.isa<fir::RecordType>())
775+
if (fir::unwrapPassByRefType(type).isa<fir::RecordType>())
776776
return getIORuntimeFunc<mkIOKey(InputDerivedType)>(loc, builder);
777777
if (!isFormatted)
778778
return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
@@ -834,7 +834,7 @@ createIoRuntimeCallForItem(Fortran::lower::AbstractConverter &converter,
834834
auto boxTy = box.getType().dyn_cast<fir::BaseBoxType>();
835835
assert(boxTy && "must be previously emboxed");
836836
inputFuncArgs.push_back(builder.createConvert(loc, argType, box));
837-
if (boxTy.getEleTy().isa<fir::RecordType>())
837+
if (fir::unwrapPassByRefType(boxTy).isa<fir::RecordType>())
838838
inputFuncArgs.push_back(getNonTbpDefinedIoTableAddr(converter));
839839
} else {
840840
mlir::Value itemAddr = fir::getBase(item);

‎flang/test/Lower/io-derived-type-2.f90

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
! Check that InputDerivedType/OutputDeriverType APIs are used
2+
! for io of derived types.
3+
! RUN: bbc -polymorphic-type -emit-fir -o - %s | FileCheck %s
4+
5+
module p
6+
type :: person
7+
type(person), pointer :: next => null()
8+
end type person
9+
type :: club
10+
class(person), allocatable :: membership(:)
11+
end type club
12+
contains
13+
subroutine pwf (dtv,unit,iotype,vlist,iostat,iomsg)
14+
class(person), intent(in) :: dtv
15+
integer, intent(in) :: unit
16+
character (len=*), intent(in) :: iotype
17+
integer, intent(in) :: vlist(:)
18+
integer, intent(out) :: iostat
19+
character (len=*), intent(inout) :: iomsg
20+
print *, 'write'
21+
end subroutine pwf
22+
subroutine prf (dtv,unit,iotype,vlist,iostat,iomsg)
23+
class(person), intent(inout) :: dtv
24+
integer, intent(in) :: unit
25+
character (len=*), intent(in) :: iotype
26+
integer, intent(in) :: vlist(:)
27+
integer, intent(out) :: iostat
28+
character (len=*), intent(inout) :: iomsg
29+
end subroutine prf
30+
subroutine test1(dtv)
31+
interface read(formatted)
32+
module procedure prf
33+
end interface read(formatted)
34+
class(person), intent(inout) :: dtv
35+
read(7, fmt='(DT)') dtv%next
36+
end subroutine test1
37+
! CHECK-LABEL: func.func @_QMpPtest1(
38+
! CHECK: %{{.*}} = fir.call @_FortranAioInputDerivedType(%{{.*}}, %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
39+
40+
subroutine test2(social_club)
41+
interface read(formatted)
42+
module procedure prf
43+
end interface read(formatted)
44+
class(club) :: social_club
45+
read(7, fmt='(DT)') social_club%membership(0)
46+
end subroutine test2
47+
! CHECK-LABEL: func.func @_QMpPtest2(
48+
! CHECK: %{{.*}} = fir.call @_FortranAioInputDerivedType(%{{.*}}, %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
49+
50+
subroutine test3(dtv)
51+
interface write(formatted)
52+
module procedure pwf
53+
end interface write(formatted)
54+
class(person), intent(inout) :: dtv
55+
write(7, fmt='(DT)') dtv%next
56+
end subroutine test3
57+
! CHECK-LABEL: func.func @_QMpPtest3(
58+
! CHECK: %{{.*}} = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
59+
60+
subroutine test4(social_club)
61+
interface write(formatted)
62+
module procedure pwf
63+
end interface write(formatted)
64+
class(club) :: social_club
65+
write(7, fmt='(DT)') social_club%membership(0)
66+
end subroutine test4
67+
! CHECK-LABEL: func.func @_QMpPtest4(
68+
! CHECK: %{{.*}} = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
69+
end module p
70+

‎flang/test/Lower/polymorphic.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -766,7 +766,7 @@ subroutine test_polymorphic_io()
766766
! 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"}
767767
! CHECK: %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
768768
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[LOAD_P]] : (!fir.class<!fir.ptr<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
769-
! CHECK: %{{.*}} = fir.call @_FortranAioInputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}} : (!fir.ref<i8>, !fir.box<none>) -> i1
769+
! CHECK: %{{.*}} = fir.call @_FortranAioInputDerivedType(%{{.*}}, %[[BOX_NONE]], %{{.*}}) {{.*}} : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
770770

771771
function unlimited_polymorphic_alloc_array_ret()
772772
class(*), allocatable :: unlimited_polymorphic_alloc_array_ret(:)

0 commit comments

Comments
 (0)