[flang-commits] [flang] d07f23e - [flang][hlfir] Use actual type when copying an actual argument variable

[Jean Perier via flang-commits]

Author: Jean Perier
Date: 2023-05-25T17:43:44+02:00
New Revision: d07f23e033220b7fbc47b40172de647c09364c62

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

LOG: [flang][hlfir] Use actual type when copying an actual argument variable

The copy must made according to the actual type, not the dummy type. In
case the dummy is polymorphic, these types will be different and the
dynamic type of the copy passed in the call should be the one of the
actual.

There is no support for "class(t), value" yet (it is hitting a TODO in
CallInterface that is moot for HLFIR but has not been lifted for lack of
proper testing) so the bug was dormant, but D151271 created a situation
where a copy is needed with polymorphic dummies and exposed the bug.
This led to a compile time assert
"value.isScalar() && fir::isa_trivial(value.getType())" in "hlfir::genAssociateExpr".

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

Added: 
    flang/test/Lower/HLFIR/calls-constant-expr-arg-polymorphic.f90

Modified: 
    flang/lib/Lower/ConvertCall.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 824f57aec81b5..53ab160f6c089 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -921,8 +921,9 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
         entity.isParameter()) {
       // Make a copy in a temporary.
       auto copy = builder.create<hlfir::AsExprOp>(loc, entity);
+      mlir::Type storageType = entity.getType();
       hlfir::AssociateOp associate = hlfir::genAssociateExpr(
-          loc, builder, hlfir::Entity{copy}, dummyType, "adapt.valuebyref");
+          loc, builder, hlfir::Entity{copy}, storageType, "adapt.valuebyref");
       entity = hlfir::Entity{associate.getBase()};
       // Register the temporary destruction after the call.
       preparedDummy.setExprAssociateCleanUp(

diff  --git a/flang/test/Lower/HLFIR/calls-constant-expr-arg-polymorphic.f90 b/flang/test/Lower/HLFIR/calls-constant-expr-arg-polymorphic.f90
new file mode 100644
index 0000000000000..f6986375fdc16
--- /dev/null
+++ b/flang/test/Lower/HLFIR/calls-constant-expr-arg-polymorphic.f90
@@ -0,0 +1,29 @@
+! RUN: bbc -emit-fir -hlfir --polymorphic-type -o - %s | FileCheck %s
+
+! Test when constant argument are copied in memory
+! and passed to polymorphic arguments.
+! The copy is done in case the dummy later appear in a
+! copy-out that would create write to this memory location.
+  type t1
+    integer :: i
+  end type
+  type, extends(t1) :: t2
+    integer :: j
+  end type
+  interface
+  subroutine foo(x)
+    import :: t1
+    class(t1) :: x(:)
+  end subroutine
+  end interface
+
+  call foo([t2(0,0)])
+end
+! CHECK-LABEL:   func.func @_QQmain() {
+! CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_2:.*]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.1x_QFTt2.0"}
+! CHECK:           %[[VAL_4:.*]] = hlfir.as_expr %[[VAL_3]]#0 : (!fir.ref<!fir.array<1x!fir.type<_QFTt2{i:i32,j:i32}>>>) -> !hlfir.expr<1x!fir.type<_QFTt2{i:i32,j:i32}>>
+! CHECK:           %[[VAL_5:.*]]:3 = hlfir.associate %[[VAL_4]](%[[VAL_2]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<1x!fir.type<_QFTt2{i:i32,j:i32}>>, !fir.shape<1>) -> (!fir.ref<!fir.array<1x!fir.type<_QFTt2{i:i32,j:i32}>>>, !fir.ref<!fir.array<1x!fir.type<_QFTt2{i:i32,j:i32}>>>, i1)
+! CHECK:           %[[VAL_6:.*]] = fir.embox %[[VAL_5]]#0(%[[VAL_2]]) : (!fir.ref<!fir.array<1x!fir.type<_QFTt2{i:i32,j:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<1x!fir.type<_QFTt2{i:i32,j:i32}>>>
+! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.box<!fir.array<1x!fir.type<_QFTt2{i:i32,j:i32}>>>) -> !fir.class<!fir.array<?x!fir.type<_QFTt1{i:i32}>>>
+! CHECK:           fir.call @_QPfoo(%[[VAL_7]]) {{.*}}: (!fir.class<!fir.array<?x!fir.type<_QFTt1{i:i32}>>>) -> ()
+! CHECK:           hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.array<1x!fir.type<_QFTt2{i:i32,j:i32}>>>, i1