From 9cf827d297869bafc5db933757f3083627df6b5d Mon Sep 17 00:00:00 2001 From: peter klausler Date: Thu, 17 Oct 2019 16:15:20 -0700 Subject: [PATCH] [flang] Pass call04 Original-commit: flang-compiler/f18@5a4483780420e105b2a5aeb82a1b268c028ef7f1 Reviewed-on: https://github.com/flang-compiler/f18/pull/783 --- flang/lib/semantics/check-declarations.cc | 22 ++++++++++------------ flang/lib/semantics/tools.cc | 17 +++++++++++++++-- flang/lib/semantics/tools.h | 4 +++- flang/test/semantics/call04.f90 | 12 ++++++------ 4 files changed, 34 insertions(+), 21 deletions(-) diff --git a/flang/lib/semantics/check-declarations.cc b/flang/lib/semantics/check-declarations.cc index 8eb17300a90e..fb8d14abcbef 100644 --- a/flang/lib/semantics/check-declarations.cc +++ b/flang/lib/semantics/check-declarations.cc @@ -114,18 +114,16 @@ void CheckHelper::Check(Symbol &symbol) { Check(object->shape()); Check(object->coshape()); if (object->isDummy() && symbol.attrs().test(Attr::INTENT_OUT)) { - if (const auto *type{object->type()}) { - if (const auto *derived{type->AsDerived()}) { - TypeInspector inspector; - inspector.Inspect(*derived); - if (const Symbol * bad{inspector.allocatableCoarray()}) { // C846 - if (auto *msg{messages_.Say( - "An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray"_err_en_US)}) { - msg->Attach( - bad->name(), "Declaration of ALLOCATABLE coarray"_en_US); - } - } - } + if (FindUltimateComponent(symbol, + std::function{[](const Symbol &symbol) { + return IsCoarray(symbol) && IsAllocatable(symbol); + }})) { // C846 + messages_.Say( + "An INTENT(OUT) dummy argument may not be, or contain, an ALLOCATABLE coarray"_err_en_US); + } + if (IsOrContainsEventOrLockComponent(symbol)) { // C847 + messages_.Say( + "An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE"_err_en_US); } } } diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc index ff02adfcc031..5189f8797b98 100644 --- a/flang/lib/semantics/tools.cc +++ b/flang/lib/semantics/tools.cc @@ -1011,7 +1011,7 @@ PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent( } const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived, - std::function predicate) { + const std::function &predicate) { UltimateComponentIterator ultimates{derived}; if (auto it{std::find_if(ultimates.begin(), ultimates.end(), [&predicate](const Symbol *component) -> bool { @@ -1022,6 +1022,20 @@ const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived, return nullptr; } +const Symbol *FindUltimateComponent(const Symbol &symbol, + const std::function &predicate) { + if (predicate(symbol)) { + return &symbol; + } else if (const auto *object{symbol.detailsIf()}) { + if (const auto *type{object->type()}) { + if (const auto *derived{type->AsDerived()}) { + return FindUltimateComponent(*derived, predicate); + } + } + } + return nullptr; +} + const Symbol *FindImmediateComponent(const DerivedTypeSpec &type, const std::function &predicate) { if (const Scope * scope{type.scope()}) { @@ -1064,5 +1078,4 @@ bool IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) { } return false; } - } diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h index 3d9cd034666b..378c6c8b66f1 100644 --- a/flang/lib/semantics/tools.h +++ b/flang/lib/semantics/tools.h @@ -81,8 +81,10 @@ bool IsSaved(const Symbol &); bool CanBeTypeBoundProc(const Symbol *); // Return an ultimate component of type that matches predicate, or nullptr. +const Symbol *FindUltimateComponent(const DerivedTypeSpec &type, + const std::function &predicate); const Symbol *FindUltimateComponent( - const DerivedTypeSpec &type, std::function predicate); + const Symbol &symbol, const std::function &predicate); // Returns an immediate component of type that matches predicate, or nullptr. const Symbol *FindImmediateComponent( diff --git a/flang/test/semantics/call04.f90 b/flang/test/semantics/call04.f90 index bed5e51afb74..1949c0afe13a 100644 --- a/flang/test/semantics/call04.f90 +++ b/flang/test/semantics/call04.f90 @@ -40,22 +40,22 @@ module m end subroutine subroutine s02(x) ! C846 - !ERROR: An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray + !ERROR: An INTENT(OUT) dummy argument may not be, or contain, an ALLOCATABLE coarray type(hasCoarray), intent(out) :: x end subroutine subroutine s03(x) ! C846 - !ERROR: An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray + !ERROR: An INTENT(OUT) dummy argument may not be, or contain, an ALLOCATABLE coarray type(extendsHasCoarray), intent(out) :: x end subroutine subroutine s04(x) ! C846 - !ERROR: An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray + !ERROR: An INTENT(OUT) dummy argument may not be, or contain, an ALLOCATABLE coarray type(hasCoarray2), intent(out) :: x end subroutine subroutine s05(x) ! C846 - !ERROR: An INTENT(OUT) dummy argument may not contain an ALLOCATABLE coarray + !ERROR: An INTENT(OUT) dummy argument may not be, or contain, an ALLOCATABLE coarray type(extendsHasCoarray2), intent(out) :: x end subroutine @@ -63,12 +63,12 @@ end module subroutine s06(x) ! C847 use ISO_FORTRAN_ENV, only: lock_type - !ERROR: A dummy argument of TYPE(LOCK_TYPE) may not be INTENT(OUT) + !ERROR: An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE type(lock_type), intent(out) :: x end subroutine subroutine s07(x) ! C847 use ISO_FORTRAN_ENV, only: event_type - !ERROR: A dummy argument of TYPE(EVENT_TYPE) may not be INTENT(OUT) + !ERROR: An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE type(event_type), intent(out) :: x end subroutine