diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -847,6 +847,8 @@ } mlir::Value resultVal = resultSymBox.match( [&](const fir::CharBoxValue &x) -> mlir::Value { + if (Fortran::semantics::IsBindCProcedure(functionSymbol)) + return builder->create(loc, x.getBuffer()); return fir::factory::CharacterExprHelper{*builder, loc} .createEmboxChar(x.getBuffer(), x.getLen()); }, @@ -2715,6 +2717,8 @@ 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(); diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -556,7 +556,7 @@ // Handle result if (const std::optional &result = procedure.functionResult) - handleImplicitResult(*result); + handleImplicitResult(*result, procedure.IsBindC()); else if (interface.side().hasAlternateReturns()) addFirResult(mlir::IndexType::get(&mlirContext), FirPlaceHolder::resultEntityPosition, Property::Value); @@ -582,18 +582,18 @@ void buildExplicitInterface( const Fortran::evaluate::characteristics::Procedure &procedure) { + bool isBindC = procedure.IsBindC(); // Handle result if (const std::optional &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()); @@ -671,7 +671,8 @@ 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"); @@ -681,7 +682,13 @@ Fortran::evaluate::DynamicType dynamicType = typeAndShape->type(); // Character result allocated by caller and passed as hidden arguments if (dynamicType.category() == Fortran::common::TypeCategory::Character) { - handleImplicitCharacterResult(dynamicType); + 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 diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -2753,6 +2753,17 @@ // 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 charTy = + funcType.getResults()[0].dyn_cast(); + mlir::Value len = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), charTy.getLen()); + return fir::CharBoxValue{call.getResult(0), len}; + } + return call.getResult(0); } diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -1527,13 +1527,16 @@ auto charLen = x.charLen(); if (replace) { Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym); - std::pair 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; + if (symBox) { + std::pair 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) { diff --git a/flang/test/Lower/call.f90 b/flang/test/Lower/call.f90 --- a/flang/test/Lower/call.f90 +++ b/flang/test/Lower/call.f90 @@ -18,3 +18,42 @@ ! CHECK: fir.call @_QPfoo(%[[result_storage]]) : (!fir.ref) -> () 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> +! CHECK: %[[LOAD_CHARBOX:.*]] = fir.load %[[CHARBOX]] : !fir.ref> +! CHECK: fir.store %[[LOAD_CHARBOX]] to %[[RESULT]] : !fir.ref> +! CHECK: %[[LOAD_RES:.*]] = fir.load %[[RESULT]] : !fir.ref> +! CHECK: return %[[LOAD_RES]] : !fir.char<1>