Skip to content

[flang][OpenMP] Support substrings and complex part refs for DEPEND #143907

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Jun 13, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 11 additions & 7 deletions flang/include/flang/Evaluate/tools.h
Original file line number Diff line number Diff line change
Expand Up @@ -490,26 +490,30 @@ template <typename A> std::optional<CoarrayRef> ExtractCoarrayRef(const A &x) {
}
}

struct ExtractSubstringHelper {
template <typename T> static std::optional<Substring> visit(T &&) {
template <typename TARGET> struct ExtractFromExprDesignatorHelper {
template <typename T> static std::optional<TARGET> visit(T &&) {
return std::nullopt;
}

static std::optional<Substring> visit(const Substring &e) { return e; }
static std::optional<TARGET> visit(const TARGET &t) { return t; }

template <typename T>
static std::optional<Substring> visit(const Designator<T> &e) {
static std::optional<TARGET> visit(const Designator<T> &e) {
return common::visit([](auto &&s) { return visit(s); }, e.u);
}

template <typename T>
static std::optional<Substring> visit(const Expr<T> &e) {
template <typename T> static std::optional<TARGET> visit(const Expr<T> &e) {
return common::visit([](auto &&s) { return visit(s); }, e.u);
}
};

template <typename A> std::optional<Substring> ExtractSubstring(const A &x) {
return ExtractSubstringHelper::visit(x);
return ExtractFromExprDesignatorHelper<Substring>::visit(x);
}

template <typename A>
std::optional<ComplexPart> ExtractComplexPart(const A &x) {
return ExtractFromExprDesignatorHelper<ComplexPart>::visit(x);
}

// If an expression is simply a whole symbol data designator,
Expand Down
13 changes: 5 additions & 8 deletions flang/lib/Lower/OpenMP/ClauseProcessor.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -926,14 +926,10 @@ bool ClauseProcessor::processDepend(lower::SymMap &symMap,
for (const omp::Object &object : objects) {
assert(object.ref() && "Expecting designator");
mlir::Value dependVar;
SomeExpr expr = *object.ref();

if (evaluate::ExtractSubstring(*object.ref())) {
TODO(converter.getCurrentLocation(),
"substring not supported for task depend");
} else if (evaluate::IsArrayElement(*object.ref())) {
// Array Section
SomeExpr expr = *object.ref();

if (evaluate::IsArrayElement(expr) || evaluate::ExtractSubstring(expr)) {
// Array Section or character (sub)string
if (isVectorSubscript(expr)) {
// OpenMP needs the address of the first indexed element (required by
// the standard to be the lowest index) to identify the dependency. We
Expand All @@ -947,7 +943,8 @@ bool ClauseProcessor::processDepend(lower::SymMap &symMap,
converter.getCurrentLocation(), converter, expr, symMap, stmtCtx);
dependVar = entity.getBase();
}
} else if (evaluate::isStructureComponent(*object.ref())) {
} else if (evaluate::isStructureComponent(expr) ||
evaluate::ExtractComplexPart(expr)) {
SomeExpr expr = *object.ref();
hlfir::EntityWithAttributes entity = convertExprToHLFIR(
converter.getCurrentLocation(), converter, expr, symMap, stmtCtx);
Expand Down
11 changes: 5 additions & 6 deletions flang/lib/Lower/OpenMP/Clauses.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -70,19 +70,18 @@ struct SymbolAndDesignatorExtractor {

static void verify(const SymbolWithDesignator &sd) {
const semantics::Symbol *symbol = std::get<0>(sd);
assert(symbol && "Expecting symbol");
auto &maybeDsg = std::get<1>(sd);
const std::optional<evaluate::Expr<evaluate::SomeType>> &maybeDsg =
std::get<1>(sd);
if (!maybeDsg)
return; // Symbol with no designator -> OK
std::optional<evaluate::DataRef> maybeRef =
evaluate::ExtractDataRef(*maybeDsg);
assert(symbol && "Expecting symbol");
std::optional<evaluate::DataRef> maybeRef = evaluate::ExtractDataRef(
*maybeDsg, /*intoSubstring=*/true, /*intoComplexPart=*/true);
if (maybeRef) {
if (&maybeRef->GetLastSymbol() == symbol)
return; // Symbol with a designator for it -> OK
llvm_unreachable("Expecting designator for given symbol");
} else {
// This could still be a Substring or ComplexPart, but at least Substring
// is not allowed in OpenMP.
#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
maybeDsg->dump();
#endif
Expand Down
34 changes: 34 additions & 0 deletions flang/lib/Semantics/check-omp-structure.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
#include "resolve-names-utils.h"
#include "flang/Evaluate/check-expression.h"
#include "flang/Evaluate/expression.h"
#include "flang/Evaluate/shape.h"
#include "flang/Evaluate/type.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/expression.h"
Expand Down Expand Up @@ -6524,6 +6525,29 @@ void OmpStructureChecker::CheckDependList(const parser::DataRef &d) {
void OmpStructureChecker::CheckArraySection(
const parser::ArrayElement &arrayElement, const parser::Name &name,
const llvm::omp::Clause clause) {
// Sometimes substring operations are incorrectly parsed as array accesses.
// Detect this by looking for array accesses on character variables which are
// not arrays.
bool isSubstring{false};
evaluate::ExpressionAnalyzer ea{context_};
if (MaybeExpr expr = ea.Analyze(arrayElement.base)) {
std::optional<evaluate::Shape> shape = evaluate::GetShape(expr);
// Not an array: rank 0
if (shape && shape->size() == 0) {
if (std::optional<evaluate::DynamicType> type = expr->GetType()) {
if (type->category() == evaluate::TypeCategory::Character) {
// Substrings are explicitly denied by the standard [6.0:163:9-11].
// This is supported as an extension. This restriction was added in
// OpenMP 5.2.
isSubstring = true;
context_.Say(GetContext().clauseSource,
"The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2."_port_en_US);
} else {
llvm_unreachable("Array indexing on a variable that isn't an array");
}
}
}
}
if (!arrayElement.subscripts.empty()) {
for (const auto &subscript : arrayElement.subscripts) {
if (const auto *triplet{
Expand All @@ -6541,6 +6565,10 @@ void OmpStructureChecker::CheckArraySection(
name.ToString(),
parser::ToUpperCaseLetters(getClauseName(clause).str()));
}
if (isSubstring) {
context_.Say(GetContext().clauseSource,
"Cannot specify a step for a substring"_err_en_US);
}
}
const auto &lower{std::get<0>(triplet->t)};
const auto &upper{std::get<1>(triplet->t)};
Expand All @@ -6564,6 +6592,12 @@ void OmpStructureChecker::CheckArraySection(
}
}
}
} else if (std::get_if<parser::IntExpr>(&subscript.u)) {
// base(n) is valid as an array index but not as a substring operation
if (isSubstring) {
context_.Say(GetContext().clauseSource,
"Substrings must be in the form parent-string(lb:ub)"_err_en_US);
}
}
}
}
Expand Down
22 changes: 22 additions & 0 deletions flang/test/Lower/OpenMP/depend-complex.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,22 @@
! RUN: %flang_fc1 -fopenmp -emit-hlfir -o - %s | FileCheck %s

subroutine depend_complex(z)
! CHECK-LABEL: func.func @_QPdepend_complex(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<complex<f32>> {fir.bindc_name = "z"}) {
complex :: z
! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {uniq_name = "_QFdepend_complexEz"} : (!fir.ref<complex<f32>>, !fir.dscope) -> (!fir.ref<complex<f32>>, !fir.ref<complex<f32>>)
!$omp task depend(in:z%re)
! CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_1]]#0 real : (!fir.ref<complex<f32>>) -> !fir.ref<f32>
! CHECK: omp.task depend(taskdependin -> %[[VAL_2]] : !fir.ref<f32>) {
! CHECK: omp.terminator
! CHECK: }
!$omp end task
!$omp task depend(in:z%im)
! CHECK: %[[VAL_3:.*]] = hlfir.designate %[[VAL_1]]#0 imag : (!fir.ref<complex<f32>>) -> !fir.ref<f32>
! CHECK: omp.task depend(taskdependin -> %[[VAL_3]] : !fir.ref<f32>) {
! CHECK: omp.terminator
! CHECK: }
!$omp end task
end subroutine

108 changes: 108 additions & 0 deletions flang/test/Lower/OpenMP/depend-substring.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,108 @@
! RUN: %flang_fc1 -fopenmp -emit-hlfir %s -o - | FileCheck %s

subroutine substring_0(c)
character(:), pointer :: c
!$omp task depend(out:c(:))
!$omp end task
end
! CHECK-LABEL: func.func @_QPsubstring_0(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>> {fir.bindc_name = "c"}) {
! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsubstring_0Ec"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_5:.*]] = fir.box_elesize %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
! CHECK: %[[VAL_6:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_5]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.boxchar<1>
! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index
! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_9:.*]] = fir.box_elesize %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (index) -> i64
! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index
! CHECK: %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index
! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_12]] : index
! CHECK: %[[VAL_15:.*]] = arith.constant 0 : index
! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_14]], %[[VAL_15]] : index
! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_14]], %[[VAL_15]] : index
! CHECK: %[[VAL_18:.*]] = hlfir.designate %[[VAL_6]] substr %[[VAL_7]], %[[VAL_11]] typeparams %[[VAL_17]] : (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1>
! CHECK: %[[VAL_19:.*]] = fir.box_addr %[[VAL_18]] : (!fir.boxchar<1>) -> !fir.ref<!fir.char<1,?>>
! CHECK: omp.task depend(taskdependout -> %[[VAL_19]] : !fir.ref<!fir.char<1,?>>) {
! CHECK: omp.terminator
! CHECK: }
! CHECK: return
! CHECK: }

subroutine substring_1(c)
character(:), pointer :: c
!$omp task depend(out:c(2:))
!$omp end task
end
! CHECK-LABEL: func.func @_QPsubstring_1(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>> {fir.bindc_name = "c"}) {
! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsubstring_1Ec"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_5:.*]] = fir.box_elesize %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
! CHECK: %[[VAL_6:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_5]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.boxchar<1>
! CHECK: %[[VAL_7:.*]] = arith.constant 2 : index
! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_9:.*]] = fir.box_elesize %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (index) -> i64
! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index
! CHECK: %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index
! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_12]] : index
! CHECK: %[[VAL_15:.*]] = arith.constant 0 : index
! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_14]], %[[VAL_15]] : index
! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_14]], %[[VAL_15]] : index
! CHECK: %[[VAL_18:.*]] = hlfir.designate %[[VAL_6]] substr %[[VAL_7]], %[[VAL_11]] typeparams %[[VAL_17]] : (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1>
! CHECK: %[[VAL_19:.*]] = fir.box_addr %[[VAL_18]] : (!fir.boxchar<1>) -> !fir.ref<!fir.char<1,?>>
! CHECK: omp.task depend(taskdependout -> %[[VAL_19]] : !fir.ref<!fir.char<1,?>>) {
! CHECK: omp.terminator
! CHECK: }
! CHECK: return
! CHECK: }

