[flang] Create a temporary of the correct size when lowering SetLength

[clementval]

Summary

This patch creates a temporary of the appropriate length while lowering SetLength.

The corresponding character can be truncated or padded if necessary.

This fix issue with array constructor in argument and also with statement function.

  character(7) :: str = "1234567"
  call s(str(1:1))
contains
 subroutine s(a)
  character(*) :: a
  call s2([Character(3)::a])
 end subroutine
 subroutine s2(c)
  character(3) :: c(1)
  print "(4a)", c(1), "end"
 end subroutine
end

The example prior the patch prints 123end instead of 1. end

[jeanPerier]

flang/lib/Lower/ConvertExpr.cpp

2370

I do not think the temp should happen on the arguments, the actual arguments must be longer than the dummy so that the program is compliant (F2018 standard 15.5.2.11 Sequence association). So replacing the character length for the argument should be enough: only "virtual" truncation can happen.

On the result side however, I think you will need to create a temp with the result symbol length and make an assignment (charHelper.createAssign) so that the padding can occure if needed (you can skip it if it can be proved at compile time that the result length is smaller or equal to the expression length, in which case replaceScalarCharacterLength should be sufficient to insert "virtual" truncation).

flang/test/Lower/statement-function.f90

172

The fact that this is printing a length 4 character seems wrong to me, stmt_fct has length 10. I think what should happen here is that the statement function result expression should be padded with blank in a temp.

This may not be visible when running this example, but if you try:

  character(4) arg
  character(10) stmt_fct
  stmt_fct(arg) = arg
  write(*,"(17A)") stmt_fct('longer_arg'), "THE_END"
end

I suspect this might print "longTHE_END" instead of "long THE_END".

[PeteSteinfeld]

All builds and tests correctly and looks good.

[clementval]

Create a temporary for the result with the stmt function result length and
assign to it the actual result.

[clementval]

flang/lib/Lower/ConvertExpr.cpp

2370

Truncated temporary for argument seems needed as well to get the expected result.

flang/test/Lower/statement-function.f90

172

Printing the correct length now.

[clementval]

Create a temproary on while lowering SetLength instead
of when dealing with statement function.

[clementval]

flang/lib/Lower/ConvertExpr.cpp

2370

Not needed anymore with the fix in SetLength.

[jeanPerier]

Thanks, LGTM !

flang/lib/Lower/ConvertExpr.cpp

replaceScalarCharacterLength(const fir::ExtendedValue &scalarChar,
     }
     return fir::CharBoxValue{charAddr, newLenValue};
   }
 
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::SetLength<KIND> &x) {
     mlir::Value newLenValue = genunbox(x.right());
     fir::ExtendedValue lhs = gen(x.left());
-    return replaceScalarCharacterLength(lhs, newLenValue);
+    fir::factory::CharacterExprHelper charHelper(builder, getLoc());
+    fir::CharBoxValue temp = charHelper.createCharacterTemp(
+        charHelper.getCharacterType(fir::getBase(lhs).getType()), newLenValue);
+    charHelper.createAssign(temp, lhs);
+    return fir::ExtendedValue{temp};
   }
 
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
                       Fortran::common::TypeCategory::Integer, KIND>> &op) {
     return createCompareOp<mlir::arith::CmpIOp>(op,
                                                 translateRelational(op.opr));
   }
for (auto [arg, bind] :
       symMap.addSymbol(*arg, gen(*expr));
     }
 
     // Explicitly map statement function host associated symbols to their
     // parent scope lowered symbol box.
     for (const Fortran::semantics::SymbolRef &sym :
          Fortran::evaluate::CollectSymbols(*details.stmtFunction()))
       if (const auto *details =
               sym->detailsIf<Fortran::semantics::HostAssocDetails>())
         if (!symMap.lookupSymbol(*sym))
           symMap.addSymbol(*sym, gen(details->symbol()));
 
     ExtValue result = genval(details.stmtFunction().value());
     LLVM_DEBUG(llvm::dbgs() << "stmt-function: " << result << '\n');
     symMap.popScope();
     return result;
   }

flang/test/Lower/statement-function.f90

integer function test_stmt_character(c, j)
   ! CHECK: %[[c10_cast:.*]] = fir.convert %[[c10]] : (i32) -> index
   ! CHECK: %[[c:.*]] = fir.emboxchar %[[unboxed]]#0, %[[c10_cast]]
 
   func(argc, argj) = len_trim(argc, 4) + argj
   ! CHECK: addi %{{.*}}, %{{.*}} : i
   test_stmt_character = func(c, j)
 end function
 
+
 ! Test statement function with a character actual argument whose
 ! length may be different than the dummy length (the dummy length
 ! must be used inside the statement function).
 ! CHECK-LABEL: @_QPtest_stmt_character_with_different_length(
 ! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1>
 integer function test_stmt_character_with_different_length(c)
   integer :: func, ifoo
   character(10) :: argc

 ! issue #247
 ! CHECK-LABEL: @_QPbug247
 subroutine bug247(r)
   I(R) = R
   ! CHECK: fir.call {{.*}}OutputInteger
   PRINT *, I(2.5)
   ! CHECK: fir.call {{.*}}EndIo
 END subroutine bug247
+
+! Test that the argument is truncated to the length of the dummy argument.
+subroutine truncate_arg
+  character(4) arg
+  character(10) stmt_fct
+  stmt_fct(arg) = arg
+  print *, stmt_fct('longer_arg')
+end subroutine
+
+! CHECK-LABEL: @_QPtruncate_arg
+! CHECK: %[[c4:.*]] = arith.constant 4 : i32
+! CHECK: %[[arg:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,10>>
+! CHECK: %[[cast_arg:.*]] = fir.convert %[[arg]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK: %[[c10:.*]] = arith.constant 10 : i64
+! CHECK: %[[temp:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".chrtmp"}
+! CHECK: %[[c10_index:.*]] = fir.convert %[[c10]] : (i64) -> index
+! CHECK: %[[c4_index:.*]] = fir.convert %[[c4]] : (i32) -> index
+! CHECK: %[[cmpi:.*]] = arith.cmpi slt, %[[c10_index]], %[[c4_index]] : index
+! CHECK: %[[select:.*]] = arith.select %[[cmpi]], %[[c10_index]], %[[c4_index]] : index
+! CHECK: %[[c1:.*]] = arith.constant 1 : i64
+! CHECK: %[[select_i64:.*]] = fir.convert %[[select]] : (index) -> i64
+! CHECK: %[[length:.*]] = arith.muli %[[c1]], %[[select_i64]] : i64
+! CHECK: %[[cast_temp_i8:.*]] = fir.convert %[[temp]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
+! CHECK: %[[cast_arg_i8:.*]] = fir.convert %[[cast_arg]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+! CHECK: fir.call @llvm.memmove.p0.p0.i64(%[[cast_temp_i8]], %[[cast_arg_i8]], %[[length]], %{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+! CHECK: %[[c1_i64:.*]] = arith.constant 1 : i64
+! CHECK: %[[ub:.*]] = arith.subi %[[c10]], %[[c1_i64]] : i64
+! CHECK: %[[ub_index:.*]] = fir.convert %[[ub]] : (i64) -> index
+! CHECK: fir.do_loop %{{.*}} = %[[select]] to %[[ub_index]] step %{{.*}} {
+! CHECK: %[[cast_temp:.*]] = fir.convert %[[temp:.*]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<i8>
+! CHECK: %{{.*}} = fir.call @_FortranAioOutputAscii(%{{.*}}, %[[cast_temp]], %[[c10]]) : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1