[flang-commits] [flang] 6472a2e - [flang] Handle parent component on the LHS of intrinsic assignment

[Valentin Clement via flang-commits]

Author: Valentin Clement
Date: 2023-03-14T16:02:00+01:00
New Revision: 6472a2ee363f3b5ac823e471b7ba5582c101a528

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

LOG: [flang] Handle parent component on the LHS of intrinsic assignment

When the LHS is referring to a parent component the box need to be
reboxed to the parent component type so the runtime can handle the
assignment correctly.

Reviewed By: PeteSteinfeld

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

Added: 
    

Modified: 
    flang/lib/Lower/Bridge.cpp
    flang/test/Lower/parent-component.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 0c99e539259df..2ed552ed4ddd5 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3140,6 +3140,14 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                 fir::factory::CharacterExprHelper{*builder, loc}.createAssign(
                     lhs, rhs);
               } else if (isDerivedCategory(lhsType->category())) {
+                // Handle parent component.
+                if (Fortran::lower::isParentComponent(assign.lhs)) {
+                  if (!fir::getBase(lhs).getType().isa<fir::BaseBoxType>())
+                    lhs = fir::getBase(builder->createBox(loc, lhs));
+                  lhs = Fortran::lower::updateBoxForParentComponent(*this, lhs,
+                                                                    assign.lhs);
+                }
+
                 // Fortran 2018 10.2.1.3 p13 and p14
                 // Recursively gen an assignment on each element pair.
                 fir::factory::genRecordAssignment(*builder, loc, lhs, rhs,

diff  --git a/flang/test/Lower/parent-component.f90 b/flang/test/Lower/parent-component.f90
index dbca53e34e5c9..0755b5409a2fd 100644
--- a/flang/test/Lower/parent-component.f90
+++ b/flang/test/Lower/parent-component.f90
@@ -175,4 +175,23 @@ subroutine init_existing_field()
   ! CHECK: %[[C1:.*]] = arith.constant 1 : index
   ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[C2]], %[[C1]] path %[[FIELD_C]] : (index, index, index, !fir.field) -> !fir.slice<1>
   ! CHECK: %{{.*}} = fir.embox %[[ALLOCA]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{a:i32,b:i32}>}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
+
+  subroutine parent_comp_lhs()
+    type(c) :: a
+    type(p) :: b
+
+    a%p = B
+  end subroutine
+
+! CHECK-LABEL: func.func @_QFPparent_comp_lhs()
+! CHECK: %[[BOX:.*]] = fir.alloca !fir.box<!fir.type<_QFTp{a:i32}>>
+! CHECK: %[[A:.*]] = fir.alloca !fir.type<_QFTc{a:i32,b:i32}> {bindc_name = "a", uniq_name = "_QFFparent_comp_lhsEa"}
+! CHECK: %[[B:.*]] = fir.alloca !fir.type<_QFTp{a:i32}> {bindc_name = "b", uniq_name = "_QFFparent_comp_lhsEb"}
+! CHECK: %[[EMBOX_A:.*]] = fir.embox %[[A]] : (!fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>) -> !fir.box<!fir.type<_QFTp{a:i32}>>
+! CHECK: %[[EMBOX_B:.*]] = fir.embox %[[B]] : (!fir.ref<!fir.type<_QFTp{a:i32}>>) -> !fir.box<!fir.type<_QFTp{a:i32}>>
+! CHECK: fir.store %[[EMBOX_A]] to %[[BOX]] : !fir.ref<!fir.box<!fir.type<_QFTp{a:i32}>>>
+! CHECK: %[[A_NONE:.*]] = fir.convert %[[BOX]] : (!fir.ref<!fir.box<!fir.type<_QFTp{a:i32}>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[B_NONE:.*]] = fir.convert %[[EMBOX_B]] : (!fir.box<!fir.type<_QFTp{a:i32}>>) -> !fir.box<none>
+! CHECK: %{{.*}} = fir.call @_FortranAAssign(%[[A_NONE]], %[[B_NONE]], %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+
 end