[flang] Set func.func arg attributes for procedure designators (#68420)

jeanPerier · web-flow · commit 886843170621 · 2023-10-09T09:29:16.000+02:00
Currently, if the first usage of a procedure not defined in the file was
inside a procedure designator reference (not a call to it), the lowered
func.func lacked the argument attributes if any.

Fix this by using `CallInterface&lt;T&gt;::declare` too in SignatureBuilder to
create a new func.func instead of using custom code.

Note: this problem was made worse by the fact that module variables
fir.global are currently lowered before the module procedures func.func
are created. I will try to fix that in a later patch (the debug location
may still be wrong in certain cases) because there is quite some test
fallout when changing the order of globals/funcop in the output.
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
@@ -418,15 +418,14 @@ mlir::FunctionType
 translateSignature(const Fortran::evaluate::ProcedureDesignator &,
                    Fortran::lower::AbstractConverter &);
 
-/// Declare or find the mlir::func::FuncOp named \p name. If the
-/// mlir::func::FuncOp does not exist yet, declare it with the signature
-/// translated from the ProcedureDesignator argument.
+/// Declare or find the mlir::func::FuncOp for the procedure designator
+/// \p proc. If the mlir::func::FuncOp does not exist yet, declare it with
+/// the signature translated from the ProcedureDesignator argument.
 /// Due to Fortran implicit function typing rules, the returned FuncOp is not
 /// guaranteed to have the signature from ProcedureDesignator if the FuncOp was
 /// already declared.
 mlir::func::FuncOp
-getOrDeclareFunction(llvm::StringRef name,
-                     const Fortran::evaluate::ProcedureDesignator &,
+getOrDeclareFunction(const Fortran::evaluate::ProcedureDesignator &,
                      Fortran::lower::AbstractConverter &);
 
 /// Return the type of an argument that is a dummy procedure. This may be an
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
@@ -54,17 +54,22 @@ bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
   return procRef.hasAlternateReturns();
 }
 
-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.
+/// Return the binding label (from BIND(C...)) or the mangled name of the
+/// symbol.
+static std::string
+getProcMangledName(const Fortran::evaluate::ProcedureDesignator &proc,
+                   Fortran::lower::AbstractConverter &converter) {
   if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
     return converter.mangleName(symbol->GetUltimate());
   assert(proc.GetSpecificIntrinsic() &&
          "expected intrinsic procedure in designator");
   return proc.GetName();
 }
 
+std::string Fortran::lower::CallerInterface::getMangledName() const {
+  return getProcMangledName(procRef.proc(), converter);
+}
+
 const Fortran::semantics::Symbol *
 Fortran::lower::CallerInterface::getProcedureSymbol() const {
   return procRef.proc().GetSymbol();
@@ -127,17 +132,25 @@ Fortran::lower::CallerInterface::getIfIndirectCallSymbol() const {
   return nullptr;
 }
 
-mlir::Location Fortran::lower::CallerInterface::getCalleeLocation() const {
-  const Fortran::evaluate::ProcedureDesignator &proc = procRef.proc();
-  // FIXME: If the callee is defined in the same file but after the current
+static mlir::Location
+getProcedureDesignatorLoc(const Fortran::evaluate::ProcedureDesignator &proc,
+                          Fortran::lower::AbstractConverter &converter) {
+  // Note: If the callee is defined in the same file but after the current
   // unit we cannot get its location here and the funcOp is created at the
   // wrong location (i.e, the caller location).
+  // To prevent this, it is up to the bridge to first declare all functions
+  // defined in the translation unit before lowering any calls or procedure
+  // designator references.
   if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
     return converter.genLocation(symbol->name());
   // Use current location for intrinsics.
   return converter.getCurrentLocation();
 }
 
+mlir::Location Fortran::lower::CallerInterface::getCalleeLocation() const {
+  return getProcedureDesignatorLoc(procRef.proc(), converter);
+}
+
 // Get dummy argument characteristic for a procedure with implicit interface
 // from the actual argument characteristic. The actual argument may not be a F77
 // entity. The attribute must be dropped and the shape, if any, must be made
@@ -1341,6 +1354,12 @@ class SignatureBuilder
     bool isImplicit = forceImplicit || proc.CanBeCalledViaImplicitInterface();
     determineInterface(isImplicit, proc);
   }
+  SignatureBuilder(const Fortran::evaluate::ProcedureDesignator &procDes,
+                   Fortran::lower::AbstractConverter &c)
+      : CallInterface{c}, procDesignator{&procDes},
+        proc{Fortran::evaluate::characteristics::Procedure::Characterize(
+                 procDes, converter.getFoldingContext())
+                 .value()} {}
   /// Does the procedure characteristics being translated have alternate
   /// returns ?
   bool hasAlternateReturns() const {
@@ -1354,17 +1373,24 @@ class SignatureBuilder
 
   /// This is only here to fulfill CRTP dependencies and should not be called.
   std::string getMangledName() const {
-    llvm_unreachable("trying to get name from SignatureBuilder");
+    if (procDesignator)
+      return getProcMangledName(*procDesignator, converter);
+    fir::emitFatalError(
+        converter.getCurrentLocation(),
+        "should not query name when only building function type");
   }
 
   /// This is only here to fulfill CRTP dependencies and should not be called.
   mlir::Location getCalleeLocation() const {
-    llvm_unreachable("trying to get callee location from SignatureBuilder");
+    if (procDesignator)
+      return getProcedureDesignatorLoc(*procDesignator, converter);
+    return converter.getCurrentLocation();
   }
 
-  /// This is only here to fulfill CRTP dependencies and should not be called.
   const Fortran::semantics::Symbol *getProcedureSymbol() const {
-    llvm_unreachable("trying to get callee symbol from SignatureBuilder");
+    if (procDesignator)
+      return procDesignator->GetSymbol();
+    return nullptr;
   };
 
   Fortran::evaluate::characteristics::Procedure characterize() const {
@@ -1380,11 +1406,37 @@ class SignatureBuilder
     return proc;
   }
 
+  /// Set internal procedure attribute on MLIR function. Internal procedure
+  /// are defined in the current file and will not go through SignatureBuilder.
+  void setFuncAttrs(mlir::func::FuncOp) const {}
+
   /// This is not the description of an indirect call.
   static constexpr bool isIndirectCall() { return false; }
 
   /// Return the translated signature.
-  mlir::FunctionType getFunctionType() { return genFunctionType(); }
+  mlir::FunctionType getFunctionType() {
+    if (interfaceDetermined)
+      fir::emitFatalError(converter.getCurrentLocation(),
+                          "SignatureBuilder should only be used once");
+    // Most unrestricted intrinsic characteristics have the Elemental attribute
+    // which triggers CanBeCalledViaImplicitInterface to return false. However,
+    // using implicit interface rules is just fine here.
+    bool forceImplicit =
+        procDesignator && procDesignator->GetSpecificIntrinsic();
+    bool isImplicit = forceImplicit || proc.CanBeCalledViaImplicitInterface();
+    determineInterface(isImplicit, proc);
+    interfaceDetermined = true;
+    return genFunctionType();
+  }
+
+  mlir::func::FuncOp getOrCreateFuncOp() {
+    if (interfaceDetermined)
+      fir::emitFatalError(converter.getCurrentLocation(),
+                          "SignatureBuilder should only be used once");
+    declare();
+    interfaceDetermined = true;
+    return getFuncOp();
+  }
 
   // Copy of base implementation.
   static constexpr bool hasHostAssociated() { return false; }
@@ -1393,47 +1445,30 @@ class SignatureBuilder
   }
 
 private:
-  const Fortran::evaluate::characteristics::Procedure &proc;
+  const Fortran::evaluate::ProcedureDesignator *procDesignator = nullptr;
+  Fortran::evaluate::characteristics::Procedure proc;
+  bool interfaceDetermined = false;
 };
 
 mlir::FunctionType Fortran::lower::translateSignature(
     const Fortran::evaluate::ProcedureDesignator &proc,
     Fortran::lower::AbstractConverter &converter) {
-  std::optional<Fortran::evaluate::characteristics::Procedure> characteristics =
-      Fortran::evaluate::characteristics::Procedure::Characterize(
-          proc, converter.getFoldingContext());
-  // Most unrestricted intrinsic characteristic has the Elemental attribute
-  // which triggers CanBeCalledViaImplicitInterface to return false. However,
-  // using implicit interface rules is just fine here.
-  bool forceImplicit = proc.GetSpecificIntrinsic();
-  return SignatureBuilder{characteristics.value(), converter, forceImplicit}
-      .getFunctionType();
+  return SignatureBuilder{proc, converter}.getFunctionType();
 }
 
 mlir::func::FuncOp Fortran::lower::getOrDeclareFunction(
-    llvm::StringRef name, const Fortran::evaluate::ProcedureDesignator &proc,
+    const Fortran::evaluate::ProcedureDesignator &proc,
     Fortran::lower::AbstractConverter &converter) {
   mlir::ModuleOp module = converter.getModuleOp();
+  std::string name = getProcMangledName(proc, converter);
   mlir::func::FuncOp func = fir::FirOpBuilder::getNamedFunction(module, name);
   if (func)
     return func;
 
-  const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
-  assert(symbol && "non user function in getOrDeclareFunction");
   // getOrDeclareFunction is only used for functions not defined in the current
   // program unit, so use the location of the procedure designator symbol, which
   // is the first occurrence of the procedure in the program unit.
-  mlir::Location loc = converter.genLocation(symbol->name());
-  std::optional<Fortran::evaluate::characteristics::Procedure> characteristics =
-      Fortran::evaluate::characteristics::Procedure::Characterize(
-          proc, converter.getFoldingContext());
-  mlir::FunctionType ty = SignatureBuilder{characteristics.value(), converter,
-                                           /*forceImplicit=*/false}
-                              .getFunctionType();
-  mlir::func::FuncOp newFunc =
-      fir::FirOpBuilder::createFunction(loc, module, name, ty);
-  addSymbolAttribute(newFunc, *symbol, converter.getMLIRContext());
-  return newFunc;
+  return SignatureBuilder{proc, converter}.getOrCreateFuncOp();
 }
 
 // Is it required to pass a dummy procedure with \p characteristics as a tuple
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -62,11 +62,11 @@ fir::ExtendedValue Fortran::lower::convertProcedureDesignator(
       std::tie(funcPtr, funcPtrResultLength) =
           fir::factory::extractCharacterProcedureTuple(builder, loc, funcPtr);
   } else {
-    std::string name = converter.mangleName(*symbol);
     mlir::func::FuncOp func =
-        Fortran::lower::getOrDeclareFunction(name, proc, converter);
-    funcPtr = builder.create<fir::AddrOfOp>(loc, func.getFunctionType(),
-                                            builder.getSymbolRefAttr(name));
+        Fortran::lower::getOrDeclareFunction(proc, converter);
+    mlir::SymbolRefAttr nameAttr = builder.getSymbolRefAttr(func.getSymName());
+    funcPtr =
+        builder.create<fir::AddrOfOp>(loc, func.getFunctionType(), nameAttr);
   }
   if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) {
     // The result length, if available here, must be propagated along the
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
@@ -362,17 +362,14 @@ getNonTbpDefinedIoTableAddr(Fortran::lower::AbstractConverter &converter,
                       Fortran::evaluate::ProcedureDesignator{*procSym}},
                   stmtCtx))));
         } else {
-          std::string procName = converter.mangleName(*procSym);
-          mlir::func::FuncOp procDef = builder.getNamedFunction(procName);
-          if (!procDef)
-            procDef = Fortran::lower::getOrDeclareFunction(
-                procName, Fortran::evaluate::ProcedureDesignator{*procSym},
-                converter);
-          insert(
-              builder.createConvert(loc, refTy,
-                                    builder.create<fir::AddrOfOp>(
-                                        loc, procDef.getFunctionType(),
-                                        builder.getSymbolRefAttr(procName))));
+          mlir::func::FuncOp procDef = Fortran::lower::getOrDeclareFunction(
+              Fortran::evaluate::ProcedureDesignator{*procSym}, converter);
+          mlir::SymbolRefAttr nameAttr =
+              builder.getSymbolRefAttr(procDef.getSymName());
+          insert(builder.createConvert(
+              loc, refTy,
+              builder.create<fir::AddrOfOp>(loc, procDef.getFunctionType(),
+                                            nameAttr)));
         }
       } else {
         insert(builder.createNullConstant(loc, refTy));
diff --git a/flang/test/Lower/HLFIR/procedure-designators-arg-attrs.f90 b/flang/test/Lower/HLFIR/procedure-designators-arg-attrs.f90
@@ -0,0 +1,17 @@
+! Ensure that func.func arguments are given the Fortran attributes
+! even if their first use is in a procedure designator reference
+! and not a call.
+
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+subroutine test(x)
+  interface
+    subroutine foo(x)
+      integer, optional, target :: x
+    end subroutine
+  end interface
+  integer, optional, target :: x
+  call takes_proc(foo)
+  call foo(x)
+end subroutine
+! CHECK: func.func private @_QPfoo(!fir.ref<i32> {fir.optional, fir.target})
