diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h --- a/flang/include/flang/Evaluate/shape.h +++ b/flang/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/flang/include/flang/Parser/message.h b/flang/include/flang/Parser/message.h --- a/flang/include/flang/Parser/message.h +++ b/flang/include/flang/Parser/message.h @@ -200,10 +200,11 @@ return std::holds_alternative(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 location_; std::variant text_; diff --git a/flang/lib/Parser/message.cpp b/flang/lib/Parser/message.cpp --- a/flang/lib/Parser/message.cpp +++ b/flang/lib/Parser/message.cpp @@ -211,6 +211,26 @@ } } +// Message's 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/flang/test/Semantics/allocate02.f90 b/flang/test/Semantics/allocate02.f90 --- a/flang/test/Semantics/allocate02.f90 +++ b/flang/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/flang/test/Semantics/array-constr-big.f90 b/flang/test/Semantics/array-constr-big.f90 new file mode 100644 --- /dev/null +++ b/flang/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/flang/test/Semantics/io06.f90 b/flang/test/Semantics/io06.f90 --- a/flang/test/Semantics/io06.f90 +++ b/flang/test/Semantics/io06.f90 @@ -35,7 +35,6 @@ !ERROR: REWIND statement must have a UNIT number specifier rewind(iostat=stat2) - !ERROR: Duplicate ERR specifier !ERROR: Duplicate ERR specifier flush(err=9, unit=10, & err=9, & diff --git a/flang/test/Semantics/omp-atomic.f90 b/flang/test/Semantics/omp-atomic.f90 --- a/flang/test/Semantics/omp-atomic.f90 +++ b/flang/test/Semantics/omp-atomic.f90 @@ -27,7 +27,6 @@ a = a + 1 !$omp end atomic - !ERROR: expected end of line !ERROR: expected end of line !$omp atomic read write a = a + 1 @@ -41,7 +40,6 @@ !$omp atomic num_threads(4) 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/flang/test/Semantics/omp-clause-validity01.f90 b/flang/test/Semantics/omp-clause-validity01.f90 --- a/flang/test/Semantics/omp-clause-validity01.f90 +++ b/flang/test/Semantics/omp-clause-validity01.f90 @@ -215,7 +215,6 @@ a = 3.14 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) diff --git a/flang/test/Semantics/omp-flush01.f90 b/flang/test/Semantics/omp-flush01.f90 --- a/flang/test/Semantics/omp-flush01.f90 +++ b/flang/test/Semantics/omp-flush01.f90 @@ -22,16 +22,13 @@ array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/) !$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/flang/test/Semantics/resolve70.f90 b/flang/test/Semantics/resolve70.f90 --- a/flang/test/Semantics/resolve70.f90 +++ b/flang/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