Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
96 changes: 72 additions & 24 deletions flang/lib/Semantics/check-coarray.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
//===----------------------------------------------------------------------===//

#include "check-coarray.h"
#include "definable.h"
#include "flang/Common/indirection.h"
#include "flang/Evaluate/expression.h"
#include "flang/Parser/message.h"
Expand Down Expand Up @@ -96,34 +97,37 @@ static void CheckCoindexedStatOrErrmsg(SemanticsContext &context,
Fortran::common::visit(CoindexedCheck, statOrErrmsg.u);
}

static void CheckSyncStat(SemanticsContext &context,
const parser::StatOrErrmsg &statOrErrmsg, bool &gotStat, bool &gotMsg) {
common::visit(
common::visitors{
[&](const parser::StatVariable &stat) {
if (gotStat) {
context.Say( // C1172
"The stat-variable in a sync-stat-list may not be repeated"_err_en_US);
}
gotStat = true;
},
[&](const parser::MsgVariable &var) {
WarnOnDeferredLengthCharacterScalar(context, GetExpr(context, var),
var.v.thing.thing.GetSource(), "ERRMSG=");
if (gotMsg) {
context.Say( // C1172
"The errmsg-variable in a sync-stat-list may not be repeated"_err_en_US);
}
gotMsg = true;
},
},
statOrErrmsg.u);

CheckCoindexedStatOrErrmsg(context, statOrErrmsg, "sync-stat-list");
}

static void CheckSyncStatList(
SemanticsContext &context, const std::list<parser::StatOrErrmsg> &list) {
bool gotStat{false}, gotMsg{false};

for (const parser::StatOrErrmsg &statOrErrmsg : list) {
common::visit(
common::visitors{
[&](const parser::StatVariable &stat) {
if (gotStat) {
context.Say( // C1172
"The stat-variable in a sync-stat-list may not be repeated"_err_en_US);
}
gotStat = true;
},
[&](const parser::MsgVariable &var) {
WarnOnDeferredLengthCharacterScalar(context,
GetExpr(context, var), var.v.thing.thing.GetSource(),
"ERRMSG=");
if (gotMsg) {
context.Say( // C1172
"The errmsg-variable in a sync-stat-list may not be repeated"_err_en_US);
}
gotMsg = true;
},
},
statOrErrmsg.u);

CheckCoindexedStatOrErrmsg(context, statOrErrmsg, "sync-stat-list");
CheckSyncStat(context, statOrErrmsg, gotStat, gotMsg);
}
}

Expand Down Expand Up @@ -260,7 +264,51 @@ void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
context_, std::get<std::list<parser::EventWaitSpec>>(x.t));
}

static void CheckLockVariable(
SemanticsContext &context, const parser::LockVariable &lockVar) {
if (const SomeExpr * expr{GetExpr(lockVar)}) {
if (auto dyType{expr->GetType()}) {
auto at{parser::FindSourceLocation(lockVar)};
if (dyType->category() != TypeCategory::Derived ||
dyType->IsUnlimitedPolymorphic() ||
!IsLockType(&dyType->GetDerivedTypeSpec())) {
context.Say(at,
"Lock variable must have type LOCK_TYPE from ISO_FORTRAN_ENV"_err_en_US);
} else if (auto whyNot{WhyNotDefinable(at, context.FindScope(at),
{DefinabilityFlag::DoNotNoteDefinition,
DefinabilityFlag::AllowEventLockOrNotifyType},
*expr)}) {
whyNot->set_severity(parser::Severity::Because);
context.Say(at, "Lock variable is not definable"_err_en_US)
.Attach(std::move(*whyNot));
}
}
}
}

void CoarrayChecker::Leave(const parser::LockStmt &x) {
CheckLockVariable(context_, std::get<parser::LockVariable>(x.t));
bool gotAcquired{false}, gotStat{false}, gotMsg{false};
for (const parser::LockStmt::LockStat &lockStat :
std::get<std::list<parser::LockStmt::LockStat>>(x.t)) {
if (const auto *statOrErrmsg{
std::get_if<parser::StatOrErrmsg>(&lockStat.u)}) {
CheckSyncStat(context_, *statOrErrmsg, gotStat, gotMsg);
} else {
CHECK(std::holds_alternative<
parser::Scalar<parser::Logical<parser::Variable>>>(lockStat.u));
if (gotAcquired) {
context_.Say(parser::FindSourceLocation(lockStat),
"Multiple ACQUIRED_LOCK specifiers"_err_en_US);
} else {
gotAcquired = true;
}
}
}
}

void CoarrayChecker::Leave(const parser::UnlockStmt &x) {
CheckLockVariable(context_, std::get<parser::LockVariable>(x.t));
CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
}

Expand Down
2 changes: 2 additions & 0 deletions flang/lib/Semantics/check-coarray.h
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ struct SyncAllStmt;
struct SyncImagesStmt;
struct SyncMemoryStmt;
struct SyncTeamStmt;
struct LockStmt;
struct UnlockStmt;
} // namespace Fortran::parser

