diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp index 6bed525d7f687..833a08899308a 100644 --- a/flang/lib/Semantics/check-coarray.cpp +++ b/flang/lib/Semantics/check-coarray.cpp @@ -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" @@ -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 &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); } } @@ -260,7 +264,51 @@ void CoarrayChecker::Leave(const parser::EventWaitStmt &x) { context_, std::get>(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(x.t)); + bool gotAcquired{false}, gotStat{false}, gotMsg{false}; + for (const parser::LockStmt::LockStat &lockStat : + std::get>(x.t)) { + if (const auto *statOrErrmsg{ + std::get_if(&lockStat.u)}) { + CheckSyncStat(context_, *statOrErrmsg, gotStat, gotMsg); + } else { + CHECK(std::holds_alternative< + parser::Scalar>>(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(x.t)); CheckSyncStatList(context_, std::get>(x.t)); } diff --git a/flang/lib/Semantics/check-coarray.h b/flang/lib/Semantics/check-coarray.h index 0af9a880fd31a..a968585b48be7 100644 --- a/flang/lib/Semantics/check-coarray.h +++ b/flang/lib/Semantics/check-coarray.h @@ -28,6 +28,7 @@ struct SyncAllStmt; struct SyncImagesStmt; struct SyncMemoryStmt; struct SyncTeamStmt; +struct LockStmt; struct UnlockStmt; } // namespace Fortran::parser @@ -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 &); diff --git a/flang/test/Semantics/lockstmt03.f90 b/flang/test/Semantics/lockstmt03.f90 index 8079bc5c7c85c..8ebe3de62d7ee 100644 --- a/flang/test/Semantics/lockstmt03.f90 +++ b/flang/test/Semantics/lockstmt03.f90 @@ -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. @@ -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) @@ -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