-
Notifications
You must be signed in to change notification settings - Fork 14.5k
[flang] Allow -fdefault-integer-8 with defined I/O #148927
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
base: main
Are you sure you want to change the base?
Conversation
Defined I/O subroutines have UNIT= and IOSTAT= dummy arguments that are required to have type INTEGER with its default kind. When that default kind is modified via -fdefault-integer-8, calls to defined I/O subroutines from the runtime don't work. Add a flag to the two data structures shared between the compiler and the runtime support library to indicate that a defined I/O subroutine was compiled under -fdefault-integer-8. This has been done in a compatible manner, so that existing binaries are compatible with the new library and new binaries are compatible with the old library, unless of course -fdefault-integer-8 is used. Fixes llvm#148638.
@llvm/pr-subscribers-flang-semantics @llvm/pr-subscribers-flang-fir-hlfir Author: Peter Klausler (klausler) ChangesDefined I/O subroutines have UNIT= and IOSTAT= dummy arguments that are required to have type INTEGER with its default kind. When that default kind is modified via -fdefault-integer-8, calls to defined I/O subroutines from the runtime don't work. Add a flag to the two data structures shared between the compiler and the runtime support library to indicate that a defined I/O subroutine was compiled under -fdefault-integer-8. This has been done in a compatible manner, so that existing binaries are compatible with the new library and new binaries are compatible with the old library, unless of course -fdefault-integer-8 is used. Fixes #148638. Patch is 82.72 KiB, truncated to 20.00 KiB below, full version: https://github.com/llvm/llvm-project/pull/148927.diff 17 Files Affected:
diff --git a/flang-rt/include/flang-rt/runtime/non-tbp-dio.h b/flang-rt/include/flang-rt/runtime/non-tbp-dio.h
index 99d4113b6c7a8..26849298ec959 100644
--- a/flang-rt/include/flang-rt/runtime/non-tbp-dio.h
+++ b/flang-rt/include/flang-rt/runtime/non-tbp-dio.h
@@ -34,11 +34,16 @@ namespace Fortran::runtime::io {
RT_OFFLOAD_API_GROUP_BEGIN
+enum NonTbpDefinedIoFlags {
+ IsDtvArgPolymorphic = 1 << 0, // first dummy arg is CLASS(T)
+ DefinedIoInteger8 = 1 << 1, // -fdefault-integer-8 affected UNIT= & IOSTAT=
+};
+
struct NonTbpDefinedIo {
const typeInfo::DerivedType &derivedType;
void (*subroutine)(); // null means no non-TBP defined I/O here
common::DefinedIo definedIo;
- bool isDtvArgPolymorphic; // first dummy arg is CLASS(T)
+ std::uint8_t flags;
};
struct NonTbpDefinedIoTable {
diff --git a/flang-rt/include/flang-rt/runtime/type-info.h b/flang-rt/include/flang-rt/runtime/type-info.h
index a8d39f4f8a1a3..93bca24a602b4 100644
--- a/flang-rt/include/flang-rt/runtime/type-info.h
+++ b/flang-rt/include/flang-rt/runtime/type-info.h
@@ -143,9 +143,9 @@ class SpecialBinding {
// I/O procedures that are not type-bound.
RT_API_ATTRS SpecialBinding(Which which, ProcedurePointer proc,
std::uint8_t isArgDescSet, std::uint8_t isTypeBound,
- std::uint8_t isArgContiguousSet)
+ std::uint8_t specialCaseFlag)
: which_{which}, isArgDescriptorSet_{isArgDescSet},
- isTypeBound_{isTypeBound}, isArgContiguousSet_{isArgContiguousSet},
+ isTypeBound_{isTypeBound}, specialCaseFlag_{specialCaseFlag},
proc_{proc} {}
static constexpr RT_API_ATTRS Which RankFinal(int rank) {
@@ -153,13 +153,11 @@ class SpecialBinding {
}
RT_API_ATTRS Which which() const { return which_; }
+ RT_API_ATTRS bool specialCaseFlag() const { return specialCaseFlag_; }
RT_API_ATTRS bool IsArgDescriptor(int zeroBasedArg) const {
return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
}
RT_API_ATTRS bool IsTypeBound() const { return isTypeBound_ != 0; }
- RT_API_ATTRS bool IsArgContiguous(int zeroBasedArg) const {
- return (isArgContiguousSet_ >> zeroBasedArg) & 1;
- }
template <typename PROC>
RT_API_ATTRS PROC GetProc(const Binding *bindings = nullptr) const {
if (bindings && isTypeBound_ > 0) {
@@ -203,10 +201,10 @@ class SpecialBinding {
// When a special binding is type-bound, this is its binding's index (plus 1,
// so that 0 signifies that it's not type-bound).
std::uint8_t isTypeBound_{0};
- // True when a FINAL subroutine has a dummy argument that is an array that
- // is CONTIGUOUS or neither assumed-rank nor assumed-shape.
- std::uint8_t isArgContiguousSet_{0};
-
+ // For a FINAL subroutine, set when it has a dummy argument that is an array
+ // that is CONTIGUOUS or neither assumed-rank nor assumed-shape.
+ // For a defined I/O subroutine, set when UNIT= and IOSTAT= are INTEGER(8).
+ std::uint8_t specialCaseFlag_{0};
ProcedurePointer proc_{nullptr};
};
diff --git a/flang-rt/lib/runtime/derived.cpp b/flang-rt/lib/runtime/derived.cpp
index bb9a68abef2a7..4ed0baaa3d108 100644
--- a/flang-rt/lib/runtime/derived.cpp
+++ b/flang-rt/lib/runtime/derived.cpp
@@ -270,7 +270,7 @@ static RT_API_ATTRS void CallFinalSubroutine(const Descriptor &descriptor,
StaticDescriptor<maxRank, true, 10> statDesc;
Descriptor ©{statDesc.descriptor()};
const Descriptor *argDescriptor{&descriptor};
- if (descriptor.rank() > 0 && special->IsArgContiguous(0) &&
+ if (descriptor.rank() > 0 && special->specialCaseFlag() &&
!descriptor.IsContiguous()) {
// The FINAL subroutine demands a contiguous array argument, but
// this INTENT(OUT) or intrinsic assignment LHS isn't contiguous.
diff --git a/flang-rt/lib/runtime/descriptor-io.cpp b/flang-rt/lib/runtime/descriptor-io.cpp
index b208cb2c397b3..50fb24c14c95d 100644
--- a/flang-rt/lib/runtime/descriptor-io.cpp
+++ b/flang-rt/lib/runtime/descriptor-io.cpp
@@ -84,8 +84,8 @@ static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
ChildIo &child{external->PushChildIo(io)};
// Child formatted I/O is nonadvancing by definition (F'2018 12.6.2.4).
auto restorer{common::ScopedSet(io.mutableModes().nonAdvancing, true)};
- int unit{external->unitNumber()};
- int ioStat{IostatOk};
+ std::int32_t unit{external->unitNumber()};
+ std::int32_t ioStat{IostatOk};
char ioMsg[100];
Fortran::common::optional<std::int64_t> startPos;
if (edit.descriptor == DataEdit::DefinedDerivedType &&
@@ -96,25 +96,48 @@ static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
}
const auto *bindings{
derived.binding().OffsetElement<const typeInfo::Binding>()};
+ bool integer8{special.specialCaseFlag()};
if (special.IsArgDescriptor(0)) {
// "dtv" argument is "class(t)", pass a descriptor
- auto *p{special.GetProc<void (*)(const Descriptor &, int &, char *,
- const Descriptor &, int &, char *, std::size_t, std::size_t)>(
- bindings)};
StaticDescriptor<1, true, 10 /*?*/> elementStatDesc;
Descriptor &elementDesc{elementStatDesc.descriptor()};
elementDesc.Establish(
derived, nullptr, 0, nullptr, CFI_attribute_pointer);
elementDesc.set_base_addr(descriptor.Element<char>(subscripts));
- p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
- sizeof ioMsg);
+ if (integer8) { // 64-bit UNIT=/IOSTAT=
+ std::int64_t unit64{unit};
+ std::int64_t ioStat64{ioStat};
+ auto *p{special.GetProc<void (*)(const Descriptor &, std::int64_t &,
+ char *, const Descriptor &, std::int64_t &, char *, std::size_t,
+ std::size_t)>(bindings)};
+ p(elementDesc, unit64, ioType, vListDesc, ioStat64, ioMsg, ioTypeLen,
+ sizeof ioMsg);
+ ioStat = ioStat64;
+ } else { // 32-bit UNIT=/IOSTAT=
+ auto *p{special.GetProc<void (*)(const Descriptor &, std::int32_t &,
+ char *, const Descriptor &, std::int32_t &, char *, std::size_t,
+ std::size_t)>(bindings)};
+ p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
+ sizeof ioMsg);
+ }
} else {
// "dtv" argument is "type(t)", pass a raw pointer
- auto *p{special.GetProc<void (*)(const void *, int &, char *,
- const Descriptor &, int &, char *, std::size_t, std::size_t)>(
- bindings)};
- p(descriptor.Element<char>(subscripts), unit, ioType, vListDesc, ioStat,
- ioMsg, ioTypeLen, sizeof ioMsg);
+ if (integer8) { // 64-bit UNIT= and IOSTAT=
+ std::int64_t unit64{unit};
+ std::int64_t ioStat64{ioStat};
+ auto *p{special.GetProc<void (*)(const void *, std::int64_t &, char *,
+ const Descriptor &, std::int64_t &, char *, std::size_t,
+ std::size_t)>(bindings)};
+ p(descriptor.Element<char>(subscripts), unit64, ioType, vListDesc,
+ ioStat64, ioMsg, ioTypeLen, sizeof ioMsg);
+ ioStat = ioStat64;
+ } else { // 32-bit UNIT= and IOSTAT=
+ auto *p{special.GetProc<void (*)(const void *, std::int32_t &, char *,
+ const Descriptor &, std::int32_t &, char *, std::size_t,
+ std::size_t)>(bindings)};
+ p(descriptor.Element<char>(subscripts), unit, ioType, vListDesc, ioStat,
+ ioMsg, ioTypeLen, sizeof ioMsg);
+ }
}
handler.Forward(ioStat, ioMsg, sizeof ioMsg);
external->PopChildIo(child);
@@ -458,11 +481,16 @@ RT_API_ATTRS int DescriptorIoTicket<DIR>::Begin(WorkQueue &workQueue) {
? common::DefinedIo::ReadUnformatted
: common::DefinedIo::WriteUnformatted)}) {
if (definedIo->subroutine) {
+ std::uint8_t isArgDescriptorSet{0};
+ if (definedIo->flags & IsDtvArgPolymorphic) {
+ isArgDescriptorSet = 1;
+ }
typeInfo::SpecialBinding special{DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadUnformatted
: typeInfo::SpecialBinding::Which::WriteUnformatted,
- definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
- false};
+ definedIo->subroutine, isArgDescriptorSet,
+ /*IsTypeBound=*/false,
+ /*specialCaseFlag=*/!!(definedIo->flags & DefinedIoInteger8)};
if (DefinedUnformattedIo(io_, instance_, *type, special)) {
anyIoTookPlace_ = true;
return StatOk;
@@ -719,8 +747,11 @@ RT_API_ATTRS int DescriptorIoTicket<DIR>::Begin(WorkQueue &workQueue) {
nonTbpSpecial_.emplace(DIR == Direction::Input
? typeInfo::SpecialBinding::Which::ReadFormatted
: typeInfo::SpecialBinding::Which::WriteFormatted,
- definedIo->subroutine, definedIo->isDtvArgPolymorphic, false,
- false);
+ definedIo->subroutine,
+ /*isArgDescriptorSet=*/
+ (definedIo->flags & IsDtvArgPolymorphic) ? 1 : 0,
+ /*isTypeBound=*/false,
+ /*specialCaseFlag=*/!!(definedIo->flags & DefinedIoInteger8));
special_ = &*nonTbpSpecial_;
}
}
diff --git a/flang-rt/lib/runtime/non-tbp-dio.cpp b/flang-rt/lib/runtime/non-tbp-dio.cpp
index 72101b06e0c6e..d516526033c27 100644
--- a/flang-rt/lib/runtime/non-tbp-dio.cpp
+++ b/flang-rt/lib/runtime/non-tbp-dio.cpp
@@ -17,7 +17,7 @@ const NonTbpDefinedIo *NonTbpDefinedIoTable::Find(
for (const auto *p{item}; j-- > 0; ++p) {
if (&p->derivedType == &type && p->definedIo == definedIo) {
return p;
- } else if (p->isDtvArgPolymorphic) {
+ } else if (p->flags & IsDtvArgPolymorphic) {
for (const typeInfo::DerivedType *t{type.GetParentType()}; t;
t = t->GetParentType()) {
if (&p->derivedType == t && p->definedIo == definedIo) {
diff --git a/flang-rt/lib/runtime/type-info.cpp b/flang-rt/lib/runtime/type-info.cpp
index 3e1d7c9c3c788..50123f4cf321c 100644
--- a/flang-rt/lib/runtime/type-info.cpp
+++ b/flang-rt/lib/runtime/type-info.cpp
@@ -330,7 +330,7 @@ FILE *SpecialBinding::Dump(FILE *f) const {
}
std::fprintf(f, " isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);
std::fprintf(f, " isTypeBound: %d\n", isTypeBound_);
- std::fprintf(f, " isArgContiguousSet: 0x%x\n", isArgContiguousSet_);
+ std::fprintf(f, " specialCaseFlag 0x%x\n", specialCaseFlag_);
std::fprintf(f, " proc: %p\n", reinterpret_cast<void *>(proc_));
return f;
}
diff --git a/flang/include/flang/Semantics/runtime-type-info.h b/flang/include/flang/Semantics/runtime-type-info.h
index 6c5a061d1c1a2..94e8293b14643 100644
--- a/flang/include/flang/Semantics/runtime-type-info.h
+++ b/flang/include/flang/Semantics/runtime-type-info.h
@@ -52,10 +52,15 @@ constexpr char procCompName[]{"proc"};
SymbolVector CollectBindings(const Scope &dtScope);
+enum NonTbpDefinedIoFlags {
+ IsDtvArgPolymorphic = 1 << 0,
+ DefinedIoInteger8 = 1 << 1,
+};
+
struct NonTbpDefinedIo {
const Symbol *subroutine;
common::DefinedIo definedIo;
- bool isDtvArgPolymorphic;
+ std::uint8_t flags;
};
std::multimap<const Symbol *, NonTbpDefinedIo>
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 63a612d7ead61..69d72d9d63b68 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -269,10 +269,12 @@ getNonTbpDefinedIoTableAddr(Fortran::lower::AbstractConverter &converter,
mlir::Type sizeTy =
fir::runtime::getModel<std::size_t>()(builder.getContext());
mlir::Type intTy = fir::runtime::getModel<int>()(builder.getContext());
+ mlir::Type byteTy =
+ fir::runtime::getModel<std::uint8_t>()(builder.getContext());
mlir::Type boolTy = fir::runtime::getModel<bool>()(builder.getContext());
mlir::Type listTy = fir::SequenceType::get(
definedIoProcMap.size(),
- mlir::TupleType::get(context, {refTy, refTy, intTy, boolTy}));
+ mlir::TupleType::get(context, {refTy, refTy, intTy, byteTy}));
mlir::Type tableTy = mlir::TupleType::get(
context, {sizeTy, fir::ReferenceType::get(listTy), boolTy});
@@ -339,9 +341,9 @@ getNonTbpDefinedIoTableAddr(Fortran::lower::AbstractConverter &converter,
insert(builder.createIntegerConstant(
loc, intTy, static_cast<int>(iface.second.definedIo)));
// polymorphic flag is set if first defined IO dummy arg is CLASS(T)
+ // defaultInt8 flag is set if -fdefined-integer-8
// [bool isDtvArgPolymorphic]
- insert(builder.createIntegerConstant(loc, boolTy,
- iface.second.isDtvArgPolymorphic));
+ insert(builder.createIntegerConstant(loc, byteTy, iface.second.flags));
}
if (tableIsLocal)
builder.create<fir::StoreOp>(loc, list, listAddr);
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 51ba21a9e5edf..5916a07df7744 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -1131,7 +1131,7 @@ void RuntimeTableBuilder::DescribeSpecialProc(
if (auto proc{evaluate::characteristics::Procedure::Characterize(
specific, context_.foldingContext())}) {
std::uint8_t isArgDescriptorSet{0};
- std::uint8_t isArgContiguousSet{0};
+ bool specialCaseFlag{0};
int argThatMightBeDescriptor{0};
MaybeExpr which;
if (isAssignment) {
@@ -1197,7 +1197,7 @@ void RuntimeTableBuilder::DescribeSpecialProc(
TypeAndShape::Attr::AssumedShape) ||
dummyData.attrs.test(evaluate::characteristics::
DummyDataObject::Attr::Contiguous)) {
- isArgContiguousSet |= 1;
+ specialCaseFlag = true;
}
}
}
@@ -1216,7 +1216,7 @@ void RuntimeTableBuilder::DescribeSpecialProc(
return;
}
if (ddo->type.type().IsPolymorphic()) {
- isArgDescriptorSet |= 1;
+ argThatMightBeDescriptor = 1;
}
switch (io.value()) {
case common::DefinedIo::ReadFormatted:
@@ -1232,6 +1232,9 @@ void RuntimeTableBuilder::DescribeSpecialProc(
which = writeUnformattedEnum_;
break;
}
+ if (context_.defaultKinds().GetDefaultKind(TypeCategory::Integer) == 8) {
+ specialCaseFlag = true; // UNIT= & IOSTAT= INTEGER(8)
+ }
}
if (argThatMightBeDescriptor != 0) {
if (const auto *dummyData{
@@ -1262,8 +1265,8 @@ void RuntimeTableBuilder::DescribeSpecialProc(
}
CHECK(bindingIndex <= 255);
AddValue(values, specialSchema_, "istypebound"s, IntExpr<1>(bindingIndex));
- AddValue(values, specialSchema_, "isargcontiguousset"s,
- IntExpr<1>(isArgContiguousSet));
+ AddValue(values, specialSchema_, "specialcaseflag"s,
+ IntExpr<1>(specialCaseFlag));
AddValue(values, specialSchema_, procCompName,
SomeExpr{evaluate::ProcedureDesignator{specific}});
// index might already be present in the case of an override
@@ -1383,19 +1386,26 @@ CollectNonTbpDefinedIoGenericInterfaces(
} else {
// Local scope's specific overrides host's for this type
bool updated{false};
+ std::uint8_t flags{0};
+ if (declType->IsPolymorphic()) {
+ flags |= IsDtvArgPolymorphic;
+ }
+ if (scope.context().GetDefaultKind(TypeCategory::Integer) ==
+ 8) {
+ flags |= DefinedIoInteger8;
+ }
for (auto [iter, end]{result.equal_range(dtDesc)}; iter != end;
++iter) {
NonTbpDefinedIo &nonTbp{iter->second};
if (nonTbp.definedIo == which) {
nonTbp.subroutine = &*specific;
- nonTbp.isDtvArgPolymorphic = declType->IsPolymorphic();
+ nonTbp.flags = flags;
updated = true;
}
}
if (!updated) {
- result.emplace(dtDesc,
- NonTbpDefinedIo{
- &*specific, which, declType->IsPolymorphic()});
+ result.emplace(
+ dtDesc, NonTbpDefinedIo{&*specific, which, flags});
}
}
}
diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90
index 8dd27d6e4c01b..6af2a5a5e30ff 100644
--- a/flang/module/__fortran_type_info.f90
+++ b/flang/module/__fortran_type_info.f90
@@ -118,7 +118,7 @@
integer(1) :: which ! SpecialBinding::Which
integer(1) :: isArgDescriptorSet
integer(1) :: isTypeBound ! binding index + 1, if any
- integer(1) :: isArgContiguousSet
+ integer(1) :: specialCaseFlag
integer(1) :: __padding0(4)
type(__builtin_c_funptr) :: proc
end type
diff --git a/flang/test/Lower/io-derived-type.f90 b/flang/test/Lower/io-derived-type.f90
index 7d2fef3faa2b7..7c289ce261678 100644
--- a/flang/test/Lower/io-derived-type.f90
+++ b/flang/test/Lower/io-derived-type.f90
@@ -37,16 +37,16 @@ subroutine test1
import, all
! CHECK: %[[V_16:[0-9]+]] = fir.embox %{{.*}} : (!fir.ref<!fir.type<_QMmTt{n:i32}>>) -> !fir.box<!fir.type<_QMmTt{n:i32}>>
! CHECK: %[[V_17:[0-9]+]] = fir.convert %[[V_16]] : (!fir.box<!fir.type<_QMmTt{n:i32}>>) -> !fir.box<none>
- ! CHECK: %[[V_18:[0-9]+]] = fir.address_of(@_QQMmFtest1.nonTbpDefinedIoTable) : !fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>
- ! CHECK: %[[V_19:[0-9]+]] = fir.convert %[[V_18]] : (!fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>) -> !fir.ref<none>
+ ! CHECK: %[[V_18:[0-9]+]] = fir.address_of(@_QQMmFtest1.nonTbpDefinedIoTable) : !fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i8>>>, i1>>
+ ! CHECK: %[[V_19:[0-9]+]] = fir.convert %[[V_18]] : (!fir.ref<tuple<i64, !fir.ref<!fir.array<1xtuple<!fir.ref<none>, !fir.ref<none>, i32, i8>>>, i1>>) -> !fir.ref<none>
! CHECK: %[[V_20:[0-9]+]] = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %[[V_17]], %[[V_19]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
print *, 'test1 outer, should call wft: ', t(1)
block
import, only: t
! CHECK: %[[V_37:[0-9]+]] = fir.embox %{{.*}} : (!fir.ref<!fir.type<_QMmTt{n:i32}>>) -> !fir.box<!fir.type<_QMmTt{n:i32}>>
! CHECK: %[[V_38:[0-9]+]] = fir.convert %[[V_37]] : (!fir.box<!fir.type<_QMmTt{n:i32}>>) -> !fir.box<none>
- ! CHECK: %[[V_39:[0-9]+]] = fir.address_of(@_QQdefault.nonTbpDefinedIoTable) : !fir.ref<tuple<i64, !fir.ref<!fir.array<0xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>
- ! CHECK: %[[V_40:[0-9]+]] = fir.convert %[[V_39]] : (!fir.ref<tuple<i64, !fir.ref<!fir.array<0xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>) -> !fir.ref<none>
+ ! CHECK: %[[V_39:[0-9]+]] = fir.address_of(@_QQdefault.nonTbpDefinedIoTable) : !fir.ref<tuple<i64, !fir.ref<!fir.array<0xtuple<!fir.ref<none>, !fir.ref<none>, i32, i8>>>, i1>>
+ ! CHECK: %[[V_40:[0-9]+]] = fir.convert %[[V_39]] : (!fir.ref<tuple<i64, !fir.ref<!fir.array<0xtuple<!fir.ref<none>, !fir.ref<none>, i32, i8>>>, i1>>) -> !fir.ref<none>
! CHECK: %[[V_41:[0-9]+]] = fir.call @_FortranAioOutputDerivedType(%{{.*}}, %[[V_38]], %[[V_40]]) fastmath<contract> : (!fir.ref<i8>, !fir.box<none>, !fir.ref<none>) -> i1
print *, 'test1 block, should not call wft: ', t(2)
end block
@@ -56,8 +56,8 @@ subroutine test1
subroutine test2
! CHECK: %[[V_15:[0-9]+]] = fir.embox %{{.*}} : (!fir.ref<!fir.type<_QMmTt{n:i32}>>) -> !fir.box<!fir.type<_QMmTt{n:i32}>>
! CHECK: %[[V_16:[0-9]+]] = fir.convert %[[V_15]] : (!fir.box<!fir.type<_QMmTt{n:i32}>>) -> !fir.box<none>
- ! CHECK: %[[V_17:[0-9]+]] = fir.address_of(@_QQdefault.nonTbpDefinedIoTable) : !fir.ref<tuple<i64, !fir.ref<!fir.array<0xtuple<!fir.ref<none>, !fir.ref<none>, i32, i1>>>, i1>>
- ! CHECK: %[[V_18:[0-9]+]] = fir.convert %[[V_17]] : (!fir.ref<tuple<i64, !fir.ref<!fir.array<0xtuple<!fir.ref<none>, !fir.re...
[truncated]
|
Defined I/O subroutines have UNIT= and IOSTAT= dummy arguments that are required to have type INTEGER with its default kind. When that default kind is modified via -fdefault-integer-8, calls to defined I/O subroutines from the runtime don't work.
Add a flag to the two data structures shared between the compiler and the runtime support library to indicate that a defined I/O subroutine was compiled under -fdefault-integer-8. This has been done in a compatible manner, so that existing binaries are compatible with the new library and new binaries are compatible with the old library, unless of course -fdefault-integer-8 is used.
Fixes #148638.