[flang][hlfir] Ramp-up support of implicit interface mismatches

[jeanPerier]

Summary

There is a lot of Fortran code that takes advantage of F77 implicit
interface to pass arguments with a different type than those from
the subprogram definition (which is well defined if the storage
and passing convention are the same or compatible).

When the definition and calls are in different files, there is nothing
special to do: the actual arguments are already used to compute the
call interface.

The trouble for lowering comes when the definition is in the same
compilation unit (Semantics raises warning). Then, lowering will
be provided with the interface from the definition to prepare the
argument, and this leads to many ad-hoc handling (see
builder.convertWithSemantics) in the current lowering to cope
with the dummy/actual mismatches on a case by case basis. The
current lowering to FIR is not even complete for all mismatch cases that
can be found in the wild (see https://github.com/llvm/llvm-project/issues/60550),
it is crashing or hitting asserts for many of the added tests.

For HLFIR, instead of coping on a case by case basis, the call
interface will be recomputed according to the actual arguments when
calling an external procedure that can be called with an explicit
interface.

One extra case still has to be handled manually because it may happen
in calls with explicit interfaces: passing a character procedure
designator to a non character procedure dummy (and vice-versa) is widely
accepted even with explicit interfaces (and flang semantic accepts it).
Yet, this "mismatch" cannot be dealt with a simple fir.convert because
character dummy procedure are passed with a different passing
convention: an extra argument is hoisted for the result length (in FIR,
there is no extra argument yet, but the MLIR func argument is a
tuple<fir.boxproc, len>).

[clementval]

Looks great!

flang/include/flang/Optimizer/Dialect/FIROps.td

def fir_ConvertOp : fir_OneResultOp<"convert", [NoMemoryEffect]> {
   let hasFolder = 1;
 
   let hasVerifier = 1;
 
   let extraClassDeclaration = [{
     static bool isIntegerCompatible(mlir::Type ty);
     static bool isFloatCompatible(mlir::Type ty);
     static bool isPointerCompatible(mlir::Type ty);
+    static bool canBeConverted(mlir::Type inType, mlir::Type outType);
   }];
   let hasCanonicalizer = 1;
 }
 
 def FortranTypeAttr : Attr<And<[CPred<"$_self.isa<mlir::TypeAttr>()">,
     Or<[CPred<"$_self.cast<mlir::TypeAttr>().getValue().isa<fir::CharacterType,"
               "fir::ComplexType, fir::IntegerType, fir::LogicalType,"
               "fir::RealType, fir::RecordType>()">]>]>,

flang/lib/Lower/CallInterface.cpp

return std::visit(
           },
           [](Fortran::evaluate::characteristics::AlternateReturn &x) {
             return Fortran::evaluate::characteristics::DummyArgument(
                 std::move(x));
           }},
       dummy.u);
 }
 
