[flang] Pass call04

Original-commit: flang-compiler/f18@5a44837804
Reviewed-on: https://github.com/flang-compiler/f18/pull/783
This commit is contained in:
peter klausler 2019-10-17 16:15:20 -07:00
parent e6bf9526e1
commit 9cf827d297
4 changed files with 34 additions and 21 deletions

View File

@ -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<bool(const Symbol &)>{[](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);
}
}
}

View File

@ -1011,7 +1011,7 @@ PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
}
const Symbol *FindUltimateComponent(const DerivedTypeSpec &derived,
std::function<bool(const Symbol &)> predicate) {
const std::function<bool(const Symbol &)> &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<bool(const Symbol &)> &predicate) {
if (predicate(symbol)) {
return &symbol;
} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
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<bool(const Symbol &)> &predicate) {
if (const Scope * scope{type.scope()}) {
@ -1064,5 +1078,4 @@ bool IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) {
}
return false;
}
}

View File

@ -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<bool(const Symbol &)> &predicate);
const Symbol *FindUltimateComponent(
const DerivedTypeSpec &type, std::function<bool(const Symbol &)> predicate);
const Symbol &symbol, const std::function<bool(const Symbol &)> &predicate);
// Returns an immediate component of type that matches predicate, or nullptr.
const Symbol *FindImmediateComponent(

View File

@ -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