[flang-commits] [flang] de3efd1 - [flang] Lower character result of bind(c) function by value
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Sat Sep 24 00:00:42 PDT 2022
Author: Valentin Clement
Date: 2022-09-24T09:00:26+02:00
New Revision: de3efd1b4c8e120c37b24e7cc264b5a117641bb1
URL: https://github.com/llvm/llvm-project/commit/de3efd1b4c8e120c37b24e7cc264b5a117641bb1
DIFF: https://github.com/llvm/llvm-project/commit/de3efd1b4c8e120c37b24e7cc264b5a117641bb1.diff
LOG: [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
Added:
Modified:
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/test/Lower/call.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index a6b8caa10ffc9..3748f72c1645f 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -847,6 +847,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
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 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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 5b77d02344b61..b55e2ed4b804d 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -556,7 +556,7 @@ class Fortran::lower::CallInterfaceImpl {
// 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 @@ class Fortran::lower::CallInterfaceImpl {
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 @@ class Fortran::lower::CallInterfaceImpl {
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 @@ class Fortran::lower::CallInterfaceImpl {
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 27503a70dd2ee..676dfa05833f8 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -2753,6 +2753,17 @@ class ScalarExprLowering {
// 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 64d9d3db688c9..97c8d6866355a 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1527,13 +1527,16 @@ void Fortran::lower::mapSymbolAttributes(
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 8c0e18402ba98..de636eec4321b 100644
--- a/flang/test/Lower/call.f90
+++ b/flang/test/Lower/call.f90
@@ -18,3 +18,42 @@ integer function bar()
! 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>
More information about the flang-commits
mailing list