diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -82,6 +82,7 @@ NODE(parser, AccObjectListWithModifier) NODE(parser, AccObjectListWithReduction) NODE(parser, AccReductionOperator) + NODE_ENUM(parser::AccReductionOperator, Operator) NODE(parser, AccSizeExpr) NODE(parser, AccSizeExprList) NODE(parser, AccStandaloneDirective) diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -3840,8 +3840,10 @@ // 2.5.13: + | * | max | min | iand | ior | ieor | .and. | .or. | .eqv. | .neqv. struct AccReductionOperator { - UNION_CLASS_BOILERPLATE(AccReductionOperator); - std::variant u; + ENUM_CLASS( + Operator, Plus, Multiply, Max, Min, Iand, Ior, Ieor, And, Or, Eqv, Neqv) + WRAPPER_CLASS_BOILERPLATE(AccReductionOperator, Operator); + CharBlock source; }; struct AccObjectListWithReduction { diff --git a/flang/lib/Parser/openacc-parsers.cpp b/flang/lib/Parser/openacc-parsers.cpp --- a/flang/lib/Parser/openacc-parsers.cpp +++ b/flang/lib/Parser/openacc-parsers.cpp @@ -145,8 +145,19 @@ maybe(","_tok / "STATIC:" >> Parser{}))) // 2.5.13 Reduction -TYPE_PARSER(construct(Parser{}) || - construct(Parser{})) +// Operator for reduction +TYPE_PARSER(sourced(construct( + first("+" >> pure(AccReductionOperator::Operator::Plus), + "*" >> pure(AccReductionOperator::Operator::Multiply), + "MAX" >> pure(AccReductionOperator::Operator::Max), + "MIN" >> pure(AccReductionOperator::Operator::Min), + "IAND" >> pure(AccReductionOperator::Operator::Iand), + "IOR" >> pure(AccReductionOperator::Operator::Ior), + "IEOR" >> pure(AccReductionOperator::Operator::Ieor), + ".AND." >> pure(AccReductionOperator::Operator::And), + ".OR." >> pure(AccReductionOperator::Operator::Or), + ".EQV." >> pure(AccReductionOperator::Operator::Eqv), + ".NEQV." >> pure(AccReductionOperator::Operator::Neqv))))) // 2.5.14 Default clause TYPE_PARSER(construct( diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -1923,6 +1923,9 @@ x.u); } void Unparse(const AccObjectList &x) { Walk(x.v, ","); } + void Unparse(const AccReductionOperator::Operator &x) { + Word(AccReductionOperator::EnumToString(x)); + } void Unparse(const AccObjectListWithReduction &x) { Walk(std::get(x.t)); Put(":"); diff --git a/flang/test/Semantics/acc-clause-validity.f90 b/flang/test/Semantics/acc-clause-validity.f90 --- a/flang/test/Semantics/acc-clause-validity.f90 +++ b/flang/test/Semantics/acc-clause-validity.f90 @@ -18,8 +18,13 @@ implicit none - integer :: i, j - integer :: N = 256 + integer :: i, j, b + integer, parameter :: N = 256 + integer, dimension(N) :: c + logical, dimension(N) :: d, e + real :: reduction_r + logical :: reduction_l + !ERROR: At least one clause is required on the DECLARE directive !$acc declare real(8) :: a(256) @@ -187,6 +192,61 @@ !ERROR: Unmatched END PARALLEL LOOP directive !$acc end parallel loop + !$acc parallel loop reduction(+: reduction_r) + do i = 1, N + reduction_r = a(i) + i + end do + + !$acc parallel loop reduction(*: reduction_r) + do i = 1, N + reduction_r = reduction_r * (a(i) + i) + end do + + !$acc parallel loop reduction(min: reduction_r) + do i = 1, N + reduction_r = min(reduction_r, a(i) * i) + end do + + !$acc parallel loop reduction(max: reduction_r) + do i = 1, N + reduction_r = max(reduction_r, a(i) * i) + end do + + !$acc parallel loop reduction(iand: b) + do i = 1, N + b = iand(b, c(i)) + end do + + !$acc parallel loop reduction(ior: b) + do i = 1, N + b = ior(b, c(i)) + end do + + !$acc parallel loop reduction(ieor: b) + do i = 1, N + b = ieor(b, c(i)) + end do + + !$acc parallel loop reduction(.and.: reduction_l) + do i = 1, N + reduction_l = d(i) .and. e(i) + end do + + !$acc parallel loop reduction(.or.: reduction_l) + do i = 1, N + reduction_l = d(i) .or. e(i) + end do + + !$acc parallel loop reduction(.eqv.: reduction_l) + do i = 1, N + reduction_l = d(i) .eqv. e(i) + end do + + !$acc parallel loop reduction(.neqv.: reduction_l) + do i = 1, N + reduction_l = d(i) .neqv. e(i) + end do + !$acc kernels wait(1, 2) async(3) !$acc end kernels