[flang-commits] [flang] 10b23ae - [flang] Handle BINC(C) variables and add TODO for corner cases
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Wed Jun 22 11:47:31 PDT 2022
Author: Valentin Clement
Date: 2022-06-22T20:47:23+02:00
New Revision: 10b23ae880f9ee0188d7ee97b7fc25243aa0c854
URL: https://github.com/llvm/llvm-project/commit/10b23ae880f9ee0188d7ee97b7fc25243aa0c854
DIFF: https://github.com/llvm/llvm-project/commit/10b23ae880f9ee0188d7ee97b7fc25243aa0c854.diff
LOG: [flang] Handle BINC(C) variables and add TODO for corner cases
- BIND(C) was ignored in lowering for objects (it can be used on
module and common blocks): use the bind name as the fir.global name.
- When an procedure is declared BIND(C) indirectly via an interface,
it should have a BIND(C) name. This was not the case because
GetBindName()/bindingName() return nothing in this case: detect this
case in mangler.cpp and use the symbol name.
Add TODOs for corner cases:
- BIND(C) module variables may be initialized on the C side. This does
not fit well with the current linkage strategy. Add a TODO until this
is revisited.
- BIND(C) internal procedures should not have a binding label (see
Fortran 2018 section 18.10.2 point 2), yet we currently lower them as
if they were BIND(C) external procedure.
I think this and the indirect interface case should really be
handled by symbol.GetBindName instead of adding more logic in
lowering to deal with this case: add a TODO.
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: klausler
Differential Revision: https://reviews.llvm.org/D128340
Co-authored-by: Jean Perier <jperier at nvidia.com>
Added:
flang/test/Lower/c-interoperability-bindc-variables.f90
Modified:
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Lower/Mangler.cpp
flang/test/Lower/call-site-mangling.f90
flang/test/Lower/program-units-fir-mangling.f90
Removed:
################################################################################
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index bea0302ea9428..18911e865ce6a 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -27,8 +27,14 @@
//===----------------------------------------------------------------------===//
// Return the binding label (from BIND(C...)) or the mangled name of a symbol.
-static std::string getMangledName(const Fortran::semantics::Symbol &symbol) {
+static std::string getMangledName(mlir::Location loc,
+ const Fortran::semantics::Symbol &symbol) {
const std::string *bindName = symbol.GetBindName();
+ // TODO: update GetBindName so that it does not return a label for internal
+ // procedures.
+ if (bindName && Fortran::semantics::ClassifyProcedure(symbol) ==
+ Fortran::semantics::ProcedureDefinitionClass::Internal)
+ TODO(loc, "BIND(C) internal procedures");
return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol);
}
@@ -63,7 +69,8 @@ bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
std::string Fortran::lower::CallerInterface::getMangledName() const {
const Fortran::evaluate::ProcedureDesignator &proc = procRef.proc();
if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
- return ::getMangledName(symbol->GetUltimate());
+ return ::getMangledName(converter.getCurrentLocation(),
+ symbol->GetUltimate());
assert(proc.GetSpecificIntrinsic() &&
"expected intrinsic procedure in designator");
return proc.GetName();
@@ -329,7 +336,8 @@ bool Fortran::lower::CalleeInterface::hasAlternateReturns() const {
std::string Fortran::lower::CalleeInterface::getMangledName() const {
if (funit.isMainProgram())
return fir::NameUniquer::doProgramEntry().str();
- return ::getMangledName(funit.getSubprogramSymbol());
+ return ::getMangledName(converter.getCurrentLocation(),
+ funit.getSubprogramSymbol());
}
const Fortran::semantics::Symbol *
@@ -362,8 +370,14 @@ bool Fortran::lower::CalleeInterface::isMainProgram() const {
mlir::func::FuncOp
Fortran::lower::CalleeInterface::addEntryBlockAndMapArguments() {
- // On the callee side, directly map the mlir::value argument of
- // the function block to the Fortran symbols.
+ // Check for bugs in the front end. The front end must not present multiple
+ // definitions of the same procedure.
+ if (!func.getBlocks().empty())
+ fir::emitFatalError(func.getLoc(),
+ "cannot process subprogram that was already processed");
+
+ // On the callee side, directly map the mlir::value argument of the function
+ // block to the Fortran symbols.
func.addEntryBlock();
mapPassedEntities();
return func;
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 564a9603b05ea..70dcf93126b78 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -460,12 +460,21 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
TODO(loc, "global"); // Procedure pointer or something else
}
// Creates undefined initializer for globals without initializers
- if (!globalIsInitialized(global))
+ if (!globalIsInitialized(global)) {
+ // TODO: Is it really required to add the undef init if the Public
+ // visibility is set ? We need to make sure the global is not optimized out
+ // by LLVM if unused in the current compilation unit, but at least for
+ // BIND(C) variables, an initial value may be given in another compilation
+ // unit (on the C side), and setting an undef init here creates linkage
+ // conflicts.
+ if (sym.attrs().test(Fortran::semantics::Attr::BIND_C))
+ TODO(loc, "BIND(C) module variable linkage");
createGlobalInitialization(
builder, global, [&](fir::FirOpBuilder &builder) {
builder.create<fir::HasValueOp>(
loc, builder.create<fir::UndefOp>(loc, symTy));
});
+ }
// Set public visibility to prevent global definition to be optimized out
// even if they have no initializer and are unused in this compilation unit.
global.setVisibility(mlir::SymbolTable::Visibility::Public);
diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index 27bef2dd447b0..ef87f175da577 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -78,6 +78,22 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
const auto &ultimateSymbol = symbol.GetUltimate();
auto symbolName = toStringRef(ultimateSymbol.name());
+ // The Fortran and BIND(C) namespaces are counterintuitive. A
+ // BIND(C) name is substituted early having precedence over the
+ // Fortran name of the subprogram. By side-effect, this allows
+ // multiple subprocedures with identical Fortran names to be legally
+ // present in the program. Assume the BIND(C) name is unique.
+ if (auto *overrideName = ultimateSymbol.GetBindName())
+ return *overrideName;
+ // TODO: the case of procedure that inherits the BIND(C) through another
+ // interface (procedure(iface)), should be dealt within GetBindName()
+ // directly, or some semantics wrapper.
+ if (!Fortran::semantics::IsPointer(ultimateSymbol) &&
+ Fortran::semantics::IsBindCProcedure(ultimateSymbol) &&
+ Fortran::semantics::ClassifyProcedure(symbol) !=
+ Fortran::semantics::ProcedureDefinitionClass::Internal)
+ return ultimateSymbol.name().ToString();
+
return std::visit(
Fortran::common::visitors{
[&](const Fortran::semantics::MainProgramDetails &) {
diff --git a/flang/test/Lower/c-interoperability-bindc-variables.f90 b/flang/test/Lower/c-interoperability-bindc-variables.f90
new file mode 100644
index 0000000000000..a8e8b3f614dfb
--- /dev/null
+++ b/flang/test/Lower/c-interoperability-bindc-variables.f90
@@ -0,0 +1,14 @@
+! Test lowering of BIND(C) variables
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+block data
+ integer :: x, y
+ common /fortran_name/ x, y
+ ! CHECK-LABEL: fir.global common @c_name
+ bind(c, name="c_name") /fortran_name/
+end block data
+
+module some_module
+ ! CHECK-LABEL: fir.global @tomato
+ integer, bind(c, name="tomato") :: apple = 42
+end module
diff --git a/flang/test/Lower/call-site-mangling.f90 b/flang/test/Lower/call-site-mangling.f90
index 4afc4d2cd8623..8cf0e4eab7c27 100644
--- a/flang/test/Lower/call-site-mangling.f90
+++ b/flang/test/Lower/call-site-mangling.f90
@@ -104,3 +104,15 @@ subroutine somecproc_1() bind(c, name="bind_somecproc")
call somecproc()
call somecproc_1()
end subroutine
+
+! CHECK-LABEL: func @_QPtest_bind_interface() {
+subroutine test_bind_interface()
+ interface
+ subroutine some_bindc_iface() bind(C, name="some_name_some_foo_does_not_inherit")
+ end subroutine
+ end interface
+ procedure(some_bindc_iface) :: foo5
+ external :: foo5
+ ! CHECK: fir.call @foo5
+ call foo5()
+end
diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90
index e9311f2e2ab74..9deff0a59429f 100644
--- a/flang/test/Lower/program-units-fir-mangling.f90
+++ b/flang/test/Lower/program-units-fir-mangling.f90
@@ -136,22 +136,22 @@ subroutine should_not_collide()
end subroutine
end program
-! CHECK-LABEL: func @omp_get_num_threads() -> f32 attributes {fir.sym_name = "_QPomp_get_num_threads"} {
+! CHECK-LABEL: func @omp_get_num_threads() -> f32 attributes {fir.sym_name = "omp_get_num_threads"} {
function omp_get_num_threads() bind(c)
! CHECK: }
end function
-! CHECK-LABEL: func @get_threads() -> f32 attributes {fir.sym_name = "_QPomp_get_num_threads_1"} {
+! CHECK-LABEL: func @get_threads() -> f32 attributes {fir.sym_name = "get_threads"} {
function omp_get_num_threads_1() bind(c, name ="get_threads")
! CHECK: }
end function
-! CHECK-LABEL: func @bEtA() -> f32 attributes {fir.sym_name = "_QPalpha"} {
+! CHECK-LABEL: func @bEtA() -> f32 attributes {fir.sym_name = "bEtA"} {
function alpha() bind(c, name =" bEtA ")
! CHECK: }
end function
-! CHECK-LABEL: func @bc1() attributes {fir.sym_name = "_QPbind_c_s"} {
+! CHECK-LABEL: func @bc1() attributes {fir.sym_name = "bc1"} {
subroutine bind_c_s() Bind(C,Name='bc1')
! CHECK: return
end subroutine bind_c_s
@@ -177,11 +177,11 @@ subroutine bind_c_s() Bind(C, name='bc1')
! Test that BIND(C) label is taken into account for ENTRY symbols.
! CHECK-LABEL: func @_QPsub_with_entries() {
subroutine sub_with_entries
-! CHECK-LABEL: func @bar() attributes {fir.sym_name = "_QPsome_entry"} {
+! CHECK-LABEL: func @bar() attributes {fir.sym_name = "bar"} {
entry some_entry() bind(c, name="bar")
! CHECK-LABEL: func @_QPnormal_entry() {
entry normal_entry()
-! CHECK-LABEL: func @some_other_entry() attributes {fir.sym_name = "_QPsome_other_entry"} {
+! CHECK-LABEL: func @some_other_entry() attributes {fir.sym_name = "some_other_entry"} {
entry some_other_entry() bind(c)
end subroutine
@@ -198,24 +198,24 @@ subroutine s1() bind(c,name=ok//'2')
end subroutine
end interface
contains
-! CHECK-LABEL: func @ok3() -> f32 attributes {fir.sym_name = "_QMtestmod3Pf2"} {
+! CHECK-LABEL: func @ok3() -> f32 attributes {fir.sym_name = "ok3"} {
real function f2() bind(c,name=foo//'3')
character*(*), parameter :: foo = ok
! CHECK: fir.call @ok1() : () -> f32
-! CHECK-LABEL: func @ok4() -> f32 attributes {fir.sym_name = "_QMtestmod3Pf3"} {
+! CHECK-LABEL: func @ok4() -> f32 attributes {fir.sym_name = "ok4"} {
entry f3() bind(c,name=foo//'4')
! CHECK: fir.call @ok1() : () -> f32
f2 = f1()
end function
-! CHECK-LABEL: func @ok5() attributes {fir.sym_name = "_QMtestmod3Ps2"} {
+! CHECK-LABEL: func @ok5() attributes {fir.sym_name = "ok5"} {
subroutine s2() bind(c,name=foo//'5')
character*(*), parameter :: foo = ok
! CHECK: fir.call @ok2() : () -> ()
-! CHECK-LABEL: func @ok6() attributes {fir.sym_name = "_QMtestmod3Ps3"} {
+! CHECK-LABEL: func @ok6() attributes {fir.sym_name = "ok6"} {
entry s3() bind(c,name=foo//'6')
! CHECK: fir.call @ok2() : () -> ()
continue ! force end of specification part
-! CHECK-LABEL: func @ok7() attributes {fir.sym_name = "_QMtestmod3Ps4"} {
+! CHECK-LABEL: func @ok7() attributes {fir.sym_name = "ok7"} {
entry s4() bind(c,name=foo//'7')
! CHECK: fir.call @ok2() : () -> ()
call s1
More information about the flang-commits
mailing list