[flang] Don't crash in error recovery situation

[klausler]

Summary

When folding the TRANSFER() intrinsic function, there's a CHECK()
that the initial image was built without error. However, there is one
condition that elicits a warning -- a derived type SOURCE= with an
allocatable or dynamic component. Remove this CHECK().

Fixes llvm-test-suite/Fortran/gfortran/regression/transfer_null_1.f90.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Evaluate/initial-image.h

 #include <map>
 #include <optional>
 #include <vector>
 
 namespace Fortran::evaluate {
 
 class InitialImage {
 public:
-  enum Result {
-    Ok,
-    NotAConstant,
-    OutOfRange,
-    SizeMismatch,
-  };
+  enum Result { Ok, NotAConstant, OutOfRange, SizeMismatch };
 
   explicit InitialImage(std::size_t bytes) : data_(bytes) {}
   InitialImage(InitialImage &&that) = default;
 
   std::size_t size() const { return data_.size(); }
 
   template <typename A>
   Result Add(ConstantSubscript, std::size_t, const A &, FoldingContext &) {

flang/lib/Evaluate/fold.cpp

if (sourceBytes && IsActuallyConstant(*source) && moldType && extents &&
       (moldLength || moldType->category() != TypeCategory::Character)) {
     std::size_t elements{
         extents->empty() ? 1 : static_cast<std::size_t>((*extents)[0])};
     std::size_t totalBytes{*sourceBytes * elements};
     // Don't fold intentional overflow cases from sneaky tests
     if (totalBytes < std::size_t{1000000} &&
         (elements == 0 || totalBytes / elements == *sourceBytes)) {
       InitialImage image{*sourceBytes};
-      InitialImage::Result imageResult{
-          image.Add(0, *sourceBytes, *source, context)};
-      CHECK(imageResult == InitialImage::Ok);
+      auto status{image.Add(0, *sourceBytes, *source, context)};
+      if (status == InitialImage::Ok) {
         return image.AsConstant(
             context, *moldType, moldLength, *extents, true /*pad with 0*/);
+      } else {
+        // Can fail due to an allocatable or automatic component;
+        // a warning will also have been produced.
+        CHECK(status == InitialImage::NotAConstant);
+      }
     }
   }
   return std::nullopt;
 }
 
 template class ExpressionBase<SomeDerived>;
 template class ExpressionBase<SomeType>;
 
 } // namespace Fortran::evaluate

flang/lib/Evaluate/initial-image.cpp

if (elements * elementBytes != bytes) {
         for (const auto &[symbolRef, indExpr] : scalar) {
           const Symbol &component{*symbolRef};
           if (component.offset() + component.size() > elementBytes) {
             return SizeMismatch;
           } else if (IsPointer(component)) {
             AddPointer(offset + component.offset(), indExpr.value());
           } else if (IsAllocatable(component) || IsAutomatic(component)) {
             return NotAConstant;
-          } else {
-            Result added{Add(offset + component.offset(), component.size(),
-                indExpr.value(), context)};
-            if (added != Ok) {
-              return added;
-            }
+          } else if (auto result{Add(offset + component.offset(),
+                         component.size(), indExpr.value(), context)};
+                     result != Ok) {
+            return result;
           }
         }
         offset += elementBytes;
       }
     }
     return Ok;
   }
 }

flang/test/Semantics/null01.f90

-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! NULL() intrinsic function error tests
 
 subroutine test
   interface
     subroutine s0
     end subroutine
     subroutine s1(j)
       integer, intent(in) :: j
subroutine test
   !ERROR: Null pointer argument requires an explicit interface
   call implicit(null())
   !ERROR: Null pointer argument requires an explicit interface
   call implicit(null(mold=ip0))
   !ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument
   print *, sin(null(rp0))
   !ERROR: A NULL() pointer is not allowed for 'source=' intrinsic argument
   print *, transfer(null(rp0),ip0)
+  !WARNING: Source of TRANSFER contains allocatable or pointer component %ra0
+  print *, transfer(dt4(null()),[0])
   !ERROR: NULL() may not be used as an expression in this context
   select case(null(ip0))
   end select
   !ERROR: NULL() may not be used as an expression in this context
   if (null(lp)) then
   end if
 end subroutine test