[flang-commits] [flang] faa1043 - [flang] Carry over dynamic type information when creating an unlimited polymorphic temp

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-21T16:08:07+01:00
New Revision: faa1043144b3f6c3362fe1d9f43e55e741b40386

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

LOG: [flang] Carry over dynamic type information when creating an unlimited polymorphic temp

The dyanmic type must be carried over in a PolymorphicValue when the address is
loaded from an unlimited polymorphic allocatable.

Reviewed By: PeteSteinfeld

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

Added: 
    

Modified: 
    flang/lib/Lower/ConvertExpr.cpp
    flang/lib/Optimizer/Builder/FIRBuilder.cpp
    flang/test/Lower/polymorphic.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 03b803e8271b1..3138d24fc5322 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -416,7 +416,8 @@ static fir::ExtendedValue genLoad(fir::FirOpBuilder &builder,
         if (fir::unwrapRefType(fir::getBase(p).getType())
                 .isa<fir::RecordType>())
           return p;
-        return builder.create<fir::LoadOp>(loc, fir::getBase(p));
+        mlir::Value load = builder.create<fir::LoadOp>(loc, fir::getBase(p));
+        return fir::PolymorphicValue(load, p.getSourceBox());
       },
       [&](const fir::UnboxedValue &v) -> fir::ExtendedValue {
         if (fir::unwrapRefType(fir::getBase(v).getType())
@@ -429,9 +430,6 @@ static fir::ExtendedValue genLoad(fir::FirOpBuilder &builder,
                        fir::factory::genMutableBoxRead(builder, loc, box));
       },
       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
-        if (box.isUnlimitedPolymorphic())
-          fir::emitFatalError(
-              loc, "attempting to load an unlimited polymorphic entity");
         return genLoad(builder, loc,
                        fir::factory::readBoxValue(builder, loc, box));
       },

diff  --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
index 244f972ca5a34..020d6c7b27eb1 100644
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -816,7 +816,7 @@ fir::factory::getExtents(mlir::Location loc, fir::FirOpBuilder &builder,
 fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
                                               mlir::Location loc,
                                               const fir::BoxValue &box) {
-  assert(!box.isUnlimitedPolymorphic() && !box.hasAssumedRank() &&
+  assert(!box.hasAssumedRank() &&
          "cannot read unlimited polymorphic or assumed rank fir.box");
   auto addr =
       builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
@@ -830,10 +830,15 @@ fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
   }
   if (box.isDerivedWithLenParameters())
     TODO(loc, "read fir.box with length parameters");
+  mlir::Value sourceBox;
+  if (box.isPolymorphic())
+    sourceBox = box.getAddr();
+  if (box.isPolymorphic() && box.rank() == 0)
+    return fir::PolymorphicValue(addr, sourceBox);
   if (box.rank() == 0)
     return addr;
   return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box),
-                            box.getLBounds());
+                            box.getLBounds(), sourceBox);
 }
 
 llvm::SmallVector<mlir::Value>

diff  --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 67699bd32495f..ccc3d86998611 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -53,6 +53,10 @@ module polymorphic_test
     class(p1), allocatable :: a(:)
   end type
 
+  type :: p5
+    class(*), allocatable :: up
+  end type
+
   contains
 
   elemental subroutine assign_p1_int(lhs, rhs)
@@ -1138,6 +1142,28 @@ subroutine class_array_with_entry(a)
 ! CHECK-SAME: %[[B:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "b"}) {
 ! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
 
+  subroutine pass_up(up)
+    class(*), intent(in) :: up
+  end subroutine
+
+  subroutine parenthesized_up(a)
+    type(p5) :: a
+    call pass_up((a%up))
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPparenthesized_up(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.type<_QMpolymorphic_testTp5{up:!fir.class<!fir.heap<none>>}>> {fir.bindc_name = "a"}) {
+! CHECK: %[[ALLOCA:.*]] = fir.alloca
+! CHECK: %[[FIELD_UP:.*]] = fir.field_index up, !fir.type<_QMpolymorphic_testTp5{up:!fir.class<!fir.heap<none>>}>
+! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[ARG0]], %[[FIELD_UP]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp5{up:!fir.class<!fir.heap<none>>}>>, !fir.field) -> !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[LOAD:.*]] = fir.load %[[COORD]] : !fir.ref<!fir.class<!fir.heap<none>>>
+! CHECK: %[[BOX_ADDR:.*]] = fir.box_addr %[[LOAD]] : (!fir.class<!fir.heap<none>>) -> !fir.heap<none>
+! CHECK: %[[LOAD_ADDR:.*]] = fir.load %[[BOX_ADDR]] : !fir.heap<none>
+! CHECK: %[[NO_REASSOC:.*]] = fir.no_reassoc %[[LOAD_ADDR]] : none
+! CHECK: fir.store %[[NO_REASSOC]] to %[[ALLOCA]] : !fir.ref<none>
+! CHECK: %[[EMBOX:.*]] = fir.embox %[[ALLOCA]] source_box %[[LOAD]] : (!fir.ref<none>, !fir.class<!fir.heap<none>>) -> !fir.class<none>
+! CHECK: fir.call @_QMpolymorphic_testPpass_up(%[[EMBOX]]) fastmath<contract> : (!fir.class<none>) -> ()
+
 end module
 
 program test