summaryrefslogtreecommitdiff
path: root/flang
diff options
context:
space:
mode:
authorKatherine Rasmussen <krasmussen@lbl.gov>2023-05-16 10:46:27 -0700
committerKatherine Rasmussen <krasmussen@lbl.gov>2023-05-16 10:46:27 -0700
commit4d84ed528358996f1aea120ddf8a7a556163993b (patch)
tree512c4f3daa0faa1080a15fa67255e95d0f29451a /flang
parent105d63a250e341c2b44fe393e74a1118b0c1c446 (diff)
downloadllvm-4d84ed528358996f1aea120ddf8a7a556163993b.tar.gz
Revert "[flang] Add check for constraints on event-stmts"
This reverts commit 9725c740fbe7841a7aed57ca35f83d28aac1814c.
Diffstat (limited to 'flang')
-rw-r--r--flang/include/flang/Evaluate/tools.h2
-rw-r--r--flang/lib/Evaluate/tools.cpp11
-rw-r--r--flang/lib/Semantics/check-coarray.cpp71
-rw-r--r--flang/lib/Semantics/check-coarray.h4
-rw-r--r--flang/test/Lower/pre-fir-tree04.f904
-rw-r--r--flang/test/Semantics/critical02.f902
-rw-r--r--flang/test/Semantics/doconcurrent01.f904
-rw-r--r--flang/test/Semantics/event01b.f9044
-rw-r--r--flang/test/Semantics/event02b.f9061
9 files changed, 22 insertions, 181 deletions
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<std::list<parser::CoarrayAssociation>>(x.t));
CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
@@ -169,64 +156,6 @@ 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 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