[flang] Lower character result of bind(c) function by value
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.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D134530
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index a6b8caa..3748f72 100644
--- 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<fir::LoadOp>(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
index 5b77d02..b55e2ed 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -556,7 +556,7 @@
// 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);
@@ -582,18 +582,18 @@
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());
@@ -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
index 27503a7..676dfa0 100644
--- 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>()) {
+ 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);
}
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 64d9d3d..97c8d68 100644
--- 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<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;
+ 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) {
diff --git a/flang/test/Lower/call.f90 b/flang/test/Lower/call.f90
index 8c0e184..de636ee 100644
--- a/flang/test/Lower/call.f90
+++ b/flang/test/Lower/call.f90
@@ -18,3 +18,42 @@
! 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>
