[flang] Allow large and erroneous ac-implied-do's

[PeteSteinfeld]

Summary

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.

[jeanPerier]

flang/include/flang/Evaluate/shape.h

187

Are they not cases where the additions cannot be folded and the array constructor could still grow big ?
If so, then we will still eventually hit the overflow, and every Fold might actually get expensive.

Maybe GetArrayConstructorExtent should give up if the non constant part grows too much (this could be done by keeping constants n and non constants n in a different accumulators for which the number of operands would be tracked, and GetArrayConstructorExtent would return nullopt after a certain threshold is reached).

I am not sure if there are actually cases where non constant n could still lead to an overflow (I suppose ac-implied-do containing such dynamic extents expression would not be unrolled). So what you have may be enough until we hit a scenario where more is needed here.

flang/lib/Parser/message.cpp

330

I am not opposed to having this here. I am wondering if the places that are raising the same messages over and over should not also be be prevented from doing so. Maybe some checkers in ArrayConstructors should stop after x errors to avoid wasting time and filling messages_.
Again, if you considered it and it turned out unpractical, what you have here already looks like an improvement to me, and it had the benefit to clean some other small error duplication cases.

[PeteSteinfeld]

Thanks for the feedback, Jean!

flang/include/flang/Evaluate/shape.h

187

I don't believe that there are cases where the additions cannot be folded. One of the conditions for folding is that the initial, final, and stride expressions of the ac-implied-do are all constants. The large extent expression that gets produced is based on these constant values. So I don't believe that, with this change, it's possible to create an extent expression that will overflow the stack no matter how large the unrolled list of values is. Note that the values in the unrolled list are not necessarily constant and are not used in the folding. It's only the extent expression.

I like your suggestion of giving up on expression processing if an expression grows to large. I think that this should be done generally for all expression processing. I'm working on a more general way to do this.

flang/lib/Parser/message.cpp

330

Here's an example of code that will produce many messages:

integer(foo),parameter :: jval4(*) = (/ (0_foo,ii=1,10) /)

Without this change, the compiler will produce 10 identical messages for the one erroneous instance of "0_foo":

./j1.f90:2:46: error: Must be a constant value
    integer(foo),parameter :: jval4(*) = (/ (0_foo,ii=1,10) /)
                                               ^^^
./j1.f90:2:46: error: Must be a constant value
    integer(foo),parameter :: jval4(*) = (/ (0_foo,ii=1,10) /)
                                               ^^^
    ...

Basing the elimination of messages on the number of messages seems incorrect to me. Rather, we should only produce one message for each group of unrolled messages. It might be possible to do that. But the current code solves the same problem in a more general way. Let me know if you disagree.

[klausler]

flang/lib/Parser/message.cpp

214

Messages*

[PeteSteinfeld]

flang/lib/Parser/message.cpp

214

Thanks. I was (unsuccessfully) trying to distinguish between the name of the type and the general English language term. I'll clean this up.

flang/include/flang/Evaluate/shape.h

 //===-- include/flang/Evaluate/shape.h --------------------------*- C++ -*-===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 // GetShape() analyzes an expression and determines its shape, if possible,
 // representing the result as a vector of scalar integer expressions.
 
 #ifndef FORTRAN_EVALUATE_SHAPE_H_
 #define FORTRAN_EVALUATE_SHAPE_H_
 
 #include "expression.h"
+#include "fold.h"
 #include "traverse.h"
 #include "variable.h"
 #include "flang/Common/indirection.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Evaluate/type.h"
 #include <optional>
 #include <variant>
 
private:
 
   template <typename T>
   MaybeExtentExpr GetArrayConstructorExtent(
       const ArrayConstructorValues<T> &values) const {
     ExtentExpr result{0};
     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 result;
   }
 
   FoldingContext *context_{nullptr};

flang/include/flang/Parser/message.h

