[flang-commits] [flang] [flang] Refine EVENT_TYPE/LOCK_TYPE usage checks (PR #123244)
via flang-commits
flang-commits at lists.llvm.org
Thu Jan 16 14:00:39 PST 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
The event variable in an EVENT POST/WAIT statement can be a coarray reference, and need not be an entire coarray.
Variables and potential subobject components with EVENT_TYPE/LOCK_TYPE must be coarrays, unless they are potential subobjects nested within coarrays or pointers.
---
Full diff: https://github.com/llvm/llvm-project/pull/123244.diff
10 Files Affected:
- (modified) flang/include/flang/Semantics/tools.h (+4-1)
- (modified) flang/lib/Semantics/check-coarray.cpp (-3)
- (modified) flang/lib/Semantics/check-declarations.cpp (+14-1)
- (modified) flang/lib/Semantics/tools.cpp (+33-10)
- (modified) flang/test/Semantics/call04.f90 (+2-2)
- (modified) flang/test/Semantics/critical02.f90 (+1-1)
- (modified) flang/test/Semantics/doconcurrent01.f90 (+1-1)
- (modified) flang/test/Semantics/event01b.f90 (+33-4)
- (modified) flang/test/Semantics/event02b.f90 (+1-3)
- (modified) flang/test/Semantics/sync-stat-list.f90 (+1-1)
``````````diff
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 07103f98ff0412..87ddd38e5ae655 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -529,6 +529,9 @@ template <ComponentKind componentKind> class ComponentIterator {
// having to check against an end() iterator.
explicit operator bool() const { return !componentPath_.empty(); }
+ // Returns the current sequence of components, including parent components.
+ SymbolVector GetComponentPath() const;
+
// Builds a designator name of the referenced component for messages.
// The designator helps when the component referred to by the iterator
// may be "buried" into other components. This gives the full
@@ -626,7 +629,7 @@ using PotentialAndPointerComponentIterator =
// is returned. Otherwise, the returned iterator casts to true and can be
// dereferenced.
PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
- const DerivedTypeSpec &);
+ const DerivedTypeSpec &, bool ignoreCoarrays = false);
UltimateComponentIterator::const_iterator FindCoarrayUltimateComponent(
const DerivedTypeSpec &);
UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
index 6cf61a6b923db3..6bed525d7f6879 100644
--- a/flang/lib/Semantics/check-coarray.cpp
+++ b/flang/lib/Semantics/check-coarray.cpp
@@ -133,9 +133,6 @@ static void CheckEventVariable(
if (!IsEventType(evaluate::GetDerivedTypeSpec(expr->GetType()))) { // C1176
context.Say(parser::FindSourceLocation(eventVar),
"The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
- } else if (!evaluate::IsCoarray(*expr)) { // C1604
- context.Say(parser::FindSourceLocation(eventVar),
- "The event-variable must be a coarray"_err_en_US);
}
}
}
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index a7e6cf32e85eea..3d960a0620caa3 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -683,7 +683,20 @@ void CheckHelper::CheckObjectEntity(
const DeclTypeSpec *type{details.type()};
const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
bool isComponent{symbol.owner().IsDerivedType()};
- if (!details.coshape().empty()) {
+ if (details.coshape().empty()) { // not a coarray
+ if (!isComponent && !IsPointer(symbol) && derived) {
+ if (IsEventTypeOrLockType(derived)) {
+ messages_.Say(
+ "Variable '%s' with EVENT_TYPE or LOCK_TYPE must be a coarray"_err_en_US,
+ symbol.name());
+ } else if (auto component{FindEventOrLockPotentialComponent(
+ *derived, /*ignoreCoarrays=*/true)}) {
+ messages_.Say(
+ "Variable '%s' with EVENT_TYPE or LOCK_TYPE potential component '%s' must be a coarray"_err_en_US,
+ symbol.name(), component.BuildResultDesignatorName());
+ }
+ }
+ } else { // it's a coarray
bool isDeferredCoshape{details.coshape().CanBeDeferredShape()};
if (IsAllocatable(symbol)) {
if (!isDeferredCoshape) { // C827
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 052d71be434720..dc1dc475952727 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1364,13 +1364,23 @@ void ComponentIterator<componentKind>::const_iterator::Increment() {
}
}
+template <ComponentKind componentKind>
+SymbolVector
+ComponentIterator<componentKind>::const_iterator::GetComponentPath() const {
+ SymbolVector result;
+ for (const auto &node : componentPath_) {
+ result.push_back(DEREF(node.component()));
+ }
+ return result;
+}
+
template <ComponentKind componentKind>
std::string
ComponentIterator<componentKind>::const_iterator::BuildResultDesignatorName()
const {
std::string designator;
- for (const auto &node : componentPath_) {
- designator += "%"s + DEREF(node.component()).name().ToString();
+ for (const Symbol &component : GetComponentPath()) {
+ designator += "%"s + component.name().ToString();
}
return designator;
}
@@ -1396,16 +1406,29 @@ UltimateComponentIterator::const_iterator FindPointerUltimateComponent(
}
PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent(
- const DerivedTypeSpec &derived) {
+ const DerivedTypeSpec &derived, bool ignoreCoarrays) {
PotentialComponentIterator potentials{derived};
- return std::find_if(
- potentials.begin(), potentials.end(), [](const Symbol &component) {
- if (const auto *details{component.detailsIf<ObjectEntityDetails>()}) {
- const DeclTypeSpec *type{details->type()};
- return type && IsEventTypeOrLockType(type->AsDerived());
+ auto iter{potentials.begin()};
+ for (auto end{potentials.end()}; iter != end; ++iter) {
+ const Symbol &component{*iter};
+ if (const auto *object{component.detailsIf<ObjectEntityDetails>()}) {
+ if (const DeclTypeSpec * type{object->type()}) {
+ if (IsEventTypeOrLockType(type->AsDerived())) {
+ if (!ignoreCoarrays) {
+ break; // found one
+ }
+ auto path{iter.GetComponentPath()};
+ path.pop_back();
+ if (std::find_if(path.begin(), path.end(), [](const Symbol &sym) {
+ return evaluate::IsCoarray(sym);
+ }) == path.end()) {
+ break; // found one not in a coarray
+ }
}
- return false;
- });
+ }
+ }
+ }
+ return iter;
}
UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent(
diff --git a/flang/test/Semantics/call04.f90 b/flang/test/Semantics/call04.f90
index 9be579fb696c03..3b079aa4fb2b1a 100644
--- a/flang/test/Semantics/call04.f90
+++ b/flang/test/Semantics/call04.f90
@@ -56,11 +56,11 @@ subroutine s05(x) ! C846
subroutine s06(x) ! C847
use ISO_FORTRAN_ENV, only: lock_type
!ERROR: An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE
- type(lock_type), intent(out) :: x
+ type(lock_type), intent(out) :: x[*]
end subroutine
subroutine s07(x) ! C847
use ISO_FORTRAN_ENV, only: event_type
!ERROR: An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE
- type(event_type), intent(out) :: x
+ type(event_type), intent(out) :: x[*]
end subroutine
diff --git a/flang/test/Semantics/critical02.f90 b/flang/test/Semantics/critical02.f90
index e1c9bb3e0ff103..692b06b025861f 100644
--- a/flang/test/Semantics/critical02.f90
+++ b/flang/test/Semantics/critical02.f90
@@ -82,7 +82,7 @@ end subroutine test8
subroutine test9()
use iso_fortran_env
- type(lock_type) :: l
+ type(lock_type), save :: l[*]
critical
!ERROR: An image control statement is not allowed in a CRITICAL construct
diff --git a/flang/test/Semantics/doconcurrent01.f90 b/flang/test/Semantics/doconcurrent01.f90
index 9bb2b453768351..9d2c9e1ab3115c 100644
--- a/flang/test/Semantics/doconcurrent01.f90
+++ b/flang/test/Semantics/doconcurrent01.f90
@@ -97,7 +97,7 @@ end subroutine s3
subroutine s4()
use iso_fortran_env
- type(lock_type) :: l
+ type(lock_type), save :: l[*]
do concurrent (i = 1:n)
!ERROR: An image control statement is not allowed in DO CONCURRENT
diff --git a/flang/test/Semantics/event01b.f90 b/flang/test/Semantics/event01b.f90
index 6a207427f6d4e4..0cd8a5bcb1f1f8 100644
--- a/flang/test/Semantics/event01b.f90
+++ b/flang/test/Semantics/event01b.f90
@@ -10,8 +10,41 @@ program test_event_post
implicit none
! event_type variables must be coarrays
+ !ERROR: Variable 'non_coarray' with EVENT_TYPE or LOCK_TYPE must be a coarray
type(event_type) non_coarray
+ ! event_type potential object components must be nested in coarrays
+ type :: has_event
+ type(event_type) event
+ end type
+ type :: bad1
+ type(has_event) component
+ end type
+ type :: bad2
+ type(has_event), allocatable :: component
+ end type
+ type :: good1
+ type(has_event), pointer :: component
+ end type
+ type :: good2
+ type(has_event), allocatable :: component[:]
+ end type
+ !ERROR: Variable 'non_coarray_component1' with EVENT_TYPE or LOCK_TYPE potential component '%event' must be a coarray
+ type(has_event) non_coarray_component1
+ !ERROR: Variable 'non_coarray_component2' with EVENT_TYPE or LOCK_TYPE potential component '%component%event' must be a coarray
+ type(bad1) non_coarray_component2
+ !ERROR: Variable 'non_coarray_component3' with EVENT_TYPE or LOCK_TYPE potential component '%component%event' must be a coarray
+ type(bad2) non_coarray_component3
+ ! these are okay
+ type(has_event) ok_non_coarray_component1[*]
+ type(has_event), pointer :: ok_non_coarray_component2
+ type(bad1) :: ok_non_coarray_component3[*]
+ type(bad1), pointer :: ok_non_coarray_component4
+ type(bad2) :: ok_non_coarray_component5[*]
+ type(bad2), pointer :: ok_non_coarray_component6
+ type(good1) ok_non_coarray_component7
+ type(good2) ok_non_coarray_component8
+
type(event_type) concert[*], occurrences(2)[*]
integer non_event[*], sync_status, co_indexed_integer[*], superfluous_stat, non_scalar(1)
character(len=128) error_message, co_indexed_character[*], superfluous_errmsg
@@ -25,10 +58,6 @@ program test_event_post
!ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV
event post(non_event)
- ! event-variable must be a coarray
- !ERROR: The event-variable must be a coarray
- event post(non_coarray)
-
!ERROR: Must be a scalar value, but is a rank-1 array
event post(occurrences)
diff --git a/flang/test/Semantics/event02b.f90 b/flang/test/Semantics/event02b.f90
index 20ee4047a1fede..94971022878ac0 100644
--- a/flang/test/Semantics/event02b.f90
+++ b/flang/test/Semantics/event02b.f90
@@ -10,6 +10,7 @@ program test_event_wait
implicit none
! event_type variables must be coarrays
+ !ERROR: Variable 'non_coarray' with EVENT_TYPE or LOCK_TYPE must be a coarray
type(event_type) non_coarray
type(event_type) concert[*], occurrences(2)[*]
@@ -24,9 +25,6 @@ program test_event_wait
!ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV
event wait(non_event)
- !ERROR: The event-variable must be a coarray
- event wait(non_coarray)
-
!ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object
event wait(concert[1])
diff --git a/flang/test/Semantics/sync-stat-list.f90 b/flang/test/Semantics/sync-stat-list.f90
index 85a85f82245342..545733049ca356 100644
--- a/flang/test/Semantics/sync-stat-list.f90
+++ b/flang/test/Semantics/sync-stat-list.f90
@@ -16,7 +16,7 @@ program test_sync_stat_list
character(len=128) error_message, superfluous_errmsg, coindexed_character[*]
logical invalid_type
type(team_type) :: home
- type(lock_type) :: latch
+ type(lock_type) :: latch[*]
! valid
change team (home, stat=sync_status, errmsg=error_message)
``````````
</details>
https://github.com/llvm/llvm-project/pull/123244
More information about the flang-commits
mailing list