[flang-commits] [flang] 92e904b - [flang][hlfir] Ramp-up support of implicit interface mismatches
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Thu Feb 9 23:58:01 PST 2023
Author: Jean Perier
Date: 2023-02-10T08:57:06+01:00
New Revision: 92e904b9ce2d3319bccf56f05179ee5b5a424f0a
URL: https://github.com/llvm/llvm-project/commit/92e904b9ce2d3319bccf56f05179ee5b5a424f0a
DIFF: https://github.com/llvm/llvm-project/commit/92e904b9ce2d3319bccf56f05179ee5b5a424f0a.diff
LOG: [flang][hlfir] Ramp-up support of implicit interface mismatches
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>).
Differential Revision: https://reviews.llvm.org/D143636
Added:
flang/test/Lower/HLFIR/implicit-call-mismatch.f90
Modified:
flang/include/flang/Optimizer/Dialect/FIROps.td
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertCall.cpp
flang/lib/Optimizer/Dialect/FIROps.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td
index fed020f300d9..1fd653b6076b 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROps.td
+++ b/flang/include/flang/Optimizer/Dialect/FIROps.td
@@ -2599,6 +2599,7 @@ def fir_ConvertOp : fir_OneResultOp<"convert", [NoMemoryEffect]> {
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;
}
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index bc6ba47c9c0f..b87ce7bc2b68 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -186,6 +186,14 @@ asImplicitArg(Fortran::evaluate::characteristics::DummyArgument &&dummy) {
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 =
@@ -195,27 +203,58 @@ Fortran::lower::CallerInterface::characterize() const {
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
diff icult 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()) {
- 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");
- 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)));
+ // "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");
+ 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)));
+ }
}
}
}
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 92a853b6f83d..5a9a244a45f1 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -100,6 +100,44 @@ Fortran::lower::argumentHostAssocs(Fortran::lower::AbstractConverter &converter,
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,
@@ -244,29 +282,16 @@ fir::ExtendedValue Fortran::lower::genCallOpAndResult(
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 =
@@ -761,6 +786,33 @@ struct ConditionallyPreparedDummy {
};
} // 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.
@@ -784,8 +836,11 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
// 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);
@@ -1019,8 +1074,8 @@ genUserCall(PreparedActualArguments &loweredActuals,
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: {
diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp
index 2af04f869e4b..671936f8186f 100644
--- a/flang/lib/Optimizer/Dialect/FIROps.cpp
+++ b/flang/lib/Optimizer/Dialect/FIROps.cpp
@@ -940,24 +940,26 @@ bool fir::ConvertOp::isPointerCompatible(mlir::Type ty) {
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)) ||
- (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>()))
+ 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>());
+}
+
+mlir::LogicalResult fir::ConvertOp::verify() {
+ if (canBeConverted(getValue().getType(), getType()))
return mlir::success();
return emitOpError("invalid type conversion");
}
diff --git a/flang/test/Lower/HLFIR/implicit-call-mismatch.f90 b/flang/test/Lower/HLFIR/implicit-call-mismatch.f90
new file mode 100644
index 000000000000..1c722fc549cf
--- /dev/null
+++ b/flang/test/Lower/HLFIR/implicit-call-mismatch.f90
@@ -0,0 +1,156 @@
+! 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]]() {{.*}}: () -> ()
More information about the flang-commits
mailing list