+static bool isExternalDefinedInSameCompilationUnit(
+    const Fortran::evaluate::ProcedureDesignator &proc) {
+  if (const auto *symbol{proc.GetSymbol()})
+    return symbol->has<Fortran::semantics::SubprogramDetails>() &&
+           symbol->owner().IsGlobal();
+  return false;
+}
+
 Fortran::evaluate::characteristics::Procedure
 Fortran::lower::CallerInterface::characterize() const {
   Fortran::evaluate::FoldingContext &foldingContext =
       converter.getFoldingContext();
   std::optional<Fortran::evaluate::characteristics::Procedure> characteristic =
       Fortran::evaluate::characteristics::Procedure::Characterize(
           procRef.proc(), foldingContext);
   assert(characteristic && "Failed to get characteristic from procRef");
   // The characteristic may not contain the argument characteristic if the
-  // ProcedureDesignator has no interface.
-  if (!characteristic->HasExplicitInterface()) {
+  // ProcedureDesignator has no interface, or may mismatch in case of implicit
+  // interface.
+  if (!characteristic->HasExplicitInterface() ||
+      (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+       isExternalDefinedInSameCompilationUnit(procRef.proc()) &&
+       characteristic->CanBeCalledViaImplicitInterface())) {
+    // In HLFIR lowering, calls to subprogram with implicit interfaces are
+    // always prepared according to the actual arguments. This is to support
+    // cases where the implicit interfaces are "abused" in old and not so old
+    // Fortran code (e.g, passing REAL(8) to CHARACTER(8), passing object
+    // pointers to procedure dummies, passing regular procedure dummies to
+    // character procedure dummies, omitted arguments....).
+    // In all those case, if the subprogram definition is in the same
+    // compilation unit, the "characteristic" from Characterize will be the one
+    // from the definition, in case of "abuses" (for which semantics raise a
+    // warning), lowering will be placed in a difficult position if it is given
+    // the dummy characteristic from the definition and an actual that has
+    // seemingly nothing to do with it: it would need to battle to anticipate
+    // and handle these mismatches (e.g., be able to prepare a fir.boxchar<>
+    // from a fir.real<> and so one). This was the approach of the lowering to
+    // FIR, and usually lead to compiler bug every time a new "abuse" was met in
+    // the wild.
+    // Instead, in HLFIR, the dummy characteristic is always computed from the
+    // actual for subprogram with implicit interfaces, and in case of call site
+    // vs fun.func MLIR function type signature mismatch, a function cast is
+    // done before placing the call. This is a hammer that should cover all
+    // cases and behave like existing compiler that "do not see" the definition
+    // when placing the call.
+    characteristic->dummyArguments.clear();
     for (const std::optional<Fortran::evaluate::ActualArgument> &arg :
          procRef.arguments()) {
+      // "arg" may be null if this is a call with missing arguments compared
+      // to the subprogram definition. Do not compute any characteristic
+      // in this case.
+      if (arg.has_value()) {
         if (arg.value().isAlternateReturn()) {
           characteristic->dummyArguments.emplace_back(
               Fortran::evaluate::characteristics::AlternateReturn{});
         } else {
           // Argument cannot be optional with implicit interface
           const Fortran::lower::SomeExpr *expr = arg.value().UnwrapExpr();
-        assert(
-            expr &&
-            "argument in call with implicit interface cannot be assumed type");
+          assert(expr && "argument in call with implicit interface cannot be "
+                         "assumed type");
           std::optional<Fortran::evaluate::characteristics::DummyArgument>
               argCharacteristic =
                   Fortran::evaluate::characteristics::DummyArgument::FromActual(
                       "actual", *expr, foldingContext);
           assert(argCharacteristic &&
                  "failed to characterize argument in implicit call");
           characteristic->dummyArguments.emplace_back(
               asImplicitArg(std::move(*argCharacteristic)));
         }
       }
     }
+  }
   return *characteristic;
 }
 
 void Fortran::lower::CallerInterface::placeInput(
     const PassedEntity &passedEntity, mlir::Value arg) {
   assert(static_cast<int>(actualInputs.size()) > passedEntity.firArgument &&
          passedEntity.firArgument >= 0 &&
          passedEntity.passBy != CallInterface::PassEntityBy::AddressAndLength &&

flang/lib/Lower/ConvertCall.cpp

if (auto addr = mlir::dyn_cast_or_null<fir::AddrOfOp>(arg.getDefiningOp())) {
     auto &builder = converter.getFirOpBuilder();
     if (auto funcOp = builder.getNamedFunction(addr.getSymbol()))
       if (fir::anyFuncArgsHaveAttr(funcOp, fir::getHostAssocAttrName()))
         return converter.hostAssocTupleValue();
   }
   return {};
 }
 
+static bool mustCastFuncOpToCopeWithImplicitInterfaceMismatch(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    mlir::FunctionType callSiteType, mlir::FunctionType funcOpType) {
+  // Deal with argument number mismatch by making a function pointer so
+  // that function type cast can be inserted. Do not emit a warning here
+  // because this can happen in legal program if the function is not
+  // defined here and it was first passed as an argument without any more
+  // information.
+  if (callSiteType.getNumResults() != funcOpType.getNumResults() ||
+      callSiteType.getNumInputs() != funcOpType.getNumInputs())
+    return true;
+
+  // Implicit interface result type mismatch are not standard Fortran, but
+  // some compilers are not complaining about it.  The front end is not
+  // protecting lowering from this currently. Support this with a
+  // discouraging warning.
+  // Cast the actual function to the current caller implicit type because
+  // that is the behavior we would get if we could not see the definition.
+  if (callSiteType.getResults() != funcOpType.getResults()) {
+    LLVM_DEBUG(mlir::emitWarning(
+        loc, "a return type mismatch is not standard compliant and may "
+             "lead to undefined behavior."));
+    return true;
+  }
+
+  // In HLFIR, there is little attempt to cope with implicit interface
+  // mismatch on the arguments. The argument are always prepared according
+  // to the implicit interface. Cast the actual function if any of the
+  // argument mismatch cannot be dealt with a simple fir.convert.
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+    for (auto [actualType, dummyType] :
+         llvm::zip(callSiteType.getInputs(), funcOpType.getInputs()))
+      if (actualType != dummyType &&
+          !fir::ConvertOp::canBeConverted(actualType, dummyType))
+        return true;
+  return false;
+}
+
 fir::ExtendedValue Fortran::lower::genCallOpAndResult(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
     Fortran::lower::CallerInterface &caller, mlir::FunctionType callSiteType,
     std::optional<mlir::Type> resultType) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
   // Handle cases where caller must allocate the result or a fir.box for it.
if (callSiteType.getNumResults() == funcOpType.getNumResults() &&
                                  fir::getHostAssocAttrName())) {
       // The number of arguments is off by one, and we're lowering a function
       // with host associations. Modify call to include host associations
       // argument by appending the value at the end of the operands.
       assert(funcOpType.getInput(findHostAssocTuplePos(caller.getFuncOp())) ==
              converter.hostAssocTupleValue().getType());
       addHostAssociations = true;
     }
+    // When this is not a call to an internal procedure (where there is a
+    // mismatch due to the extra argument, but the interface is otherwise
+    // explicit and safe), handle interface mismatch due to F77 implicit
+    // interface "abuse" with a function address cast if needed.
     if (!addHostAssociations &&
-        (callSiteType.getNumResults() != funcOpType.getNumResults() ||
-         callSiteType.getNumInputs() != funcOpType.getNumInputs())) {
-      // Deal with argument number mismatch by making a function pointer so
-      // that function type cast can be inserted. Do not emit a warning here
-      // because this can happen in legal program if the function is not
-      // defined here and it was first passed as an argument without any more
-      // information.
-      funcPointer = builder.create<fir::AddrOfOp>(loc, funcOpType, symbolAttr);
-    } else if (callSiteType.getResults() != funcOpType.getResults()) {
-      // Implicit interface result type mismatch are not standard Fortran, but
-      // some compilers are not complaining about it.  The front end is not
-      // protecting lowering from this currently. Support this with a
-      // discouraging warning.
-      LLVM_DEBUG(mlir::emitWarning(
-          loc, "a return type mismatch is not standard compliant and may "
-               "lead to undefined behavior."));
-      // Cast the actual function to the current caller implicit type because
-      // that is the behavior we would get if we could not see the definition.
+        mustCastFuncOpToCopeWithImplicitInterfaceMismatch(
+            loc, converter, callSiteType, funcOpType))
       funcPointer = builder.create<fir::AddrOfOp>(loc, funcOpType, symbolAttr);
-    } else {
+    else
       funcSymbolAttr = symbolAttr;
-    }
-  }
 
   mlir::FunctionType funcType =
       funcPointer ? callSiteType : caller.getFuncOp().getFunctionType();
   llvm::SmallVector<mlir::Value> operands;
   // First operand of indirect call is the function pointer. Cast it to
   // required function type for the call to handle procedures that have a
   // compatible interface in Fortran, but that have different signatures in
   // FIR.
