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?
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");
}
}
bool IsEventTypeOrLockType(const DerivedTypeSpec *derivedTypeSpec) {
- return IsBuiltinDerivedType(derivedTypeSpec, "event_type") ||
- IsBuiltinDerivedType(derivedTypeSpec, "lock_type");
+ return IsEventType(derivedTypeSpec) || IsLockType(derivedTypeSpec);
}
int CountLenParameters(const DerivedTypeSpec &type) {
}
}
+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));
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;
class MessageFixedText;
struct ChangeTeamStmt;
struct CoarrayAssociation;
+struct EventPostStmt;
+struct EventWaitStmt;
struct FormTeamStmt;
struct ImageSelector;
struct SyncAllStmt;
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 &);
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
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)
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)
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)
!______ 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
!______ 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
!_________________________ 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
!______ 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