#define FORTRAN_EVALUATE_SHAPE_H_
#include "expression.h"
+#include "fold.h"
#include "traverse.h"
#include "variable.h"
#include "flang/Common/indirection.h"
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;
}
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_;
}
}
+// 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() ||
}
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;
}
}
!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
--- /dev/null
+! 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
rewind(iostat=stat2)
!ERROR: Duplicate ERR specifier
- !ERROR: Duplicate ERR specifier
flush(err=9, unit=10, &
err=9, &
err=9)
!$omp end atomic
!ERROR: expected end of line
- !ERROR: expected end of line
!$omp atomic read write
a = a + 1
a = a + 1
!ERROR: expected end of line
- !ERROR: expected end of line
!$omp atomic capture num_threads(4)
a = a + 1
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
!$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
! 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