From 4d84ed528358996f1aea120ddf8a7a556163993b Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Tue, 16 May 2023 10:46:27 -0700 Subject: Revert "[flang] Add check for constraints on event-stmts" This reverts commit 9725c740fbe7841a7aed57ca35f83d28aac1814c. --- flang/include/flang/Evaluate/tools.h | 2 - flang/lib/Evaluate/tools.cpp | 11 +---- flang/lib/Semantics/check-coarray.cpp | 71 --------------------------------- flang/lib/Semantics/check-coarray.h | 4 -- flang/test/Lower/pre-fir-tree04.f90 | 4 +- flang/test/Semantics/critical02.f90 | 2 +- flang/test/Semantics/doconcurrent01.f90 | 4 +- flang/test/Semantics/event01b.f90 | 44 +++----------------- flang/test/Semantics/event02b.f90 | 61 +++++----------------------- 9 files changed, 22 insertions(+), 181 deletions(-) (limited to 'flang') diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 716c4a972694..dfc811fa2856 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1201,8 +1201,6 @@ 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 befe28605055..b9fb511b47cb 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1568,14 +1568,6 @@ 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"); } @@ -1585,7 +1577,8 @@ bool IsBadCoarrayType(const DerivedTypeSpec *derived) { } bool IsEventTypeOrLockType(const DerivedTypeSpec *derivedTypeSpec) { - return IsEventType(derivedTypeSpec) || IsLockType(derivedTypeSpec); + return IsBuiltinDerivedType(derivedTypeSpec, "event_type") || + IsBuiltinDerivedType(derivedTypeSpec, "lock_type"); } int CountLenParameters(const DerivedTypeSpec &type) { diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp index 688c3a7c92ad..f291a80a7033 100644 --- a/flang/lib/Semantics/check-coarray.cpp +++ b/flang/lib/Semantics/check-coarray.cpp @@ -124,19 +124,6 @@ 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>(x.t)); CheckTeamType(context_, std::get(x.t)); @@ -169,64 +156,6 @@ void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) { CheckSyncStatList(context_, std::get>(x.t)); } -void CoarrayChecker::Leave(const parser::EventPostStmt &x) { - CheckSyncStatList(context_, std::get>(x.t)); - CheckEventVariable(context_, std::get(x.t)); -} - -void CoarrayChecker::Leave(const parser::EventWaitStmt &x) { - const auto &eventVar{std::get(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>(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 51d030cbf771..b4ce5b42ad6f 100644 --- a/flang/lib/Semantics/check-coarray.h +++ b/flang/lib/Semantics/check-coarray.h @@ -17,8 +17,6 @@ class CharBlock; class MessageFixedText; struct ChangeTeamStmt; struct CoarrayAssociation; -struct EventPostStmt; -struct EventWaitStmt; struct FormTeamStmt; struct ImageSelector; struct SyncAllStmt; @@ -37,8 +35,6 @@ 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 e5f804245854..8188bfd54b40 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 e1c9bb3e0ff1..10581f9fd805 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 36595df5a62f..0f4e13da2290 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 6a207427f6d4..7cf374fbcc84 100644 --- a/flang/test/Semantics/event01b.f90 +++ b/flang/test/Semantics/event01b.f90 @@ -22,11 +22,9 @@ 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 @@ -50,50 +48,18 @@ program test_event_post !______ invalid sync-stat-lists: redundant sync-stat-list ____________ - !ERROR: The stat-variable in a sync-stat-list may not be repeated + ! No specifier shall appear more than once in a given sync-stat-list event post(concert, stat=sync_status, stat=superfluous_stat) - !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 + ! No specifier shall appear more than once in a given sync-stat-list event post(concert, errmsg=error_message, errmsg=superfluous_errmsg) - !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) + !______ invalid sync-stat-lists: coindexed stat-variable ____________ - !______ 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 + ! Check constraint C1173 from the Fortran 2018 standard event post(concert, stat=co_indexed_integer[1]) - !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object + ! Check constraint C1173 from the Fortran 2018 standard 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 20ee4047a1fe..8aa53bd96213 100644 --- a/flang/test/Semantics/event02b.f90 +++ b/flang/test/Semantics/event02b.f90 @@ -21,16 +21,16 @@ program test_event_wait !_________________________ invalid event-variable ________________________________ - !ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV + ! event-variable must be event_type event wait(non_event) - !ERROR: The event-variable must be a coarray + ! 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-variable must not be coindexed event wait(concert[1]) - !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object + ! event-variable must not be coindexed event wait(occurrences(1)[1]) !ERROR: Must be a scalar value, but is a rank-1 array @@ -62,62 +62,21 @@ program test_event_wait !______ invalid event-wait-spec-lists: redundant event-wait-spec-list ____________ - !ERROR: Until-spec in a event-wait-spec-list may not be repeated + ! No specifier shall appear more than once in a given event-wait-spec-list event wait(concert, until_count=threshold, 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, 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 + ! No specifier shall appear more than once in a given event-wait-spec-list event wait(concert, stat=sync_status, 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, 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 + ! No specifier shall appear more than once in a given event-wait-spec-list event wait(concert, errmsg=error_message, errmsg=superfluous_errmsg) - !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) + !_____________ 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, 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 + ! Check constraint C1173 from the Fortran 2018 standard event wait(concert, stat=co_indexed_integer[1]) - !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object + ! Check constraint C1173 from the Fortran 2018 standard 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 -- cgit v1.2.1