[flang] Allow large and erroneous ac-implied-do's
We sometimes unroll an ac-implied-do of an array constructor into a flat list
of values. We then re-analyze the array constructor that contains the
resulting list of expressions. Such a list may or may not contain errors.
But when processing an array constructor with an unrolled ac-implied-do, the
compiler was building an expression to represent the extent of the resulting
array constructor containing the list of values. The number of operands
in this extent expression was based on the number of elements in the
unrolled list of values. For very large lists, this created an
expression so large that it could not be evaluated by the compiler
without overflowing the stack.
I fixed this by continuously folding the extent expression as each operand is
added to it. I added the test .../flang/test/Semantics/array-constr-big.f90
that will cause the compiler to seg fault without this change.
Also, when the unrolled ac-implied-do expression contains errors, we were
repeating the same error message referencing the same source line for every
instance of the erroneous expression in the unrolled list. This potentially
resulted in a very long list of messages for a single error in the source code.
I fixed this by comparing the message being emitted to the previously emitted
message. If they are the same, I do not emit the message. This change is also
tested by the new test array-constr-big.f90.
Several of the existing tests had duplicate error messages for the same source
line, and this change caused differences in their output. So I adjusted the
tests to match the new message emitting behavior.
Differential Revision: https://reviews.llvm.org/D102210
GitOrigin-RevId: 5a9497d6890145da74325dfcb032ad2963b5da3f
diff --git a/include/flang/Evaluate/shape.h b/include/flang/Evaluate/shape.h
index 65c4c1b..507a710 100644
--- a/include/flang/Evaluate/shape.h
+++ b/include/flang/Evaluate/shape.h
@@ -13,6 +13,7 @@
#define FORTRAN_EVALUATE_SHAPE_H_
#include "expression.h"
+#include "fold.h"
#include "traverse.h"
#include "variable.h"
#include "flang/Common/indirection.h"
@@ -180,6 +181,11 @@
for (const auto &value : values) {
if (MaybeExtentExpr n{GetArrayConstructorValueExtent(value)}) {
result = std::move(result) + std::move(*n);
+ if (context_) {
+ // Fold during expression creation to avoid creating an expression so
+ // large we can't evalute it without overflowing the stack.
+ result = Fold(*context_, std::move(result));
+ }
} else {
return std::nullopt;
}
diff --git a/include/flang/Parser/message.h b/include/flang/Parser/message.h
index 13f3087..21aff2b 100644
--- a/include/flang/Parser/message.h
+++ b/include/flang/Parser/message.h
@@ -200,10 +200,11 @@
return std::holds_alternative<MessageExpectedText>(text_);
}
bool Merge(const Message &);
+ bool operator==(const Message &that) const;
+ bool operator!=(const Message &that) const { return !(*this == that); }
private:
bool AtSameLocation(const Message &) const;
-
std::variant<ProvenanceRange, CharBlock> location_;
std::variant<MessageFixedText, MessageFormattedText, MessageExpectedText>
text_;
diff --git a/lib/Parser/message.cpp b/lib/Parser/message.cpp
index d1c29fb..f565112 100644
--- a/lib/Parser/message.cpp
+++ b/lib/Parser/message.cpp
@@ -211,6 +211,26 @@
}
}
+// Messages are equal if they're for the same location and text, and the user
+// visible aspects of their attachments are the same
+bool Message::operator==(const Message &that) const {
+ if (!AtSameLocation(that) || ToString() != that.ToString()) {
+ return false;
+ }
+ const Message *thatAttachment{that.attachment_.get()};
+ for (const Message *attachment{attachment_.get()}; attachment;
+ attachment = attachment->attachment_.get()) {
+ if (!thatAttachment ||
+ attachment->attachmentIsContext_ !=
+ thatAttachment->attachmentIsContext_ ||
+ *attachment != *thatAttachment) {
+ return false;
+ }
+ thatAttachment = thatAttachment->attachment_.get();
+ }
+ return true;
+}
+
bool Message::Merge(const Message &that) {
return AtSameLocation(that) &&
(!that.attachment_.get() ||
@@ -305,8 +325,14 @@
}
std::stable_sort(sorted.begin(), sorted.end(),
[](const Message *x, const Message *y) { return x->SortBefore(*y); });
+ const Message *lastMsg{nullptr};
for (const Message *msg : sorted) {
+ if (lastMsg && *msg == *lastMsg) {
+ // Don't emit two identical messages for the same location
+ continue;
+ }
msg->Emit(o, allCooked, echoSourceLines);
+ lastMsg = msg;
}
}
diff --git a/test/Semantics/allocate02.f90 b/test/Semantics/allocate02.f90
index c396de0..8cc83dd 100644
--- a/test/Semantics/allocate02.f90
+++ b/test/Semantics/allocate02.f90
@@ -44,6 +44,5 @@
!ERROR: At most one of source-expr and type-spec may appear in a ALLOCATE statement
allocate(y3, source=src, stat=stat, errmsg=msg, mold=mld)
!ERROR: At most one of source-expr and type-spec may appear in a ALLOCATE statement
- !ERROR: At most one of source-expr and type-spec may appear in a ALLOCATE statement
allocate(real:: y4, source=src, stat=stat, errmsg=msg, mold=mld)
end subroutine
diff --git a/test/Semantics/array-constr-big.f90 b/test/Semantics/array-constr-big.f90
new file mode 100644
index 0000000..1e8bd5d
--- /dev/null
+++ b/test/Semantics/array-constr-big.f90
@@ -0,0 +1,28 @@
+! RUN: %S/test_errors.sh %s %t %flang_fc1
+! Ensure that evaluating a very large array constructor does not crash the
+! compiler
+program BigArray
+ integer, parameter :: limit = 30
+ !ERROR: Must be a constant value
+ integer(foo),parameter :: jval4(limit,limit,limit) = &
+ !ERROR: Must be a constant value
+ reshape( (/ &
+ ( &
+ ( &
+ (0,ii=1,limit), &
+ jj=-limit,kk &
+ ), &
+ ( &
+ i4,jj=-kk,kk &
+ ), &
+ ( &
+ ( &
+ !ERROR: Must be a constant value
+ 0_foo,ii=1,limit &
+ ),
+ jj=kk,limit &
+ ), &
+ kk=1,limit &
+ ) /), &
+ (/ limit /) )
+end
diff --git a/test/Semantics/io06.f90 b/test/Semantics/io06.f90
index 40ac1df..be07319 100644
--- a/test/Semantics/io06.f90
+++ b/test/Semantics/io06.f90
@@ -36,7 +36,6 @@
rewind(iostat=stat2)
!ERROR: Duplicate ERR specifier
- !ERROR: Duplicate ERR specifier
flush(err=9, unit=10, &
err=9, &
err=9)
diff --git a/test/Semantics/omp-atomic.f90 b/test/Semantics/omp-atomic.f90
index aa50f80..da1d585 100644
--- a/test/Semantics/omp-atomic.f90
+++ b/test/Semantics/omp-atomic.f90
@@ -28,7 +28,6 @@
!$omp end atomic
!ERROR: expected end of line
- !ERROR: expected end of line
!$omp atomic read write
a = a + 1
@@ -42,7 +41,6 @@
a = a + 1
!ERROR: expected end of line
- !ERROR: expected end of line
!$omp atomic capture num_threads(4)
a = a + 1
diff --git a/test/Semantics/omp-clause-validity01.f90 b/test/Semantics/omp-clause-validity01.f90
index acff933..a2de8e7 100644
--- a/test/Semantics/omp-clause-validity01.f90
+++ b/test/Semantics/omp-clause-validity01.f90
@@ -216,7 +216,6 @@
enddo
!ERROR: Clause LINEAR is not allowed if clause ORDERED appears on the DO directive
- !ERROR: Clause LINEAR is not allowed if clause ORDERED appears on the DO directive
!ERROR: The parameter of the ORDERED clause must be a constant positive integer expression
!$omp do ordered(1-1) private(b) linear(b) linear(a)
do i = 1, N
diff --git a/test/Semantics/omp-flush01.f90 b/test/Semantics/omp-flush01.f90
index 3b1bd4e..b189642 100644
--- a/test/Semantics/omp-flush01.f90
+++ b/test/Semantics/omp-flush01.f90
@@ -23,15 +23,12 @@
!$omp flush acquire
!ERROR: expected end of line
- !ERROR: expected end of line
!$omp flush private(array)
!ERROR: expected end of line
- !ERROR: expected end of line
!$omp flush num_threads(4)
! Mix allowed and not allowed clauses.
!ERROR: expected end of line
- !ERROR: expected end of line
!$omp flush num_threads(4) acquire
end if
!$omp end parallel
diff --git a/test/Semantics/resolve70.f90 b/test/Semantics/resolve70.f90
index be49df5..6fe5008 100644
--- a/test/Semantics/resolve70.f90
+++ b/test/Semantics/resolve70.f90
@@ -24,7 +24,6 @@
! ac-spec for an array constructor
!ERROR: ABSTRACT derived type may not be used here
- !ERROR: ABSTRACT derived type may not be used here
type (abstractType), parameter :: abstractArray(*) = (/ abstractType :: /)
class(*), allocatable :: selector
