[flang-commits] [flang] 19d8642 - [flang] Catch I/O of bad derived type at compile time
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Feb 28 15:40:20 PST 2022
Author: Peter Klausler
Date: 2022-02-28T15:40:12-08:00
New Revision: 19d86426331ea79e33ab8ca7a56b584565bd4640
URL: https://github.com/llvm/llvm-project/commit/19d86426331ea79e33ab8ca7a56b584565bd4640
DIFF: https://github.com/llvm/llvm-project/commit/19d86426331ea79e33ab8ca7a56b584565bd4640.diff
LOG: [flang] Catch I/O of bad derived type at compile time
Derived types with allocatable and pointer components cannot
be used in I/O data transfer statements unless they have defined
I/O procedures available (as type-bound or regular generics).
These cases are caught as errors by the I/O runtime library,
but it would be better if they were flagged during compilation.
(Address comment in review: don't use explicit name string lengths.)
Differential Revision: https://reviews.llvm.org/D120675
Added:
flang/test/Semantics/io12.f90
Modified:
flang/include/flang/Semantics/symbol.h
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/check-io.cpp
flang/lib/Semantics/check-io.h
flang/lib/Semantics/runtime-type-info.cpp
flang/lib/Semantics/symbol.cpp
flang/lib/Semantics/tools.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index bf78eb2494ca7..b9d041e335039 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -423,6 +423,7 @@ struct GenericKind {
bool IsIntrinsicOperator() const;
bool IsOperator() const;
std::string ToString() const;
+ static SourceName AsFortran(DefinedIo);
std::variant<OtherKind, common::NumericOperator, common::LogicalOperator,
common::RelationalOperator, DefinedIo>
u;
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 93676a4e39310..90d8d1d3d9555 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -528,6 +528,8 @@ UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent(
const DerivedTypeSpec &);
+DirectComponentIterator::const_iterator FindAllocatableOrPointerDirectComponent(
+ const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator
FindPolymorphicAllocatableUltimateComponent(const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator
@@ -583,5 +585,15 @@ std::optional<ArraySpec> ToArraySpec(
std::optional<ArraySpec> ToArraySpec(
evaluate::FoldingContext &, const std::optional<evaluate::Shape> &);
+// Searches a derived type and a scope for a particular user defined I/O
+// procedure.
+bool HasDefinedIo(
+ GenericKind::DefinedIo, const DerivedTypeSpec &, const Scope * = nullptr);
+// Seeks out an allocatable or pointer ultimate component that is not
+// nested in a nonallocatable/nonpointer component with a specific
+// defined I/O procedure.
+const Symbol *FindUnsafeIoDirectComponent(
+ GenericKind::DefinedIo, const DerivedTypeSpec &, const Scope * = nullptr);
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_TOOLS_H_
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 7c2a4f77e17ba..15e8b79052242 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -319,6 +319,12 @@ void IoChecker::Enter(const parser::InputItem &spec) {
return;
}
CheckForDefinableVariable(*var, "Input");
+ if (auto expr{AnalyzeExpr(context_, *var)}) {
+ CheckForBadIoComponent(*expr,
+ flags_.test(Flag::FmtOrNml) ? GenericKind::DefinedIo::ReadFormatted
+ : GenericKind::DefinedIo::ReadUnformatted,
+ var->GetSource());
+ }
}
void IoChecker::Enter(const parser::InquireSpec &spec) {
@@ -580,6 +586,11 @@ void IoChecker::Enter(const parser::OutputItem &item) {
context_.Say(parser::FindSourceLocation(*x),
"Output item must not be a procedure pointer"_err_en_US); // C1233
}
+ CheckForBadIoComponent(*expr,
+ flags_.test(Flag::FmtOrNml)
+ ? GenericKind::DefinedIo::WriteFormatted
+ : GenericKind::DefinedIo::WriteUnformatted,
+ parser::FindSourceLocation(item));
}
}
}
@@ -987,4 +998,20 @@ void IoChecker::CheckForPureSubprogram() const { // C1597
}
}
+// Fortran 2018, 12.6.3 paragraph 7
+void IoChecker::CheckForBadIoComponent(const SomeExpr &expr,
+ GenericKind::DefinedIo which, parser::CharBlock where) const {
+ if (auto type{expr.GetType()}) {
+ if (type->category() == TypeCategory::Derived &&
+ !type->IsUnlimitedPolymorphic()) {
+ if (const Symbol *
+ bad{FindUnsafeIoDirectComponent(
+ which, type->GetDerivedTypeSpec(), &context_.FindScope(where))}) {
+ context_.SayWithDecl(*bad, where,
+ "Derived type in I/O cannot have an allocatable or pointer direct component unless using defined I/O"_err_en_US);
+ }
+ }
+ }
+}
+
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/check-io.h b/flang/lib/Semantics/check-io.h
index 44c01e85ffdcf..3e40a14415bda 100644
--- a/flang/lib/Semantics/check-io.h
+++ b/flang/lib/Semantics/check-io.h
@@ -126,6 +126,9 @@ class IoChecker : public virtual BaseChecker {
void CheckForPureSubprogram() const;
+ void CheckForBadIoComponent(
+ const SomeExpr &, GenericKind::DefinedIo, parser::CharBlock) const;
+
void Init(IoStmtKind s) {
stmt_ = s;
specifierSet_.reset();
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 1c585f3291531..dc302de38e0f6 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -74,8 +74,8 @@ class RuntimeTableBuilder {
const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
std::optional<GenericKind::DefinedIo>);
void IncorporateDefinedIoGenericInterfaces(
- std::map<int, evaluate::StructureConstructor> &, SourceName,
- GenericKind::DefinedIo, const Scope *);
+ std::map<int, evaluate::StructureConstructor> &, GenericKind::DefinedIo,
+ const Scope *);
// Instantiated for ParamValue and Bound
template <typename A>
@@ -523,18 +523,14 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
DescribeSpecialProc(
specials, *pair.second, false /*!isAssignment*/, true, std::nullopt);
}
- IncorporateDefinedIoGenericInterfaces(specials,
- SourceName{"read(formatted)", 15},
- GenericKind::DefinedIo::ReadFormatted, &scope);
- IncorporateDefinedIoGenericInterfaces(specials,
- SourceName{"read(unformatted)", 17},
- GenericKind::DefinedIo::ReadUnformatted, &scope);
- IncorporateDefinedIoGenericInterfaces(specials,
- SourceName{"write(formatted)", 16},
- GenericKind::DefinedIo::WriteFormatted, &scope);
- IncorporateDefinedIoGenericInterfaces(specials,
- SourceName{"write(unformatted)", 18},
- GenericKind::DefinedIo::WriteUnformatted, &scope);
+ IncorporateDefinedIoGenericInterfaces(
+ specials, GenericKind::DefinedIo::ReadFormatted, &scope);
+ IncorporateDefinedIoGenericInterfaces(
+ specials, GenericKind::DefinedIo::ReadUnformatted, &scope);
+ IncorporateDefinedIoGenericInterfaces(
+ specials, GenericKind::DefinedIo::WriteFormatted, &scope);
+ IncorporateDefinedIoGenericInterfaces(
+ specials, GenericKind::DefinedIo::WriteUnformatted, &scope);
// Pack the special procedure bindings in ascending order of their "which"
// code values, and compile a little-endian bit-set of those codes for
// use in O(1) look-up at run time.
@@ -1072,8 +1068,9 @@ void RuntimeTableBuilder::DescribeSpecialProc(
}
void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces(
- std::map<int, evaluate::StructureConstructor> &specials, SourceName name,
+ std::map<int, evaluate::StructureConstructor> &specials,
GenericKind::DefinedIo definedIo, const Scope *scope) {
+ SourceName name{GenericKind::AsFortran(definedIo)};
for (; !scope->IsGlobal(); scope = &scope->parent()) {
if (auto asst{scope->find(name)}; asst != scope->end()) {
const Symbol &generic{asst->second->GetUltimate()};
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index c556adc64fba2..14cd9ef724867 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -13,6 +13,7 @@
#include "flang/Semantics/semantics.h"
#include "flang/Semantics/tools.h"
#include "llvm/Support/raw_ostream.h"
+#include <cstring>
#include <string>
#include <type_traits>
@@ -657,7 +658,7 @@ std::string GenericKind::ToString() const {
return std::visit(
common::visitors {
[](const OtherKind &x) { return EnumToString(x); },
- [](const DefinedIo &x) { return EnumToString(x); },
+ [](const DefinedIo &x) { return AsFortran(x).ToString(); },
#if !__clang__ && __GNUC__ == 7 && __GNUC_MINOR__ == 2
[](const common::NumericOperator &x) {
return common::EnumToString(x);
@@ -675,13 +676,32 @@ std::string GenericKind::ToString() const {
u);
}
+SourceName GenericKind::AsFortran(DefinedIo x) {
+ const char *name{nullptr};
+ switch (x) {
+ SWITCH_COVERS_ALL_CASES
+ case DefinedIo::ReadFormatted:
+ name = "read(formatted)";
+ break;
+ case DefinedIo::ReadUnformatted:
+ name = "read(unformatted)";
+ break;
+ case DefinedIo::WriteFormatted:
+ name = "write(formatted)";
+ break;
+ case DefinedIo::WriteUnformatted:
+ name = "write(unformatted)";
+ break;
+ }
+ return {name, std::strlen(name)};
+}
+
bool GenericKind::Is(GenericKind::OtherKind x) const {
const OtherKind *y{std::get_if<OtherKind>(&u)};
return y && *y == x;
}
-bool SymbolOffsetCompare::operator()(
- const SymbolRef &x, const SymbolRef &y) const {
+bool SymbolOffsetCompare::operator()(const SymbolRef &x, const SymbolRef &y) const {
const Symbol *xCommon{FindCommonBlockContaining(*x)};
const Symbol *yCommon{FindCommonBlockContaining(*y)};
if (xCommon) {
@@ -709,6 +729,7 @@ bool SymbolOffsetCompare::operator()(
return x->GetSemanticsContext().allCookedSources().Precedes(
x->name(), y->name());
}
+
bool SymbolOffsetCompare::operator()(
const MutableSymbolRef &x, const MutableSymbolRef &y) const {
return (*this)(SymbolRef{*x}, SymbolRef{*y});
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 3b1ad208f81f3..b2de64efc8862 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1273,6 +1273,12 @@ UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent(
return std::find_if(ultimates.begin(), ultimates.end(), IsAllocatable);
}
+DirectComponentIterator::const_iterator FindAllocatableOrPointerDirectComponent(
+ const DerivedTypeSpec &derived) {
+ DirectComponentIterator directs{derived};
+ return std::find_if(directs.begin(), directs.end(), IsAllocatableOrPointer);
+}
+
UltimateComponentIterator::const_iterator
FindPolymorphicAllocatableUltimateComponent(const DerivedTypeSpec &derived) {
UltimateComponentIterator ultimates{derived};
@@ -1458,4 +1464,75 @@ std::optional<ArraySpec> ToArraySpec(evaluate::FoldingContext &context,
return shape ? ToArraySpec(context, *shape) : std::nullopt;
}
+bool HasDefinedIo(GenericKind::DefinedIo which, const DerivedTypeSpec &derived,
+ const Scope *scope) {
+ if (const Scope * dtScope{derived.scope()}) {
+ for (const auto &pair : *dtScope) {
+ const Symbol &symbol{*pair.second};
+ if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
+ GenericKind kind{generic->kind()};
+ if (const auto *io{std::get_if<GenericKind::DefinedIo>(&kind.u)}) {
+ if (*io == which) {
+ return true; // type-bound GENERIC exists
+ }
+ }
+ }
+ }
+ }
+ if (scope) {
+ SourceName name{GenericKind::AsFortran(which)};
+ evaluate::DynamicType dyDerived{derived};
+ for (; scope && !scope->IsGlobal(); scope = &scope->parent()) {
+ auto iter{scope->find(name)};
+ if (iter != scope->end()) {
+ const auto &generic{iter->second->GetUltimate().get<GenericDetails>()};
+ for (auto ref : generic.specificProcs()) {
+ const Symbol &procSym{ref->GetUltimate()};
+ if (const auto *subp{procSym.detailsIf<SubprogramDetails>()}) {
+ if (!subp->dummyArgs().empty()) {
+ if (const Symbol * first{subp->dummyArgs().at(0)}) {
+ if (const DeclTypeSpec * dtSpec{first->GetType()}) {
+ if (auto dyDummy{evaluate::DynamicType::From(*dtSpec)}) {
+ if (dyDummy->IsTkCompatibleWith(dyDerived)) {
+ return true; // GENERIC or INTERFACE not in type
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return false;
+}
+
+const Symbol *FindUnsafeIoDirectComponent(GenericKind::DefinedIo which,
+ const DerivedTypeSpec &derived, const Scope *scope) {
+ if (HasDefinedIo(which, derived, scope)) {
+ return nullptr;
+ }
+ if (const Scope * dtScope{derived.scope()}) {
+ for (const auto &pair : *dtScope) {
+ const Symbol &symbol{*pair.second};
+ if (IsAllocatableOrPointer(symbol)) {
+ return &symbol;
+ }
+ if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
+ if (const DeclTypeSpec * type{details->type()}) {
+ if (type->category() == DeclTypeSpec::Category::TypeDerived) {
+ if (const Symbol *
+ bad{FindUnsafeIoDirectComponent(
+ which, type->derivedTypeSpec(), scope)}) {
+ return bad;
+ }
+ }
+ }
+ }
+ }
+ }
+ return nullptr;
+}
+
} // namespace Fortran::semantics
diff --git a/flang/test/Semantics/io12.f90 b/flang/test/Semantics/io12.f90
new file mode 100644
index 0000000000000..f0f2ae18e7aa0
--- /dev/null
+++ b/flang/test/Semantics/io12.f90
@@ -0,0 +1,76 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Tests for I/O of derived types without defined I/O procedures
+! but with exposed allocatable/pointer components that would fail
+! at run time.
+
+module m1
+ type :: poison
+ real, allocatable :: allocatableComponent(:)
+ end type
+ type :: ok
+ integer :: x
+ type(poison) :: pill
+ contains
+ procedure :: wuf1
+ generic :: write(unformatted) => wuf1
+ end type
+ type :: maybeBad
+ integer :: x
+ type(poison) :: pill
+ end type
+ contains
+ subroutine wuf1(dtv, unit, iostat, iomsg)
+ class(ok), intent(in) :: dtv
+ integer, intent(in) :: unit
+ integer, intent(out) :: iostat
+ character(*), intent(in out) :: iomsg
+ write(unit) dtv%x
+ end subroutine
+end module
+
+module m2
+ use m1
+ interface write(unformatted)
+ module procedure wuf2
+ end interface
+ contains
+ subroutine wuf2(dtv, unit, iostat, iomsg)
+ class(maybeBad), intent(in) :: dtv
+ integer, intent(in) :: unit
+ integer, intent(out) :: iostat
+ character(*), intent(in out) :: iomsg
+ write(unit) dtv%x
+ end subroutine
+end module
+
+module m3
+ use m1
+ contains
+ subroutine test3(u)
+ integer, intent(in) :: u
+ type(ok) :: x
+ type(maybeBad) :: y
+ type(poison) :: z
+ write(u) x ! always ok
+ !ERROR: Derived type in I/O cannot have an allocatable or pointer direct component unless using defined I/O
+ write(u) y ! bad here
+ !ERROR: Derived type in I/O cannot have an allocatable or pointer direct component unless using defined I/O
+ write(u) z ! bad
+ end subroutine
+end module
+
+module m4
+ use m2
+ contains
+ subroutine test4(u)
+ integer, intent(in) :: u
+ type(ok) :: x
+ type(maybeBad) :: y
+ type(poison) :: z
+ write(u) x ! always ok
+ write(u) y ! ok here
+ !ERROR: Derived type in I/O cannot have an allocatable or pointer direct component unless using defined I/O
+ write(u) z ! bad
+ end subroutine
+end module
+
More information about the flang-commits
mailing list