diff options
author | Katherine Rasmussen <krasmussen@lbl.gov> | 2023-05-16 12:09:48 -0700 |
---|---|---|
committer | Katherine Rasmussen <krasmussen@lbl.gov> | 2023-05-16 12:09:48 -0700 |
commit | e03200164be0d7cc2e8514e98548fe309b0829d0 (patch) | |
tree | a789be2d52b36024892f3632a12e575b865db930 /flang | |
parent | 49007a020c14a48062fac34c5c83c907d6ae1c31 (diff) | |
download | llvm-e03200164be0d7cc2e8514e98548fe309b0829d0.tar.gz |
[flang] Add check for constraints on event-stmts
In the CoarrayChecker, add checks for the constraints C1177 and
C1178 for event-wait-stmt. Add event-post-stmt to the check
for the constraints for sync-stat-list. Add a check for the
constraint C1176 on event-variable.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D137204
Diffstat (limited to 'flang')
-rw-r--r-- | flang/include/flang/Evaluate/tools.h | 2 | ||||
-rw-r--r-- | flang/lib/Evaluate/tools.cpp | 11 | ||||
-rw-r--r-- | flang/lib/Semantics/check-coarray.cpp | 71 | ||||
-rw-r--r-- | flang/lib/Semantics/check-coarray.h | 4 | ||||
-rw-r--r-- | flang/test/Lower/pre-fir-tree04.f90 | 4 | ||||
-rw-r--r-- | flang/test/Semantics/critical02.f90 | 2 | ||||
-rw-r--r-- | flang/test/Semantics/doconcurrent01.f90 | 4 | ||||
-rw-r--r-- | flang/test/Semantics/event01b.f90 | 44 | ||||
-rw-r--r-- | flang/test/Semantics/event02b.f90 | 61 |
9 files changed, 181 insertions, 22 deletions
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index dfc811fa2856..716c4a972694 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1201,6 +1201,8 @@ bool IsLenTypeParameter(const Symbol &); bool IsExtensibleType(const DerivedTypeSpec *); bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name); bool IsBuiltinCPtr(const Symbol &); +bool IsEventType(const DerivedTypeSpec *); +bool IsLockType(const DerivedTypeSpec *); // Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV? bool IsTeamType(const DerivedTypeSpec *); // Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR? diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index b9fb511b47cb..befe28605055 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1568,6 +1568,14 @@ bool IsIsoCType(const DerivedTypeSpec *derived) { IsBuiltinDerivedType(derived, "c_funptr"); } +bool IsEventType(const DerivedTypeSpec *derived) { + return IsBuiltinDerivedType(derived, "event_type"); +} + +bool IsLockType(const DerivedTypeSpec *derived) { + return IsBuiltinDerivedType(derived, "lock_type"); +} + bool IsTeamType(const DerivedTypeSpec *derived) { return IsBuiltinDerivedType(derived, "team_type"); } @@ -1577,8 +1585,7 @@ bool IsBadCoarrayType(const DerivedTypeSpec *derived) { } bool IsEventTypeOrLockType(const DerivedTypeSpec *derivedTypeSpec) { - return IsBuiltinDerivedType(derivedTypeSpec, "event_type") || - IsBuiltinDerivedType(derivedTypeSpec, "lock_type"); + return IsEventType(derivedTypeSpec) || IsLockType(derivedTypeSpec); } int CountLenParameters(const DerivedTypeSpec &type) { diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp index f291a80a7033..688c3a7c92ad 100644 --- a/flang/lib/Semantics/check-coarray.cpp +++ b/flang/lib/Semantics/check-coarray.cpp @@ -124,6 +124,19 @@ static void CheckSyncStatList( } } +static void CheckEventVariable( + SemanticsContext &context, const parser::EventVariable &eventVar) { + if (const auto *expr{GetExpr(context, eventVar)}) { + 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); + } + } +} + void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) { CheckNamesAreDistinct(std::get<std::list<parser::CoarrayAssociation>>(x.t)); CheckTeamType(context_, std::get<parser::TeamValue>(x.t)); @@ -156,6 +169,64 @@ void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) { CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t)); } +void CoarrayChecker::Leave(const parser::EventPostStmt &x) { + CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t)); + CheckEventVariable(context_, std::get<parser::EventVariable>(x.t)); +} + +void CoarrayChecker::Leave(const parser::EventWaitStmt &x) { + const auto &eventVar{std::get<parser::EventVariable>(x.t)}; + + if (const auto *expr{GetExpr(context_, eventVar)}) { + if (ExtractCoarrayRef(expr)) { + context_.Say(parser::FindSourceLocation(eventVar), // C1177 + "A event-variable in a EVENT WAIT statement may not be a coindexed object"_err_en_US); + } else { + CheckEventVariable(context_, eventVar); + } + } + + bool gotStat{false}, gotMsg{false}, gotUntil{false}; + using EventWaitSpec = parser::EventWaitStmt::EventWaitSpec; + for (const EventWaitSpec &eventWaitSpec : + std::get<std::list<EventWaitSpec>>(x.t)) { + common::visit( + common::visitors{ + [&](const parser::ScalarIntExpr &untilCount) { + if (gotUntil) { + context_.Say( // C1178 + "Until-spec in a event-wait-spec-list may not be repeated"_err_en_US); + } + gotUntil = true; + }, + [&](const parser::StatOrErrmsg &statOrErrmsg) { + common::visit( + common::visitors{ + [&](const parser::StatVariable &stat) { + if (gotStat) { + context_.Say( // C1178 + "A stat-variable in a event-wait-spec-list may not be repeated"_err_en_US); + } + gotStat = true; + }, + [&](const parser::MsgVariable &errmsg) { + if (gotMsg) { + context_.Say( // C1178 + "A errmsg-variable in a event-wait-spec-list may not be repeated"_err_en_US); + } + gotMsg = true; + }, + }, + statOrErrmsg.u); + CheckCoindexedStatOrErrmsg( + context_, statOrErrmsg, "event-wait-spec-list"); + }, + + }, + eventWaitSpec.u); + } +} + void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) { haveStat_ = false; haveTeam_ = false; diff --git a/flang/lib/Semantics/check-coarray.h b/flang/lib/Semantics/check-coarray.h index b4ce5b42ad6f..51d030cbf771 100644 --- a/flang/lib/Semantics/check-coarray.h +++ b/flang/lib/Semantics/check-coarray.h @@ -17,6 +17,8 @@ class CharBlock; class MessageFixedText; struct ChangeTeamStmt; struct CoarrayAssociation; +struct EventPostStmt; +struct EventWaitStmt; struct FormTeamStmt; struct ImageSelector; struct SyncAllStmt; @@ -35,6 +37,8 @@ public: void Leave(const parser::SyncImagesStmt &); void Leave(const parser::SyncMemoryStmt &); void Leave(const parser::SyncTeamStmt &); + void Leave(const parser::EventPostStmt &); + void Leave(const parser::EventWaitStmt &); void Leave(const parser::ImageSelector &); void Leave(const parser::FormTeamStmt &); diff --git a/flang/test/Lower/pre-fir-tree04.f90 b/flang/test/Lower/pre-fir-tree04.f90 index 8188bfd54b40..e5f804245854 100644 --- a/flang/test/Lower/pre-fir-tree04.f90 +++ b/flang/test/Lower/pre-fir-tree04.f90 @@ -6,8 +6,8 @@ Subroutine test_coarray use iso_fortran_env, only: team_type, event_type, lock_type type(team_type) :: t - type(event_type) :: done - type(lock_type) :: alock + type(event_type) :: done[*] + type(lock_type) :: alock[*] real :: y[10,*] integer :: counter[*] logical :: is_square diff --git a/flang/test/Semantics/critical02.f90 b/flang/test/Semantics/critical02.f90 index 10581f9fd805..e1c9bb3e0ff1 100644 --- a/flang/test/Semantics/critical02.f90 +++ b/flang/test/Semantics/critical02.f90 @@ -61,7 +61,7 @@ end subroutine test6 subroutine test7() use iso_fortran_env - type(event_type) :: x, y + type(event_type) :: x[*], y[*] critical !ERROR: An image control statement is not allowed in a CRITICAL construct event post (x) diff --git a/flang/test/Semantics/doconcurrent01.f90 b/flang/test/Semantics/doconcurrent01.f90 index 0f4e13da2290..36595df5a62f 100644 --- a/flang/test/Semantics/doconcurrent01.f90 +++ b/flang/test/Semantics/doconcurrent01.f90 @@ -66,7 +66,7 @@ end subroutine do_concurrent_test2 subroutine s1() use iso_fortran_env - type(event_type) :: x + type(event_type) :: x[*] do concurrent (i = 1:n) !ERROR: An image control statement is not allowed in DO CONCURRENT event post (x) @@ -75,7 +75,7 @@ end subroutine s1 subroutine s2() use iso_fortran_env - type(event_type) :: x + type(event_type) :: x[*] do concurrent (i = 1:n) !ERROR: An image control statement is not allowed in DO CONCURRENT event wait (x) diff --git a/flang/test/Semantics/event01b.f90 b/flang/test/Semantics/event01b.f90 index 7cf374fbcc84..6a207427f6d4 100644 --- a/flang/test/Semantics/event01b.f90 +++ b/flang/test/Semantics/event01b.f90 @@ -22,9 +22,11 @@ program test_event_post !______ invalid event-variable ____________________________ ! event-variable must be event_type + !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 @@ -48,18 +50,50 @@ program test_event_post !______ invalid sync-stat-lists: redundant sync-stat-list ____________ - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: The stat-variable in a sync-stat-list may not be repeated event post(concert, stat=sync_status, stat=superfluous_stat) - ! No specifier shall appear more than once in a given sync-stat-list + !ERROR: The stat-variable in a sync-stat-list may not be repeated + event post(concert, errmsg=error_message, stat=sync_status, stat=superfluous_stat) + + !ERROR: The stat-variable in a sync-stat-list may not be repeated + event post(concert, stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: The stat-variable in a sync-stat-list may not be repeated + event post(concert, stat=sync_status, stat=superfluous_stat, errmsg=error_message) + + !ERROR: The errmsg-variable in a sync-stat-list may not be repeated event post(concert, errmsg=error_message, errmsg=superfluous_errmsg) - !______ invalid sync-stat-lists: coindexed stat-variable ____________ + !ERROR: The errmsg-variable in a sync-stat-list may not be repeated + event post(concert, stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg) + + !ERROR: The errmsg-variable in a sync-stat-list may not be repeated + event post(concert, errmsg=error_message, stat=sync_status, errmsg=superfluous_errmsg) + + !ERROR: The errmsg-variable in a sync-stat-list may not be repeated + event post(concert, errmsg=error_message, errmsg=superfluous_errmsg, stat=sync_status) - ! Check constraint C1173 from the Fortran 2018 standard + !______ invalid sync-stat-lists: coindexed stat-variable - C1173____________ + + !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object event post(concert, stat=co_indexed_integer[1]) - ! Check constraint C1173 from the Fortran 2018 standard + !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object event post(concert, errmsg=co_indexed_character[1]) + !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + event post(concert, stat=co_indexed_integer[1], errmsg=error_message) + + !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + event post(concert, stat=sync_status, errmsg=co_indexed_character[1]) + + !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + event post(concert, stat=co_indexed_integer[1], errmsg=co_indexed_character[1]) + + !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + event post(concert, errmsg=co_indexed_character[1], stat=co_indexed_integer[1]) + end program test_event_post diff --git a/flang/test/Semantics/event02b.f90 b/flang/test/Semantics/event02b.f90 index 8aa53bd96213..20ee4047a1fe 100644 --- a/flang/test/Semantics/event02b.f90 +++ b/flang/test/Semantics/event02b.f90 @@ -21,16 +21,16 @@ program test_event_wait !_________________________ invalid event-variable ________________________________ - ! event-variable must be event_type + !ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV event wait(non_event) - ! event-variable must be a coarray + !ERROR: The event-variable must be a coarray event wait(non_coarray) - ! event-variable must not be coindexed + !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object event wait(concert[1]) - ! event-variable must not be coindexed + !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object event wait(occurrences(1)[1]) !ERROR: Must be a scalar value, but is a rank-1 array @@ -62,21 +62,62 @@ program test_event_wait !______ invalid event-wait-spec-lists: redundant event-wait-spec-list ____________ - ! No specifier shall appear more than once in a given event-wait-spec-list + !ERROR: Until-spec in a event-wait-spec-list may not be repeated event wait(concert, until_count=threshold, until_count=indexed(1)) - ! No specifier shall appear more than once in a given event-wait-spec-list + !ERROR: Until-spec in a event-wait-spec-list may not be repeated + event wait(concert, until_count=threshold, stat=sync_status, until_count=indexed(1)) + + !ERROR: Until-spec in a event-wait-spec-list may not be repeated + event wait(concert, until_count=threshold, errmsg=error_message, until_count=indexed(1)) + + !ERROR: Until-spec in a event-wait-spec-list may not be repeated + event wait(concert, until_count=threshold, stat=sync_status, errmsg=error_message, until_count=indexed(1)) + + !ERROR: A stat-variable in a event-wait-spec-list may not be repeated event wait(concert, stat=sync_status, stat=superfluous_stat) - ! No specifier shall appear more than once in a given event-wait-spec-list + !ERROR: A stat-variable in a event-wait-spec-list may not be repeated + event wait(concert, stat=sync_status, until_count=threshold, stat=superfluous_stat) + + !ERROR: A stat-variable in a event-wait-spec-list may not be repeated + event wait(concert, stat=sync_status, errmsg=error_message, stat=superfluous_stat) + + !ERROR: A stat-variable in a event-wait-spec-list may not be repeated + event wait(concert, stat=sync_status, until_count=threshold, errmsg=error_message, stat=superfluous_stat) + + !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated event wait(concert, errmsg=error_message, errmsg=superfluous_errmsg) - !_____________ invalid sync-stat-lists: coindexed stat-variable __________________ + !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated + event wait(concert, errmsg=error_message, until_count=threshold, errmsg=superfluous_errmsg) + + !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated + event wait(concert, errmsg=error_message, stat=superfluous_stat, errmsg=superfluous_errmsg) - ! Check constraint C1173 from the Fortran 2018 standard + !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated + event wait(concert, errmsg=error_message, until_count=threshold, stat=superfluous_stat, errmsg=superfluous_errmsg) + + !_____________ invalid sync-stat-lists: coindexed stat-variable - C1173 __________________ + + !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object event wait(concert, stat=co_indexed_integer[1]) - ! Check constraint C1173 from the Fortran 2018 standard + !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object event wait(concert, errmsg=co_indexed_character[1]) + !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object + event wait(concert, stat=co_indexed_integer[1], errmsg=error_message) + + !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object + event wait(concert, stat=sync_status, errmsg=co_indexed_character[1]) + + !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object + !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object + event wait(concert, stat=co_indexed_integer[1], errmsg=co_indexed_character[1]) + + !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object + !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object + event wait(concert, errmsg=co_indexed_character[1], stat=co_indexed_integer[1]) + end program test_event_wait |