[flang] Lower character result of bind(c) function by value

[clementval]

Summary

BIND(C) Function returning character must return it by value and
not as hidden argument like done currently. This patch update the
code to return it by value for both use cases.

[PeteSteinfeld]

Aside from the clang-format diff, all builds and tests correctly and looks good.

flang/lib/Lower/ConvertVariable.cpp

1535

It looks like clang-format needs to be run.

[clementval]

flang/lib/Lower/ConvertVariable.cpp

1535

My bad. I'll update my clang version. Looks like smth changed from 14.

flang/lib/Lower/Bridge.cpp

void genReturnSymbol(const Fortran::semantics::Symbol &functionSymbol) {
     Fortran::lower::SymbolBox resultSymBox = lookupSymbol(resultSym);
     mlir::Location loc = toLocation();
     if (!resultSymBox) {
       mlir::emitError(loc, "internal error when processing function return");
       return;
     }
     mlir::Value resultVal = resultSymBox.match(
         [&](const fir::CharBoxValue &x) -> mlir::Value {
+          if (Fortran::semantics::IsBindCProcedure(functionSymbol))
+            return builder->create<fir::LoadOp>(loc, x.getBuffer());
           return fir::factory::CharacterExprHelper{*builder, loc}
               .createEmboxChar(x.getBuffer(), x.getLen());
         },
         [&](const auto &) -> mlir::Value {
           mlir::Value resultRef = resultSymBox.getAddr();
           mlir::Type resultType = genType(resultSym);
           mlir::Type resultRefType = builder->getRefType(resultType);
           // A function with multiple entry points returning different types
#endif
   /// variables. When the result is passed as a hidden argument, the Fortran
   /// result is also mapped. The symbol map is used to hold this mapping.
   void mapDummiesAndResults(Fortran::lower::pft::FunctionLikeUnit &funit,
                             const Fortran::lower::CalleeInterface &callee) {
     assert(builder && "require a builder object at this point");
     using PassBy = Fortran::lower::CalleeInterface::PassEntityBy;
     auto mapPassedEntity = [&](const auto arg) {
       if (arg.passBy == PassBy::AddressAndLength) {
+        if (callee.characterize().IsBindC())
+          return;
         // TODO: now that fir call has some attributes regarding character
         // return, PassBy::AddressAndLength should be retired.
         mlir::Location loc = toLocation();
         fir::factory::CharacterExprHelper charHelp{*builder, loc};
         mlir::Value box =
             charHelp.createEmboxChar(arg.firArgument, arg.firLength);
         addSymbol(arg.entity->get(), box);
       } else {

flang/lib/Lower/CallInterface.cpp

public:
   CallInterfaceImpl(CallInterface &i)
       : interface(i), mlirContext{i.converter.getMLIRContext()} {}
 
   void buildImplicitInterface(
       const Fortran::evaluate::characteristics::Procedure &procedure) {
     // Handle result
     if (const std::optional<Fortran::evaluate::characteristics::FunctionResult>
             &result = procedure.functionResult)
-      handleImplicitResult(*result);
+      handleImplicitResult(*result, procedure.IsBindC());
     else if (interface.side().hasAlternateReturns())
       addFirResult(mlir::IndexType::get(&mlirContext),
                    FirPlaceHolder::resultEntityPosition, Property::Value);
     // Handle arguments
     const auto &argumentEntities =
         getEntityContainer(interface.side().getCallDescription());
     for (auto pair : llvm::zip(procedure.dummyArguments, argumentEntities)) {
       const Fortran::evaluate::characteristics::DummyArgument
for (auto pair : llvm::zip(procedure.dummyArguments, argumentEntities)) {
               },
           },
           argCharacteristics.u);
     }
   }
 
   void buildExplicitInterface(
       const Fortran::evaluate::characteristics::Procedure &procedure) {
+    bool isBindC = procedure.IsBindC();
     // Handle result
     if (const std::optional<Fortran::evaluate::characteristics::FunctionResult>
             &result = procedure.functionResult) {
       if (result->CanBeReturnedViaImplicitInterface())
-        handleImplicitResult(*result);
+        handleImplicitResult(*result, isBindC);
       else
         handleExplicitResult(*result);
     } else if (interface.side().hasAlternateReturns()) {
       addFirResult(mlir::IndexType::get(&mlirContext),
                    FirPlaceHolder::resultEntityPosition, Property::Value);
     }
-    bool isBindC = procedure.IsBindC();
     // Handle arguments
     const auto &argumentEntities =
         getEntityContainer(interface.side().getCallDescription());
     for (auto pair : llvm::zip(procedure.dummyArguments, argumentEntities)) {
       const Fortran::evaluate::characteristics::DummyArgument
           &argCharacteristics = std::get<0>(pair);
       std::visit(
           Fortran::common::visitors{
static bool mustPassLengthWithDummyProcedure(
     if (llvm::Optional<Fortran::evaluate::DynamicType> type =
             getResultDynamicType(procedure))
       return type->category() == Fortran::common::TypeCategory::Character;
     return false;
   }
 
 private:
   void handleImplicitResult(
-      const Fortran::evaluate::characteristics::FunctionResult &result) {
+      const Fortran::evaluate::characteristics::FunctionResult &result,
+      bool isBindC) {
     if (result.IsProcedurePointer())
       TODO(interface.converter.getCurrentLocation(),
            "procedure pointer result not yet handled");
     const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
         result.GetTypeAndShape();
     assert(typeAndShape && "expect type for non proc pointer result");
     Fortran::evaluate::DynamicType dynamicType = typeAndShape->type();
     // Character result allocated by caller and passed as hidden arguments
     if (dynamicType.category() == Fortran::common::TypeCategory::Character) {
+      if (isBindC) {
+        mlir::Type mlirType = translateDynamicType(dynamicType);
+        addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
+                     Property::Value);
+      } else {
         handleImplicitCharacterResult(dynamicType);
+      }
     } else if (dynamicType.category() ==
                Fortran::common::TypeCategory::Derived) {
       // Derived result need to be allocated by the caller and the result value
       // must be saved. Derived type in implicit interface cannot have length
       // parameters.
       setSaveResult();
       mlir::Type mlirType = translateDynamicType(dynamicType);
       addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,

flang/lib/Lower/ConvertExpr.cpp

ExtValue genCallOpAndResult(Fortran::lower::CallerInterface &caller,
     }
 
     if (!resultType)
       return mlir::Value{}; // subroutine call
     // For now, Fortran return values are implemented with a single MLIR
     // function return value.
     assert(call.getNumResults() == 1 &&
            "Expected exactly one result in FUNCTION call");
+
+    // Call a BIND(C) function that return a char.
+    if (caller.characterize().IsBindC() &&
+        funcType.getResults()[0].isa<fir::CharacterType>()) {
+      fir::CharacterType charTy =
+          funcType.getResults()[0].dyn_cast<fir::CharacterType>();
+      mlir::Value len = builder.createIntegerConstant(
+          loc, builder.getCharacterLengthType(), charTy.getLen());
+      return fir::CharBoxValue{call.getResult(0), len};
+    }
+
     return call.getResult(0);
   }
 
   /// Like genExtAddr, but ensure the address returned is a temporary even if \p
   /// expr is variable inside parentheses.
   ExtValue genTempExtAddr(const Fortran::lower::SomeExpr &expr) {
     // In general, genExtAddr might not create a temp for variable inside
     // parentheses to avoid creating array temporary in sub-expressions. It only

flang/lib/Lower/ConvertVariable.cpp

ba.match(
       // the caller and never having a missing column size.
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::ScalarStaticChar &x) {
         // type is a CHARACTER, determine the LEN value
         auto charLen = x.charLen();
         if (replace) {
           Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
+          if (symBox) {
             std::pair<mlir::Value, mlir::Value> unboxchar =
                 charHelp.createUnboxChar(symBox.getAddr());
             mlir::Value boxAddr = unboxchar.first;
             // Set/override LEN with a constant
             mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
             symMap.addCharSymbol(sym, boxAddr, len, true);
             return;
           }
+        }
         mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
         if (preAlloc) {
           symMap.addCharSymbol(sym, preAlloc, len);
           return;
         }
         mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
         symMap.addCharSymbol(sym, local, len);
       },

flang/test/Lower/call.f90

interface
     end function
   end interface
   ! CHECK: %[[result_storage:.*]] = fir.alloca i32 {adapt.valuebyref}
   ! CHECK: %[[result:.*]] = fir.call @_QPbar() : () -> i32
   ! CHECK: fir.store %[[result]] to %[[result_storage]] : !fir.ref<i32>
   ! CHECK: fir.call @_QPfoo(%[[result_storage]]) : (!fir.ref<i32>) -> ()
   call foo(bar())
 end subroutine
+
+! Check correct lowering of the result from call to bind(c) function that
+! return a char.
+subroutine call_bindc_char()
+  interface
+  function int_to_char(int) bind(c)
+    use iso_c_binding
+    character(kind=c_char) :: int_to_char
+    integer(c_int), value :: int
+  end function
+  end interface
+
+  print*, int_to_char(40)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_bindc_char
+! CHECK: %{{.*}} = fir.call @int_to_char(%{{.*}}) : (i32) -> !fir.char<1>
+
+! Check correct lowering of function body that return char and have the bind(c)
+! attribute.
+function f_int_to_char(i) bind(c, name="f_int_to_char")
+  use iso_c_binding
+  character(kind=c_char) :: f_int_to_char
+  integer(c_int), value :: i
+  f_int_to_char = char(i)
+end function
+
+! CHECK-LABEL: func.func @f_int_to_char(
+! CHECK-SAME: %[[ARG0:.*]]: i32 {fir.bindc_name = "i"}) -> !fir.char<1> attributes {fir.bindc_name = "f_int_to_char"} {
+! CHECK: %[[CHARBOX:.*]] = fir.alloca !fir.char<1> {adapt.valuebyref}
+! CHECK: %[[RESULT:.*]] = fir.alloca !fir.char<1> {bindc_name = "f_int_to_char", uniq_name = "_QFf_int_to_charEf_int_to_char"}
+! CHECK: %[[ARG0_I64:.*]] = fir.convert %[[ARG0]] : (i32) -> i64
+! CHECK: %[[ARG0_I8:.*]] = fir.convert %[[ARG0_I64]] : (i64) -> i8
+! CHECK: %[[UNDEF:.*]] = fir.undefined !fir.char<1>
+! CHECK: %[[CHAR_RES:.*]] = fir.insert_value %4, %3, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+! CHECK: fir.store %[[CHAR_RES]] to %[[CHARBOX]] : !fir.ref<!fir.char<1>>
+! CHECK: %[[LOAD_CHARBOX:.*]] = fir.load %[[CHARBOX]] : !fir.ref<!fir.char<1>>
+! CHECK: fir.store %[[LOAD_CHARBOX]] to %[[RESULT]] : !fir.ref<!fir.char<1>>
+! CHECK: %[[LOAD_RES:.*]] = fir.load %[[RESULT]] : !fir.ref<!fir.char<1>>
+! CHECK: return %[[LOAD_RES]] : !fir.char<1>