[flang] Adding NOTIFY specifier in image selector and add notify type checks (#148810)
This PR adds support for the NOTIFY specifier in the image selector as
described in the 2023 standard, and add checks for the NOTIFY_TYPE type.
GitOrigin-RevId: 87fb7b002db39af9fbf9351cbd404cf14396bb93
diff --git a/examples/FeatureList/FeatureList.cpp b/examples/FeatureList/FeatureList.cpp
index ef58da6..bb55a81 100644
--- a/examples/FeatureList/FeatureList.cpp
+++ b/examples/FeatureList/FeatureList.cpp
@@ -348,6 +348,7 @@
READ_FEATURE(TeamValue)
READ_FEATURE(ImageSelector)
READ_FEATURE(ImageSelectorSpec)
+ READ_FEATURE(ImageSelectorSpec::Notify)
READ_FEATURE(ImageSelectorSpec::Stat)
READ_FEATURE(ImageSelectorSpec::Team_Number)
READ_FEATURE(ImplicitPart)
diff --git a/include/flang/Evaluate/traverse.h b/include/flang/Evaluate/traverse.h
index 48aafa8..d63c16f 100644
--- a/include/flang/Evaluate/traverse.h
+++ b/include/flang/Evaluate/traverse.h
@@ -146,7 +146,7 @@
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.notify(), x.stat(), x.team());
}
Result operator()(const DataRef &x) const { return visitor_(x.u); }
Result operator()(const Substring &x) const {
diff --git a/include/flang/Evaluate/variable.h b/include/flang/Evaluate/variable.h
index 5c14421..4f64ede 100644
--- a/include/flang/Evaluate/variable.h
+++ b/include/flang/Evaluate/variable.h
@@ -260,6 +260,9 @@
// it's TEAM=.
std::optional<Expr<SomeType>> team() const;
CoarrayRef &set_team(Expr<SomeType> &&);
+ // When notify() is Expr<Some>, it's NOTIFY=.
+ std::optional<Expr<SomeType>> notify() const;
+ CoarrayRef &set_notify(Expr<SomeType> &&);
int Rank() const;
int Corank() const { return 0; }
@@ -272,6 +275,7 @@
private:
common::CopyableIndirection<DataRef> base_;
std::vector<Expr<SubscriptInteger>> cosubscript_;
+ std::optional<common::CopyableIndirection<Expr<SomeType>>> notify_;
std::optional<common::CopyableIndirection<Expr<SomeInteger>>> stat_;
std::optional<common::CopyableIndirection<Expr<SomeType>>> team_;
};
diff --git a/include/flang/Parser/dump-parse-tree.h b/include/flang/Parser/dump-parse-tree.h
index de27164..b242402 100644
--- a/include/flang/Parser/dump-parse-tree.h
+++ b/include/flang/Parser/dump-parse-tree.h
@@ -387,6 +387,7 @@
NODE(parser, TeamValue)
NODE(parser, ImageSelector)
NODE(parser, ImageSelectorSpec)
+ NODE(ImageSelectorSpec, Notify)
NODE(ImageSelectorSpec, Stat)
NODE(ImageSelectorSpec, Team_Number)
NODE(parser, ImplicitPart)
diff --git a/include/flang/Parser/parse-tree.h b/include/flang/Parser/parse-tree.h
index 8c7578f..32e444f 100644
--- a/include/flang/Parser/parse-tree.h
+++ b/include/flang/Parser/parse-tree.h
@@ -1684,13 +1684,15 @@
WRAPPER_CLASS(TeamValue, Scalar<common::Indirection<Expr>>);
// R926 image-selector-spec ->
+// NOTIFY = notify-variable |
// STAT = stat-variable | TEAM = team-value |
// TEAM_NUMBER = scalar-int-expr
struct ImageSelectorSpec {
WRAPPER_CLASS(Stat, Scalar<Integer<common::Indirection<Variable>>>);
WRAPPER_CLASS(Team_Number, ScalarIntExpr);
+ WRAPPER_CLASS(Notify, Scalar<common::Indirection<Variable>>);
UNION_CLASS_BOILERPLATE(ImageSelectorSpec);
- std::variant<Stat, TeamValue, Team_Number> u;
+ std::variant<Notify, Stat, TeamValue, Team_Number> u;
};
// R924 image-selector ->
diff --git a/include/flang/Semantics/tools.h b/include/flang/Semantics/tools.h
index 8a7b986..1c34770 100644
--- a/include/flang/Semantics/tools.h
+++ b/include/flang/Semantics/tools.h
@@ -107,6 +107,7 @@
// 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
@@ -652,6 +653,8 @@
// 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/lib/Evaluate/variable.cpp b/lib/Evaluate/variable.cpp
index b9b34d4..b257dad 100644
--- a/lib/Evaluate/variable.cpp
+++ b/lib/Evaluate/variable.cpp
@@ -89,6 +89,14 @@
}
}
+std::optional<Expr<SomeType>> CoarrayRef::notify() const {
+ if (notify_) {
+ return notify_.value().value();
+ } else {
+ return std::nullopt;
+ }
+}
+
CoarrayRef &CoarrayRef::set_stat(Expr<SomeInteger> &&v) {
CHECK(IsVariable(v));
stat_.emplace(std::move(v));
@@ -100,6 +108,11 @@
return *this;
}
+CoarrayRef &CoarrayRef::set_notify(Expr<SomeType> &&v) {
+ notify_.emplace(std::move(v));
+ return *this;
+}
+
const Symbol &CoarrayRef::GetFirstSymbol() const {
return base().GetFirstSymbol();
}
diff --git a/lib/Lower/Support/Utils.cpp b/lib/Lower/Support/Utils.cpp
index 1b4d37e..4b95a3a 100644
--- a/lib/Lower/Support/Utils.cpp
+++ b/lib/Lower/Support/Utils.cpp
@@ -82,7 +82,7 @@
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 @@
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/lib/Parser/Fortran-parsers.cpp b/lib/Parser/Fortran-parsers.cpp
index 59fe7d8..ea6a1ea 100644
--- a/lib/Parser/Fortran-parsers.cpp
+++ b/lib/Parser/Fortran-parsers.cpp
@@ -1212,12 +1212,15 @@
// 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<ImageSelectorSpec>(construct<ImageSelectorSpec::Stat>(
"STAT =" >> scalar(integer(indirect(variable))))) ||
construct<ImageSelectorSpec>(construct<TeamValue>("TEAM =" >> teamValue)) ||
construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Team_Number>(
- "TEAM_NUMBER =" >> scalarIntExpr)))
+ "TEAM_NUMBER =" >> scalarIntExpr)) ||
+ construct<ImageSelectorSpec>(construct<ImageSelectorSpec::Notify>(
+ "NOTIFY =" >> scalar(indirect(variable)))))
// R927 allocate-stmt ->
// ALLOCATE ( [type-spec ::] allocation-list [, alloc-opt-list] )
diff --git a/lib/Parser/unparse.cpp b/lib/Parser/unparse.cpp
index 8412303..6bb14a4 100644
--- a/lib/Parser/unparse.cpp
+++ b/lib/Parser/unparse.cpp
@@ -819,6 +819,7 @@
Word("TEAM=");
}
}
+ void Before(const ImageSelectorSpec::Notify &) { Word("NOTIFY="); }
void Unparse(const AllocateStmt &x) { // R927
Word("ALLOCATE(");
Walk(std::get<std::optional<TypeSpec>>(x.t), "::");
diff --git a/lib/Semantics/check-declarations.cpp b/lib/Semantics/check-declarations.cpp
index de407d3..9a6b3ff 100644
--- a/lib/Semantics/check-declarations.cpp
+++ b/lib/Semantics/check-declarations.cpp
@@ -855,6 +855,15 @@
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());
}
}
}
@@ -873,6 +882,10 @@
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/lib/Semantics/dump-expr.cpp b/lib/Semantics/dump-expr.cpp
index 66cedab..8d354cf 100644
--- a/lib/Semantics/dump-expr.cpp
+++ b/lib/Semantics/dump-expr.cpp
@@ -23,6 +23,7 @@
Indent("coarray ref");
Show(x.base());
Show(x.cosubscript());
+ Show(x.notify());
Show(x.stat());
Show(x.team());
Outdent();
diff --git a/lib/Semantics/expression.cpp b/lib/Semantics/expression.cpp
index c8167fd..ac58dfc 100644
--- a/lib/Semantics/expression.cpp
+++ b/lib/Semantics/expression.cpp
@@ -1579,6 +1579,19 @@
std::get<std::list<parser::ImageSelectorSpec>>(x.imageSelector.t)) {
common::visit(
common::visitors{
+ [&](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<SomeType>{*expr});
+ } else {
+ Say("NOTIFY= specifier must have type NOTIFY_TYPE from ISO_FORTRAN_ENV"_err_en_US);
+ }
+ }
+ },
[&](const parser::ImageSelectorSpec::Stat &x) {
Analyze(x.v);
if (const auto *expr{GetExpr(context_, x.v)}) {
diff --git a/lib/Semantics/tools.cpp b/lib/Semantics/tools.cpp
index 8eddd03..cf1e5e7 100644
--- a/lib/Semantics/tools.cpp
+++ b/lib/Semantics/tools.cpp
@@ -582,6 +582,18 @@
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)) {
@@ -1489,6 +1501,32 @@
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<ObjectEntityDetails>()}) {
+ 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/test/Semantics/coarrays02.f90 b/test/Semantics/coarrays02.f90
index b16e0cc..e866dd8 100644
--- a/test/Semantics/coarrays02.f90
+++ b/test/Semantics/coarrays02.f90
@@ -16,6 +16,8 @@
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 @@
!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/test/Semantics/notifywait03.f90 b/test/Semantics/notifywait03.f90
index 0fc56f6..a336a7a 100644
--- a/test/Semantics/notifywait03.f90
+++ b/test/Semantics/notifywait03.f90
@@ -10,6 +10,7 @@
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)[*]
