[flang][hlfir] Turn fir.char<1> results into hlfir.expr<fir.char<1>>

[jeanPerier]

Summary

This gets rid of a special case with CHAR() intrinsic and BIND(C) results.
I tested this has no impact on the LLVM assembly when LLVM opt -01 or
more is run.
See comment in the patch for more details.

[clementval]

LGTM

flang/lib/Lower/ConvertCall.cpp

 // Helper to transform a fir::ExtendedValue to an hlfir::EntityWithAttributes.
 static hlfir::EntityWithAttributes
 extendedValueToHlfirEntity(mlir::Location loc, fir::FirOpBuilder &builder,
                            const fir::ExtendedValue &exv,
                            llvm::StringRef name) {
   mlir::Value firBase = fir::getBase(exv);
   if (fir::isa_trivial(firBase.getType()))
     return hlfir::EntityWithAttributes{firBase};
+  if (auto charTy = firBase.getType().dyn_cast<fir::CharacterType>()) {
+    // CHAR() intrinsic and BIND(C) procedures returning CHARACTER(1)
+    // are lowered to a fir.char<kind,1> that is not in memory.
+    // This tends to cause a lot of bugs because the rest of the
+    // infrastructure is mostly tested with characters that are
+    // in memory.
+    // To avoid having to deal with this special case here and there,
+    // place it in memory here. If this turns out to be suboptimal,
+    // this could be fixed, but for now llvm opt -O1 is able to get
+    // rid of the memory indirection in a = char(b), so there is
+    // little incentive to increase the compiler complexity.
+    hlfir::Entity storage{builder.createTemporary(loc, charTy)};
+    builder.create<fir::StoreOp>(loc, firBase, storage);
+    auto asExpr = builder.create<hlfir::AsExprOp>(
+        loc, storage, /*mustFree=*/builder.createBool(loc, false));
+    return hlfir::EntityWithAttributes{asExpr.getResult()};
+  }
   return hlfir::genDeclare(loc, builder, exv, name,
                            fir::FortranVariableFlagsAttr{});
 }
 namespace {
 /// Structure to hold the clean-up related to a dummy argument preparation
 /// that may have to be done after a call (copy-out or temporary deallocation).
 struct CallCleanUp {
   struct CopyIn {
auto [resultExv, mustBeFreed] = Fortran::lower::genIntrinsicCall(
       callContext.getBuilder(), loc, intrinsic.name, scalarResultType,
       operands);
   if (!fir::getBase(resultExv))
     return std::nullopt;
   hlfir::EntityWithAttributes resultEntity = extendedValueToHlfirEntity(
       loc, builder, resultExv, ".tmp.intrinsic_result");
   // Move result into memory into an hlfir.expr since they are immutable from
   // that point, and the result storage is some temp.
-  if (!fir::isa_trivial(resultEntity.getType())) {
+  if (resultEntity.isVariable()) {
     hlfir::AsExprOp asExpr;
     // Character/Derived MERGE lowering returns one of its argument address
     // (this is the only intrinsic implemented in that way so far). The
     // ownership of this address cannot be taken here since it may not be a
     // temp.
     if (intrinsic.name == "merge")
       asExpr = builder.create<hlfir::AsExprOp>(loc, resultEntity);
     else

flang/test/Lower/HLFIR/calls-character-singleton-result.f90

+! Test handling of intrinsics and BIND(C) functions returning CHARACTER(1).
+! This is a special case because characters are always returned
+! or handled in memory otherwise.
+
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+
+subroutine scalar_char(c, i)
+  character(1) :: c
+  integer(8) :: i
+  c = char(i)
+end subroutine
+! CHECK-LABEL: func.func @_QPscalar_char(
+! CHECK:  %[[VAL_2:.*]] = fir.alloca !fir.char<1>
+! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare %{{.*}}#0 typeparams %{{.*}}  {{.*}}Ec
+! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare %{{.*}}  {{.*}}Ei
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_6]]#1 : !fir.ref<i64>
+! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> i8
+! CHECK:  %[[VAL_9:.*]] = fir.undefined !fir.char<1>
+! CHECK:  %[[VAL_10:.*]] = fir.insert_value %[[VAL_9]], %[[VAL_8]], [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+! CHECK:  fir.store %[[VAL_10]] to %[[VAL_2]] : !fir.ref<!fir.char<1>>
+! CHECK:  %[[VAL_11:.*]] = arith.constant false
+! CHECK:  %[[VAL_12:.*]] = hlfir.as_expr %[[VAL_2]] move %[[VAL_11]] : (!fir.ref<!fir.char<1>>, i1) -> !hlfir.expr<!fir.char<1>>
+! CHECK:  hlfir.assign %[[VAL_12]] to %[[VAL_5]]#0 : !hlfir.expr<!fir.char<1>>, !fir.boxchar<1>
+
+subroutine scalar_bindc(c)
+  character(1) :: c
+  interface
+    character(1) function bar() bind(c)
+    end function
+  end interface
+  c = bar()
+end subroutine
+! CHECK-LABEL: func.func @_QPscalar_bindc(
+! CHECK:  %[[VAL_1:.*]] = fir.alloca !fir.char<1>
+! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %{{.*}}#0 typeparams %{{.*}}  {{.*}}Ec
+! CHECK:  %[[VAL_5:.*]] = fir.call @bar() fastmath<contract> : () -> !fir.char<1>
+! CHECK:  fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref<!fir.char<1>>
+! CHECK:  %[[VAL_6:.*]] = arith.constant false
+! CHECK:  %[[VAL_7:.*]] = hlfir.as_expr %[[VAL_1]] move %[[VAL_6]] : (!fir.ref<!fir.char<1>>, i1) -> !hlfir.expr<!fir.char<1>>
+! CHECK:  hlfir.assign %[[VAL_7]] to %[[VAL_4]]#0 : !hlfir.expr<!fir.char<1>>, !fir.boxchar<1>
+
+subroutine array_char(c, i)
+  character(1) :: c(100)
+  integer(8) :: i(100)
+  c = char(i)
+end subroutine
+! CHECK-LABEL: func.func @_QParray_char(
+! CHECK:  %[[VAL_2:.*]] = fir.alloca !fir.char<1>
+! CHECK:  %[[VAL_13:.*]] = hlfir.elemental %{{.*}} typeparams %{{.*}} : (!fir.shape<1>, index) -> !hlfir.expr<100x!fir.char<1>> {
+! CHECK:  ^bb0(%[[VAL_14:.*]]: index):
+! CHECK:    %[[VAL_19:.*]] = fir.insert_value {{.*}} -> !fir.char<1>
+! CHECK:    fir.store %[[VAL_19]] to %[[VAL_2]] : !fir.ref<!fir.char<1>>
+! CHECK:    %[[VAL_20:.*]] = arith.constant false
+! CHECK:    %[[VAL_21:.*]] = hlfir.as_expr %[[VAL_2]] move %[[VAL_20]] : (!fir.ref<!fir.char<1>>, i1) -> !hlfir.expr<!fir.char<1>>
+! CHECK:    hlfir.yield_element %[[VAL_21]] : !hlfir.expr<!fir.char<1>>
+! CHECK:  }
+! CHECK:  hlfir.assign %[[VAL_13]] to %{{.*}} : !hlfir.expr<100x!fir.char<1>>, !fir.ref<!fir.array<100x!fir.char<1>>>