public:
   // If this Message or any of its attachments locates itself via a CharBlock,
   // replace its location with the corresponding ProvenanceRange.
   void ResolveProvenances(const AllCookedSources &);
 
   bool IsMergeable() const {
     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_;
   bool attachmentIsContext_{false};
   Reference attachment_;
 };
 
 class Messages {

flang/lib/Parser/message.cpp

for (const Message *attachment{attachment_.get()}; attachment;
     }
     text += attachment->ToString();
     sources.EmitMessage(
         o, attachment->GetProvenanceRange(allCooked), text, echoSourceLine);
     isContext = attachment->attachmentIsContext_;
   }
 }
 
+// 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() ||
           attachment_.get() == that.attachment_.get()) &&
       std::visit(
           common::visitors{
               [](MessageExpectedText &e1, const MessageExpectedText &e2) {
                 return e1.Merge(e2);

 void Messages::Emit(llvm::raw_ostream &o, const AllCookedSources &allCooked,
     bool echoSourceLines) const {
   std::vector<const Message *> sorted;
   for (const auto &msg : messages_) {
     sorted.push_back(&msg);
   }
   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;
   }
 }
 
 void Messages::AttachTo(Message &msg) {
   for (Message &m : messages_) {
     msg.Attach(std::move(m));
   }
   messages_.clear();

flang/test/Semantics/allocate02.f90

! At most one of source-expr and type-spec must appear.
 
   !ERROR: At most one of source-expr and type-spec may appear in a ALLOCATE statement
   allocate(real:: y1, source=src)
   !ERROR: At most one of source-expr and type-spec may appear in a ALLOCATE statement
   allocate(real:: y2, mold=mld)
   !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

flang/test/Semantics/array-constr-big.f90

+! 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

flang/test/Semantics/io06.f90

! RUN: %S/test_errors.sh %s %t %flang_fc1
 
   !ERROR: IOMSG variable 'const_msg' must be definable
   flush(iomsg=const_msg, unit=10, iostat=stat8, err=9)
 
   !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, &
         err=9)
 
   !ERROR: Duplicate ID specifier
   !ERROR: WAIT statement must have a UNIT number specifier
   wait(id=id2, eor=9, id=id3)
 
 9 continue
 end

flang/test/Semantics/omp-atomic.f90

! Check OpenMP 2.13.6 atomic Construct
   !$omp end atomic
 
   !$omp atomic hint(1) acq_rel capture
   b = a
   a = a + 1
   !$omp end atomic
 
   !ERROR: expected end of line
-  !ERROR: expected end of line
   !$omp atomic read write
   a = a + 1
 
   !$omp atomic
   a = a + 1
   !ERROR: expected 'UPDATE'
   !ERROR: expected 'WRITE'
   !ERROR: expected 'CAPTURE'
   !ERROR: expected 'READ'
   !$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
 
   !$omp atomic relaxed
   a = a + 1
 
   !ERROR: expected 'UPDATE'
   !ERROR: expected 'WRITE'
   !ERROR: expected 'CAPTURE'
   !ERROR: expected 'READ'
   !$omp atomic num_threads write
   a = a + 1
 
   !$omp end parallel
 end

flang/test/Semantics/omp-clause-validity01.f90

!                     ordered-clause
   enddo
 
   !$omp do schedule(simd, monotonic:dynamic)
   do i = 1, N
      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)
   do i = 1, N
      a = 3.14
   enddo
 
   !ERROR: The parameter of the ORDERED clause must be greater than or equal to the parameter of the COLLAPSE clause
   !$omp do collapse(num-14) ordered(1)

flang/test/Semantics/omp-flush01.f90

if (omp_get_thread_num() == 1) then
     ! Allowed clauses.
     !$omp flush acq_rel
     array = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/)
     !$omp flush release
     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
 end
 

flang/test/Semantics/resolve70.f90

subroutine s()
   end type concreteType
 
   ! declaration-type-spec
   !ERROR: ABSTRACT derived type may not be used here
   type (abstractType), allocatable :: abstractVar
 
   ! 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
 
   ! Structure constructor
   !ERROR: ABSTRACT derived type may not be used here
   !ERROR: ABSTRACT derived type 'abstracttype' may not be used in a structure constructor
   type (abstractType) :: abstractVar1 = abstractType()