[flang-commits] [flang] 0779406 - [flang][openacc] Make OpenACC block construct parse errors less verbose. (#131042)
via flang-commits
flang-commits at lists.llvm.org
Wed Mar 26 12:36:08 PDT 2025
Author: Andre Kuhlenschmidt
Date: 2025-03-26T12:36:04-07:00
New Revision: 077940621d2ef1352f0353a58c3130ed6c3034e8
URL: https://github.com/llvm/llvm-project/commit/077940621d2ef1352f0353a58c3130ed6c3034e8
DIFF: https://github.com/llvm/llvm-project/commit/077940621d2ef1352f0353a58c3130ed6c3034e8.diff
LOG: [flang][openacc] Make OpenACC block construct parse errors less verbose. (#131042)
This PR does reduces the verbosity of parser errors for OpenACC block
constructs that do not parse correctly because they are missing their
trailing end block directive by:
- Removing the redundant error messages created by parsing 3 different
styles of directive tokens.
- Providing a general mechanism of configuring the max number of
contexts printed for every syntax error.
- Not printing less specific contexts that are at the same location.
Prior to the changes:
```
$ flang -fc1 -fopenacc -fsyntax-only flang/test/Parser/acc-data-statement.f90 2>&1 | tee acc-data-statement.prior.log | wc -l
262
```
[acc-data-statement.prior.log](https://github.com/user-attachments/files/19298165/acc-data-statement.prior.log)
```
$ flang -fc1 -fopenacc -fsyntax-only flang/test/Parser/acc-data-statement.f90 2>&1 | tee acc-data-statement.prior.log | wc -l
73
```
[acc-data-statement.post.log](https://github.com/user-attachments/files/19298181/acc-data-statement.post.log)
Added:
flang/test/Parser/acc-data-statement.f90
flang/test/Parser/acc.f
Modified:
flang/lib/Parser/message.cpp
flang/lib/Parser/openacc-parsers.cpp
flang/test/Driver/debug-parsing-log.f90
Removed:
################################################################################
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 <cstdio>
#include <cstring>
#include <string>
+#include <tuple>
#include <vector>
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> 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<AccBeginBlockDirective>(
sourced(Parser<AccBlockDirective>{}), Parser<AccClauseList>{})))
TYPE_PARSER(startAccLine >> sourced(construct<AccEndBlockDirective>("END"_tok >>
- sourced(Parser<AccBlockDirective>{}))))
+ recovery(sourced(Parser<AccBlockDirective>{}),
+ construct<AccBlockDirective>(pure(
+ llvm::acc::Directive::ACCD_data))))))
TYPE_PARSER(construct<OpenACCBlockConstruct>(
Parser<AccBeginBlockDirective>{} / endAccLine, block,
- Parser<AccEndBlockDirective>{} / endAccLine))
+ // NB, This allows mismatched directives, but semantics checks that they
+ // match.
+ recovery(withMessage("expected OpenACC end block directive"_err_en_US,
+ attempt(Parser<AccEndBlockDirective>{} / endAccLine)),
+ construct<AccEndBlockDirective>(construct<AccBlockDirective>(
+ pure(llvm::acc::Directive::ACCD_data))))))
// Standalone constructs
TYPE_PARSER(construct<OpenACCStandaloneConstruct>(
@@ -249,8 +263,11 @@ TYPE_PARSER(sourced(construct<OpenACCEndConstruct>(
TYPE_CONTEXT_PARSER("OpenACC construct"_en_US,
startAccLine >>
withMessage("expected OpenACC directive"_err_en_US,
- first(construct<OpenACCConstruct>(Parser<OpenACCBlockConstruct>{}),
+ // Combined constructs before block constructs so we try to match
+ // the longest possible match first.
+ first(
construct<OpenACCConstruct>(Parser<OpenACCCombinedConstruct>{}),
+ construct<OpenACCConstruct>(Parser<OpenACCBlockConstruct>{}),
construct<OpenACCConstruct>(Parser<OpenACCLoopConstruct>{}),
construct<OpenACCConstruct>(
Parser<OpenACCStandaloneConstruct>{}),
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
More information about the flang-commits
mailing list