[flang-commits] [flang] fbca61c - [flang] Load fir.ref<fir.class<T>> instead of creating a wrong box

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-14T21:45:20+01:00
New Revision: fbca61c46612a6377b7d7cf5b56573df3c6759e2

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

LOG: [flang] Load fir.ref<fir.class<T>> instead of creating a wrong box

When a subroutine has an entry statement, the non-used argument
will be a fir.alloca and result in a fir.ref<fir.class<T>> for
polymorphic entities. In createBox, just load the box instead of
creating a wrong box.

Reviewed By: PeteSteinfeld

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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
index 64c3c26231eb2..39253e727265e 100644
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -516,6 +516,9 @@ mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
         << itemAddr.getType();
     llvm_unreachable("not a memory reference type");
   }
+  if (itemAddr.getType().isa<fir::ReferenceType>() &&
+      elementType.isa<fir::BaseBoxType>())
+    return create<fir::LoadOp>(loc, fir::getBase(exv));
   mlir::Type boxTy = fir::BoxType::get(elementType);
   mlir::Value tdesc;
   if (isPolymorphic) {

diff  --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 6bb9f735f5d9a..dd023b9694ff1 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -1086,6 +1086,32 @@ subroutine test_parent_comp_opt(p)
 ! CHECK: %[[CONV:.*]] = fir.convert %[[RES]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
 ! CHECK: fir.call @_QMpolymorphic_testPtakes_p1_opt(%[[CONV]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()
 
+  subroutine class_with_entry(a)
+    class(p1) :: a,b
+    select type (a)
+    type is(p2)
+      print*, a%c
+    class default
+      print*, a%a
+    end select
+    return
+  entry d(b)
+    select type(b)
+    type is(p2)
+      print*,b%c
+    class default
+      print*,b%a
+    end select
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPclass_with_entry(
+! CHECK-SAME: %[[A:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}) {
+! CHECK: %[[B:.*]] = fir.alloca !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "b", uniq_name = "_QMpolymorphic_testFclass_with_entryEb"}
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPd(
+! CHECK-SAME: %[[B:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "b"}) {
+! CHECK: %[[A:.*]] = fir.alloca !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {bindc_name = "a", uniq_name = "_QMpolymorphic_testFclass_with_entryEa"}
+
 end module
 
 program test