[flang-commits] [flang] 5754bae - [flang] Lower procedure designator
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Mon Mar 21 10:05:25 PDT 2022
Author: Valentin Clement
Date: 2022-03-21T18:05:18+01:00
New Revision: 5754bae42984caafb6a3bb9616ab86ae4f631a26
URL: https://github.com/llvm/llvm-project/commit/5754bae42984caafb6a3bb9616ab86ae4f631a26
DIFF: https://github.com/llvm/llvm-project/commit/5754bae42984caafb6a3bb9616ab86ae4f631a26.diff
LOG: [flang] Lower procedure designator
This patch adds lowering for procedure designator.
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D122153
Co-authored-by: Jean Perier <jperier at nvidia.com>
Co-authored-by: Eric Schweitz <eschweitz at nvidia.com>
Added:
flang/test/Fir/peephole.fir
flang/test/Lower/procedure-declarations.f90
flang/test/Lower/program-units-fir-mangling.f90
flang/test/Lower/read-write-buffer.f90
Modified:
flang/include/flang/Lower/IntrinsicCall.h
flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/IntrinsicCall.cpp
flang/lib/Optimizer/Dialect/FIROps.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/IntrinsicCall.h b/flang/include/flang/Lower/IntrinsicCall.h
index 5778013c98637..19b339bae15bc 100644
--- a/flang/include/flang/Lower/IntrinsicCall.h
+++ b/flang/include/flang/Lower/IntrinsicCall.h
@@ -82,6 +82,14 @@ ArgLoweringRule lowerIntrinsicArgumentAs(mlir::Location,
/// Return place-holder for absent intrinsic arguments.
fir::ExtendedValue getAbsentIntrinsicArgument();
+/// Get SymbolRefAttr of runtime (or wrapper function containing inlined
+// implementation) of an unrestricted intrinsic (defined by its signature
+// and generic name)
+mlir::SymbolRefAttr
+getUnrestrictedIntrinsicSymbolRefAttr(fir::FirOpBuilder &, mlir::Location,
+ llvm::StringRef name,
+ mlir::FunctionType signature);
+
//===----------------------------------------------------------------------===//
// Direct access to intrinsics that may be used by lowering outside
// of intrinsic call lowering.
diff --git a/flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td b/flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td
index a63a448b7ce0e..c8de8ffc09e2c 100644
--- a/flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td
+++ b/flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td
@@ -23,28 +23,80 @@ def IdenticalTypePred : Constraint<CPred<"$0.getType() == $1.getType()">>;
def IntegerTypePred : Constraint<CPred<"fir::isa_integer($0.getType())">>;
def IndexTypePred : Constraint<CPred<"$0.getType().isa<mlir::IndexType>()">>;
-def SmallerWidthPred
- : Constraint<CPred<"$0.getType().getIntOrFloatBitWidth() "
- "<= $1.getType().getIntOrFloatBitWidth()">>;
+// Widths are monotonic.
+// $0.bits >= $1.bits >= $2.bits or $0.bits <= $1.bits <= $2.bits
+def MonotonicTypePred
+ : Constraint<CPred<"(($0.getType().isa<mlir::IntegerType>() && "
+ " $1.getType().isa<mlir::IntegerType>() && "
+ " $2.getType().isa<mlir::IntegerType>()) || "
+ " ($0.getType().isa<mlir::FloatType>() && "
+ " $1.getType().isa<mlir::FloatType>() && "
+ " $2.getType().isa<mlir::FloatType>())) && "
+ "(($0.getType().getIntOrFloatBitWidth() <= "
+ " $1.getType().getIntOrFloatBitWidth() && "
+ " $1.getType().getIntOrFloatBitWidth() <= "
+ " $2.getType().getIntOrFloatBitWidth()) || "
+ " ($0.getType().getIntOrFloatBitWidth() >= "
+ " $1.getType().getIntOrFloatBitWidth() && "
+ " $1.getType().getIntOrFloatBitWidth() >= "
+ " $2.getType().getIntOrFloatBitWidth()))">>;
+def IntPred : Constraint<CPred<
+ "$0.getType().isa<mlir::IntegerType>() && "
+ "$1.getType().isa<mlir::IntegerType>()">>;
+
+// If both are int type and the first is smaller than the second.
+// $0.bits <= $1.bits
+def SmallerWidthPred : Constraint<CPred<
+ "$0.getType().getIntOrFloatBitWidth() <= "
+ "$1.getType().getIntOrFloatBitWidth()">>;
+def StrictSmallerWidthPred : Constraint<CPred<
+ "$0.getType().getIntOrFloatBitWidth() < "
+ "$1.getType().getIntOrFloatBitWidth()">>;
+
+// floats or ints that undergo successive extensions or successive truncations.
def ConvertConvertOptPattern
- : Pat<(fir_ConvertOp (fir_ConvertOp $arg)),
+ : Pat<(fir_ConvertOp:$res (fir_ConvertOp:$irm $arg)),
+ (fir_ConvertOp $arg),
+ [(MonotonicTypePred $res, $irm, $arg)]>;
+
+// Widths are increasingly monotonic to type index, so there is no
+// possibility of a truncation before the conversion to index.
+// $res == index && $irm.bits >= $arg.bits
+def ConvertAscendingIndexOptPattern
+ : Pat<(fir_ConvertOp:$res (fir_ConvertOp:$irm $arg)),
+ (fir_ConvertOp $arg),
+ [(IndexTypePred $res), (IntPred $irm, $arg),
+ (SmallerWidthPred $arg, $irm)]>;
+
+// Widths are decreasingly monotonic from type index, so the truncations
+// continue to lop off more bits.
+// $arg == index && $res.bits < $irm.bits
+def ConvertDescendingIndexOptPattern
+ : Pat<(fir_ConvertOp:$res (fir_ConvertOp:$irm $arg)),
(fir_ConvertOp $arg),
- [(IntegerTypePred $arg)]>;
+ [(IndexTypePred $arg), (IntPred $irm, $res),
+ (SmallerWidthPred $res, $irm)]>;
+// Useless convert to exact same type.
def RedundantConvertOptPattern
: Pat<(fir_ConvertOp:$res $arg),
(replaceWithValue $arg),
- [(IdenticalTypePred $res, $arg)
- ,(IntegerTypePred $arg)]>;
+ [(IdenticalTypePred $res, $arg)]>;
+// Useless extension followed by truncation to get same width integer.
def CombineConvertOptPattern
: Pat<(fir_ConvertOp:$res(fir_ConvertOp:$irm $arg)),
(replaceWithValue $arg),
- [(IdenticalTypePred $res, $arg)
- ,(IntegerTypePred $arg)
- ,(IntegerTypePred $irm)
- ,(SmallerWidthPred $arg, $irm)]>;
+ [(IntPred $res, $arg), (IdenticalTypePred $res, $arg),
+ (IntPred $arg, $irm), (SmallerWidthPred $arg, $irm)]>;
+
+// Useless extension followed by truncation to get smaller width integer.
+def CombineConvertTruncOptPattern
+ : Pat<(fir_ConvertOp:$res(fir_ConvertOp:$irm $arg)),
+ (fir_ConvertOp $arg),
+ [(IntPred $res, $arg), (StrictSmallerWidthPred $res, $arg),
+ (IntPred $arg, $irm), (SmallerWidthPred $arg, $irm)]>;
def createConstantOp
: NativeCodeCall<"$_builder.create<mlir::arith::ConstantOp>"
@@ -55,7 +107,6 @@ def createConstantOp
def ForwardConstantConvertPattern
: Pat<(fir_ConvertOp:$res (Arith_ConstantOp:$cnt $attr)),
(createConstantOp $res, $attr),
- [(IndexTypePred $res)
- ,(IntegerTypePred $cnt)]>;
+ [(IndexTypePred $res), (IntegerTypePred $cnt)]>;
#endif // FORTRAN_FIR_REWRITE_PATTERNS
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 15483dd00833d..d27b01f6142fd 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -330,6 +330,16 @@ static bool isParenthesizedVariable(const Fortran::evaluate::Expr<T> &expr) {
}
}
+/// Does \p expr only refer to symbols that are mapped to IR values in \p symMap
+/// ?
+static bool allSymbolsInExprPresentInMap(const Fortran::lower::SomeExpr &expr,
+ Fortran::lower::SymMap &symMap) {
+ for (const auto &sym : Fortran::evaluate::CollectSymbols(expr))
+ if (!symMap.lookupSymbol(sym))
+ return false;
+ return true;
+}
+
/// Generate a load of a value from an address. Beware that this will lose
/// any dynamic type information for polymorphic entities (note that unlimited
/// polymorphic cannot be loaded and must not be provided here).
@@ -743,11 +753,69 @@ class ScalarExprLowering {
/// The type of the function indirection is not guaranteed to match the one
/// of the ProcedureDesignator due to Fortran implicit typing rules.
ExtValue genval(const Fortran::evaluate::ProcedureDesignator &proc) {
- TODO(getLoc(), "genval ProcedureDesignator");
+ mlir::Location loc = getLoc();
+ if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =
+ proc.GetSpecificIntrinsic()) {
+ mlir::FunctionType signature =
+ Fortran::lower::translateSignature(proc, converter);
+ // Intrinsic lowering is based on the generic name, so retrieve it here in
+ // case it is
diff erent from the specific name. The type of the specific
+ // intrinsic is retained in the signature.
+ std::string genericName =
+ converter.getFoldingContext().intrinsics().GetGenericIntrinsicName(
+ intrinsic->name);
+ mlir::SymbolRefAttr symbolRefAttr =
+ Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
+ builder, loc, genericName, signature);
+ mlir::Value funcPtr =
+ builder.create<fir::AddrOfOp>(loc, signature, symbolRefAttr);
+ return funcPtr;
+ }
+ const Fortran::semantics::Symbol *symbol = proc.GetSymbol();
+ assert(symbol && "expected symbol in ProcedureDesignator");
+ mlir::Value funcPtr;
+ mlir::Value funcPtrResultLength;
+ if (Fortran::semantics::IsDummy(*symbol)) {
+ Fortran::lower::SymbolBox val = symMap.lookupSymbol(*symbol);
+ assert(val && "Dummy procedure not in symbol map");
+ funcPtr = val.getAddr();
+ if (fir::isCharacterProcedureTuple(funcPtr.getType(),
+ /*acceptRawFunc=*/false))
+ std::tie(funcPtr, funcPtrResultLength) =
+ fir::factory::extractCharacterProcedureTuple(builder, loc, funcPtr);
+ } else {
+ std::string name = converter.mangleName(*symbol);
+ mlir::FuncOp func =
+ Fortran::lower::getOrDeclareFunction(name, proc, converter);
+ funcPtr = builder.create<fir::AddrOfOp>(loc, func.getFunctionType(),
+ builder.getSymbolRefAttr(name));
+ }
+ if (Fortran::lower::mustPassLengthWithDummyProcedure(proc, converter)) {
+ // The result length, if available here, must be propagated along the
+ // procedure address so that call sites where the result length is assumed
+ // can retrieve the length.
+ Fortran::evaluate::DynamicType resultType = proc.GetType().value();
+ if (const auto &lengthExpr = resultType.GetCharLength()) {
+ // The length expression may refer to dummy argument symbols that are
+ // meaningless without any actual arguments. Leave the length as
+ // unknown in that case, it be resolved on the call site
+ // with the actual arguments.
+ if (allSymbolsInExprPresentInMap(toEvExpr(*lengthExpr), symMap)) {
+ mlir::Value rawLen = fir::getBase(genval(*lengthExpr));
+ // F2018 7.4.4.2 point 5.
+ funcPtrResultLength =
+ Fortran::lower::genMaxWithZero(builder, getLoc(), rawLen);
+ }
+ }
+ if (!funcPtrResultLength)
+ funcPtrResultLength = builder.createIntegerConstant(
+ loc, builder.getCharacterLengthType(), -1);
+ return fir::CharBoxValue{funcPtr, funcPtrResultLength};
+ }
+ return funcPtr;
}
-
ExtValue genval(const Fortran::evaluate::NullPointer &) {
- TODO(getLoc(), "genval NullPointer");
+ return builder.createNullConstant(getLoc());
}
static bool
diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 5c82f594e02c8..9450d98309bb9 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -574,6 +574,12 @@ struct IntrinsicLibrary {
mlir::Value invokeGenerator(SubroutineGenerator generator,
llvm::ArrayRef<mlir::Value> args);
+ /// Get pointer to unrestricted intrinsic. Generate the related unrestricted
+ /// intrinsic if it is not defined yet.
+ mlir::SymbolRefAttr
+ getUnrestrictedIntrinsicSymbolRefAttr(llvm::StringRef name,
+ mlir::FunctionType signature);
+
/// Add clean-up for \p temp to the current statement context;
void addCleanUpForTemp(mlir::Location loc, mlir::Value temp);
/// Helper function for generating code clean-up for result descriptors
@@ -1608,6 +1614,39 @@ IntrinsicLibrary::getRuntimeCallGenerator(llvm::StringRef name,
};
}
+mlir::SymbolRefAttr IntrinsicLibrary::getUnrestrictedIntrinsicSymbolRefAttr(
+ llvm::StringRef name, mlir::FunctionType signature) {
+ // Unrestricted intrinsics signature follows implicit rules: argument
+ // are passed by references. But the runtime versions expect values.
+ // So instead of duplicating the runtime, just have the wrappers loading
+ // this before calling the code generators.
+ bool loadRefArguments = true;
+ mlir::FuncOp funcOp;
+ if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
+ funcOp = std::visit(
+ [&](auto generator) {
+ return getWrapper(generator, name, signature, loadRefArguments);
+ },
+ handler->generator);
+
+ if (!funcOp) {
+ llvm::SmallVector<mlir::Type> argTypes;
+ for (mlir::Type type : signature.getInputs()) {
+ if (auto refType = type.dyn_cast<fir::ReferenceType>())
+ argTypes.push_back(refType.getEleTy());
+ else
+ argTypes.push_back(type);
+ }
+ mlir::FunctionType soughtFuncType =
+ builder.getFunctionType(argTypes, signature.getResults());
+ IntrinsicLibrary::RuntimeCallGenerator rtCallGenerator =
+ getRuntimeCallGenerator(name, soughtFuncType);
+ funcOp = getWrapper(rtCallGenerator, name, signature, loadRefArguments);
+ }
+
+ return mlir::SymbolRefAttr::get(funcOp);
+}
+
void IntrinsicLibrary::addCleanUpForTemp(mlir::Location loc, mlir::Value temp) {
assert(stmtCtx);
fir::FirOpBuilder *bldr = &builder;
@@ -3611,3 +3650,10 @@ mlir::Value Fortran::lower::genPow(fir::FirOpBuilder &builder,
mlir::Value x, mlir::Value y) {
return IntrinsicLibrary{builder, loc}.genRuntimeCall("pow", type, {x, y});
}
+
+mlir::SymbolRefAttr Fortran::lower::getUnrestrictedIntrinsicSymbolRefAttr(
+ fir::FirOpBuilder &builder, mlir::Location loc, llvm::StringRef name,
+ mlir::FunctionType signature) {
+ return IntrinsicLibrary{builder, loc}.getUnrestrictedIntrinsicSymbolRefAttr(
+ name, signature);
+}
diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp
index 518377cff6c78..4d36ec4a5a6f1 100644
--- a/flang/lib/Optimizer/Dialect/FIROps.cpp
+++ b/flang/lib/Optimizer/Dialect/FIROps.cpp
@@ -820,9 +820,10 @@ mlir::LogicalResult ConstcOp::verify() {
void fir::ConvertOp::getCanonicalizationPatterns(RewritePatternSet &results,
MLIRContext *context) {
- results.insert<ConvertConvertOptPattern, RedundantConvertOptPattern,
- CombineConvertOptPattern, ForwardConstantConvertPattern>(
- context);
+ results.insert<ConvertConvertOptPattern, ConvertAscendingIndexOptPattern,
+ ConvertDescendingIndexOptPattern, RedundantConvertOptPattern,
+ CombineConvertOptPattern, CombineConvertTruncOptPattern,
+ ForwardConstantConvertPattern>(context);
}
mlir::OpFoldResult fir::ConvertOp::fold(llvm::ArrayRef<mlir::Attribute> opnds) {
@@ -875,6 +876,7 @@ mlir::LogicalResult ConvertOp::verify() {
(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)))
return mlir::success();
return emitOpError("invalid type conversion");
diff --git a/flang/test/Fir/peephole.fir b/flang/test/Fir/peephole.fir
new file mode 100644
index 0000000000000..4bfa2decf8adf
--- /dev/null
+++ b/flang/test/Fir/peephole.fir
@@ -0,0 +1,126 @@
+// RUN: tco %s | FileCheck %s
+
+// Test peephole optimizations
+
+// CHECK-LABEL: define i8 @test_trunc(
+// CHECK-SAME: i256 %[[arg:.*]])
+// CHECK-NEXT: = trunc i256 %[[arg]] to i8
+// CHECK-NEXT: ret i8
+func @test_trunc(%0 : i256) -> i8 {
+ %1 = fir.convert %0 : (i256) -> i128
+ %2 = fir.convert %1 : (i128) -> i64
+ %3 = fir.convert %2 : (i64) -> i32
+ %4 = fir.convert %3 : (i32) -> i16
+ %5 = fir.convert %4 : (i16) -> i8
+ return %5 : i8
+}
+
+// CHECK-LABEL: define i256 @test_sext(
+// CHECK-SAME: i8 %[[arg:.*]])
+// CHECK-NEXT: = sext i8 %[[arg]] to i256
+// CHECK-NEXT: ret i256
+func @test_sext(%0 : i8) -> i256 {
+ %1 = fir.convert %0 : (i8) -> i16
+ %2 = fir.convert %1 : (i16) -> i32
+ %3 = fir.convert %2 : (i32) -> i64
+ %4 = fir.convert %3 : (i64) -> i128
+ %5 = fir.convert %4 : (i128) -> i256
+ return %5 : i256
+}
+
+// CHECK-LABEL: define half @test_fptrunc(
+// CHECK-SAME: fp128 %[[arg:.*]])
+// CHECK-NEXT: %[[res:.*]] = fptrunc fp128 %[[arg]] to half
+// CHECK-NEXT: ret half %[[res]]
+func @test_fptrunc(%0 : f128) -> f16 {
+ %2 = fir.convert %0 : (f128) -> f64
+ %3 = fir.convert %2 : (f64) -> f32
+ %4 = fir.convert %3 : (f32) -> f16
+ return %4 : f16
+}
+
+// CHECK-LABEL: define x86_fp80 @test_fpext(
+// CHECK-SAME: bfloat %[[arg:.*]])
+// CHECK-NEXT: = fpext bfloat %[[arg]] to x86_fp80
+// CHECK-NEXT: ret x86_fp80
+func @test_fpext(%0 : bf16) -> f80 {
+ %2 = fir.convert %0 : (bf16) -> f32
+ %3 = fir.convert %2 : (f32) -> f64
+ %4 = fir.convert %3 : (f64) -> f80
+ return %4 : f80
+}
+
+// CHECK-LABEL: define i64 @test_ascending(
+// CHECK-SAME: i8 %[[arg:.*]])
+// CHECK-NEXT: = sext i8 %[[arg]] to i64
+// CHECK-NEXT: ret i64
+func @test_ascending(%0 : i8) -> index {
+ %1 = fir.convert %0 : (i8) -> i16
+ %2 = fir.convert %1 : (i16) -> i32
+ %3 = fir.convert %2 : (i32) -> i64
+ %5 = fir.convert %3 : (i64) -> index
+ return %5 : index
+}
+
+// CHECK-LABEL: define i8 @test_descending(
+// CHECK-SAME: i64 %[[arg:.*]])
+// CHECK-NEXT: = trunc i64 %[[arg]] to i8
+// CHECK-NEXT: ret i8
+func @test_descending(%0 : index) -> i8 {
+ %2 = fir.convert %0 : (index) -> i64
+ %3 = fir.convert %2 : (i64) -> i32
+ %4 = fir.convert %3 : (i32) -> i16
+ %5 = fir.convert %4 : (i16) -> i8
+ return %5 : i8
+}
+
+// CHECK-LABEL: define float @test_useless(
+// CHECK-SAME: float %[[arg:.*]])
+// CHECK-NEXT: ret float %[[arg]]
+func @test_useless(%0 : f32) -> f32 {
+ %1 = fir.convert %0 : (f32) -> f32
+ return %1 : f32
+}
+
+// CHECK-LABEL: define float @test_useless_sext(
+// CHECK-SAME: i32 %[[arg:.*]])
+// CHECK-NEXT: %[[res:.*]] = sitofp i32 %[[arg]] to float
+// CHECK-NEXT: ret float %[[res]]
+func @test_useless_sext(%0 : i32) -> f32 {
+ %1 = fir.convert %0 : (i32) -> i64
+ %2 = fir.convert %1 : (i64) -> i32
+ %3 = fir.convert %2 : (i32) -> f32
+ return %3 : f32
+}
+
+// CHECK-LABEL: define i16 @test_hump(
+// CHECK-SAME: i32 %[[arg:.*]])
+// CHECK-NEXT: trunc i32 %[[arg]] to i16
+// CHECK-NEXT: ret i16
+func @test_hump(%0 : i32) -> i16 {
+ %1 = fir.convert %0 : (i32) -> i64
+ %2 = fir.convert %1 : (i64) -> i16
+ return %2 : i16
+}
+
+// CHECK-LABEL: define i16 @test_slump(
+// CHECK-SAME: i32 %[[arg:.*]])
+// CHECK-NEXT: %[[i:.*]] = trunc i32 %[[arg]] to i8
+// CHECK-NEXT: sext i8 %[[i]] to i16
+// CHECK-NEXT: ret i16
+func @test_slump(%0 : i32) -> i16 {
+ %1 = fir.convert %0 : (i32) -> i8
+ %2 = fir.convert %1 : (i8) -> i16
+ return %2 : i16
+}
+
+// CHECK-LABEL: define i64 @test_slump2(
+// CHECK-SAME: i64 %[[arg:.*]])
+// CHECK-NEXT: %[[i:.*]] = trunc i64 %[[arg]] to i16
+// CHECK-NEXT: sext i16 %[[i]] to i64
+// CHECK-NEXT: ret i64
+func @test_slump2(%0 : index) -> index {
+ %1 = fir.convert %0 : (index) -> i16
+ %2 = fir.convert %1 : (i16) -> index
+ return %2 : index
+}
diff --git a/flang/test/Lower/procedure-declarations.f90 b/flang/test/Lower/procedure-declarations.f90
new file mode 100644
index 0000000000000..8278cf90f5a15
--- /dev/null
+++ b/flang/test/Lower/procedure-declarations.f90
@@ -0,0 +1,142 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test procedure declarations. Change appearance order of definition and usages
+! (passing a procedure and calling it), with and without definitions.
+! Check that the definition type prevail if available and that casts are inserted to
+! accommodate for the signature mismatch in the
diff erent location due to implicit
+! typing rules and Fortran loose interface compatibility rule history.
+
+
+! Note: all the cases where their is a definition are exactly the same,
+! since definition should be processed first regardless.
+
+! pass, call, define
+! CHECK-LABEL: func @_QPcall_foo(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<10xi32>>{{.*}}) {
+subroutine call_foo(i)
+ integer :: i(10)
+ ! %[[argconvert:*]] = fir.convert %arg0 :
+ ! fir.call @_QPfoo(%[[argconvert]]) : (!fir.ref<!fir.array<2x5xi32>>) -> ()
+ call foo(i)
+end subroutine
+! CHECK-LABEL: func @_QPfoo(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<2x5xi32>>{{.*}}) {
+subroutine foo(i)
+ integer :: i(2, 5)
+ call do_something(i)
+end subroutine
+
+! call, pass, define
+! CHECK-LABEL: func @_QPcall_foo2(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<10xi32>>{{.*}}) {
+subroutine call_foo2(i)
+ integer :: i(10)
+ ! %[[argconvert:*]] = fir.convert %arg0 :
+ ! fir.call @_QPfoo2(%[[argconvert]]) : (!fir.ref<!fir.array<2x5xi32>>) -> ()
+ call foo2(i)
+end subroutine
+! CHECK-LABEL: func @_QPfoo2(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<2x5xi32>>{{.*}}) {
+subroutine foo2(i)
+ integer :: i(2, 5)
+ call do_something(i)
+end subroutine
+
+! call, define, pass
+! CHECK-LABEL: func @_QPcall_foo3(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<10xi32>>{{.*}}) {
+subroutine call_foo3(i)
+ integer :: i(10)
+ ! %[[argconvert:*]] = fir.convert %arg0 :
+ ! fir.call @_QPfoo3(%[[argconvert]]) : (!fir.ref<!fir.array<2x5xi32>>) -> ()
+ call foo3(i)
+end subroutine
+! CHECK-LABEL: func @_QPfoo3(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<2x5xi32>>{{.*}}) {
+subroutine foo3(i)
+ integer :: i(2, 5)
+ call do_something(i)
+end subroutine
+
+! define, call, pass
+! CHECK-LABEL: func @_QPfoo4(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<2x5xi32>>{{.*}}) {
+subroutine foo4(i)
+ integer :: i(2, 5)
+ call do_something(i)
+end subroutine
+! CHECK-LABEL: func @_QPcall_foo4(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<10xi32>>{{.*}}) {
+subroutine call_foo4(i)
+ integer :: i(10)
+ ! %[[argconvert:*]] = fir.convert %arg0 :
+ ! fir.call @_QPfoo4(%[[argconvert]]) : (!fir.ref<!fir.array<2x5xi32>>) -> ()
+ call foo4(i)
+end subroutine
+
+! define, pass, call
+! CHECK-LABEL: func @_QPfoo5(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<2x5xi32>>{{.*}}) {
+subroutine foo5(i)
+ integer :: i(2, 5)
+ call do_something(i)
+end subroutine
+! CHECK-LABEL: func @_QPcall_foo5(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<10xi32>>{{.*}}) {
+subroutine call_foo5(i)
+ integer :: i(10)
+ ! %[[argconvert:*]] = fir.convert %arg0 :
+ ! fir.call @_QPfoo5(%[[argconvert]]) : (!fir.ref<!fir.array<2x5xi32>>) -> ()
+ call foo5(i)
+end subroutine
+
+
+! Test when there is no definition (declaration at the end of the mlir module)
+! First use gives the function type
+
+! call, pass
+! CHECK-LABEL: func @_QPcall_foo6(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<10xi32>>{{.*}}) {
+subroutine call_foo6(i)
+ integer :: i(10)
+ ! CHECK-NOT: convert
+ call foo6(i)
+end subroutine
+
+
+! call, call with
diff erent type
+! CHECK-LABEL: func @_QPcall_foo8(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<10xi32>>{{.*}}) {
+subroutine call_foo8(i)
+ integer :: i(10)
+ ! CHECK-NOT: convert
+ call foo8(i)
+end subroutine
+! CHECK-LABEL: func @_QPcall_foo8_2(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.array<2x5xi32>>{{.*}}) {
+subroutine call_foo8_2(i)
+ integer :: i(2, 5)
+ ! %[[argconvert:*]] = fir.convert %arg0 :
+ call foo8(i)
+end subroutine
+
+! Test that target attribute is lowered in declaration of functions that are
+! not defined in this file.
+! CHECK-LABEL:func @_QPtest_target_in_iface
+subroutine test_target_in_iface()
+ interface
+ subroutine test_target(i, x)
+ integer, target :: i
+ real, target :: x(:)
+ end subroutine
+ end interface
+ integer :: i
+ real :: x(10)
+ ! CHECK: fir.call @_QPtest_target
+ call test_target(i, x)
+end subroutine
+
+! CHECK: func private @_QPfoo6(!fir.ref<!fir.array<10xi32>>)
+
+! Test declaration from test_target_in_iface
+! CHECK-LABEL: func private @_QPtest_target(!fir.ref<i32> {fir.target}, !fir.box<!fir.array<?xf32>> {fir.target})
diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90
new file mode 100644
index 0000000000000..769deefc8f951
--- /dev/null
+++ b/flang/test/Lower/program-units-fir-mangling.f90
@@ -0,0 +1,154 @@
+! RUN: bbc %s -o "-" -emit-fir | FileCheck %s
+
+! CHECK-LABEL: func @_QPsub() {
+subroutine sub()
+! CHECK: }
+end subroutine
+
+! CHECK-LABEL: func @_QPasubroutine() {
+subroutine AsUbRoUtInE()
+! CHECK: }
+end subroutine
+
+! CHECK-LABEL: func @_QPfoo() -> f32 {
+function foo()
+ real(4) :: foo
+ real :: pi = 3.14159
+! CHECK: }
+end function
+
+
+! CHECK-LABEL: func @_QPfunctn() -> f32 {
+function functn
+ real, parameter :: pi = 3.14
+! CHECK: }
+end function
+
+
+module testMod
+contains
+ ! CHECK-LABEL: func @_QMtestmodPsub() {
+ subroutine sub()
+ ! CHECK: }
+ end subroutine
+
+ ! CHECK-LABEL: func @_QMtestmodPfoo() -> f32 {
+ function foo()
+ real(4) :: foo
+ ! CHECK: }
+ end function
+end module
+
+
+! CHECK-LABEL: func @_QPfoo2()
+function foo2()
+ real(4) :: foo2
+contains
+ ! CHECK-LABEL: func @_QFfoo2Psub() {
+ subroutine sub()
+ ! CHECK: }
+ end subroutine
+
+ ! CHECK-LABEL: func @_QFfoo2Pfoo() {
+ subroutine foo()
+ ! CHECK: }
+ end subroutine
+end function
+
+! CHECK-LABEL: func @_QPsub2()
+subroutine sUb2()
+contains
+ ! CHECK-LABEL: func @_QFsub2Psub() {
+ subroutine sub()
+ ! CHECK: }
+ end subroutine
+
+ ! CHECK-LABEL: func @_QFsub2Pfoo() {
+ subroutine Foo()
+ ! CHECK: }
+ end subroutine
+end subroutine
+
+module testMod2
+contains
+ ! CHECK-LABEL: func @_QMtestmod2Psub()
+ subroutine sub()
+ contains
+ ! CHECK-LABEL: func @_QMtestmod2FsubPsubsub() {
+ subroutine subSub()
+ ! CHECK: }
+ end subroutine
+ end subroutine
+end module
+
+
+module color_points
+ interface
+ module subroutine draw()
+ end subroutine
+ module function erase()
+ integer(4) :: erase
+ end function
+ end interface
+end module color_points
+
+! We don't handle lowering of submodules yet. The following tests are
+! commented out and "CHECK" is changed to "xHECK" to not trigger FileCheck.
+!submodule (color_points) color_points_a
+!contains
+! ! xHECK-LABEL: func @_QMcolor_pointsScolor_points_aPsub() {
+! subroutine sub
+! end subroutine
+! ! xHECK: }
+!end submodule
+!
+!submodule (color_points:color_points_a) impl
+!contains
+! ! xHECK-LABEL: func @_QMcolor_pointsScolor_points_aSimplPfoo()
+! subroutine foo
+! contains
+! ! xHECK-LABEL: func @_QMcolor_pointsScolor_points_aSimplFfooPbar() {
+! subroutine bar
+! ! xHECK: }
+! end subroutine
+! end subroutine
+! ! xHECK-LABEL: func @_QMcolor_pointsPdraw() {
+! module subroutine draw()
+! end subroutine
+! !FIXME func @_QMcolor_pointsPerase() -> i32 {
+! module procedure erase
+! ! xHECK: }
+! end procedure
+!end submodule
+
+! CHECK-LABEL: func @_QPshould_not_collide() {
+subroutine should_not_collide()
+! CHECK: }
+end subroutine
+
+! CHECK-LABEL: func @_QQmain() {
+program test
+! CHECK: }
+contains
+! CHECK-LABEL: func @_QFPshould_not_collide() {
+subroutine should_not_collide()
+! CHECK: }
+end subroutine
+end program
+
+! CHECK-LABEL: func @omp_get_num_threads() -> f32 attributes {fir.sym_name = "_QPomp_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"} {
+function omp_get_num_threads_1() bind(c, name ="get_threads")
+! CHECK: }
+end function
+
+! CHECK-LABEL: func @bEtA() -> f32 attributes {fir.sym_name = "_QPalpha"} {
+function alpha() bind(c, name =" bEtA ")
+! CHECK: }
+end function
+
+! CHECK-LABEL: fir.global internal @_QFfooEpi : f32 {
diff --git a/flang/test/Lower/read-write-buffer.f90 b/flang/test/Lower/read-write-buffer.f90
new file mode 100644
index 0000000000000..330a48c6c7d59
--- /dev/null
+++ b/flang/test/Lower/read-write-buffer.f90
@@ -0,0 +1,35 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test that we are passing the correct length when using character array as
+! Format (Fortran 2018 12.6.2.2 point 3)
+! CHECK-LABEL: func @_QPtest_array_format
+subroutine test_array_format
+ ! CHECK-DAG: %[[c2:.*]] = arith.constant 2 : index
+ ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 : index
+ ! CHECK-DAG: %[[mem:.*]] = fir.alloca !fir.array<2x!fir.char<1,10>>
+ character(10) :: array(2)
+ array(1) ="(15HThis i"
+ array(2) ="s a test.)"
+ ! CHECK-DAG: %[[fmtLen:.*]] = arith.muli %[[c10]], %[[c2]] : index
+ ! CHECK-DAG: %[[scalarFmt:.*]] = fir.convert %[[mem]] : (!fir.ref<!fir.array<2x!fir.char<1,10>>>) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK-DAG: %[[fmtArg:.*]] = fir.convert %[[scalarFmt]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK-DAG: %[[fmtLenArg:.*]] = fir.convert %[[fmtLen]] : (index) -> i64
+ ! CHECK: fir.call @_FortranAioBeginExternalFormattedOutput(%[[fmtArg]], %[[fmtLenArg]], {{.*}})
+ write(*, array)
+ end subroutine
+
+ ! A test to check the buffer and it's length.
+ ! CHECK-LABEL: @_QPsome
+ subroutine some()
+ character(LEN=255):: buffer
+ character(LEN=255):: greeting
+ 10 format (A255)
+ ! CHECK: fir.address_of(@_QQcl.636F6D70696C6572) :
+ write (buffer, 10) "compiler"
+ read (buffer, 10) greeting
+ end
+ ! CHECK-LABEL: fir.global linkonce @_QQcl.636F6D70696C6572
+ ! CHECK: %[[lit:.*]] = fir.string_lit "compiler"(8) : !fir.char<1,8>
+ ! CHECK: fir.has_value %[[lit]] : !fir.char<1,8>
+ ! CHECK: }
+
\ No newline at end of file
More information about the flang-commits
mailing list