subroutine substring_2(c)
character(:), pointer :: c
!$omp task depend(out:c(:2))
!$omp end task
end
! CHECK-LABEL: func.func @_QPsubstring_2(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>> {fir.bindc_name = "c"}) {
! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsubstring_2Ec"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_5:.*]] = fir.box_elesize %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
! CHECK: %[[VAL_6:.*]] = fir.emboxchar %[[VAL_3]], %[[VAL_5]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.boxchar<1>
! CHECK: %[[VAL_7:.*]] = arith.constant 1 : index
! CHECK: %[[VAL_8:.*]] = arith.constant 2 : index
! CHECK: %[[VAL_9:.*]] = arith.constant 2 : index
! CHECK: %[[VAL_10:.*]] = hlfir.designate %[[VAL_6]] substr %[[VAL_7]], %[[VAL_8]] typeparams %[[VAL_9]] : (!fir.boxchar<1>, index, index, index) -> !fir.ref<!fir.char<1,2>>
! CHECK: omp.task depend(taskdependout -> %[[VAL_10]] : !fir.ref<!fir.char<1,2>>) {
! CHECK: omp.terminator
! CHECK: }
! CHECK: return
! CHECK: }

subroutine substring_4(c)
character(:), pointer :: c
!$omp task depend(out:c)
!$omp end task
end
! CHECK-LABEL: func.func @_QPsubstring_4(
! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>> {fir.bindc_name = "c"}) {
! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFsubstring_4Ec"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
! CHECK: omp.task depend(taskdependout -> %[[VAL_3]] : !fir.ptr<!fir.char<1,?>>) {
! CHECK: omp.terminator
! CHECK: }
! CHECK: return
! CHECK: }
65 changes: 65 additions & 0 deletions flang/test/Semantics/OpenMP/depend-substring.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,65 @@
! RUN: %python %S/../test_errors.py %s %flang -fopenmp
! Test for parsing confusion between array indexing and string subscripts

! This is okay: selects the whole substring
subroutine substring_0(c)
character(:), pointer :: c
!PORTABILITY: The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2.
!$omp task depend(out:c(:))
!$omp end task
end

! This is okay: selects from the second character onwards
subroutine substring_1(c)
character(:), pointer :: c
!PORTABILITY: The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2.
!$omp task depend(out:c(2:))
!$omp end task
end

! This is okay: selects the first 2 characters
subroutine substring_2(c)
character(:), pointer :: c
!PORTABILITY: The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2.
!$omp task depend(out:c(:2))
!$omp end task
end

! Error
subroutine substring_3(c)
character(:), pointer :: c
!PORTABILITY: The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2.
!ERROR: Substrings must be in the form parent-string(lb:ub)
!$omp task depend(out:c(2))
!$omp end task
end

! This is okay: interpreted as indexing into the array not as a substring
subroutine substring_3b(c)
character(:), pointer :: c(:)
!$omp task depend(out:c(2))
!$omp end task
end

! This is okay: no indexing or substring at all
subroutine substring_4(c)
character(:), pointer :: c
!$omp task depend(out:c)
!$omp end task
end

! This is not okay: substrings can't have a stride
subroutine substring_5(c)
character(:), pointer :: c
!PORTABILITY: The use of substrings in OpenMP argument lists has been disallowed since OpenMP 5.2.
!ERROR: Cannot specify a step for a substring
!$omp task depend(out:c(1:20:5))
!$omp end task
end

! This is okay: interpreted as indexing the array
subroutine substring_5b(c)
character(:), pointer :: c(:)
!$omp task depend(out:c(1:20:5))
!$omp end task
end