diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -235,7 +235,9 @@ const parser::OmpAtomicClauseList *, const parser::OmpAtomicClauseList *); void CheckAtomicHintClause( const parser::OmpAtomicClauseList *, const parser::OmpAtomicClauseList *); - void CheckAtomicUpdateAssignmentStmt(const parser::AssignmentStmt &); + void CheckAtomicUpdateStmt(const parser::AssignmentStmt &); + void CheckAtomicCaptureStmt(const parser::AssignmentStmt &); + void CheckAtomicWriteStmt(const parser::AssignmentStmt &); void CheckAtomicConstructStructure(const parser::OpenMPAtomicConstruct &); void CheckDistLinear(const parser::OpenMPLoopConstruct &x); void CheckSIMDNest(const parser::OpenMPConstruct &x); @@ -265,6 +267,8 @@ void CheckPredefinedAllocatorRestriction( const parser::CharBlock &source, const parser::Name &name); bool isPredefinedAllocator{false}; + const parser::Name *GetNameIfAllocatableVariable( + const semantics::Symbol &, const parser::Variable &); void EnterDirectiveNest(const int index) { directiveNest_[index]++; } void ExitDirectiveNest(const int index) { directiveNest_[index]--; } int GetDirectiveNest(const int index) { return directiveNest_[index]; } diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1454,6 +1454,20 @@ } } +const parser::Name *OmpStructureChecker::GetNameIfAllocatableVariable( + const semantics::Symbol &symbol, const parser::Variable &var) { + // Return parser::Name from parser::Designator if the given symbol has + // ALLOCATABLE attribute + if (IsAllocatable(symbol)) { + const auto &designator = + std::get>(var.u); + const auto *dataRef = + std::get_if(&designator.value().u); + return dataRef ? std::get_if(&dataRef->u) : nullptr; + } + return nullptr; +} + template bool OmpStructureChecker::IsOperatorValid(const T &node, const D &variable) { using AllowedBinaryOperators = @@ -1474,16 +1488,63 @@ if ((exprLeft.value().source.ToString() != variableName) && (exprRight.value().source.ToString() != variableName)) { context_.Say(variable.GetSource(), - "Atomic update variable '%s' not found in the RHS of the " - "assignment statement in an ATOMIC (UPDATE) construct"_err_en_US, - variableName); + "Atomic update statement should be of form " + "`%s = %s operator expr` OR `%s = expr operator %s`"_err_en_US, + variableName, variableName, variableName, variableName); } return common::HasMember; } return true; } -void OmpStructureChecker::CheckAtomicUpdateAssignmentStmt( +void OmpStructureChecker::CheckAtomicCaptureStmt( + const parser::AssignmentStmt &assignmentStmt) { + const auto &expr{std::get(assignmentStmt.t)}; + bool isVariable{false}; + common::visit( + common::visitors{ + [&](const common::Indirection &designator) { + if (const auto *dataRef = std::get_if( + &designator.value().u)) { + if (const auto *name = + std::get_if(&dataRef->u)) { + if (IsVariableName(*name->symbol)) { + isVariable = true; + if (IsAllocatable(*name->symbol)) + context_.Say(name->source, + "%s must not have ALLOCATABLE " + "attribute"_err_en_US, + name->ToString()); + } + } + } + }, + [&](const auto &) {}, + }, + expr.u); + if (!isVariable) { + context_.Say(expr.source, + "Expected scalar variable " + "of intrinsic type on RHS of OPENMP Atomic " + " (CAPTURE) assignment statement"_err_en_US); + } +} + +void OmpStructureChecker::CheckAtomicWriteStmt( + const parser::AssignmentStmt &assignment) { + const auto &var{std::get(assignment.t)}; + if (const auto *e{GetExpr(context_, var)}) { + for (const Symbol &symbol : evaluate::CollectSymbols(*e)) { + if (const parser::Name *name = GetNameIfAllocatableVariable(symbol, var)) + context_.Say(name->source, + "%s must not have ALLOCATABLE " + "attribute"_err_en_US, + name->ToString()); + } + } +} + +void OmpStructureChecker::CheckAtomicUpdateStmt( const parser::AssignmentStmt &assignment) { const auto &expr{std::get(assignment.t)}; const auto &var{std::get(assignment.t)}; @@ -1540,6 +1601,15 @@ }, }, expr.u); + if (const auto *e{GetExpr(context_, var)}) { + for (const Symbol &symbol : evaluate::CollectSymbols(*e)) { + if (const parser::Name *name = GetNameIfAllocatableVariable(symbol, var)) + context_.Say(name->source, + "%s must not have ALLOCATABLE " + "attribute"_err_en_US, + name->ToString()); + } + } } void OmpStructureChecker::CheckAtomicMemoryOrderClause( @@ -1607,7 +1677,7 @@ const auto &dir{std::get(atomicConstruct.t)}; PushContextAndClauseSets( dir.source, llvm::omp::Directive::OMPD_atomic); - CheckAtomicUpdateAssignmentStmt( + CheckAtomicUpdateStmt( std::get>( atomicConstruct.t) .statement); @@ -1622,7 +1692,7 @@ const auto &dir{std::get(atomicUpdate.t)}; PushContextAndClauseSets( dir.source, llvm::omp::Directive::OMPD_atomic); - CheckAtomicUpdateAssignmentStmt( + CheckAtomicUpdateStmt( std::get>( atomicUpdate.t) .statement); @@ -1631,6 +1701,32 @@ CheckAtomicHintClause( &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t)); }, + [&](const parser::OmpAtomicRead &atomicRead) { + const auto &dir{std::get(atomicRead.t)}; + PushContextAndClauseSets( + dir.source, llvm::omp::Directive::OMPD_atomic); + CheckAtomicMemoryOrderClause( + &std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t)); + CheckAtomicHintClause( + &std::get<0>(atomicRead.t), &std::get<2>(atomicRead.t)); + CheckAtomicCaptureStmt( + std::get>( + atomicRead.t) + .statement); + }, + [&](const parser::OmpAtomicWrite &atomicWrite) { + const auto &dir{std::get(atomicWrite.t)}; + PushContextAndClauseSets( + dir.source, llvm::omp::Directive::OMPD_atomic); + CheckAtomicMemoryOrderClause( + &std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t)); + CheckAtomicHintClause( + &std::get<0>(atomicWrite.t), &std::get<2>(atomicWrite.t)); + CheckAtomicWriteStmt( + std::get>( + atomicWrite.t) + .statement); + }, [&](const auto &atomicConstruct) { const auto &dir{std::get(atomicConstruct.t)}; PushContextAndClauseSets( diff --git a/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90 b/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90 @@ -0,0 +1,42 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp +! Semantic checks for various assignments related to atomic constructs + +program sample + use omp_lib + integer :: x, v + integer :: y(10) + integer, allocatable :: k + + !$omp atomic read + v = x + + !$omp atomic read + !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar INTEGER(4) and rank 1 array of INTEGER(4) + !ERROR: Expected scalar variable of intrinsic type on RHS of OPENMP Atomic (CAPTURE) assignment statement + v = y(1:3) + + !$omp atomic read + !ERROR: Expected scalar variable of intrinsic type on RHS of OPENMP Atomic (CAPTURE) assignment statement + v = x * (10 + x) + + !$omp atomic read + !ERROR: Expected scalar variable of intrinsic type on RHS of OPENMP Atomic (CAPTURE) assignment statement + v = 4 + + !$omp atomic read + !ERROR: k must not have ALLOCATABLE attribute + v = k + + !$omp atomic write + !ERROR: k must not have ALLOCATABLE attribute + k = x + + !$omp atomic update + !ERROR: Atomic update statement should be of form `k = k operator expr` OR `k = expr operator k` + !ERROR: k must not have ALLOCATABLE attribute + k = v + k * (v * k) + + !$omp atomic + !ERROR: k must not have ALLOCATABLE attribute + k = v * k +end program diff --git a/flang/test/Semantics/OpenMP/omp-atomic02.f90 b/flang/test/Semantics/OpenMP/omp-atomic02.f90 --- a/flang/test/Semantics/OpenMP/omp-atomic02.f90 +++ b/flang/test/Semantics/OpenMP/omp-atomic02.f90 @@ -32,27 +32,27 @@ !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement c = c//d !$omp atomic - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .LT. b !$omp atomic - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .LE. b !$omp atomic - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .EQ. b !$omp atomic - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .NE. b !$omp atomic - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .GE. b !$omp atomic - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .GT. b !$omp atomic @@ -78,23 +78,23 @@ !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement c = c//d !$omp atomic update - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .LT. b !$omp atomic update - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .LE. b !$omp atomic update - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .EQ. b !$omp atomic update - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .GE. b !$omp atomic update - !ERROR: Atomic update variable 'l' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l` !ERROR: Invalid operator in OpenMP ATOMIC (UPDATE) statement l = a .GT. b !$omp atomic update diff --git a/flang/test/Semantics/OpenMP/omp-atomic04.f90 b/flang/test/Semantics/OpenMP/omp-atomic04.f90 --- a/flang/test/Semantics/OpenMP/omp-atomic04.f90 +++ b/flang/test/Semantics/OpenMP/omp-atomic04.f90 @@ -18,21 +18,22 @@ !$omp atomic x = 1 + x !$omp atomic - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = y + 1 !$omp atomic - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct - x = 1 + y + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` + x = 1 + (y + x) !$omp atomic - x = x - 1 + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` + x = 1 - (10 * (y + x)) !$omp atomic x = 1 - x !$omp atomic - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = y - 1 !$omp atomic - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = 1 - y !$omp atomic @@ -40,21 +41,21 @@ !$omp atomic x = 1*x !$omp atomic - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct - x = y*1 + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` + x = y*(10 + x) !$omp atomic - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct - x = 1*y + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` + x = (44 * x) * y !$omp atomic x = x/1 !$omp atomic x = 1/x !$omp atomic - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = y/1 !$omp atomic - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = 1/y !$omp atomic @@ -62,7 +63,7 @@ !$omp atomic m = n .AND. m !$omp atomic - !ERROR: Atomic update variable 'm' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m` m = n .AND. l !$omp atomic @@ -70,7 +71,7 @@ !$omp atomic m = n .OR. m !$omp atomic - !ERROR: Atomic update variable 'm' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m` m = n .OR. l !$omp atomic @@ -78,7 +79,7 @@ !$omp atomic m = n .EQV. m !$omp atomic - !ERROR: Atomic update variable 'm' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m` m = n .EQV. l !$omp atomic @@ -86,7 +87,7 @@ !$omp atomic m = n .NEQV. m !$omp atomic - !ERROR: Atomic update variable 'm' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m` m = n .NEQV. l !$omp atomic update @@ -94,10 +95,10 @@ !$omp atomic update x = 1 + x !$omp atomic update - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = y + 1 !$omp atomic update - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = 1 + y !$omp atomic update @@ -105,10 +106,10 @@ !$omp atomic update x = 1 - x !$omp atomic update - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = y - 1 !$omp atomic update - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = 1 - y !$omp atomic update @@ -116,10 +117,10 @@ !$omp atomic update x = 1*x !$omp atomic update - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = y*1 !$omp atomic update - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` x = 1*y !$omp atomic update @@ -127,18 +128,18 @@ !$omp atomic update x = 1/x !$omp atomic update - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct - x = y/1 + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` + x = max(x, y) + 10 !$omp atomic update - !ERROR: Atomic update variable 'x' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct - x = 1/y + !ERROR: Atomic update statement should be of form `x = x operator expr` OR `x = expr operator x` + x = y * min(x, y) !$omp atomic update m = m .AND. n !$omp atomic update m = n .AND. m !$omp atomic update - !ERROR: Atomic update variable 'm' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m` m = n .AND. l !$omp atomic update @@ -146,7 +147,7 @@ !$omp atomic update m = n .OR. m !$omp atomic update - !ERROR: Atomic update variable 'm' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m` m = n .OR. l !$omp atomic update @@ -154,7 +155,7 @@ !$omp atomic update m = n .EQV. m !$omp atomic update - !ERROR: Atomic update variable 'm' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m` m = n .EQV. l !$omp atomic update @@ -162,7 +163,7 @@ !$omp atomic update m = n .NEQV. m !$omp atomic update - !ERROR: Atomic update variable 'm' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct + !ERROR: Atomic update statement should be of form `m = m operator expr` OR `m = expr operator m` m = n .NEQV. l end program OmpAtomic