Expand All @@ -45,6 +46,7 @@ class CoarrayChecker : public virtual BaseChecker {
void Leave(const parser::NotifyWaitStmt &);
void Leave(const parser::EventPostStmt &);
void Leave(const parser::EventWaitStmt &);
void Leave(const parser::LockStmt &);
void Leave(const parser::UnlockStmt &);
void Leave(const parser::CriticalStmt &);
void Leave(const parser::ImageSelector &);
Expand Down
52 changes: 34 additions & 18 deletions flang/test/Semantics/lockstmt03.f90
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
! XFAIL: *
! This test checks for semantic errors in lock statements based on the
! statement specification in section 11.6.10 of the Fortran 2018 standard.

Expand All @@ -10,14 +9,16 @@ program test_lock_stmt
character(len=128) error_message, msg_array(10), coindexed_msg[*], repeated_msg
integer status, stat_array(10), coindexed_int[*], non_bool, repeated_stat
logical non_integer, bool, bool_array(10), non_char, coindexed_logical[*], repeated_bool
type(lock_type) :: lock_var[*], lock_array(10)[*], non_coarray_lock
type(lock_type) :: lock_var[*], lock_array(10)[*]
!ERROR: Variable 'non_coarray_lock' with EVENT_TYPE or LOCK_TYPE must be a coarray
type(lock_type) :: non_coarray_lock
type(event_type) :: not_lock_var[*]

!___ non-standard-conforming statements ___

! type mismatches

!ERROR: to be determined
!ERROR: Lock variable must have type LOCK_TYPE from ISO_FORTRAN_ENV
lock(not_lock_var)

!ERROR: Must have LOGICAL type, but is INTEGER(4)
Expand Down Expand Up @@ -45,50 +46,65 @@ program test_lock_stmt

! corank mismatch

!ERROR: to be determined
lock(non_coarray_lock)
lock(non_coarray_lock) ! caught above

! C1173 - stat-variable and errmsg-variable shall not be a coindexed object

!ERROR: to be determined
!ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
lock(lock_var, stat=coindexed_int[1])

!ERROR: to be determined
!ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
lock(lock_var, errmsg=coindexed_msg[1])

!ERROR: to be determined
!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
lock(lock_var, acquired_lock=coindexed_logical[1], stat=coindexed_int[1], errmsg=coindexed_msg[1])

! C1181 - No specifier shall appear more than once in a given lock-stat-list

!ERROR: to be determined
!ERROR: Multiple ACQUIRED_LOCK specifiers
lock(lock_var, acquired_lock=bool, acquired_lock=repeated_bool)

!ERROR: to be determined
!ERROR: The stat-variable in a sync-stat-list may not be repeated
lock(lock_var, stat=status, stat=repeated_stat)

!ERROR: to be determined
!ERROR: The errmsg-variable in a sync-stat-list may not be repeated
lock(lock_var, errmsg=error_message, errmsg=repeated_msg)

!ERROR: to be determined
!ERROR: Multiple ACQUIRED_LOCK specifiers
lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, acquired_lock=repeated_bool)

!ERROR: to be determined
!ERROR: The stat-variable in a sync-stat-list may not be repeated
lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, stat=repeated_stat)

!ERROR: to be determined
!ERROR: The errmsg-variable in a sync-stat-list may not be repeated
lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, errmsg=repeated_msg)

!ERROR: to be determined
!ERROR: The stat-variable in a sync-stat-list may not be repeated
!ERROR: Multiple ACQUIRED_LOCK specifiers
lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, acquired_lock=repeated_bool, stat=repeated_stat)

!ERROR: to be determined
!ERROR: The errmsg-variable in a sync-stat-list may not be repeated
!ERROR: Multiple ACQUIRED_LOCK specifiers
lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, acquired_lock=repeated_bool, errmsg=repeated_msg)

!ERROR: to be determined
!ERROR: The stat-variable in a sync-stat-list may not be repeated
!ERROR: The errmsg-variable in a sync-stat-list may not be repeated
lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, stat=repeated_stat, errmsg=repeated_msg)

!ERROR: to be determined
!ERROR: The stat-variable in a sync-stat-list may not be repeated
!ERROR: The errmsg-variable in a sync-stat-list may not be repeated
!ERROR: Multiple ACQUIRED_LOCK specifiers
lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, acquired_lock=repeated_bool, stat=repeated_stat, errmsg=repeated_msg)

contains
subroutine lockit(x)
type(lock_type), intent(in) :: x[*]
!ERROR: Lock variable is not definable
!BECAUSE: 'x' is an INTENT(IN) dummy argument
lock(x)
!ERROR: Lock variable is not definable
!BECAUSE: 'x' is an INTENT(IN) dummy argument
unlock(x)
end
end program test_lock_stmt