[flang] Handle polymorphic value when creating temporary

[clementval]

Remove debug flag

[PeteSteinfeld]

Please respond to my comment.

Aside from the one comment, all builds and tests correctly and looks good.

flang/lib/Lower/ConvertExpr.cpp

2197

This coding construct seems dangerous to me, although you're just mimicking the other cases. The function genTempExtAddr is returning a lambda where the capture is by reference. If I understand things correctly, this lambda will be evaluated after genTempExtAddr returns. The stack context at that point will not include the stack frame of genTempExtAddr. This means that any local variable declared in genTempExtAddr will not have a valid address at the point of evaluation. This section of code references the local variable loc. Thus, (again, please correct me if I have this wrong) at the time when this lambda is evaluated the reference to the variable loc will be erroneous. Furthermore, I believe that is erroneous reference will usually go undetected.

I'm guessing that there are many places in the lowering code like this.

[clementval]

flang/lib/Lower/ConvertExpr.cpp

2197

The function genTempExtAddr is returning an ExtendedValue, not a lambda. The lambda is evaluated in the match so we are fine on this side.

[PeteSteinfeld]

Thanks, @clementval. Sorry for the false alarm.

[clementval]

Rebase

[clementval]

In D138921#3957882, @PeteSteinfeld wrote:

Thanks, @clementval. Sorry for the false alarm.

Thanks for the review @PeteSteinfeld

[clementval]

clang-format

flang/lib/Frontend/CompilerInvocation.cpp

 
 /// Set \p loweringOptions controlling lowering behavior based
 /// on the \p optimizationLevel.
 void CompilerInvocation::setLoweringOptions() {
   const CodeGenOptions &codegenOpts = getCodeGenOpts();
 
   // Lower TRANSPOSE as a runtime call under -O0.
   loweringOpts.setOptimizeTranspose(codegenOpts.OptimizationLevel > 0);
+  loweringOpts.setPolymorphicTypeImpl(true);
 
   const LangOptions &langOptions = getLangOpts();
   Fortran::common::MathOptionsBase &mathOpts = loweringOpts.getMathOptions();
   // TODO: when LangOptions are finalized, we can represent
   //       the math related options using Fortran::commmon::MathOptionsBase,
   //       so that we can just copy it into LoweringOptions.
   mathOpts
       .setFPContractEnabled(langOptions.getFPContractMode() ==
                             LangOptions::FPM_Fast)
       .setNoHonorInfs(langOptions.NoHonorInfs)
       .setNoHonorNaNs(langOptions.NoHonorNaNs)
       .setApproxFunc(langOptions.ApproxFunc)
       .setNoSignedZeros(langOptions.NoSignedZeros)
       .setAssociativeMath(langOptions.AssociativeMath)
       .setReciprocalMath(langOptions.ReciprocalMath);
 }

flang/lib/Lower/ConvertExpr.cpp

return genExtValue(expr).match(
           // created always has the declared type.
           mlir::Value var =
               fir::getBase(fir::factory::readBoxValue(builder, loc, x));
           auto value = builder.create<fir::LoadOp>(loc, var);
           mlir::Value temp = builder.createTemporary(loc, value.getType());
           builder.create<fir::StoreOp>(loc, value, temp);
           return temp;
         },
+        [&](const fir::PolymorphicValue &p) -> ExtValue {
+          mlir::Type type = p.getAddr().getType();
+          mlir::Value value = p.getAddr();
+          if (fir::isa_ref_type(type))
+            value = builder.create<fir::LoadOp>(loc, value);
+          mlir::Value temp = builder.createTemporary(loc, value.getType());
+          builder.create<fir::StoreOp>(loc, value, temp);
+          mlir::Value empty;
+          mlir::ValueRange emptyRange;
+          auto boxTy = fir::ClassType::get(value.getType());
+          return builder.create<fir::EmboxOp>(loc, boxTy, temp, empty, empty,
+                                              emptyRange, p.getTdesc());
+        },
         [&](const auto &) -> ExtValue {
           fir::emitFatalError(loc, "expr is not a scalar value");
         });
   }
 
   /// Helper structure to track potential copy-in of non contiguous variable
   /// argument into a contiguous temp. It is used to deallocate the temp that
   /// may have been created as well as to the copy-out from the temp to the

flang/test/Lower/polymorphic.f90

! CHECK-LABEL: func.func @_QMpolymorphic_testPsub_with_type_array(%{{.*}}: !fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"})
   end subroutine
 
 ! CHECK-LABEL: func.func @_QMpolymorphic_testPcall_sub_with_type_array(
 ! CHECK-SAME: %[[ARG0:.*]]: !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>> {fir.bindc_name = "p"}) {
 ! CHECK: %[[CLASS:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>>
 ! CHECK: %[[REBOX:.*]] = fir.rebox %[[CLASS]] : (!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>>) -> !fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>
 ! CHECK: fir.call @_QMpolymorphic_testPsub_with_type_array(%[[REBOX]]) {{.*}} : (!fir.box<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> ()
 
+  subroutine takes_p1(p)
+    class(p1), intent(in) :: p
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPtakes_p1
+
+  subroutine no_reassoc_poly_value(a, i)
+    class(p1), intent(in) :: a(:)
+    integer :: i
+    call takes_p1((a(i)))
+  end subroutine
+
+! CHECK-LABEL: func.func @_QMpolymorphic_testPno_reassoc_poly_value(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>> {fir.bindc_name = "a"}, %[[I:.*]]: !fir.ref<i32> {fir.bindc_name = "i"}) {
+! CHECK:  %[[TEMP:.*]] = fir.alloca !fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>
+! CHECK:  %[[LOADED_I:.*]] = fir.load %[[I]] : !fir.ref<i32>
+! CHECK:  %[[I_I64:.*]] = fir.convert %[[LOADED_I]] : (i32) -> i64
+! CHECK:  %[[C1:.*]] = arith.constant 1 : i64
+! CHECK:  %[[IDX:.*]] = arith.subi %[[I_I64]], %[[C1]] : i64
+! CHECK:  %[[COORD:.*]] = fir.coordinate_of %[[ARG0]], %[[IDX]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>, i64) -> !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK:  %[[TDESC:.*]] = fir.box_tdesc %[[ARG0]] : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>>) -> !fir.tdesc<none>
+! CHECK:  %[[NO_REASSOC:.*]] = fir.no_reassoc %[[COORD]] : !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK:  %[[LOAD:.*]] = fir.load %[[NO_REASSOC]] : !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK:  fir.store %[[LOAD]] to %[[TEMP]] : !fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK:  %[[EMBOX:.*]] = fir.embox %[[TEMP]] tdesc %[[TDESC]] : (!fir.ref<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>, !fir.tdesc<none>) -> !fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>
+! CHECK:  fir.call @_QMpolymorphic_testPtakes_p1(%[[EMBOX]]) {{.*}} : (!fir.class<!fir.type<_QMpolymorphic_testTp1{a:i32,b:i32}>>) -> ()
+
 end module