[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@nvidia.com>

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
+  // Check for bugs in the front end. The front end must not present multiple
-  // the function block to the Fortran symbols.
+  // 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;

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);

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 &) {

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

flang/test/Lower/call-site-mangling.f90

@@ -104,3 +104,15 @@ subroutine test_bindmodule_call
   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

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 @@ end
 ! 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 @@ module testMod3
     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