[flang-commits] [flang] [flang] Fix NOTIFY= placement checking and folding (PR #231660)
via flang-commits
flang-commits at lists.llvm.org
Tue Oct 13 15:50:58 PDT 2026
https://github.com/MattPD updated https://github.com/llvm/llvm-project/pull/231660
>From 19f5f845e393f0fb60eb3d9c3822e8b6dce05abb Mon Sep 17 00:00:00 2001
From: Matt <matt-p.dziubinski at hpe.com>
Date: Tue, 13 Oct 2026 16:04:31 -0500
Subject: [PATCH] [flang] Fix NOTIFY= placement checking and folding
F2023 C933 permits NOTIFY= only in the image selector of an intrinsic
assignment's target variable. Semantic analysis currently accepts it in
other contexts.
Assignment checking reuses the analyzed assignment's classification as
intrinsic or defined. For intrinsic assignment, an existing parse-tree
helper identifies the target variable's own image selector. The new
check permits a NOTIFY= specifier only if its parse-tree node belongs to
that selector's specifier list. It rejects NOTIFY= on separate
designators nested within the target variable.
If an operand error prevents assignment analysis, the checker avoids an
extra placement diagnostic on the target's own selector. Existing
duplicate-specifier diagnostics remain unchanged.
FoldOperation(CoarrayRef) currently drops NOTIFY= from the rebuilt
reference. The change retains and folds the notification expression and
renders it in Fortran output.
CoarrayRef comparison continues to ignore NOTIFY= because the annotation
does not change the designated variable. OpenMP and OpenACC atomic
checks can therefore still match references to the same atomic variable.
Fixes https://github.com/llvm/llvm-project/issues/230633
Assisted-by: GPT-6.1 Sol, GPT-5.6 Sol, Claude Opus 5.5.
---
flang/lib/Evaluate/fold.cpp | 3 +
flang/lib/Evaluate/formatting.cpp | 4 +
flang/lib/Semantics/assignment.cpp | 38 +++-
flang/lib/Semantics/assignment.h | 2 +
flang/test/Semantics/coarrays02.f90 | 1 +
.../Semantics/notify-assignment-errors.f90 | 171 ++++++++++++++++++
.../Semantics/notify-assignment-valid.f90 | 143 +++++++++++++++
flang/unittests/Evaluate/expression.cpp | 80 ++++++++
8 files changed, 439 insertions(+), 3 deletions(-)
create mode 100644 flang/test/Semantics/notify-assignment-errors.f90
create mode 100644 flang/test/Semantics/notify-assignment-valid.f90
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index 6cf5a654b648d..b2102ccc85d70 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -172,6 +172,9 @@ CoarrayRef FoldOperation(FoldingContext &context, CoarrayRef &&coarrayRef) {
if (std::optional<Expr<SomeInteger>> stat{coarrayRef.stat()}) {
folded.set_stat(Fold(context, std::move(*stat)));
}
+ if (std::optional<Expr<SomeType>> notify{coarrayRef.notify()}) {
+ folded.set_notify(Fold(context, std::move(*notify)));
+ }
if (std::optional<Expr<SomeType>> team{coarrayRef.team()}) {
folded.set_team(Fold(context, std::move(*team)));
}
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 161372e3ab61b..08c72a7d46c09 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -810,6 +810,10 @@ llvm::raw_ostream &CoarrayRef::AsFortran(llvm::raw_ostream &o) const {
EmitVar(o << separator, stat_, "STAT=");
separator = ',';
}
+ if (notify_) {
+ EmitVar(o << separator, notify_, "NOTIFY=");
+ separator = ',';
+ }
if (team_) {
EmitVar(o << separator, team_,
std::holds_alternative<Expr<SomeInteger>>(team_->value().u)
diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp
index 46cf271cf05af..dcc74e0379a59 100644
--- a/flang/lib/Semantics/assignment.cpp
+++ b/flang/lib/Semantics/assignment.cpp
@@ -16,9 +16,11 @@
#include "flang/Evaluate/tools.h"
#include "flang/Parser/message.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
#include "flang/Semantics/expression.h"
#include "flang/Semantics/symbol.h"
#include "flang/Semantics/tools.h"
+#include <list>
#include <optional>
#include <string>
@@ -37,6 +39,7 @@ class AssignmentContext {
void PopWhereContext();
void Analyze(const parser::AssignmentStmt &);
void Analyze(const parser::PointerAssignmentStmt &);
+ void Analyze(const parser::ImageSelectorSpec &);
SemanticsContext &context() { return context_; }
private:
@@ -54,17 +57,27 @@ class AssignmentContext {
int whereDepth_{0}; // number of WHEREs currently nested in
// shape of masks in LHS of assignments in current WHERE:
std::vector<std::optional<std::int64_t>> whereExtents_;
+ const parser::ImageSelector *notifySelector_{nullptr};
};
void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
- if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
+ const evaluate::Assignment *assignment{GetAssignment(stmt)};
+ bool isDefinedAssignment{assignment &&
+ std::holds_alternative<evaluate::ProcedureRef>(assignment->u)};
+ notifySelector_ = nullptr;
+ // Preserve the target's selector during operand-error recovery.
+ if (!isDefinedAssignment) {
+ if (const auto *coindexed{parser::GetCoindexedNamedObject(
+ std::get<parser::Variable>(stmt.t))}) {
+ notifySelector_ = &std::get<parser::ImageSelector>(coindexed->t);
+ }
+ }
+ if (assignment) {
const SomeExpr &lhs{assignment->lhs};
const SomeExpr &rhs{assignment->rhs};
auto lhsLoc{std::get<parser::Variable>(stmt.t).GetSource()};
const Scope &scope{context_.FindScope(lhsLoc)};
DefinabilityFlags flags{DefinabilityFlag::VectorSubscriptIsOk};
- bool isDefinedAssignment{
- std::holds_alternative<evaluate::ProcedureRef>(assignment->u)};
if (isDefinedAssignment) {
flags.set(DefinabilityFlag::AllowEventLockOrNotifyType);
} else if (const Symbol *
@@ -99,6 +112,22 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
}
}
+void AssignmentContext::Analyze(const parser::ImageSelectorSpec &spec) {
+ if (const auto *notify{
+ std::get_if<parser::ImageSelectorSpec::Notify>(&spec.u)}) {
+ if (notifySelector_) {
+ for (const auto &lhsSpec :
+ std::get<std::list<parser::ImageSelectorSpec>>(notifySelector_->t)) {
+ if (&lhsSpec == &spec) {
+ return;
+ }
+ }
+ }
+ Say(parser::FindSourceLocation(notify->v), // F2023 C933
+ "NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement"_err_en_US);
+ }
+}
+
void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
CHECK(whereDepth_ == 0);
if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
@@ -220,6 +249,9 @@ void AssignmentChecker::Enter(const parser::AssignmentStmt &x) {
void AssignmentChecker::Enter(const parser::PointerAssignmentStmt &x) {
context_.value().Analyze(x);
}
+void AssignmentChecker::Enter(const parser::ImageSelectorSpec &x) {
+ context_.value().Analyze(x);
+}
void AssignmentChecker::Enter(const parser::WhereStmt &x) {
context_.value().PushWhereContext(x);
}
diff --git a/flang/lib/Semantics/assignment.h b/flang/lib/Semantics/assignment.h
index 193feb8b92d3d..126d8dc109850 100644
--- a/flang/lib/Semantics/assignment.h
+++ b/flang/lib/Semantics/assignment.h
@@ -17,6 +17,7 @@ namespace Fortran::parser {
class ContextualMessages;
struct AssignmentStmt;
struct EndWhereStmt;
+struct ImageSelectorSpec;
struct MaskedElsewhereStmt;
struct PointerAssignmentStmt;
struct WhereConstructStmt;
@@ -40,6 +41,7 @@ class AssignmentChecker : public virtual BaseChecker {
void Enter(const parser::OmpDeclareReductionDirective &x);
void Enter(const parser::AssignmentStmt &);
void Enter(const parser::PointerAssignmentStmt &);
+ void Enter(const parser::ImageSelectorSpec &);
void Enter(const parser::WhereStmt &);
void Leave(const parser::WhereStmt &);
void Enter(const parser::WhereConstructStmt &);
diff --git a/flang/test/Semantics/coarrays02.f90 b/flang/test/Semantics/coarrays02.f90
index e866dd89c07ab..475361d9262c6 100644
--- a/flang/test/Semantics/coarrays02.f90
+++ b/flang/test/Semantics/coarrays02.f90
@@ -135,5 +135,6 @@ subroutine s5(a, notify, 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
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
print *, a[1, NOTIFY=notify]
end
diff --git a/flang/test/Semantics/notify-assignment-errors.f90 b/flang/test/Semantics/notify-assignment-errors.f90
new file mode 100644
index 0000000000000..e812c0aa616ec
--- /dev/null
+++ b/flang/test/Semantics/notify-assignment-errors.f90
@@ -0,0 +1,171 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=51 -fopenacc
+! F2023 C933
+
+module notify_defined_assignment
+ type t
+ integer :: value
+ integer :: values(4)
+ end type
+ interface assignment(=)
+ module procedure assign_integer
+ end interface
+contains
+ subroutine assign_integer(lhs, rhs)
+ type(t), intent(out) :: lhs
+ integer, intent(in) :: rhs
+ lhs%value = rhs
+ end subroutine
+ subroutine host_associated_assignment
+ use iso_fortran_env, only: notify_type
+ type(t), save :: d[*]
+ type(notify_type), save :: n[*]
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ d[1, notify=n] = 1
+ end subroutine
+end module
+
+module notify_type_bound_assignment
+ type t
+ integer :: value
+ contains
+ procedure :: assign_integer
+ generic :: assignment(=) => assign_integer
+ end type
+contains
+ subroutine assign_integer(lhs, rhs)
+ class(t), intent(out) :: lhs
+ integer, intent(in) :: rhs
+ lhs%value = rhs
+ end subroutine
+end module
+
+program invalid_notify_contexts
+ use iso_fortran_env, only: notify_type, event_type, team_type
+ use notify_defined_assignment
+ use notify_type_bound_assignment, only: bound_t => t
+ implicit none
+ integer, target :: a(4)[*], b[*], local(4)
+ integer :: i
+ integer, pointer :: q, qa(:)
+ type(event_type) :: e[*]
+ type(notify_type) :: n[*], na(4)[*]
+ type(team_type) :: teams(4)
+ character(8) :: text[*]
+ type(t) :: d[*]
+ type(bound_t) :: bound_d[*]
+
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ event post(e[1, notify=n])
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ b = a(1)[1, notify=n]
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ call consume(a(1)[1, notify=n])
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ print *, a(1)[1, notify=n]
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ a(1)[1, notify=n] = a(2)[1, notify=n]
+ !ERROR: A coindexed object may not be a pointer target
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ q => a(1)[1, notify=n]
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ qa(a(1)[1, notify=n]:) => local
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ d[1, notify=n] = 1
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ bound_d[1, notify=n] = 1
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ where (a(:)[1, notify=n] > 0) a(:)[1] = 1
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ forall (i=1:a(1)[1, notify=n]) a(i)[1] = 1
+ a(1)[1, notify=n] = 1
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ print *, a(1)[1, notify=n]
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ pointer_result(a(1)[1, notify=n]) = 1
+
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ a(b[1, notify=n])[2] = 15
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ local(b[1, notify=n]) = 16
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ a(b[1, notify=n])[2, &
+ notify=na(1)] = 17
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ text[1](b[1, notify=n]:4) = 'abc'
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ a(1)[b[1, notify=n], &
+ notify=n] = 18
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ d[1]%values(b[1, notify=n]) = 18
+ a(1)[1, notify=na( &
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ b[1, notify=n])] = 19
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ a(1)[1, stat=local(b[1, notify=n])] = 20
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ a(1)[1, team=teams(b[1, notify=n])] = 21
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ a(1)[1, team_number=b[1, notify=n]] = 22
+ b[1, notify=n[2, &
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ notify=n]] = 23
+ !ERROR: coindexed reference has multiple NOTIFY= specifiers
+ b[1, notify=n, notify=n] = 24
+
+ !$omp atomic write
+ !WARNING: Within atomic operation b[1_8,NOTIFY=n] and b[1_8]+1_4 access the same storage
+ b[1, notify=n] = b[1] + 1
+ !$acc atomic write
+ !ERROR: The RHS of this atomic write statement cannot reference the atomic variable: b[1_8,NOTIFY=n]
+ b[1, notify=n] = b[1] + 1
+ !$omp atomic update
+ !ERROR: The atomic variable b[1_8,NOTIFY=n] should appear as an argument of the top-level + operator
+ b[1, notify=n] = b[2] + 1
+ !$acc atomic update
+ !ERROR: The RHS of this atomic update statement must reference the updated variable: b[1_8,NOTIFY=n]
+ b[1, notify=n] = b[2] + 1
+contains
+ subroutine consume(x)
+ integer, intent(in) :: x
+ end subroutine
+ function pointer_result(i) result(p)
+ integer, intent(in) :: i
+ integer, pointer :: p
+ p => local(i)
+ end function
+end program
+
+subroutine renamed_defined_assignment
+ use iso_fortran_env, only: notify_type
+ use notify_defined_assignment, only: t, renamed => assign_integer
+ interface assignment(=)
+ procedure renamed
+ end interface
+ type(t), save :: d[*]
+ type(notify_type), save :: n[*]
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ d[1, notify=n] = 1
+end subroutine
+
+subroutine failed_assignment_analysis
+ use iso_fortran_env, only: notify_type
+ use notify_defined_assignment, only: t
+ implicit none
+ integer, save :: b[*]
+ type(notify_type), save :: n[*]
+ type(t), save :: d[*]
+ integer :: local(4)
+ !ERROR: No explicit type declared for 'undeclared'
+ b[1, notify=n] = undeclared
+ !ERROR: No explicit type declared for 'missing'
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ missing = b[1, notify=n]
+ b[1, notify=n] = 1
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ print *, b[1, notify=n]
+ !ERROR: No explicit type declared for 'missing_nested_rhs'
+ !ERROR: NOTIFY= may appear only in the image selector of the variable of an intrinsic assignment statement
+ local(b[1, notify=n]) = missing_nested_rhs
+ !ERROR: No explicit type declared for 'missing_component_rhs'
+ d[1, notify=n]%values(2) = missing_component_rhs
+end subroutine
diff --git a/flang/test/Semantics/notify-assignment-valid.f90 b/flang/test/Semantics/notify-assignment-valid.f90
new file mode 100644
index 0000000000000..3b40edd9d0205
--- /dev/null
+++ b/flang/test/Semantics/notify-assignment-valid.f90
@@ -0,0 +1,143 @@
+! NOTE: Do not autogenerate
+! RUN: %flang_fc1 -cpp -fopenmp -fopenmp-version=51 -fopenacc -fsyntax-only %s
+! RUN: %flang_fc1 -cpp -fopenmp -fopenmp-version=51 -fopenacc -fdebug-dump-parse-tree %s | FileCheck %s
+
+module notify_intrinsic_types
+ type t
+ integer :: value
+ integer :: values(4)
+ end type
+ interface assignment(=)
+ module procedure assign_integer
+ end interface
+contains
+ subroutine assign_integer(lhs, rhs)
+ type(t), intent(out) :: lhs
+ integer, intent(in) :: rhs
+ lhs%value = rhs
+ end subroutine
+end module
+
+module notify_intrinsic_bound_types
+ type t
+ integer :: value
+ contains
+ procedure :: assign_integer
+ generic :: assignment(=) => assign_integer
+ end type
+contains
+ subroutine assign_integer(lhs, rhs)
+ class(t), intent(out) :: lhs
+ integer, intent(in) :: rhs
+ lhs%value = rhs
+ end subroutine
+end module
+
+#define REMOTE b[1, notify=n]
+
+program intrinsic_notify_assignment
+ use iso_fortran_env, only: notify_type, team_type
+ use notify_intrinsic_types
+ use notify_intrinsic_bound_types, only: bound_t => t
+ implicit none
+ type container
+ integer, allocatable :: c[:]
+ end type
+ integer :: a(4)[*], b[*], local_array(4), status, i
+ logical :: mask(4)
+ type(t) :: d[*], rhs
+ type(bound_t) :: bound_d[*], bound_rhs
+ type(notify_type) :: n[*], na(4)[*]
+ type(team_type) :: team
+ type(container) :: x
+ character(8) :: text[*]
+ complex :: z[*]
+
+ !CHECK: AssignmentStmt = 'b[1_8,NOTIFY=n]=1_4'
+ b[1, notify=n] = 1
+ !CHECK: AssignmentStmt = 'a(1_8)[1_8,NOTIFY=na(2_8)]=2_4'
+ a(1)[1, notify=na(1+1)] = 2
+ a(:)[1, notify=n] = 3
+ d[1, notify=n]%value = 4
+ text[1, notify=n](2:4) = 'abc'
+ z[1, notify=n]%re = 5.
+ !CHECK: AssignmentStmt = 'b[1_8,STAT=status,NOTIFY=n]=6_4'
+ b[1, notify=n, stat=status] = 6
+ !CHECK: AssignmentStmt = 'b[1_8,STAT=status,NOTIFY=n,TEAM=team]=7_4'
+ b[1, stat=status, notify=n, team=team] = 7
+ !CHECK: AssignmentStmt = 'b[1_8,STAT=status,NOTIFY=n,TEAM_NUMBER=1_4]=8_4'
+ b[1, team_number=1, notify=n, stat=status] = 8
+ if (.true.) b[1, notify=n] = 9
+ where (mask) a(:)[1, notify=n] = 10
+ where (mask)
+ a(:)[1, notify=n] = 11
+ elsewhere
+ a(:)[1, notify=n] = 12
+ end where
+ forall (i=1:4) a(i)[1, notify=n] = 13
+ forall (i=1:4)
+ a(i)[1, notify=n] = 14
+ end forall
+
+ ! A visible but nonmatching generic leaves these assignments intrinsic.
+ d[1, notify=n] = rhs
+ bound_d[1, notify=n] = bound_rhs
+
+ ! Ordinary coindexed reads in target expressions remain permitted.
+ a(b[1])[2, notify=n] = 15
+ local_array(b[1]) = 16
+ a(1)[b[1], notify=na(1)] = 17
+ text[1, notify=n](b[1]:4) = 'abc'
+ b[1, &
+ notify=n] = 18
+ REMOTE = 19
+ a(1)[1, notify=na(b[1])] = 20
+ allocate(x%c[*])
+ x%c[1, notify=n] = 21
+ associate (remote => b)
+ remote[1, notify=n] = 22
+ end associate
+ d[1, notify=n]%values(2) = 23
+
+ !$omp atomic update
+ b[1, notify=n] = b[1] + 1
+ !$omp atomic capture
+ i = b[1]
+ b[1, notify=n] = b[1] + 1
+ !$omp end atomic
+ !$omp atomic capture
+ b[1, notify=n] = b[1] + 1
+ i = b[1]
+ !$omp end atomic
+ !$omp atomic compare
+ if (b[1] == i) b[1, notify=n] = 1
+ !$omp atomic compare capture
+ i = b[1]
+ if (b[1] == status) then
+ b[1, notify=n] = 1
+ end if
+ !$omp end atomic
+ !$acc atomic update
+ b[1, notify=n] = b[1] + 1
+ !$acc atomic capture
+ i = b[1]
+ b[1, notify=n] = b[1] + 1
+ !$acc end atomic
+ !$acc atomic capture
+ b[1, notify=n] = b[1] + 1
+ i = b[1]
+ !$acc end atomic
+
+ !$omp atomic update
+ d[1, notify=n]%value = d[1]%value + 1
+ !$omp atomic capture
+ i = d[1]%value
+ d[1, notify=n]%value = d[1]%value + 1
+ !$omp end atomic
+ !$acc atomic update
+ d[1, notify=n]%value = d[1]%value + 1
+ !$acc atomic capture
+ i = d[1]%value
+ d[1, notify=n]%value = d[1]%value + 1
+ !$acc end atomic
+end program
diff --git a/flang/unittests/Evaluate/expression.cpp b/flang/unittests/Evaluate/expression.cpp
index 47228ab8ca3bb..cecd3bc0a0a0a 100644
--- a/flang/unittests/Evaluate/expression.cpp
+++ b/flang/unittests/Evaluate/expression.cpp
@@ -12,6 +12,10 @@
#include "flang/Evaluate/target.h"
#include "flang/Evaluate/tools.h"
#include "flang/Parser/message.h"
+#include "flang/Parser/provenance.h"
+#include "flang/Semantics/scope.h"
+#include "flang/Semantics/semantics.h"
+#include "flang/Semantics/symbol.h"
#include "flang/Testing/testing.h"
#include <cstdio>
#include <cstdlib>
@@ -43,5 +47,81 @@ int main() {
a = b;
MATCH("2_4", a.AsFortran());
MATCH("2_4", b.AsFortran());
+
+ Fortran::parser::AllSources allSources;
+ Fortran::parser::AllCookedSources cookedSources{allSources};
+ Fortran::common::LangOptions langOptions;
+ Fortran::semantics::SemanticsContext semantics{
+ defaults, languageFeatures, langOptions, cookedSources};
+ auto &scope{semantics.globalScope()};
+ const auto &integerType{
+ scope.MakeNumericType(TypeCategory::Integer, Expr<SubscriptInteger>{4})};
+ auto &coarray{scope.MakeSymbol(Fortran::parser::CharBlock{"a", 1}, {},
+ Fortran::semantics::ObjectEntityDetails{})};
+ auto &status{scope.MakeSymbol(Fortran::parser::CharBlock{"s", 1}, {},
+ Fortran::semantics::ObjectEntityDetails{})};
+ coarray.get<Fortran::semantics::ObjectEntityDetails>().set_type(integerType);
+ status.get<Fortran::semantics::ObjectEntityDetails>().set_type(integerType);
+ auto asExpr{[](const CoarrayRef &ref) {
+ return DefaultIntegerExpr{
+ Designator<DefaultIntegerExpr::Result>{DataRef{ref}}};
+ }};
+
+ CoarrayRef noNotify{DataRef{coarray},
+ {Expr<SubscriptInteger>{1} + Expr<SubscriptInteger>{1}}};
+ CoarrayRef withNotify{noNotify};
+ // Integer expressions exercise the type-independent specifier representation.
+ withNotify.set_notify(
+ AsGenericExpr(DefaultIntegerExpr{2} + DefaultIntegerExpr{3}));
+ CoarrayRef sameNotify{withNotify};
+ CoarrayRef otherNotify{withNotify};
+ otherNotify.set_notify(AsGenericExpr(DefaultIntegerExpr{6}));
+ // Notification does not change which variable the reference designates.
+ TEST(noNotify == withNotify);
+ TEST(withNotify == noNotify);
+ TEST(withNotify == sameNotify);
+ TEST(withNotify == otherNotify);
+ CoarrayRef otherImage{withNotify};
+ otherImage.cosubscript().front() = Expr<SubscriptInteger>{3};
+ TEST(!(withNotify == otherImage));
+ MATCH("a[1_8+1_8,NOTIFY=2_4+3_4]", asExpr(withNotify).AsFortran());
+
+ auto foldedNotify{ExtractCoarrayRef(Fold(context, asExpr(withNotify)))};
+ TEST(foldedNotify.has_value());
+ if (foldedNotify) {
+ TEST(foldedNotify->notify().has_value());
+ MATCH("2_8", foldedNotify->cosubscript().front().AsFortran());
+ MATCH("a[2_8,NOTIFY=5_4]", asExpr(*foldedNotify).AsFortran());
+ if (auto notify{foldedNotify->notify()}) {
+ MATCH("5_4", notify->AsFortran());
+ }
+ }
+ auto foldedAbsent{ExtractCoarrayRef(Fold(context, asExpr(noNotify)))};
+ TEST(foldedAbsent.has_value());
+ if (foldedAbsent) {
+ TEST(!foldedAbsent->notify().has_value());
+ MATCH("a[2_8]", asExpr(*foldedAbsent).AsFortran());
+ }
+
+ CoarrayRef combined{withNotify};
+ combined.set_stat(AsCategoryExpr(DefaultIntegerExpr{
+ Designator<DefaultIntegerExpr::Result>{DataRef{status}}}));
+ combined.set_team(
+ AsGenericExpr(DefaultIntegerExpr{7} + DefaultIntegerExpr{1}));
+ auto foldedCombined{ExtractCoarrayRef(Fold(context, asExpr(combined)))};
+ TEST(foldedCombined.has_value());
+ if (foldedCombined) {
+ TEST(foldedCombined->notify().has_value());
+ TEST(foldedCombined->stat().has_value());
+ TEST(foldedCombined->team().has_value());
+ MATCH("a[2_8,STAT=s,NOTIFY=5_4,TEAM_NUMBER=8_4]",
+ asExpr(*foldedCombined).AsFortran());
+ if (auto stat{foldedCombined->stat()}) {
+ MATCH("s", stat->AsFortran());
+ }
+ if (auto team{foldedCombined->team()}) {
+ MATCH("8_4", team->AsFortran());
+ }
+ }
return testing::Complete();
}
More information about the flang-commits
mailing list