diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp index a36b8719e365d..eff4eb6a537cb 100644 --- a/flang/examples/FeatureList/FeatureList.cpp +++ b/flang/examples/FeatureList/FeatureList.cpp @@ -350,6 +350,7 @@ struct NodeVisitor { READ_FEATURE(ImageSelectorSpec) READ_FEATURE(ImageSelectorSpec::Stat) READ_FEATURE(ImageSelectorSpec::Team_Number) + READ_FEATURE(ImageSelectorSpec::Notify) READ_FEATURE(ImplicitPart) READ_FEATURE(ImplicitPartStmt) READ_FEATURE(ImplicitSpec) diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h index 48aafa8982559..9a6978b6be6f7 100644 --- a/flang/include/flang/Evaluate/traverse.h +++ b/flang/include/flang/Evaluate/traverse.h @@ -146,7 +146,7 @@ class Traverse { return Combine(x.base(), x.subscript()); } Result operator()(const CoarrayRef &x) const { - return Combine(x.base(), x.cosubscript(), x.stat(), x.team()); + return Combine(x.base(), x.cosubscript(), x.stat(), x.team(), x.notify()); } Result operator()(const DataRef &x) const { return visitor_(x.u); } Result operator()(const Substring &x) const { diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h index 5c14421fd3a1b..6f1716f6e44b5 100644 --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -260,6 +260,9 @@ class CoarrayRef { // it's TEAM=. std::optional> team() const; CoarrayRef &set_team(Expr &&); + // When notify() is Expr, it's NOTIFY=. + std::optional> notify() const; + CoarrayRef &set_notify(Expr &&); int Rank() const; int Corank() const { return 0; } @@ -274,6 +277,7 @@ class CoarrayRef { std::vector> cosubscript_; std::optional>> stat_; std::optional>> team_; + std::optional>> notify_; }; // R911 data-ref is defined syntactically as a series of part-refs, which diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h index e3eed6aed8079..0186181cb43d6 100644 --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -385,6 +385,7 @@ class ParseTreeDumper { NODE(parser, ImageSelectorSpec) NODE(ImageSelectorSpec, Stat) NODE(ImageSelectorSpec, Team_Number) + NODE(ImageSelectorSpec, Notify) NODE(parser, ImplicitPart) NODE(parser, ImplicitPartStmt) NODE(parser, ImplicitSpec) diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h index 7e752eeb4dfe4..518be9b33a493 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -1682,12 +1682,14 @@ WRAPPER_CLASS(TeamValue, Scalar>); // R926 image-selector-spec -> // STAT = stat-variable | TEAM = team-value | -// TEAM_NUMBER = scalar-int-expr +// TEAM_NUMBER = scalar-int-expr | +// NOTIFY = notify-variable struct ImageSelectorSpec { WRAPPER_CLASS(Stat, Scalar>>); WRAPPER_CLASS(Team_Number, ScalarIntExpr); + WRAPPER_CLASS(Notify, Scalar>); UNION_CLASS_BOILERPLATE(ImageSelectorSpec); - std::variant u; + std::variant u; }; // R924 image-selector -> diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index fb670528f3ce4..e230620f5fcd3 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -107,6 +107,7 @@ bool IsBindCProcedure(const Scope &); // Returns a pointer to the function's symbol when true, else null const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &); bool IsOrContainsEventOrLockComponent(const Symbol &); +bool IsOrContainsNotifyComponent(const Symbol &); bool CanBeTypeBoundProc(const Symbol &); // Does a non-PARAMETER symbol have explicit initialization with =value or // =>target in its declaration (but not in a DATA statement)? (Being @@ -642,6 +643,8 @@ using PotentialAndPointerComponentIterator = // dereferenced. PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent( const DerivedTypeSpec &, bool ignoreCoarrays = false); +PotentialComponentIterator::const_iterator FindNotifyPotentialComponent( + const DerivedTypeSpec &, bool ignoreCoarrays = false); PotentialComponentIterator::const_iterator FindCoarrayPotentialComponent( const DerivedTypeSpec &); PotentialAndPointerComponentIterator::const_iterator diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index d1bff03a6ea5f..41003a2e53a8d 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -89,6 +89,14 @@ std::optional> CoarrayRef::team() const { } } +std::optional> CoarrayRef::notify() const { + if (notify_) { + return notify_.value().value(); + } else { + return std::nullopt; + } +} + CoarrayRef &CoarrayRef::set_stat(Expr &&v) { CHECK(IsVariable(v)); stat_.emplace(std::move(v)); @@ -100,6 +108,11 @@ CoarrayRef &CoarrayRef::set_team(Expr &&v) { return *this; } +CoarrayRef &CoarrayRef::set_notify(Expr &&v) { + notify_.emplace(std::move(v)); + return *this; +} + const Symbol &CoarrayRef::GetFirstSymbol() const { return base().GetFirstSymbol(); } diff --git a/flang/lib/Lower/Support/Utils.cpp b/flang/lib/Lower/Support/Utils.cpp index c65f51ce6cacd..30635b66bbd39 100644 --- a/flang/lib/Lower/Support/Utils.cpp +++ b/flang/lib/Lower/Support/Utils.cpp @@ -82,7 +82,7 @@ class HashEvaluateExpr { x.cosubscript()) cosubs -= getHashValue(v); return getHashValue(x.base()) * 97u - cosubs + getHashValue(x.stat()) + - 257u + getHashValue(x.team()); + 257u + getHashValue(x.team()) + getHashValue(x.notify()); } static unsigned getHashValue(const Fortran::evaluate::NamedEntity &x) { if (x.IsSymbol()) @@ -341,7 +341,8 @@ class IsEqualEvaluateExpr { const Fortran::evaluate::CoarrayRef &y) { return isEqual(x.base(), y.base()) && isEqual(x.cosubscript(), y.cosubscript()) && - isEqual(x.stat(), y.stat()) && isEqual(x.team(), y.team()); + isEqual(x.stat(), y.stat()) && isEqual(x.team(), y.team()) && + isEqual(x.notify(), y.notify()); } static bool isEqual(const Fortran::evaluate::NamedEntity &x, const Fortran::evaluate::NamedEntity &y) { diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp index fbe629ab52935..30bd807d16a46 100644 --- a/flang/lib/Parser/Fortran-parsers.cpp +++ b/flang/lib/Parser/Fortran-parsers.cpp @@ -1212,12 +1212,15 @@ TYPE_CONTEXT_PARSER("image selector"_en_US, // R926 image-selector-spec -> // STAT = stat-variable | TEAM = team-value | -// TEAM_NUMBER = scalar-int-expr +// TEAM_NUMBER = scalar-int-expr | +// NOTIFY = notify-variable TYPE_PARSER(construct(construct( "STAT =" >> scalar(integer(indirect(variable))))) || construct(construct("TEAM =" >> teamValue)) || construct(construct( - "TEAM_NUMBER =" >> scalarIntExpr))) + "TEAM_NUMBER =" >> scalarIntExpr)) || + construct(construct( + "NOTIFY =" >> scalar(indirect(variable))))) // R927 allocate-stmt -> // ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] ) diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index dcd1ac165adc1..942aacd777388 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -819,6 +819,7 @@ class UnparseVisitor { Word("TEAM="); } } + void Before(const ImageSelectorSpec::Notify &) { Word("NOTIFY="); } void Unparse(const AllocateStmt &x) { // R927 Word("ALLOCATE("); Walk(std::get>(x.t), "::"); diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index f9d64485f1407..644c3e1effc21 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -762,6 +762,15 @@ void CheckHelper::CheckObjectEntity( messages_.Say( "Variable '%s' with EVENT_TYPE or LOCK_TYPE potential component '%s' must be a coarray"_err_en_US, symbol.name(), component.BuildResultDesignatorName()); + } else if (IsNotifyType(derived)) { // C1612 + messages_.Say( + "Variable '%s' with NOTIFY_TYPE must be a coarray"_err_en_US, + symbol.name()); + } else if (auto component{FindNotifyPotentialComponent( // C1611 + *derived, /*ignoreCoarrays=*/true)}) { + messages_.Say( + "Variable '%s' with NOTIFY_TYPE potential component '%s' must be a coarray"_err_en_US, + symbol.name(), component.BuildResultDesignatorName()); } } } @@ -780,6 +789,10 @@ void CheckHelper::CheckObjectEntity( messages_.Say( "An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE"_err_en_US); } + if (IsOrContainsNotifyComponent(symbol)) { // C1613 + messages_.Say( + "An INTENT(OUT) dummy argument may not be, or contain, NOTIFY_TYPE"_err_en_US); + } if (IsAssumedSizeArray(symbol)) { // C834 if (type && type->IsPolymorphic()) { messages_.Say( diff --git a/flang/lib/Semantics/dump-expr.cpp b/flang/lib/Semantics/dump-expr.cpp index 66cedab94bfb4..bd7373abffb31 100644 --- a/flang/lib/Semantics/dump-expr.cpp +++ b/flang/lib/Semantics/dump-expr.cpp @@ -25,6 +25,7 @@ void DumpEvaluateExpr::Show(const evaluate::CoarrayRef &x) { Show(x.cosubscript()); Show(x.stat()); Show(x.team()); + Show(x.notify()); Outdent(); } diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index f4af738284ed7..b96dd77ac964c 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1596,6 +1596,19 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) { coarrayRef.set_team(Expr{*expr}); } } + }, + [&](const parser::ImageSelectorSpec::Notify &x) { + Analyze(x.v); + if (const auto *expr{GetExpr(context_, x.v)}) { + if (coarrayRef.notify()) { + Say("coindexed reference has multiple NOTIFY= specifiers"_err_en_US); + } else if (auto dyType{expr->GetType()}; + dyType && IsNotifyType(GetDerivedTypeSpec(*dyType))) { + coarrayRef.set_notify(Expr{*expr}); + } else { + Say("NOTIFY= specifier must have type NOTIFY_TYPE from ISO_FORTRAN_ENV"_err_en_US); + } + } }}, imageSelSpec.u); } diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index d27d250b3f11e..bc7a754cfc0d9 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -582,6 +582,18 @@ bool IsOrContainsEventOrLockComponent(const Symbol &original) { return false; } +bool IsOrContainsNotifyComponent(const Symbol &original) { + const Symbol &symbol{ResolveAssociations(original, /*stopAtTypeGuard=*/true)}; + if (evaluate::IsVariable(symbol)) { + if (const DeclTypeSpec *type{symbol.GetType()}) { + if (const DerivedTypeSpec *derived{type->AsDerived()}) { + return IsNotifyType(derived) || FindNotifyPotentialComponent(*derived); + } + } + } + return false; +} + // Check this symbol suitable as a type-bound procedure - C769 bool CanBeTypeBoundProc(const Symbol &symbol) { if (IsDummy(symbol) || IsProcedurePointer(symbol)) { @@ -1464,6 +1476,32 @@ PotentialComponentIterator::const_iterator FindEventOrLockPotentialComponent( return iter; } +PotentialComponentIterator::const_iterator FindNotifyPotentialComponent( + const DerivedTypeSpec &derived, bool ignoreCoarrays) { + PotentialComponentIterator potentials{derived}; + auto iter{potentials.begin()}; + for (auto end{potentials.end()}; iter != end; ++iter) { + const Symbol &component{*iter}; + if (const auto *object{component.detailsIf()}) { + if (const DeclTypeSpec *type{object->type()}) { + if (IsNotifyType(type->AsDerived())) { + if (!ignoreCoarrays) { + break; // found one + } + auto path{iter.GetComponentPath()}; + path.pop_back(); + if (std::find_if(path.begin(), path.end(), [](const Symbol &sym) { + return evaluate::IsCoarray(sym); + }) == path.end()) { + break; // found one not in a coarray + } + } + } + } + } + return iter; +} + UltimateComponentIterator::const_iterator FindAllocatableUltimateComponent( const DerivedTypeSpec &derived) { UltimateComponentIterator ultimates{derived}; diff --git a/flang/test/Semantics/coarrays02.f90 b/flang/test/Semantics/coarrays02.f90 index b16e0ccb58797..e866dd89c07ab 100644 --- a/flang/test/Semantics/coarrays02.f90 +++ b/flang/test/Semantics/coarrays02.f90 @@ -16,6 +16,8 @@ program main type(event_type) event !ERROR: Variable 'lock' with EVENT_TYPE or LOCK_TYPE must be a coarray type(lock_type) lock + !ERROR: Variable 'notify' with NOTIFY_TYPE must be a coarray + type(notify_type) notify integer :: local[*] ! ok in main end @@ -120,3 +122,18 @@ subroutine s4 !ERROR: Subscripts must appear in a coindexed reference when its base is an array print *, ta(1)%a[1] end + +subroutine s5(a, notify, res) + use iso_fortran_env + type t + type(notify_type) :: a + end type + real, intent(in) :: a[*] + type(event_type), intent(in) :: notify[*] + !ERROR: An INTENT(OUT) dummy argument may not be, or contain, NOTIFY_TYPE + type(notify_type), intent(out) :: res[*] + !ERROR: Variable 'bad' with NOTIFY_TYPE potential component '%a' must be a coarray + type(t) :: bad + !ERROR: NOTIFY= specifier must have type NOTIFY_TYPE from ISO_FORTRAN_ENV + print *, a[1, NOTIFY=notify] +end diff --git a/flang/test/Semantics/notifywait03.f90 b/flang/test/Semantics/notifywait03.f90 index 0fc56f66ad32d..a336a7a67669a 100644 --- a/flang/test/Semantics/notifywait03.f90 +++ b/flang/test/Semantics/notifywait03.f90 @@ -10,6 +10,7 @@ program test_notify_wait implicit none ! notify_type variables must be coarrays + !ERROR: Variable 'non_coarray' with NOTIFY_TYPE must be a coarray type(notify_type) :: non_coarray type(notify_type) :: notify_var[*], notify_array(2)[*]