[flang-commits] [flang] 057a2c2 - [flang] Don't fold STORAGE_SIZE() on polymorphic argument

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-01-27T11:58:41-08:00
New Revision: 057a2c239e801810fc28d3e87fc4e9cf50be0fc5

URL: https://github.com/llvm/llvm-project/commit/057a2c239e801810fc28d3e87fc4e9cf50be0fc5
DIFF: https://github.com/llvm/llvm-project/commit/057a2c239e801810fc28d3e87fc4e9cf50be0fc5.diff

LOG: [flang] Don't fold STORAGE_SIZE() on polymorphic argument

More generally, don't return a successful result from
Fortran::evaluate::DynamicType::MeasureSizeInBytes() when the
type is polymorphic.

Differential Revision: https://reviews.llvm.org/D142772

Added: 
    

Modified: 
    flang/lib/Evaluate/type.cpp
    flang/test/Evaluate/errors01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index 85e4315de1127..81744cb752d61 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -157,7 +157,7 @@ std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
     }
     break;
   case TypeCategory::Derived:
-    if (derived_ && derived_->scope()) {
+    if (!IsPolymorphic() && derived_ && derived_->scope()) {
       auto size{derived_->scope()->size()};
       auto align{aligned ? derived_->scope()->alignment().value_or(0) : 0};
       auto alignedSize{align > 0 ? ((size + align - 1) / align) * align : size};

diff  --git a/flang/test/Evaluate/errors01.f90 b/flang/test/Evaluate/errors01.f90
index f3246a40c4a94..ce5e40c282945 100644
--- a/flang/test/Evaluate/errors01.f90
+++ b/flang/test/Evaluate/errors01.f90
@@ -2,6 +2,9 @@
 ! Check errors found in folding
 ! TODO: test others emitted from flang/lib/Evaluate
 module m
+  type t
+    real x
+  end type t
  contains
   subroutine s1(a,b)
     real :: a(*), b(:)
@@ -100,6 +103,14 @@ subroutine s9
     !CHECK: error: DIM=4 argument to SPREAD must be between 1 and 3
     integer, parameter :: bad3 = spread(matrix, 4, 1)
   end subroutine
+  subroutine s12(x,y)
+    class(t), intent(in) :: x
+    class(*), intent(in) :: y
+    !CHERK: error: Must be a constant value
+    integer, parameter :: bad1 = storage_size(x)
+    !CHERK: error: Must be a constant value
+    integer, parameter :: bad2 = storage_size(y)
+  end subroutine
   subroutine warnings
     real, parameter :: ok1 = scale(0.0, 99999) ! 0.0
     real, parameter :: ok2 = scale(1.0, -99999) ! 0.0