[flang-commits] [flang] 33a13f3 - [flang] Handle parent component in select type

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-06T14:11:37+01:00
New Revision: 33a13f300bd6fa05b306146e54c2d7d2dd600aae

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

LOG: [flang] Handle parent component in select type

In select type construct the associating entity in a TYPE IS
type guard statement is obtained with a fir.convert. Update the code
for the parent component to support fir.convert defining op
as well.

Reviewed By: jeanPerier

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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 045a91d03442..9d7476b76c7a 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -7236,7 +7236,7 @@ updateBoxForParentComponent(Fortran::lower::AbstractConverter &converter,
   auto &builder = converter.getFirOpBuilder();
   mlir::Value boxBase = fir::getBase(box);
   mlir::Operation *op = boxBase.getDefiningOp();
-  fir::BoxType boxTy = boxBase.getType().dyn_cast<fir::BoxType>();
+  auto boxTy = boxBase.getType().dyn_cast<fir::BaseBoxType>();
   mlir::Type boxEleTy = fir::unwrapAllRefAndSeqType(boxTy.getEleTy());
   auto originalRecTy = boxEleTy.dyn_cast<fir::RecordType>();
   mlir::Type actualTy = converter.genType(expr);
@@ -7244,9 +7244,10 @@ updateBoxForParentComponent(Fortran::lower::AbstractConverter &converter,
   auto parentCompTy = eleTy.dyn_cast<fir::RecordType>();
   assert(parentCompTy && "expecting derived-type");
 
-  assert(
-      (mlir::dyn_cast<fir::EmboxOp>(op) || mlir::dyn_cast<fir::ReboxOp>(op)) &&
-      "expecting fir.embox or fir.rebox operation");
+  assert((mlir::dyn_cast<fir::EmboxOp>(op) ||
+          mlir::dyn_cast<fir::ReboxOp>(op) ||
+          mlir::dyn_cast<fir::ConvertOp>(op)) &&
+         "expecting fir.embox or fir.rebox or fir.convert operation");
 
   if (parentCompTy.getTypeList().empty())
     TODO(loc, "parent component with no component");
@@ -7259,6 +7260,12 @@ updateBoxForParentComponent(Fortran::lower::AbstractConverter &converter,
       loc, fieldTy, firstComponent.first, originalRecTy,
       /*typeParams=*/mlir::ValueRange{});
 
+  if (auto convert = mlir::dyn_cast<fir::ConvertOp>(op)) {
+    auto rebox = builder.create<fir::ReboxOp>(loc, fir::BoxType::get(actualTy),
+                                              convert.getValue(), mlir::Value{},
+                                              mlir::Value{});
+    return fir::substBase(box, fir::getBase(rebox));
+  }
   if (auto embox = mlir::dyn_cast<fir::EmboxOp>(op)) {
     mlir::Value slice = createSliceForParentComp(builder, loc, embox, box,
                                                  field, expr.Rank() > 0);

diff  --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 16757ff279a8..04613a7b848c 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -1001,6 +1001,30 @@ subroutine move_alloc_poly(a, b)
 ! CHECK: %[[TYPE_DESC_CONV:.*]] = fir.convert %[[TYPE_DESC]] : (!fir.tdesc<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<none>
 ! CHECK: %{{.*}} = fir.call @_FortranAMoveAlloc(%[[B_CONV]], %[[A_CONV]], %[[TYPE_DESC_CONV]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, !fir.ref<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
 
+  subroutine test_parent_comp_in_select_type(s)
+    class(p1), allocatable :: s
+    class(p1), allocatable :: p
+
+    allocate(p1::p)
+
+    select type(s)
+      type is(p2)
+        s%p1 = p
+    end select
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_parent_comp_in_select_type(
+! CHECK-SAME: %[[S:.*]]: !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>> {fir.bindc_name = "s"}) {
+! CHECK:  %[[P:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {bindc_name = "p", uniq_name = "_QMpolymorphic_testFtest_parent_comp_in_select_typeEp"}
+! CHECK:  %[[LOAD_S:.*]] = fir.load %[[S]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+! CHECK:  fir.select_type %[[LOAD_S]] : !fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> [#fir.type_is<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>, ^bb1, unit, ^bb2]
+! CHECK: ^bb1:
+! CHECK:  %[[REBOX_P1:.*]] = fir.rebox %[[LOAD_S]] : (!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK:  %[[LOAD_P:.*]] = fir.load %[[P]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>
+! CHECK:  %[[LHS_CONV:.*]] = fir.convert %[[REBOX_P1]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.ref<!fir.box<none>>
+! CHECK:  %[[RHS_CONV:.*]] = fir.convert %[[LOAD_P]] : (!fir.class<!fir.heap<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.box<none>
+! CHECK:  %{{.*}} = fir.call @_FortranAAssign(%[[LHS_CONV]], %[[RHS_CONV]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+
 end module
 
 program test