[flang-commits] [flang] b797a6a - [flang] Lower special bind(c) cases without binding labels (#65758)
via flang-commits
flang-commits at lists.llvm.org
Tue Sep 26 00:29:40 PDT 2023
Author: jeanPerier
Date: 2023-09-26T09:29:37+02:00
New Revision: b797a6aede3dbdf7e2287e4fbde13f2550961d96
URL: https://github.com/llvm/llvm-project/commit/b797a6aede3dbdf7e2287e4fbde13f2550961d96
DIFF: https://github.com/llvm/llvm-project/commit/b797a6aede3dbdf7e2287e4fbde13f2550961d96.diff
LOG: [flang] Lower special bind(c) cases without binding labels (#65758)
1. Deal with BIND(C,NAME="")
BIND(C,NAME="") is different from BIND(C). The latter implies that there
us a binding label which is the Fortran symbol name (no Fortran mangling
must be added like underscores). The former implies there is no binding
label (the name in the object file must be the same as if it there was
no BIND(C) attribute at all).
This is correctly implemented in the front-end, but lowering mistakenly
overrode this in the code dealing with the case where BIND(C) is
inherited from a procedure interface. Handling of this last case is moved into name
resolution.
2. Deal with BIND(C) internal procedure
Also according to 18.10.2, BIND(C) does not give a p prevent name
resolution from adding a label to them, otherwise,
bindc_internal_proc.f90 was not going through semantics (bogus error
about conflicting global names). Nothing TODO in lowering other than
removing the TODO.
Added:
flang/test/Lower/HLFIR/bindc-proc-interface.f90
flang/test/Lower/HLFIR/bindc_empty_name.f90
flang/test/Lower/HLFIR/bindc_internal_proc.f90
Modified:
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/Mangler.cpp
flang/lib/Semantics/resolve-names.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index bc666532a545e52..379d9be0e53a3dc 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -23,22 +23,6 @@
#include "flang/Semantics/tools.h"
#include <optional>
-//===----------------------------------------------------------------------===//
-// BIND(C) mangling helpers
-//===----------------------------------------------------------------------===//
-
-// Return the binding label (from BIND(C...)) or the mangled name of a symbol.
-static std::string getMangledName(Fortran::lower::AbstractConverter &converter,
- 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(converter.getCurrentLocation(), "BIND(C) internal procedures");
- return bindName ? *bindName : converter.mangleName(symbol);
-}
-
mlir::Type Fortran::lower::getUntypedBoxProcType(mlir::MLIRContext *context) {
llvm::SmallVector<mlir::Type> resultTys;
llvm::SmallVector<mlir::Type> inputTys;
@@ -72,8 +56,10 @@ bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
std::string Fortran::lower::CallerInterface::getMangledName() const {
const Fortran::evaluate::ProcedureDesignator &proc = procRef.proc();
+ // Return the binding label (from BIND(C...)) or the mangled name of the
+ // symbol.
if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
- return ::getMangledName(converter, symbol->GetUltimate());
+ return converter.mangleName(symbol->GetUltimate());
assert(proc.GetSpecificIntrinsic() &&
"expected intrinsic procedure in designator");
return proc.GetName();
@@ -420,7 +406,7 @@ bool Fortran::lower::CalleeInterface::hasAlternateReturns() const {
std::string Fortran::lower::CalleeInterface::getMangledName() const {
if (funit.isMainProgram())
return fir::NameUniquer::doProgramEntry().str();
- return ::getMangledName(converter, funit.getSubprogramSymbol());
+ return converter.mangleName(funit.getSubprogramSymbol());
}
const Fortran::semantics::Symbol *
diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index 728441020b4cab6..24abbce01c059e2 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -96,14 +96,6 @@ std::string Fortran::lower::mangle::mangleName(
if (auto *overrideName = ultimateSymbol.GetBindName())
return *overrideName;
- // TODO: A procedure that inherits BIND(C) through another interface
- // (procedure(iface)) should be dealt with in GetBindName() or some wrapper.
- if (!Fortran::semantics::IsPointer(ultimateSymbol) &&
- Fortran::semantics::IsBindCProcedure(ultimateSymbol) &&
- Fortran::semantics::ClassifyProcedure(symbol) !=
- Fortran::semantics::ProcedureDefinitionClass::Internal)
- return ultimateSymbol.name().ToString();
-
llvm::StringRef symbolName = toStringRef(ultimateSymbol.name());
llvm::SmallVector<llvm::StringRef> modules;
llvm::SmallVector<llvm::StringRef> procs;
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 303840b00f8f250..22e52521e188362 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1739,9 +1739,11 @@ bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
}
void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
- if (!attrs_ || !attrs_->test(Attr::BIND_C)) {
+ if ((!attrs_ || !attrs_->test(Attr::BIND_C)) &&
+ !symbol.attrs().test(Attr::BIND_C)) {
return;
}
+
std::optional<std::string> label{
evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};
// 18.9.2(2): discard leading and trailing blanks
@@ -1754,6 +1756,9 @@ void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
}
auto last{label->find_last_not_of(" ")};
label = label->substr(first, last - first + 1);
+ } else if (ClassifyProcedure(symbol) == ProcedureDefinitionClass::Internal) {
+ // BIND(C) does not give an implicit binding label to internal procedures.
+ return;
} else {
label = symbol.name().ToString();
}
@@ -4834,6 +4839,13 @@ Symbol &DeclarationVisitor::DeclareProcEntity(
} else if (interface->test(Symbol::Flag::Subroutine)) {
symbol.set(Symbol::Flag::Subroutine);
}
+ if (IsBindCProcedure(*interface) && !IsPointer(symbol) &&
+ !IsDummy(symbol)) {
+ // Inherit BIND_C attribute from the interface, but not the NAME="..."
+ // if any. This is not clearly described in the standard, but matches
+ // the behavior of other compilers.
+ SetImplicitAttr(symbol, Attr::BIND_C);
+ }
} else if (auto *type{GetDeclTypeSpec()}) {
SetType(name, *type);
symbol.set(Symbol::Flag::Function);
diff --git a/flang/test/Lower/HLFIR/bindc-proc-interface.f90 b/flang/test/Lower/HLFIR/bindc-proc-interface.f90
new file mode 100644
index 000000000000000..6bef20f2aa597be
--- /dev/null
+++ b/flang/test/Lower/HLFIR/bindc-proc-interface.f90
@@ -0,0 +1,69 @@
+! Test mangling with BIND(C) inherited from procedure interface.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+subroutine test()
+ interface
+ subroutine iface_notbindc()
+ end subroutine
+ subroutine iface_bindc() bind(c)
+ end subroutine
+ subroutine iface_explicit_name() bind(c, name="explicit_name")
+ end subroutine
+ subroutine iface_nobinding() bind(c, name="")
+ end subroutine
+ end interface
+
+ procedure(iface_bindc) :: foo_iface_bindc
+ procedure(iface_explicit_name) :: foo_iface_explicit_name
+ procedure(iface_nobinding) :: foo_iface_nobinding
+
+ procedure(iface_bindc), bind(c) :: extra_bindc_iface_bindc
+ procedure(iface_explicit_name), bind(c) :: extra_bindc_iface_explicit_name
+ procedure(iface_nobinding), bind(c) :: extra_bindc_iface_nobinding
+
+ procedure(iface_bindc), bind(c, name="bar_iface_bindc_2") :: bar_iface_bindc
+ procedure(iface_explicit_name), bind(c,name="bar_iface_explicit_name_2") :: bar_iface_explicit_name
+ procedure(iface_nobinding), bind(c, name="bar_iface_nobinding_2") :: bar_iface_nobinding
+
+ procedure(iface_bindc), bind(c, name="") :: nobinding_iface_bindc
+ procedure(iface_explicit_name), bind(c, name="") :: nobinding_iface_explicit_name
+ procedure(iface_nobinding), bind(c, name="") :: nobinding_iface_nobinding
+
+ call iface_notbindc()
+ call iface_bindc()
+ call iface_explicit_name()
+ call iface_nobinding()
+
+ call foo_iface_bindc()
+ call foo_iface_explicit_name()
+ call foo_iface_nobinding()
+
+ call extra_bindc_iface_bindc()
+ call extra_bindc_iface_explicit_name()
+ call extra_bindc_iface_nobinding()
+
+ call bar_iface_bindc()
+ call bar_iface_explicit_name()
+ call bar_iface_nobinding()
+
+ call nobinding_iface_bindc()
+ call nobinding_iface_explicit_name()
+ call nobinding_iface_nobinding()
+
+! CHECK: fir.call @_QPiface_notbindc()
+! CHECK: fir.call @iface_bindc()
+! CHECK: fir.call @explicit_name()
+! CHECK: fir.call @_QPiface_nobinding()
+! CHECK: fir.call @foo_iface_bindc()
+! CHECK: fir.call @foo_iface_explicit_name()
+! CHECK: fir.call @foo_iface_nobinding()
+! CHECK: fir.call @extra_bindc_iface_bindc()
+! CHECK: fir.call @extra_bindc_iface_explicit_name()
+! CHECK: fir.call @extra_bindc_iface_nobinding()
+! CHECK: fir.call @bar_iface_bindc_2()
+! CHECK: fir.call @bar_iface_explicit_name_2()
+! CHECK: fir.call @bar_iface_nobinding_2()
+! CHECK: fir.call @_QPnobinding_iface_bindc()
+! CHECK: fir.call @_QPnobinding_iface_explicit_name()
+! CHECK: fir.call @_QPnobinding_iface_nobinding()
+end subroutine
diff --git a/flang/test/Lower/HLFIR/bindc_empty_name.f90 b/flang/test/Lower/HLFIR/bindc_empty_name.f90
new file mode 100644
index 000000000000000..9a0142e9913ef17
--- /dev/null
+++ b/flang/test/Lower/HLFIR/bindc_empty_name.f90
@@ -0,0 +1,23 @@
+! Test that lowering makes a
diff erence between NAME="" and no NAME
+! in BIND(C). See Fortran 2018 standard 18.10.2 point 2.
+! BIND(C, NAME="") implies there is no binding label, meaning that
+! the Fortran mangled name has to be used.
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK: func.func @_QPfoo(%{{.*}}: !fir.ref<i16>
+subroutine foo(x) bind(c, name="")
+ integer(2) :: x
+end subroutine
+
+!CHECK: func.func @bar(%{{.*}}: !fir.ref<i32>
+subroutine foo(x) bind(c, name="bar")
+ integer(4) :: x
+end subroutine
+
+!CHECK: func.func @_QMinamodule1Pfoo(%{{.*}}: !fir.ref<i64>
+module inamodule1
+contains
+subroutine foo(x) bind(c, name="")
+ integer(8) :: x
+end subroutine
+end module
diff --git a/flang/test/Lower/HLFIR/bindc_internal_proc.f90 b/flang/test/Lower/HLFIR/bindc_internal_proc.f90
new file mode 100644
index 000000000000000..027c94f95a326e5
--- /dev/null
+++ b/flang/test/Lower/HLFIR/bindc_internal_proc.f90
@@ -0,0 +1,24 @@
+! Test that internal procedure with BIND(C) do not have binding labels,
+! that is, that they are generated using usual flang mangling for non BIND(C)
+! internal procedures.
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK: func.func @_QFsub1Pfoo(%{{.*}}: i32
+subroutine sub1()
+ call foo(42)
+contains
+ subroutine foo(i) bind(c)
+ integer, value :: i
+ print *, i
+ end subroutine
+end subroutine
+
+!CHECK: func.func @_QFsub2Pfoo(%{{.*}}: i64
+subroutine sub2()
+ call foo(42_8)
+contains
+ subroutine foo(i) bind(c)
+ integer(8), value :: i
+ print *, i
+ end subroutine
+end subroutine
More information about the flang-commits
mailing list