[flang-commits] [flang] [flang][OpenMP] Error out when CHARACTER type is used in atomic constructs (PR #113045)
via flang-commits
flang-commits at lists.llvm.org
Sat Oct 19 07:38:16 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-openmp
Author: None (NimishMishra)
<details>
<summary>Changes</summary>
According to OpenMPv5.2 1.2.6, "For Fortran, a scalar variable with intrinsic type, as defined by the base language, excluding character type.". Likewise, section 4.3.1.3 states that atomic operations are on "scalar variables of intrinsic type". This PR hence introduces a check to error out when CHARACTER type is used in atomic operations.
Fixes https://github.com/llvm/llvm-project/issues/112918
---
Full diff: https://github.com/llvm/llvm-project/pull/113045.diff
6 Files Affected:
- (modified) flang/lib/Lower/DirectivesCommon.h (+1)
- (modified) flang/lib/Semantics/check-omp-structure.cpp (+14-5)
- (removed) flang/test/Lower/OpenMP/Todo/atomic-character.f90 (-8)
- (modified) flang/test/Semantics/OpenMP/atomic02.f90 (+2)
- (modified) flang/test/Semantics/OpenMP/atomic03.f90 (+1-1)
- (modified) flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90 (+11)
``````````diff
diff --git a/flang/lib/Lower/DirectivesCommon.h b/flang/lib/Lower/DirectivesCommon.h
index da192ded4aa971..4e0e59816e8197 100644
--- a/flang/lib/Lower/DirectivesCommon.h
+++ b/flang/lib/Lower/DirectivesCommon.h
@@ -128,6 +128,7 @@ static void processOmpAtomicTODO(mlir::Type elementType,
Fortran::parser::OmpAtomicClauseList>()) {
// Based on assertion for supported element types in OMPIRBuilder.cpp
// createAtomicRead
+ // TODO: Enumerate remaining unsupported types for atomics
mlir::Type unwrappedEleTy = fir::unwrapRefType(elementType);
bool supportedAtomicType = fir::isa_trivial(unwrappedEleTy);
if (!supportedAtomicType)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 461a99f59e4ce7..6479d15821d14b 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1888,16 +1888,21 @@ inline void OmpStructureChecker::ErrIfLHSAndRHSSymbolsMatch(
inline void OmpStructureChecker::ErrIfNonScalarAssignmentStmt(
const parser::Variable &var, const parser::Expr &expr) {
// Err out if either the variable on the LHS or the expression on the RHS of
- // the assignment statement are non-scalar (i.e. have rank > 0)
+ // the assignment statement are non-scalar (i.e. have rank > 0 or is of
+ // CHARACTER type)
const auto *e{GetExpr(context_, expr)};
const auto *v{GetExpr(context_, var)};
if (e && v) {
- if (e->Rank() != 0)
+ if (e->Rank() != 0 ||
+ (e->GetType().has_value() &&
+ e->GetType().value().category() == common::TypeCategory::Character))
context_.Say(expr.source,
"Expected scalar expression "
"on the RHS of atomic assignment "
"statement"_err_en_US);
- if (v->Rank() != 0)
+ if (v->Rank() != 0 ||
+ (v->GetType().has_value() &&
+ v->GetType()->category() == common::TypeCategory::Character))
context_.Say(var.GetSource(),
"Expected scalar variable "
"on the LHS of atomic assignment "
@@ -2008,12 +2013,16 @@ void OmpStructureChecker::CheckAtomicUpdateStmt(
expr.u);
if (const auto *e{GetExpr(context_, expr)}) {
const auto *v{GetExpr(context_, var)};
- if (e->Rank() != 0)
+ if (e->Rank() != 0 ||
+ (e->GetType().has_value() &&
+ e->GetType().value().category() == common::TypeCategory::Character))
context_.Say(expr.source,
"Expected scalar expression "
"on the RHS of atomic update assignment "
"statement"_err_en_US);
- if (v->Rank() != 0)
+ if (v->Rank() != 0 ||
+ (v->GetType().has_value() &&
+ v->GetType()->category() == common::TypeCategory::Character))
context_.Say(var.GetSource(),
"Expected scalar variable "
"on the LHS of atomic update assignment "
diff --git a/flang/test/Lower/OpenMP/Todo/atomic-character.f90 b/flang/test/Lower/OpenMP/Todo/atomic-character.f90
deleted file mode 100644
index 88effa4a2a5156..00000000000000
--- a/flang/test/Lower/OpenMP/Todo/atomic-character.f90
+++ /dev/null
@@ -1,8 +0,0 @@
-! RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s
-
-! CHECK: not yet implemented: Unsupported atomic type
-subroutine character_atomic
- character :: l, r
- !$omp atomic read
- l = r
-end subroutine
diff --git a/flang/test/Semantics/OpenMP/atomic02.f90 b/flang/test/Semantics/OpenMP/atomic02.f90
index b823bc4c33b239..57a97d88b9e9b3 100644
--- a/flang/test/Semantics/OpenMP/atomic02.f90
+++ b/flang/test/Semantics/OpenMP/atomic02.f90
@@ -32,6 +32,7 @@ program OmpAtomic
a = a**4
!$omp atomic
!ERROR: Invalid or missing operator in atomic update statement
+ !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
c = c//d
!$omp atomic
!ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
@@ -78,6 +79,7 @@ program OmpAtomic
a = a**4
!$omp atomic update
!ERROR: Invalid or missing operator in atomic update statement
+ !ERROR: Expected scalar expression on the RHS of atomic update assignment statement
c = c//d
!$omp atomic update
!ERROR: Atomic update statement should be of form `l = l operator expr` OR `l = expr operator l`
diff --git a/flang/test/Semantics/OpenMP/atomic03.f90 b/flang/test/Semantics/OpenMP/atomic03.f90
index 76367495b98612..40347170bacd2b 100644
--- a/flang/test/Semantics/OpenMP/atomic03.f90
+++ b/flang/test/Semantics/OpenMP/atomic03.f90
@@ -129,7 +129,7 @@ subroutine more_invalid_atomic_update_stmts()
!$omp atomic update
!ERROR: Expected scalar variable on the LHS of atomic update assignment statement
- !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'k'
+ !ERROR: Intrinsic procedure arguments in atomic update statement must have exactly one occurence of 'k'
k = max(x, y)
!$omp atomic
diff --git a/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90 b/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
index 9701c1db92c1cd..505cbc48fef901 100644
--- a/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
+++ b/flang/test/Semantics/OpenMP/omp-atomic-assignment-stmt.f90
@@ -14,6 +14,7 @@ program sample
integer :: m
endtype
type(sample_type) :: z
+ character :: l, r
!$omp atomic read
v = x
@@ -148,4 +149,14 @@ program sample
y(1) = y(1) + 1
x = y(2)
!$omp end atomic
+
+ !$omp atomic read
+ !ERROR: Expected scalar variable on the LHS of atomic assignment statement
+ !ERROR: Expected scalar expression on the RHS of atomic assignment statement
+ l = r
+
+ !$omp atomic write
+ !ERROR: Expected scalar variable on the LHS of atomic assignment statement
+ !ERROR: Expected scalar expression on the RHS of atomic assignment statement
+ l = r
end program
``````````
</details>
https://github.com/llvm/llvm-project/pull/113045
More information about the flang-commits
mailing list