diff --git a/flang/lib/Parser/message.cpp b/flang/lib/Parser/message.cpp index 69e4814bf246c..799998c54b531 100644 --- a/flang/lib/Parser/message.cpp +++ b/flang/lib/Parser/message.cpp @@ -16,6 +16,7 @@ #include #include #include +#include #include namespace Fortran::parser { @@ -272,19 +273,52 @@ static llvm::raw_ostream::Colors PrefixColor(Severity severity) { return llvm::raw_ostream::SAVEDCOLOR; } +static constexpr int MAX_CONTEXTS_EMITTED{2}; +static constexpr bool OMIT_SHARED_CONTEXTS{true}; + void Message::Emit(llvm::raw_ostream &o, const AllCookedSources &allCooked, bool echoSourceLine) const { std::optional provenanceRange{GetProvenanceRange(allCooked)}; const AllSources &sources{allCooked.allSources()}; sources.EmitMessage(o, provenanceRange, ToString(), Prefix(severity()), PrefixColor(severity()), echoSourceLine); + // Refers to whether the attachment in the loop below is a context, but can't + // be declared inside the loop because the previous iteration's + // attachment->attachmentIsContext_ indicates this. bool isContext{attachmentIsContext_}; + int contextsEmitted{0}; + // Emit attachments. for (const Message *attachment{attachment_.get()}; attachment; - attachment = attachment->attachment_.get()) { + isContext = attachment->attachmentIsContext_, + attachment = attachment->attachment_.get()) { Severity severity = isContext ? Severity::Context : attachment->severity(); - sources.EmitMessage(o, attachment->GetProvenanceRange(allCooked), - attachment->ToString(), Prefix(severity), PrefixColor(severity), - echoSourceLine); + auto emitAttachment = [&]() { + sources.EmitMessage(o, attachment->GetProvenanceRange(allCooked), + attachment->ToString(), Prefix(severity), PrefixColor(severity), + echoSourceLine); + }; + + if (isContext) { + // Truncate the number of contexts emitted. + if (contextsEmitted < MAX_CONTEXTS_EMITTED) { + emitAttachment(); + ++contextsEmitted; + } + if constexpr (OMIT_SHARED_CONTEXTS) { + // Skip less specific contexts at the same location. + for (const Message *next_attachment{attachment->attachment_.get()}; + next_attachment && next_attachment->attachmentIsContext_ && + next_attachment->AtSameLocation(*attachment); + next_attachment = next_attachment->attachment_.get()) { + attachment = next_attachment; + } + // NB, this loop increments `attachment` one more time after the + // previous loop is done advancing it to the last context at the same + // location. + } + } else { + emitAttachment(); + } } } @@ -298,7 +332,7 @@ bool Message::operator==(const Message &that) const { } const Message *thatAttachment{that.attachment_.get()}; for (const Message *attachment{attachment_.get()}; attachment; - attachment = attachment->attachment_.get()) { + attachment = attachment->attachment_.get()) { if (!thatAttachment || !attachment->AtSameLocation(*thatAttachment) || attachment->ToString() != thatAttachment->ToString() || attachment->severity() != thatAttachment->severity()) { diff --git a/flang/lib/Parser/openacc-parsers.cpp b/flang/lib/Parser/openacc-parsers.cpp index c78676664e0a3..fb731ee52cbba 100644 --- a/flang/lib/Parser/openacc-parsers.cpp +++ b/flang/lib/Parser/openacc-parsers.cpp @@ -19,9 +19,16 @@ // OpenACC Directives and Clauses namespace Fortran::parser { +// Only need to handle ! line comments because prescanning normalizes the +// other types of line comments from fixed form. constexpr auto startAccLine{skipStuffBeforeStatement >> - ("!$ACC "_sptok || "C$ACC "_sptok || "*$ACC "_sptok)}; -constexpr auto endAccLine{space >> endOfLine}; + withMessage( + "expected OpenACC directive sentinel: !$ACC, C$ACC, or *$ACC"_err_en_US, + "!$ACC "_sptok)}; +constexpr auto endAccLine{space >> + recovery( + withMessage("expected end of OpenACC directive"_err_en_US, endOfLine), + SkipTo<'\n'>{} || ok)}; // Autogenerated clauses parser. Information is taken from ACC.td and the // parser is generated by tablegen. @@ -221,11 +228,18 @@ TYPE_PARSER(sourced(construct( sourced(Parser{}), Parser{}))) TYPE_PARSER(startAccLine >> sourced(construct("END"_tok >> - sourced(Parser{})))) + recovery(sourced(Parser{}), + construct(pure( + llvm::acc::Directive::ACCD_data)))))) TYPE_PARSER(construct( Parser{} / endAccLine, block, - Parser{} / endAccLine)) + // NB, This allows mismatched directives, but semantics checks that they + // match. + recovery(withMessage("expected OpenACC end block directive"_err_en_US, + attempt(Parser{} / endAccLine)), + construct(construct( + pure(llvm::acc::Directive::ACCD_data)))))) // Standalone constructs TYPE_PARSER(construct( @@ -249,8 +263,11 @@ TYPE_PARSER(sourced(construct( TYPE_CONTEXT_PARSER("OpenACC construct"_en_US, startAccLine >> withMessage("expected OpenACC directive"_err_en_US, - first(construct(Parser{}), + // Combined constructs before block constructs so we try to match + // the longest possible match first. + first( construct(Parser{}), + construct(Parser{}), construct(Parser{}), construct( Parser{}), diff --git a/flang/test/Driver/debug-parsing-log.f90 b/flang/test/Driver/debug-parsing-log.f90 index 7297163109450..fdf52071ab956 100644 --- a/flang/test/Driver/debug-parsing-log.f90 +++ b/flang/test/Driver/debug-parsing-log.f90 @@ -2,24 +2,14 @@ ! Below are just few lines extracted from the dump. The actual output is much _much_ bigger. -! CHECK: {{.*[/\\]}}debug-parsing-log.f90:25:1: IMPLICIT statement +! CHECK: {{.*[/\\]}}debug-parsing-log.f90:15:1: IMPLICIT statement ! CHECK-NEXT: END PROGRAM ! CHECK-NEXT: ^ ! CHECK-NEXT: fail 3 -! CHECK-NEXT: {{.*[/\\]}}debug-parsing-log.f90:25:1: error: expected 'IMPLICIT NONE' +! CHECK-NEXT: {{.*[/\\]}}debug-parsing-log.f90:15:1: error: expected 'IMPLICIT NONE' ! CHECK-NEXT: END PROGRAM ! CHECK-NEXT: ^ -! CHECK-NEXT: {{.*[/\\]}}debug-parsing-log.f90:25:1: in the context: IMPLICIT statement +! CHECK-NEXT: {{.*[/\\]}}debug-parsing-log.f90:15:1: in the context: IMPLICIT statement ! CHECK-NEXT: END PROGRAM ! CHECK-NEXT: ^ -! CHECK-NEXT: {{.*[/\\]}}debug-parsing-log.f90:25:1: in the context: implicit part -! CHECK-NEXT: END PROGRAM -! CHECK-NEXT: ^ -! CHECK-NEXT: {{.*[/\\]}}debug-parsing-log.f90:25:1: in the context: specification part -! CHECK-NEXT: END PROGRAM -! CHECK-NEXT: ^ -! CHECK-NEXT: {{.*[/\\]}}debug-parsing-log.f90:25:1: in the context: main program -! CHECK-NEXT: END PROGRAM -! CHECK-NEXT: ^ - END PROGRAM diff --git a/flang/test/Parser/acc-data-statement.f90 b/flang/test/Parser/acc-data-statement.f90 new file mode 100644 index 0000000000000..40c76b2561b24 --- /dev/null +++ b/flang/test/Parser/acc-data-statement.f90 @@ -0,0 +1,199 @@ +! RUN: not %flang_fc1 -fsyntax-only -fopenacc %s 2>&1 | FileCheck %s +program acc_data_test + implicit none + integer :: a(100), b(100), c(100), d(100) + integer :: i, s ! FIXME: if s is named sum you get semantic errors. + + ! Positive tests + + ! Basic data construct in program body + !$acc data copy(a, b) create(c) + a = 1 + b = 2 + c = a + b + !$acc end data + print *, "After first data region" + + ! Data construct within IF block + if (.true.) then + !$acc data copyout(a) + a = a + 1 + !$acc end data + print *, "Inside if block" + end if + + ! Data construct within DO loop + do i = 1, 10 + !$acc data present(a) + a(i) = a(i) * 2 + !$acc end data + print *, "Loop iteration", i + end do + + ! Nested data constructs + !$acc data copyin(a) + s = 0 + !$acc data copy(s) + s = s + 1 + !$acc end data + print *, "After nested data" + !$acc end data + + ! Negative tests + ! Basic data construct in program body + !$acc data copy(a, b) create(d) bogus() + !CHECK: acc-data-statement.f90: + !CHECK-SAME: error: expected end of OpenACC directive + !CHECK-NEXT: !$acc data copy(a, b) create(d) bogus() + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data copy(a, b) create(d) bogus() + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: execution part + !CHECK-NEXT: !$acc data copy(a, b) create(c) + !CHECK-NEXT: ^ + a = 1 + b = 2 + d = a + b +! !$acc end data + print *, "After first data region" + + ! Data construct within IF block + if (.true.) then + !$acc data copyout(a) + a = a + 1 +! !$acc end data + print *, "Inside if block" + !CHECK: acc-data-statement.f90: + !CHECK-SAME: error: expected OpenACC end block directive + !CHECK-NEXT: end if + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data copyout(a) + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: IF construct + !CHECK-NEXT: if (.true.) then + !CHECK-NEXT: ^ + end if + + ! Data construct within DO loop + do i = 1, 10 + !$acc data present(a) + a(i) = a(i) * 2 +! !$acc end data + print *, "Loop iteration", i + !CHECK: acc-data-statement.f90: + !CHECK-SAME: error: expected OpenACC end block directive + !CHECK-NEXT: end do + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data present(a) + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: DO construct + !CHECK-NEXT: do i = 1, 10 + !CHECK-NEXT: ^ + end do + + ! Nested data constructs + !$acc data copyin(a) + s = 0 + !$acc data copy(s) + s = s + 1 +! !$acc end data + print *, "After nested data" + !$acc end data I forgot to comment this out. + !CHECK: acc-data-statement.f90: + !CHECK-SAME: error: expected end of OpenACC directive + !CHECK-NEXT: !$acc end data I forgot to comment this out. + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data copy(s) + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data copyin(a) + !CHECK-NEXT: ^ + print *, "Program finished" + + !CHECK: acc-data-statement.f90: + !CHECK-SAME: error: expected OpenACC end block directive + !CHECK-NEXT: contains + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data copyin(a) + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data copy(a, b) create(d) bogus() + !CHECK-NEXT: ^ + !CHECK: acc-data-statement.f90: + !CHECK-SAME: error: expected OpenACC end block directive + !CHECK-NEXT: contains + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: $acc data copy(a, b) create(d) bogus() + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: execution part + !CHECK-NEXT: !$acc data copy(a, b) create(c) + !CHECK-NEXT: ^ +contains + subroutine positive_process_array(x) + integer, intent(inout) :: x(:) + + ! Data construct in subroutine + !$acc data copy(x) + x = x + 1 + !$acc end data + print *, "Subroutine finished" + end subroutine + + function positive_compute_sum(x) result(total) + integer, intent(in) :: x(:) + integer :: total + + ! Data construct in function + !$acc data copyin(x) copy(total) + total = sum(x) + !$acc end data + print *, "Function finished" + end function + + subroutine negative_process_array(x) + integer, intent(inout) :: x(:) + + ! Data construct in subroutine + !$acc data copy(x) + x = x + 1 +! !$acc end data + print *, "Subroutine finished" + !CHECK: acc-data-statement.f90: + !CHECK-SAME: error: expected OpenACC end block directive + !CHECK-NEXT: end subroutine + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data copy(x) + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: SUBROUTINE subprogram + !CHECK-NEXT: subroutine negative_process_array(x) + !CHECK-NEXT: ^ + end subroutine + + function negative_compute_sum(x) result(total) + integer, intent(in) :: x(:) + integer :: total + total = sum(x) + ! Data construct in function + !$acc data copyin(x) copy(total) + total = total + x +! !$acc end data + print *, "Function finished" + !CHECK: acc-data-statement.f90: + !CHECK-SAME: error: expected OpenACC end block directive + !CHECK-NEXT: end function + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: OpenACC construct + !CHECK-NEXT: !$acc data copyin(x) copy(total) + !CHECK-NEXT: ^ + !CHECK-NEXT: in the context: execution part + !CHECK-NEXT: total = sum(x) + !CHECK-NEXT: ^ + end function +end program acc_data_test \ No newline at end of file diff --git a/flang/test/Parser/acc.f b/flang/test/Parser/acc.f new file mode 100644 index 0000000000000..b0c3927772568 --- /dev/null +++ b/flang/test/Parser/acc.f @@ -0,0 +1,96 @@ +! RUN: %flang_fc1 -fsyntax-only -fopenacc %s 2>&1 +C Test file for OpenACC directives in fixed-form Fortran + PROGRAM ACCTEST + IMPLICIT NONE + INTEGER :: N, I, J + PARAMETER (N=100) + REAL :: A(N), B(N), C(N), D(N) + REAL :: SUM + +C Initialize arrays + DO I = 1, N + A(I) = I * 1.0 + B(I) = I * 2.0 + C(I) = 0.0 + D(I) = 1.0 + END DO + +C Basic data construct using C$ACC +C$ACC DATA COPYIN(A,B) COPYOUT(C) + DO I = 1, N + C(I) = A(I) + B(I) + END DO +C$ACC END DATA + +* Parallel construct with loop using *$ACC +*$ACC PARALLEL PRESENT(A,B,C) +*$ACC LOOP + DO I = 1, N + C(I) = C(I) * 2.0 + END DO +*$ACC END PARALLEL + +C Nested loops with collapse - C$ACC style +C$ACC PARALLEL LOOP COLLAPSE(2) + DO I = 1, N + DO J = 1, N + A(J) = A(J) + B(J) + END DO + END DO +C$ACC END PARALLEL LOOP + +* Combined parallel loop with reduction - *$ACC style + SUM = 0.0 +*$ACC PARALLEL LOOP REDUCTION(+:SUM) + DO I = 1, N + SUM = SUM + C(I) + END DO +*$ACC END PARALLEL LOOP + +C Kernels construct - C$ACC with continuation +C$ACC KERNELS +C$ACC+ COPYOUT(A) + DO I = 1, N + A(I) = A(I) * 2.0 + END DO +C$ACC END KERNELS + +* Data construct with update - *$ACC with continuation +*$ACC DATA COPY(B) +*$ACC+ PRESENT(D) + B(1) = 999.0 +*$ACC UPDATE HOST(B(1:1)) + PRINT *, 'B(1) = ', B(1) +*$ACC END DATA + +C Mixed style directives in nested constructs +C$ACC DATA COPY(A,B,C) +*$ACC PARALLEL LOOP + DO I = 1, N + A(I) = B(I) + C(I) + END DO +*$ACC END PARALLEL LOOP +C$ACC END DATA + +* Subroutine call within data region - *$ACC style +*$ACC DATA COPY(A,B,C) + CALL SUB1(A, B, C, N) +*$ACC END DATA + + PRINT *, 'Sum = ', SUM + END PROGRAM + +C Subroutine with mixed ACC directive styles + SUBROUTINE SUB1(X, Y, Z, M) + INTEGER M, I + REAL X(M), Y(M), Z(M) + +*$ACC PARALLEL PRESENT(X,Y) +C$ACC LOOP PRIVATE(I) + DO I = 1, M + Z(I) = X(I) + Y(I) + END DO +C$ACC END LOOP +*$ACC END PARALLEL + RETURN + END SUBROUTINE \ No newline at end of file