getPreparedDummy(fir::IfOp ifOp,
     }
     return preparedDummy;
   }
 
   llvm::SmallVector<mlir::Value> thenResultValues;
 };
 } // namespace
 
+/// Fix-up the fact that it is supported to pass a character procedure
+/// designator to a non character procedure dummy procedure and vice-versa, even
+/// in case of explicit interface. Uglier cases where an object is passed as
+/// procedure designator or vice versa are handled only for implicit interfaces
+/// (refused by semantics with explicit interface), and handled with a funcOp
+/// cast like other implicit interface mismatches.
+static hlfir::Entity fixProcedureDummyMismatch(mlir::Location loc,
+                                               fir::FirOpBuilder &builder,
+                                               hlfir::Entity actual,
+                                               mlir::Type dummyType) {
+  if (actual.getType().isa<fir::BoxProcType>() &&
+      fir::isCharacterProcedureTuple(dummyType)) {
+    mlir::Value length =
+        builder.create<fir::UndefOp>(loc, builder.getCharacterLengthType());
+    mlir::Value tuple = fir::factory::createCharacterProcedureTuple(
+        builder, loc, dummyType, actual, length);
+    return hlfir::Entity{tuple};
+  }
+  assert(fir::isCharacterProcedureTuple(actual.getType()) &&
+         dummyType.isa<fir::BoxProcType>() &&
+         "unsupported dummy procedure mismatch with the actual argument");
+  mlir::Value boxProc = fir::factory::extractCharacterProcedureTuple(
+                            builder, loc, actual, /*openBoxProc=*/false)
+                            .first;
+  return hlfir::Entity{boxProc};
+}
+
 /// When dummy is not ALLOCATABLE, POINTER and is not passed in register,
 /// prepare the actual argument according to the interface. Do as needed:
 /// - address element if this is an array argument in an elemental call.
 /// - set dynamic type to the dummy type if the dummy is not polymorphic.
 /// - copy-in into contiguous variable if the dummy must be contiguous
 /// - copy into a temporary if the dummy has the VALUE attribute.
 /// - package the prepared dummy as required (fir.box, fir.class,
 ///   fir.box_char...).
 /// This function should only be called with an actual that is present.
 /// The optional aspects must be handled by this function user.
 static PreparedDummyArgument preparePresentUserCallActualArgument(
     mlir::Location loc, fir::FirOpBuilder &builder,
     const PreparedActualArgument &preparedActual, mlir::Type dummyType,
     const Fortran::lower::CallerInterface::PassedEntity &arg,
     const Fortran::lower::SomeExpr &expr,
     Fortran::evaluate::FoldingContext &foldingContext) {
 
   // Step 1: get the actual argument, which includes addressing the
   // element if this is an array in an elemental call.
   hlfir::Entity actual = preparedActual.getActual(loc, builder);
 
   // Do nothing if this is a procedure argument. It is already a
   // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
-  if (actual.isProcedure())
+  if (actual.isProcedure()) {
+    if (actual.getType() != dummyType)
+      actual = fixProcedureDummyMismatch(loc, builder, actual, dummyType);
     return PreparedDummyArgument{actual, std::nullopt};
+  }
 
   const bool passingPolymorphicToNonPolymorphic =
       actual.isPolymorphic() && !fir::isPolymorphicType(dummyType);
 
   // When passing a CLASS(T) to TYPE(T), only the "T" part must be
   // passed. Unless the entity is a scalar passed by raw address, a
   // new descriptor must be made using the dummy argument type as
   // dynamic type. This must be done before any copy/copy-in because the
for (auto [preparedActual, arg] :
     case PassBy::AddressAndLength:
       // PassBy::AddressAndLength is only used for character results. Results
       // are not handled here.
       fir::emitFatalError(
           loc, "unexpected PassBy::AddressAndLength for actual arguments");
       break;
     case PassBy::CharProcTuple: {
       hlfir::Entity actual = preparedActual->getActual(loc, builder);
-      assert(fir::isCharacterProcedureTuple(actual.getType()) &&
-             "character dummy procedure was not prepared as expected");
+      if (!fir::isCharacterProcedureTuple(actual.getType()))
+        actual = fixProcedureDummyMismatch(loc, builder, actual, argTy);
       caller.placeInput(arg, actual);
     } break;
     case PassBy::MutableBox: {
       hlfir::Entity actual = preparedActual->getActual(loc, builder);
       if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
               *expr)) {
         // If expr is NULL(), the mutableBox created must be a deallocated
         // pointer with the dummy argument characteristics (see table 16.5

flang/lib/Optimizer/Dialect/FIROps.cpp

 }
 
 bool fir::ConvertOp::isPointerCompatible(mlir::Type ty) {
   return ty.isa<fir::ReferenceType, fir::PointerType, fir::HeapType,
                 fir::LLVMPointerType, mlir::MemRefType, mlir::FunctionType,
                 fir::TypeDescType>();
 }
 
-mlir::LogicalResult fir::ConvertOp::verify() {
-  auto inType = getValue().getType();
-  auto outType = getType();
+bool fir::ConvertOp::canBeConverted(mlir::Type inType, mlir::Type outType) {
   if (inType == outType)
-    return mlir::success();
-  if ((isPointerCompatible(inType) && isPointerCompatible(outType)) ||
+    return true;
+  return (isPointerCompatible(inType) && isPointerCompatible(outType)) ||
          (isIntegerCompatible(inType) && isIntegerCompatible(outType)) ||
          (isIntegerCompatible(inType) && isFloatCompatible(outType)) ||
          (isFloatCompatible(inType) && isIntegerCompatible(outType)) ||
          (isFloatCompatible(inType) && isFloatCompatible(outType)) ||
          (isIntegerCompatible(inType) && isPointerCompatible(outType)) ||
          (isPointerCompatible(inType) && isIntegerCompatible(outType)) ||
          (inType.isa<fir::BoxType>() && outType.isa<fir::BoxType>()) ||
          (inType.isa<fir::BoxProcType>() && outType.isa<fir::BoxProcType>()) ||
          (fir::isa_complex(inType) && fir::isa_complex(outType)) ||
          (fir::isBoxedRecordType(inType) && fir::isPolymorphicType(outType)) ||
          (fir::isPolymorphicType(inType) && fir::isPolymorphicType(outType)) ||
-      (fir::isPolymorphicType(inType) && outType.isa<BoxType>()))
+         (fir::isPolymorphicType(inType) && outType.isa<BoxType>());
+}
+
+mlir::LogicalResult fir::ConvertOp::verify() {
+  if (canBeConverted(getValue().getType(), getType()))
     return mlir::success();
   return emitOpError("invalid type conversion");
 }
 
 //===----------------------------------------------------------------------===//
 // CoordinateOp
 //===----------------------------------------------------------------------===//
 

flang/test/Lower/HLFIR/implicit-call-mismatch.f90

+! Test questionable but existing abuses of implicit interfaces.
+! Lowering must close the eyes and do as if it did not know
+! about the function definition since semantic lets these
+! programs through with a warning.
+! RUN: bbc -emit-fir -hlfir %s -o - | FileCheck %s
+
+subroutine takes_char(c)
+  character(8) :: c
+end subroutine
+
+subroutine pass_real_to_char(r)
+  real(8) :: r
+  call takes_char(r)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_real_to_char(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Er
+! CHECK:  %[[VAL_2:.*]] = fir.address_of(@_QPtakes_char) : (!fir.boxchar<1>) -> ()
+! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : ((!fir.boxchar<1>) -> ()) -> ((!fir.ref<f64>) -> ())
+! CHECK:  fir.call %[[VAL_3]](%[[VAL_1]]#1) {{.*}}: (!fir.ref<f64>) -> ()
+
+subroutine pass_char_proc_to_char()
+  character(8), external :: char_proc
+  call takes_char(char_proc)
+end subroutine
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPchar_proc) : (!fir.ref<!fir.char<1,8>>, index) -> !fir.boxchar<1>
+! CHECK:  %[[VAL_1:.*]] = arith.constant 8 : i64
+! CHECK:  %[[VAL_2:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<!fir.char<1,8>>, index) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>
+! CHECK:  %[[VAL_3:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_1]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_6:.*]] = fir.address_of(@_QPtakes_char) : (!fir.boxchar<1>) -> ()
+! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : ((!fir.boxchar<1>) -> ()) -> ((tuple<!fir.boxproc<() -> ()>, i64>) -> ())
+! CHECK:  fir.call %[[VAL_7]](%[[VAL_5]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+
+subroutine pass_kind2_char_to_char(c)
+  character(4, kind=2) :: c
+  call takes_char(c)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_kind2_char_to_char(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ec
+! CHECK:  %[[VAL_4:.*]] = fir.address_of(@_QPtakes_char) : (!fir.boxchar<1>) -> ()
+! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : ((!fir.boxchar<1>) -> ()) -> ((!fir.boxchar<2>) -> ())
+! CHECK:  fir.call %[[VAL_5]](%[[VAL_3]]#0) {{.*}}: (!fir.boxchar<2>) -> ()
+
+subroutine takes_real(r)
+  real(8) :: r
+end subroutine
+
+subroutine pass_int_to_real(i)
+  integer(8) :: i
+  call takes_real(i)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_int_to_real(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ei
+! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.ref<i64>) -> !fir.ref<f64>
+! CHECK:  fir.call @_QPtakes_real(%[[VAL_2]]) {{.*}}: (!fir.ref<f64>) -> ()
+
+subroutine pass_char_to_real(c)
+  character(8) :: c
+  call takes_real(c)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_char_to_real(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ec
+! CHECK:  %[[VAL_4:.*]] = fir.address_of(@_QPtakes_real) : (!fir.ref<f64>) -> ()
+! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : ((!fir.ref<f64>) -> ()) -> ((!fir.boxchar<1>) -> ())
+! CHECK:  fir.call %[[VAL_5]](%[[VAL_3]]#0) {{.*}}: (!fir.boxchar<1>) -> ()
+
+subroutine pass_proc_to_real()
+  real(8), external :: proc
+  call takes_real(proc)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_proc_to_real() {
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPproc) : () -> f64
+! CHECK:  %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : (() -> f64) -> !fir.boxproc<() -> ()>
+! CHECK:  %[[VAL_2:.*]] = fir.address_of(@_QPtakes_real) : (!fir.ref<f64>) -> ()
+! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : ((!fir.ref<f64>) -> ()) -> ((!fir.boxproc<() -> ()>) -> ())
+! CHECK:  fir.call %[[VAL_3]](%[[VAL_1]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
+
+subroutine pass_complex_to_real(cmplx)
+  complex(4) :: cmplx
+  call takes_real(cmplx)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_complex_to_real(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ecmplx
+! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#1 : (!fir.ref<!fir.complex<4>>) -> !fir.ref<f64>
+! CHECK:  fir.call @_QPtakes_real(%[[VAL_2]]) {{.*}}: (!fir.ref<f64>) -> ()
+
+subroutine takes_char_proc(c)
+  character(8), external :: c
+end subroutine
+
+subroutine pass_proc_to_char_proc()
+  external :: proc
+  call takes_char_proc(proc)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_proc_to_char_proc() {
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPproc) : () -> f64
+! CHECK:  %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : (() -> f64) -> !fir.boxproc<() -> ()>
+! CHECK:  %[[VAL_2:.*]] = fir.address_of(@_QPtakes_char_proc) : (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : ((tuple<!fir.boxproc<() -> ()>, i64>) -> ()) -> ((!fir.boxproc<() -> ()>) -> ())
+! CHECK:  fir.call %[[VAL_3]](%[[VAL_1]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
+
+subroutine pass_char_to_char_proc(c)
+  character(8) :: c
+  call takes_char_proc(c)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_char_to_char_proc(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}Ec
+! CHECK:  %[[VAL_4:.*]] = fir.address_of(@_QPtakes_char_proc) : (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : ((tuple<!fir.boxproc<() -> ()>, i64>) -> ()) -> ((!fir.boxchar<1>) -> ())
+! CHECK:  fir.call %[[VAL_5]](%[[VAL_3]]#0) {{.*}}: (!fir.boxchar<1>) -> ()
+
+subroutine takes_proc(proc)
+  real(8), external :: proc
+end subroutine
+
+subroutine pass_char_proc_to_proc()
+  character(8), external :: char_proc
+  call takes_proc(char_proc)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_char_proc_to_proc() {
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPchar_proc) : (!fir.ref<!fir.char<1,8>>, index) -> !fir.boxchar<1>
+! CHECK:  %[[VAL_1:.*]] = arith.constant 8 : i64
+! CHECK:  %[[VAL_2:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<!fir.char<1,8>>, index) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>
+! CHECK:  %[[VAL_3:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_1]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK:  %[[VAL_6:.*]] = fir.address_of(@_QPtakes_proc) : (!fir.boxproc<() -> ()>) -> ()
+! CHECK:  %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : ((!fir.boxproc<() -> ()>) -> ()) -> ((tuple<!fir.boxproc<() -> ()>, i64>) -> ())
+! CHECK:  fir.call %[[VAL_7]](%[[VAL_5]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+
+subroutine pass_real_to_proc(r)
+  real(8) :: r
+  call takes_proc(r)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_real_to_proc(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Er
+! CHECK:  %[[VAL_2:.*]] = fir.address_of(@_QPtakes_proc) : (!fir.boxproc<() -> ()>) -> ()
+! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : ((!fir.boxproc<() -> ()>) -> ()) -> ((!fir.ref<f64>) -> ())
+! CHECK:  fir.call %[[VAL_3]](%[[VAL_1]]#1) {{.*}}: (!fir.ref<f64>) -> ()
+
+subroutine pass_too_many_args()
+  call takes_real(I, Kown, what, I, am, doing)
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_too_many_args() {
+! CHECK:  %[[VAL_10:.*]] = fir.address_of(@_QPtakes_real) : (!fir.ref<f64>) -> ()
+! CHECK:  %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : ((!fir.ref<f64>) -> ()) -> ((!fir.ref<i32>, !fir.ref<i32>, !fir.ref<f32>, !fir.ref<i32>, !fir.ref<f32>, !fir.ref<f32>) -> ())
+! CHECK:  fir.call %[[VAL_11]](%{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}}: (!fir.ref<i32>, !fir.ref<i32>, !fir.ref<f32>, !fir.ref<i32>, !fir.ref<f32>, !fir.ref<f32>) -> ()
+
+subroutine pass_too_few_args()
+  call takes_real()
+end subroutine
+! CHECK-LABEL: func.func @_QPpass_too_few_args() {
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QPtakes_real) : (!fir.ref<f64>) -> ()
+! CHECK:  %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : ((!fir.ref<f64>) -> ()) -> (() -> ())
+! CHECK:  fir.call %[[VAL_1]]() {{.*}}: () -> ()