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

Fixes #142404

The parser can't tell the difference between array indexing and a
substring: that has to be done in semantics once we have types.
Substrings can only be in the form string([lower]:[higher]) not
string(index) or string(lower:higher:step). I added semantic checks to
catch this for the DEPEND clause.

This patch also adds lowering for correct substrings and for complex
part references.
This commit is contained in:
Tom Eccles
2025-06-13 14:16:58 +01:00
committed by GitHub
parent 85a9f2e148
commit 4a47634a00
7 changed files with 250 additions and 21 deletions

View File

@@ -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,

View File

@@ -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
@@ -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);

View File

@@ -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

View File

@@ -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"
@@ -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{
@@ -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)};
@@ -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);
}
}
}
}

View File

@@ -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

View File

@@ -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: }

View File

@@ -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