[flang-commits] [PATCH] D157336: [flang] Don't crash in error recovery situation

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D157336

Files:
  flang/include/flang/Evaluate/initial-image.h
  flang/lib/Evaluate/fold.cpp
  flang/lib/Evaluate/initial-image.cpp
  flang/test/Semantics/null01.f90


Index: flang/test/Semantics/null01.f90
===================================================================
--- flang/test/Semantics/null01.f90
+++ flang/test/Semantics/null01.f90
@@ -1,4 +1,4 @@
-! 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
@@ -103,6 +103,8 @@
   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
Index: flang/lib/Evaluate/initial-image.cpp
===================================================================
--- flang/lib/Evaluate/initial-image.cpp
+++ flang/lib/Evaluate/initial-image.cpp
@@ -35,12 +35,10 @@
             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;
Index: flang/lib/Evaluate/fold.cpp
===================================================================
--- flang/lib/Evaluate/fold.cpp
+++ flang/lib/Evaluate/fold.cpp
@@ -275,11 +275,15 @@
     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);
-      return image.AsConstant(
-          context, *moldType, moldLength, *extents, true /*pad with 0*/);
+      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;
Index: flang/include/flang/Evaluate/initial-image.h
===================================================================
--- flang/include/flang/Evaluate/initial-image.h
+++ flang/include/flang/Evaluate/initial-image.h
@@ -22,12 +22,7 @@
 
 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;


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D157336.547962.patch
Type: text/x-patch
Size: 3201 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230807/e167c21c/attachment-0001.bin>