[flang-commits] [flang] 71e2d71 - [flang] Handle parent component in intrinsic function arguments

Valentin Clement via flang-commits flang-commits at lists.llvm.org
Mon Mar 13 07:28:28 PDT 2023


Author: Valentin Clement
Date: 2023-03-13T15:28:09+01:00
New Revision: 71e2d7106fe58ff2dcc6886c80ea0839a129d3c0

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

LOG: [flang] Handle parent component in intrinsic function arguments

When the argument is a parent component the box needs to
be updated to reflect the correct type. Use `updateBoxForParentComponent`
to update the argument accordingly.

Reviewed By: PeteSteinfeld

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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h
index e8b388bd0b7f9..a4a8a524e9ada 100644
--- a/flang/include/flang/Lower/ConvertExpr.h
+++ b/flang/include/flang/Lower/ConvertExpr.h
@@ -79,6 +79,14 @@ fir::MutableBoxValue createMutableBox(mlir::Location loc,
                                       AbstractConverter &converter,
                                       const SomeExpr &expr, SymMap &symMap);
 
+/// Return true iff the expression is pointing to a parent component.
+bool isParentComponent(const SomeExpr &expr);
+
+/// Update the extended value to represent the parent component.
+fir::ExtendedValue updateBoxForParentComponent(AbstractConverter &converter,
+                                               fir::ExtendedValue exv,
+                                               const SomeExpr &expr);
+
 /// Create a fir::BoxValue describing the value of \p expr.
 /// If \p expr is a variable without vector subscripts, the fir::BoxValue
 /// described the variable storage. Otherwise, the created fir::BoxValue

diff  --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index f6cd76188316b..7a60f44d9c4d9 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1753,6 +1753,11 @@ class ScalarExprLowering {
                                               fir::getBase(exv));
     }
     mlir::Value box = builder.createBox(loc, exv, exv.isPolymorphic());
+    if (Fortran::lower::isParentComponent(expr)) {
+      fir::ExtendedValue newExv =
+          Fortran::lower::updateBoxForParentComponent(converter, box, expr);
+      box = fir::getBase(newExv);
+    }
     return fir::BoxValue(
         box, fir::factory::getNonDefaultLowerBounds(builder, loc, exv),
         fir::factory::getNonDeferredLenParams(exv));
@@ -7188,7 +7193,7 @@ fir::MutableBoxValue Fortran::lower::createMutableBox(
       .genMutableBoxValue(expr);
 }
 
-bool isParentComponent(const Fortran::lower::SomeExpr &expr) {
+bool Fortran::lower::isParentComponent(const Fortran::lower::SomeExpr &expr) {
   if (const Fortran::semantics::Symbol * symbol{GetLastSymbol(expr)}) {
     if (symbol->test(Fortran::semantics::Symbol::Flag::ParentComp))
       return true;
@@ -7196,24 +7201,6 @@ bool isParentComponent(const Fortran::lower::SomeExpr &expr) {
   return false;
 }
 
-template <typename OP>
-mlir::Value createSliceForParentComp(fir::FirOpBuilder &builder,
-                                     mlir::Location loc, OP boxOp,
-                                     fir::ExtendedValue box, mlir::Value field,
-                                     bool isArray) {
-  if (boxOp.getSlice()) {
-    mlir::Value existingSlice = boxOp.getSlice();
-    fir::SliceOp sliceOp =
-        mlir::dyn_cast<fir::SliceOp>(existingSlice.getDefiningOp());
-    llvm::SmallVector<mlir::Value> fields = sliceOp.getFields();
-    fields.push_back(field);
-    return builder.createSlice(loc, box, sliceOp.getTriples(), fields);
-  }
-  if (isArray)
-    return builder.createSlice(loc, box, {}, {field});
-  return {};
-}
-
 // Handling special case where the last component is referring to the
 // parent component.
 //
@@ -7228,10 +7215,9 @@ mlir::Value createSliceForParentComp(fir::FirOpBuilder &builder,
 // y(:)%t  ! just need to update the box with a slice pointing to the first
 //         ! component of `t`.
 // a%t     ! simple conversion to TYPE(t).
-fir::ExtendedValue
-updateBoxForParentComponent(Fortran::lower::AbstractConverter &converter,
-                            fir::ExtendedValue box,
-                            const Fortran::lower::SomeExpr &expr) {
+fir::ExtendedValue Fortran::lower::updateBoxForParentComponent(
+    Fortran::lower::AbstractConverter &converter, fir::ExtendedValue box,
+    const Fortran::lower::SomeExpr &expr) {
   mlir::Location loc = converter.getCurrentLocation();
   auto &builder = converter.getFirOpBuilder();
   mlir::Value boxBase = fir::getBase(box);

diff  --git a/flang/test/Lower/polymorphic.f90 b/flang/test/Lower/polymorphic.f90
index 14df12eb2db3f..1681e8425d886 100644
--- a/flang/test/Lower/polymorphic.f90
+++ b/flang/test/Lower/polymorphic.f90
@@ -1039,6 +1039,22 @@ subroutine move_alloc_unlimited_poly(a, b)
 ! CHECK: %[[A_CONV:.*]] = fir.convert %[[A]] : (!fir.ref<!fir.class<!fir.heap<none>>>) -> !fir.ref<!fir.box<none>>
 ! CHECK: %{{.*}} = fir.call @_FortranAMoveAlloc(%[[B_CONV]], %[[A_CONV]], %[[NULL]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!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_intrinsic(a, b)
+    class(p1) :: a
+    type(p2), allocatable :: b
+    logical :: c
+
+    c = same_type_as(a, b%p1)
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtest_parent_comp_intrinsic(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>> {fir.bindc_name = "a"}, %[[ARG1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>> {fir.bindc_name = "b"}) {
+! CHECK: %[[LOAD_ARG1:.*]] = fir.load %[[ARG1]] : !fir.ref<!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>>
+! CHECK: %[[REBOX_ARG1:.*]] = fir.rebox %[[LOAD_ARG1]] : (!fir.box<!fir.heap<!fir.type<_QMpolymorphic_testTp2{a:i32,b:i32,c:f32}>>>) -> !fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK: %[[BOX_NONE_ARG0:.*]] = fir.convert %[[ARG0]] : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
+! CHECK: %[[BOX_NONE_ARG1:.*]] = fir.convert %[[REBOX_ARG1]] : (!fir.box<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranASameTypeAs(%[[BOX_NONE_ARG0]], %[[BOX_NONE_ARG1]]) {{.*}} : (!fir.box<none>, !fir.box<none>) -> i1
+
 end module
 
 program test


        


More information about the flang-commits mailing list