[flang-commits] [flang] 1e1f60c - [flang] Alternate entry points with unused arguments
V Donaldson via flang-commits
flang-commits at lists.llvm.org
Tue May 24 10:56:20 PDT 2022
Author: V Donaldson
Date: 2022-05-24T10:56:04-07:00
New Revision: 1e1f60c605a9b1c803f3bbb1a1339c9bb1af4e34
URL: https://github.com/llvm/llvm-project/commit/1e1f60c605a9b1c803f3bbb1a1339c9bb1af4e34
DIFF: https://github.com/llvm/llvm-project/commit/1e1f60c605a9b1c803f3bbb1a1339c9bb1af4e34.diff
LOG: [flang] Alternate entry points with unused arguments
A dummy argument in an entry point of a subprogram with multiple
entry points need not be defined in other entry points. It is only
legal to reference such an argument when calling an entry point that
does have a definition. An entry point without such a definition
needs a local "substitute" definition sufficient to generate code.
It is nonconformant to reference such a definition at runtime.
Most such definitions and associated code will be deleted as dead
code at compile time. However, that is not always possible, as in
the following code. This code is conformant if all calls to entry
point ss set m=3, and all calls to entry point ee set n=3.
subroutine ss(a, b, m, d, k) ! no x, y, n
integer :: a(m), b(a(m)), m, d(k)
integer :: x(n), y(x(n)), n
integer :: k
1 print*, m, k
print*, a
print*, b
print*, d
if (m == 3) return
entry ee(x, y, n, d, k) ! no a, b, m
print*, n, k
print*, x
print*, y
print*, d
if (n /= 3) goto 1
end
integer :: xx(3), yy(5), zz(3)
xx = 5
yy = 7
zz = 9
call ss(xx, yy, 3, zz, 3)
call ss(xx, yy, 3, zz, 3)
end
Lowering currently generates fir::UndefOp's for all unused arguments.
This is usually ok, but cases such as the one here incorrectly access
unused UndefOp arguments for m and n from an entry point that doesn't
have a proper definition.
The problem is addressed by creating a more complete definition of an
unused argument in most cases. This is implemented in large part by
moving the definition of an unused argument from mapDummiesAndResults
to mapSymbolAttributes. The code in mapSymbolAttributes then chooses
one of three code generation options, depending on information
available there.
This patch deals with dummy procedures in alternate entries, and adds
a TODO for procedure pointers (the PFTBuilder is modified to analyze
procedure pointer symbol so that they are not silently ignored, and
instead hits proper TODOs).
BoxAnalyzer is also changed because assumed-sized arrays were wrongfully
categorized as constant shape arrays. This had no impact, except when
there were unused entry points.
Co-authored-by: jeanPerier <jperier at nvidia.com>
Differential Revision: https://reviews.llvm.org/D125867
Added:
flang/test/Lower/dummy-procedure-in-entry.f90
Modified:
flang/include/flang/Lower/BoxAnalyzer.h
flang/include/flang/Lower/PFTBuilder.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ConvertType.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Lower/PFTBuilder.cpp
flang/test/Lower/entry-statement.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/BoxAnalyzer.h b/flang/include/flang/Lower/BoxAnalyzer.h
index 8baf23e13ec57..e347d5299c6ac 100644
--- a/flang/include/flang/Lower/BoxAnalyzer.h
+++ b/flang/include/flang/Lower/BoxAnalyzer.h
@@ -236,6 +236,10 @@ inline bool isExplicitShape(const Fortran::semantics::Symbol &sym) {
return det && det->IsArray() && det->shape().IsExplicitShape();
}
+inline bool isAssumedSize(const Fortran::semantics::Symbol &sym) {
+ return Fortran::semantics::IsAssumedSizeArray(sym.GetUltimate());
+}
+
//===----------------------------------------------------------------------===//
// Perform analysis to determine a box's parameter values
//===----------------------------------------------------------------------===//
@@ -378,7 +382,7 @@ class BoxAnalyzer : public fir::details::matcher<BoxAnalyzer> {
/// Run the analysis on `sym`.
void analyze(const Fortran::semantics::Symbol &sym) {
if (symIsArray(sym)) {
- bool isConstant = true;
+ bool isConstant = !isAssumedSize(sym);
llvm::SmallVector<int64_t> lbounds;
llvm::SmallVector<int64_t> shapes;
llvm::SmallVector<const Fortran::semantics::ShapeSpec *> bounds;
@@ -396,6 +400,8 @@ class BoxAnalyzer : public fir::details::matcher<BoxAnalyzer> {
continue;
}
} else if (subs.ubound().isStar()) {
+ assert(Fortran::semantics::IsNamedConstant(sym) &&
+ "expect implied shape constant");
shapes.push_back(fir::SequenceType::getUnknownExtent());
continue;
}
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index 0c9aba6d2e2f2..2fcbdcadeea1e 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -668,8 +668,6 @@ struct FunctionLikeUnit : public ProgramUnit {
entryPointList{std::pair{nullptr, nullptr}};
/// Current index into entryPointList. Index 0 is the primary entry point.
int activeEntry = 0;
- /// Dummy arguments that are not universal across entry points.
- llvm::SmallVector<const semantics::Symbol *, 1> nonUniversalDummyArguments;
/// Primary result for function subprograms with alternate entries. This
/// is one of the largest result values, not necessarily the first one.
const semantics::Symbol *primaryResult{nullptr};
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index e41f525e8217a..28dbc8b8b0b4a 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2392,19 +2392,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
for (const Fortran::lower::CalleeInterface::PassedEntity &arg :
callee.getPassedArguments())
mapPassedEntity(arg);
-
- // Allocate local skeleton instances of dummies from other entry points.
- // Most of these locals will not survive into final generated code, but
- // some will. It is illegal to reference them at run time if they do.
- for (const Fortran::semantics::Symbol *arg :
- funit.nonUniversalDummyArguments) {
- if (lookupSymbol(*arg))
- continue;
- mlir::Type type = genType(*arg);
- // TODO: Account for VALUE arguments (and possibly other variants).
- type = builder->getRefType(type);
- addSymbol(*arg, builder->create<fir::UndefOp>(toLocation(), type));
- }
if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
passedResult = callee.getPassedResult()) {
mapPassedEntity(*passedResult);
@@ -2491,15 +2478,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
}
- // If this is a host procedure with host associations, then create the tuple
- // of pointers for passing to the internal procedures.
- if (!funit.getHostAssoc().empty())
- funit.getHostAssoc().hostProcedureBindings(*this, localSymbols);
-
- /// TODO: should use same mechanism as equivalence?
- /// One blocking point is character entry returns that need special handling
- /// since they are not locally allocated but come as argument. CHARACTER(*)
- /// is not something that fit wells with equivalence lowering.
+ // TODO: should use same mechanism as equivalence?
+ // One blocking point is character entry returns that need special handling
+ // since they are not locally allocated but come as argument. CHARACTER(*)
+ // is not something that fits well with equivalence lowering.
for (const Fortran::lower::pft::Variable &altResult :
deferredFuncResultList) {
if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
@@ -2510,6 +2492,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
stmtCtx, primaryFuncResultStorage);
}
+ // If this is a host procedure with host associations, then create the tuple
+ // of pointers for passing to the internal procedures.
+ if (!funit.getHostAssoc().empty())
+ funit.getHostAssoc().hostProcedureBindings(*this, localSymbols);
+
// Create most function blocks in advance.
createEmptyBlocks(funit.evaluationList);
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 056490ec41986..389cb87d297f8 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -225,6 +225,8 @@ struct TypeBuilder {
// links, the fir type is built based on the ultimate symbol. This relies
// on the fact volatile and asynchronous are not reflected in fir types.
const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
+ if (Fortran::semantics::IsProcedurePointer(ultimate))
+ TODO(loc, "procedure pointers");
if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
type->AsIntrinsic()) {
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 88b0e69bf7f1f..86f7fac38c836 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -122,7 +122,7 @@ static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
// symbol is an object of a function pointer.
const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
if (!ultimate.has<Fortran::semantics::ObjectEntityDetails>() &&
- !ultimate.has<Fortran::semantics::ProcEntityDetails>())
+ !Fortran::semantics::IsProcedurePointer(ultimate))
mlir::emitError(loc, "lowering global declaration: symbol '")
<< toStringRef(sym.name()) << "' has unexpected details\n";
return builder.createGlobal(loc, converter.genType(var), globalName, linkage,
@@ -378,6 +378,10 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
if (global && globalIsInitialized(global))
return global;
+
+ if (Fortran::semantics::IsProcedurePointer(sym))
+ TODO(loc, "procedure pointer globals");
+
// If this is an array, check to see if we can use a dense attribute
// with a tensor mlir type. This optimization currently only supports
// rank-1 Fortran arrays of integer, real, or logical. The tensor
@@ -1187,11 +1191,10 @@ static mlir::Value genExtentValue(fir::FirOpBuilder &builder,
}
/// Lower specification expressions and attributes of variable \p var and
-/// add it to the symbol map.
-/// For global and aliases, the address must be pre-computed and provided
-/// in \p preAlloc.
-/// Dummy arguments must have already been mapped to mlir block arguments
-/// their mapping may be updated here.
+/// add it to the symbol map. For a global or an alias, the address must be
+/// pre-computed and provided in \p preAlloc. A dummy argument for the current
+/// entry point has already been mapped to an mlir block argument in
+/// mapDummiesAndResults. Its mapping may be updated here.
void Fortran::lower::mapSymbolAttributes(
AbstractConverter &converter, const Fortran::lower::pft::Variable &var,
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
@@ -1200,14 +1203,32 @@ void Fortran::lower::mapSymbolAttributes(
const Fortran::semantics::Symbol &sym = var.getSymbol();
const mlir::Location loc = converter.genLocation(sym.name());
mlir::IndexType idxTy = builder.getIndexType();
- const bool isDummy = Fortran::semantics::IsDummy(sym);
+ const bool isDeclaredDummy = Fortran::semantics::IsDummy(sym);
+ // An active dummy from the current entry point.
+ const bool isDummy = isDeclaredDummy && symMap.lookupSymbol(sym).getAddr();
+ // An unused dummy from another entry point.
+ const bool isUnusedEntryDummy = isDeclaredDummy && !isDummy;
const bool isResult = Fortran::semantics::IsFunctionResult(sym);
const bool replace = isDummy || isResult;
fir::factory::CharacterExprHelper charHelp{builder, loc};
+
+ if (Fortran::semantics::IsProcedure(sym)) {
+ if (isUnusedEntryDummy) {
+ // Additional discussion below.
+ mlir::Type dummyProcType =
+ Fortran::lower::getDummyProcedureType(sym, converter);
+ mlir::Value undefOp = builder.create<fir::UndefOp>(loc, dummyProcType);
+ symMap.addSymbol(sym, undefOp);
+ }
+ if (Fortran::semantics::IsPointer(sym))
+ TODO(loc, "procedure pointers");
+ return;
+ }
+
Fortran::lower::BoxAnalyzer ba;
ba.analyze(sym);
- // First deal with pointers an allocatables, because their handling here
+ // First deal with pointers and allocatables, because their handling here
// is the same regardless of their rank.
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
// Get address of fir.box describing the entity.
@@ -1263,6 +1284,42 @@ void Fortran::lower::mapSymbolAttributes(
}
}
+ // A dummy from another entry point that is not declared in the current
+ // entry point requires a skeleton definition. Most such "unused" dummies
+ // will not survive into final generated code, but some will. It is illegal
+ // to reference one at run time if it does. Such a dummy is mapped to a
+ // value in one of three ways:
+ //
+ // - Generate a fir::UndefOp value. This is lightweight, easy to clean up,
+ // and often valid, but it may fail for a dummy with dynamic bounds,
+ // or a dummy used to define another dummy. Information to distinguish
+ // valid cases is not generally available here, with the exception of
+ // dummy procedures. See the first function exit above.
+ //
+ // - Allocate an uninitialized stack slot. This is an intermediate-weight
+ // solution that is harder to clean up. It is often valid, but may fail
+ // for an object with dynamic bounds. This option is "automatically"
+ // used by default for cases that do not use one of the other options.
+ //
+ // - Allocate a heap box/descriptor, initialized to zero. This always
+ // works, but is more heavyweight and harder to clean up. It is used
+ // for dynamic objects via calls to genUnusedEntryPointBox.
+
+ auto genUnusedEntryPointBox = [&]() {
+ if (isUnusedEntryDummy) {
+ assert(!Fortran::semantics::IsAllocatableOrPointer(sym) &&
+ "handled above");
+ // The box is read right away because lowering code does not expect
+ // a non pointer/allocatable symbol to be mapped to a MutableBox.
+ symMap.addSymbol(sym, fir::factory::genMutableBoxRead(
+ builder, loc,
+ fir::factory::createTempMutableBox(
+ builder, loc, converter.genType(var))));
+ return true;
+ }
+ return false;
+ };
+
// Helper to generate scalars for the symbol properties.
auto genValue = [&](const Fortran::lower::SomeExpr &expr) {
return genScalarValue(converter, loc, expr, symMap, stmtCtx);
@@ -1412,6 +1469,8 @@ void Fortran::lower::mapSymbolAttributes(
//===--------------------------------------------------------------===//
[&](const Fortran::lower::details::ScalarDynamicChar &x) {
+ if (genUnusedEntryPointBox())
+ return;
// type is a CHARACTER, determine the LEN value
auto charLen = x.charLen();
if (replace) {
@@ -1419,17 +1478,8 @@ void Fortran::lower::mapSymbolAttributes(
mlir::Value boxAddr = symBox.getAddr();
mlir::Value len;
mlir::Type addrTy = boxAddr.getType();
- if (addrTy.isa<fir::BoxCharType>() || addrTy.isa<fir::BoxType>()) {
+ if (addrTy.isa<fir::BoxCharType>() || addrTy.isa<fir::BoxType>())
std::tie(boxAddr, len) = charHelp.createUnboxChar(symBox.getAddr());
- } else {
- // dummy from an other entry case: we cannot get a dynamic length
- // for it, it's illegal for the user program to use it. However,
- // since we are lowering all function unit statements regardless
- // of whether the execution will reach them or not, we need to
- // fill a value for the length here.
- len = builder.createIntegerConstant(
- loc, builder.getCharacterLengthType(), 1);
- }
// Override LEN with an expression
if (charLen)
len = genExplicitCharLen(charLen);
@@ -1484,6 +1534,8 @@ void Fortran::lower::mapSymbolAttributes(
//===--------------------------------------------------------------===//
[&](const Fortran::lower::details::DynamicArray &x) {
+ if (genUnusedEntryPointBox())
+ return;
// cast to the known constant parts from the declaration
mlir::Type varType = converter.genType(var);
mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
@@ -1587,6 +1639,8 @@ void Fortran::lower::mapSymbolAttributes(
//===--------------------------------------------------------------===//
[&](const Fortran::lower::details::StaticArrayDynamicChar &x) {
+ if (genUnusedEntryPointBox())
+ return;
mlir::Value addr;
mlir::Value len;
[[maybe_unused]] bool mustBeDummy = false;
@@ -1656,6 +1710,8 @@ void Fortran::lower::mapSymbolAttributes(
//===--------------------------------------------------------------===//
[&](const Fortran::lower::details::DynamicArrayStaticChar &x) {
+ if (genUnusedEntryPointBox())
+ return;
mlir::Value addr;
mlir::Value len;
mlir::Value argBox;
@@ -1714,6 +1770,8 @@ void Fortran::lower::mapSymbolAttributes(
//===--------------------------------------------------------------===//
[&](const Fortran::lower::details::DynamicArrayDynamicChar &x) {
+ if (genUnusedEntryPointBox())
+ return;
mlir::Value addr;
mlir::Value len;
mlir::Value argBox;
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 3be7ebedb3da6..70774425760a6 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -975,30 +975,28 @@ class PFTBuilder {
}
}
- /// For multiple entry subprograms, build a list of the dummy arguments that
- /// appear in some, but not all entry points. For those that are functions,
- /// also find one of the largest function results, since a single result
- /// container holds the result for all entries.
+ /// Do processing specific to subprograms with multiple entry points.
void processEntryPoints() {
lower::pft::Evaluation *initialEval = &evaluationListStack.back()->front();
lower::pft::FunctionLikeUnit *unit = initialEval->getOwningProcedure();
int entryCount = unit->entryPointList.size();
if (entryCount == 1)
return;
- llvm::DenseMap<semantics::Symbol *, int> dummyCountMap;
+
+ // The first executable statement in the subprogram is preceded by a
+ // branch to the entry point, so it starts a new block.
+ if (initialEval->hasNestedEvaluations())
+ initialEval = &initialEval->getFirstNestedEvaluation();
+ else if (initialEval->isA<Fortran::parser::EntryStmt>())
+ initialEval = initialEval->lexicalSuccessor;
+ initialEval->isNewBlock = true;
+
+ // All function entry points share a single result container.
+ // Find one of the largest results.
for (int entryIndex = 0; entryIndex < entryCount; ++entryIndex) {
unit->setActiveEntry(entryIndex);
const auto &details =
unit->getSubprogramSymbol().get<semantics::SubprogramDetails>();
- for (semantics::Symbol *arg : details.dummyArgs()) {
- if (!arg)
- continue; // alternate return specifier (no actual argument)
- const auto iter = dummyCountMap.find(arg);
- if (iter == dummyCountMap.end())
- dummyCountMap.try_emplace(arg, 1);
- else
- ++iter->second;
- }
if (details.isFunction()) {
const semantics::Symbol *resultSym = &details.result();
assert(resultSym && "missing result symbol");
@@ -1008,16 +1006,6 @@ class PFTBuilder {
}
}
unit->setActiveEntry(0);
- for (auto arg : dummyCountMap)
- if (arg.second < entryCount)
- unit->nonUniversalDummyArguments.push_back(arg.first);
- // The first executable statement in the subprogram is preceded by a
- // branch to the entry point, so it starts a new block.
- if (initialEval->hasNestedEvaluations())
- initialEval = &initialEval->getFirstNestedEvaluation();
- else if (initialEval->isA<Fortran::parser::EntryStmt>())
- initialEval = initialEval->lexicalSuccessor;
- initialEval->isNewBlock = true;
}
std::unique_ptr<lower::pft::Program> pgm;
@@ -1401,10 +1389,14 @@ struct SymbolDependenceDepth {
LLVM_DEBUG(llvm::dbgs() << "analyze symbol: " << sym << '\n');
if (!done.second)
return 0;
- if (semantics::IsProcedure(sym)) {
- // TODO: add declaration?
+ const bool isProcedurePointerOrDummy =
+ semantics::IsProcedurePointer(sym) ||
+ (semantics::IsProcedure(sym) && IsDummy(sym));
+ // A procedure argument in a subprogram with multiple entry points might
+ // need a vars list entry to trigger creation of a symbol map entry in
+ // some cases. Non-dummy procedures don't.
+ if (semantics::IsProcedure(sym) && !isProcedurePointerOrDummy)
return 0;
- }
semantics::Symbol ultimate = sym.GetUltimate();
if (const auto *details =
ultimate.detailsIf<semantics::NamelistDetails>()) {
@@ -1414,7 +1406,7 @@ struct SymbolDependenceDepth {
return 0;
}
if (!ultimate.has<semantics::ObjectEntityDetails>() &&
- !ultimate.has<semantics::ProcEntityDetails>())
+ !isProcedurePointerOrDummy)
return 0;
if (sym.has<semantics::DerivedTypeDetails>())
@@ -1422,15 +1414,14 @@ struct SymbolDependenceDepth {
// Symbol must be something lowering will have to allocate.
int depth = 0;
- const semantics::DeclTypeSpec *symTy = sym.GetType();
- assert(symTy && "symbol must have a type");
-
// Analyze symbols appearing in object entity specification expression. This
// ensures these symbols will be instantiated before the current one.
// This is not done for object entities that are host associated because
// they must be instantiated from the value of the host symbols (the
// specification expressions should not be re-evaluated).
if (const auto *details = sym.detailsIf<semantics::ObjectEntityDetails>()) {
+ const semantics::DeclTypeSpec *symTy = sym.GetType();
+ assert(symTy && "symbol must have a type");
// check CHARACTER's length
if (symTy->category() == semantics::DeclTypeSpec::Character)
if (auto e = symTy->characterTypeSpec().length().GetExplicit())
@@ -1471,9 +1462,8 @@ struct SymbolDependenceDepth {
// If there are alias sets, then link the participating variables to their
// aggregate stores when constructing the new variable on the list.
- if (lower::pft::Variable::AggregateStore *store = findStoreIfAlias(sym)) {
+ if (lower::pft::Variable::AggregateStore *store = findStoreIfAlias(sym))
vars[depth].back().setAlias(store->getOffset());
- }
return depth;
}
diff --git a/flang/test/Lower/dummy-procedure-in-entry.f90 b/flang/test/Lower/dummy-procedure-in-entry.f90
new file mode 100644
index 0000000000000..7e9cacc522863
--- /dev/null
+++ b/flang/test/Lower/dummy-procedure-in-entry.f90
@@ -0,0 +1,90 @@
+! Test dummy procedures that are not an argument in every entry.
+! This requires creating a mock value in the entries where it is
+! not an argument.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+subroutine dummy_with_iface()
+ interface
+ real function x()
+ end function
+ end interface
+ entry dummy_with_iface_entry(x)
+ call takes_real(x())
+end subroutine
+! CHECK-LABEL: func @_QPdummy_with_iface() {
+! CHECK: %[[VAL_0:.*]] = fir.alloca f32 {adapt.valuebyref}
+! CHECK: %[[VAL_1:.*]] = fir.undefined !fir.boxproc<() -> ()>
+! CHECK: br ^bb1
+! CHECK: ^bb1:
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> f32)
+! CHECK: %[[VAL_3:.*]] = fir.call %[[VAL_2]]() : () -> f32
+! CHECK: fir.store %[[VAL_3]] to %[[VAL_0]] : !fir.ref<f32>
+! CHECK: fir.call @_QPtakes_real(%[[VAL_0]]) : (!fir.ref<f32>) -> ()
+
+! CHECK-LABEL: func @_QPdummy_with_iface_entry(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
+! CHECK: %[[VAL_1:.*]] = fir.alloca f32 {adapt.valuebyref}
+! CHECK: br ^bb1
+! CHECK: ^bb1:
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> f32)
+! CHECK: %[[VAL_3:.*]] = fir.call %[[VAL_2]]() : () -> f32
+! CHECK: fir.store %[[VAL_3]] to %[[VAL_1]] : !fir.ref<f32>
+! CHECK: fir.call @_QPtakes_real(%[[VAL_1]]) : (!fir.ref<f32>) -> ()
+
+subroutine subroutine_dummy()
+ entry subroutine_dummy_entry(x)
+ call x()
+end subroutine
+! CHECK-LABEL: func @_QPsubroutine_dummy() {
+! CHECK: %[[VAL_0:.*]] = fir.undefined !fir.boxproc<() -> ()>
+! CHECK: br ^bb1
+! CHECK: ^bb1:
+! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: fir.call %[[VAL_1]]() : () -> ()
+
+! CHECK-LABEL: func @_QPsubroutine_dummy_entry(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
+! CHECK: br ^bb1
+! CHECK: ^bb1:
+! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: fir.call %[[VAL_1]]() : () -> ()
+
+subroutine character_dummy()
+ external :: c
+ character(*) :: c
+ entry character_dummy_entry(c)
+ call takes_char(c())
+end subroutine
+! CHECK-LABEL: func @_QPcharacter_dummy() {
+! CHECK: %[[VAL_0:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: br ^bb1
+! CHECK: ^bb1:
+! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
+! CHECK: %[[VAL_4:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
+! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_3]] : i64) {bindc_name = ".result"}
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
+! CHECK: %[[VAL_8:.*]] = fir.call %[[VAL_6]](%[[VAL_5]], %[[VAL_7]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
+! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) : (!fir.boxchar<1>) -> ()
+! CHECK: fir.call @llvm.stackrestore(%[[VAL_4]]) : (!fir.ref<i8>) -> ()
+
+! CHECK-LABEL: func @_QPcharacter_dummy_entry(
+! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
+! CHECK: br ^bb1
+! CHECK: ^bb1:
+! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
+! CHECK: %[[VAL_4:.*]] = fir.call @llvm.stacksave() : () -> !fir.ref<i8>
+! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_3]] : i64) {bindc_name = ".result"}
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]] : (() -> ()) -> ((!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>)
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
+! CHECK: %[[VAL_8:.*]] = fir.call %[[VAL_6]](%[[VAL_5]], %[[VAL_7]]) : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
+! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_9]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) : (!fir.boxchar<1>) -> ()
+! CHECK: fir.call @llvm.stackrestore(%[[VAL_4]]) : (!fir.ref<i8>) -> ()
diff --git a/flang/test/Lower/entry-statement.f90 b/flang/test/Lower/entry-statement.f90
index c4d202200e9d5..4d826cf34c167 100644
--- a/flang/test/Lower/entry-statement.f90
+++ b/flang/test/Lower/entry-statement.f90
@@ -16,10 +16,26 @@ subroutine compare1(x, c1, c2)
end
program entries
+ character c(3)
character(10) hh, qq, m
character(len=4) s1, s2
- integer mm
+ integer mm, x(3), y(5)
logical r
+ complex xx(3)
+ character(5), external :: f1, f2, f3
+
+ interface
+ subroutine ashapec(asc)
+ character asc(:)
+ end subroutine
+ subroutine ashapei(asi)
+ integer asi(:)
+ end subroutine
+ subroutine ashapex(asx)
+ complex asx(:)
+ end subroutine
+ end interface
+
s1 = 'a111'
s2 = 'a222'
call compare1(r, s1, s2); print*, r
@@ -37,6 +53,16 @@ program entries
call dd2
call dd3(6)
6 continue
+ x = 5
+ y = 7
+ call level3a(x, y, 3)
+ call level3b(x, y, 3)
+ call ashapec(c); print*, c
+ call ashapei(x); print*, x
+ call ashapex(xx); print*, xx
+ print *, f1(1)
+ print *, f2(2)
+ print *, f3()
end
! CHECK-LABEL: func @_QPss(
@@ -110,8 +136,7 @@ function char_array()
! CHECK-LABEL: func @_QPdd1()
subroutine dd1
- ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name =
- ! "_QFdd1Ekk"}
+ ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = "_QFdd1Ekk"}
! CHECK: br ^bb1
! CHECK: ^bb1: // pred: ^bb0
! CHECK: %[[ten:.*]] = arith.constant 10 : i32
@@ -126,8 +151,7 @@ subroutine dd1
kk = 10
! CHECK-LABEL: func @_QPdd2()
- ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name =
- ! "_QFdd1Ekk"}
+ ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = "_QFdd1Ekk"}
! CHECK: br ^bb1
! CHECK: ^bb1: // pred: ^bb0
! CHECK: %[[twenty:.*]] = arith.constant 20 : i32
@@ -141,8 +165,7 @@ subroutine dd1
! CHECK-LABEL: func @_QPdd3
! CHECK: %[[dd3:[0-9]*]] = fir.alloca index {bindc_name = "dd3"}
- ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name =
- ! "_QFdd1Ekk"}
+ ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name = "_QFdd1Ekk"}
! CHECK: %[[zero:.*]] = arith.constant 0 : index
! CHECK: fir.store %[[zero:.*]] to %[[dd3]] : !fir.ref<index>
! CHECK: br ^bb1
@@ -156,3 +179,297 @@ subroutine dd1
entry dd3(*)
kk = 30
end
+
+! CHECK-LABEL: func @_QPashapec(
+subroutine ashapec(asc)
+ ! CHECK: %[[asx:[0-9]*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>
+ ! CHECK: %[[asi:[0-9]*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: %[[zeroi:[0-9]*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+ ! CHECK: %[[shapei:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[boxi:[0-9]*]] = fir.embox %[[zeroi]](%[[shapei]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: fir.store %[[boxi]] to %[[asi]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+ ! CHECK: %[[zerox:[0-9]*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.complex<4>>>
+ ! CHECK: %[[shapex:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[boxx:[0-9].*]] = fir.embox %[[zerox]](%[[shapex]]) : (!fir.heap<!fir.array<?x!fir.complex<4>>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>
+ ! CHECK: fir.store %[[boxx]] to %[[asx]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>>
+ character asc(:)
+ integer asi(:)
+ complex asx(:)
+ asc = '?'
+ return
+! CHECK-LABEL: func @_QPashapei(
+entry ashapei(asi)
+ ! CHECK: %[[asx:[0-9]*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>
+ ! CHECK: %[[asc:[0-9]*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1>>>>
+ ! CHECK: %[[zeroc:[0-9]*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[shapec:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[boxc:[0-9]*]] = fir.embox %[[zeroc]](%[[shapec]]) : (!fir.heap<!fir.array<?x!fir.char<1>>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1>>>>
+ ! CHECK: fir.store %[[boxc]] to %[[asc]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1>>>>>
+ ! CHECK: %[[zerox:[0-9]*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.complex<4>>>
+ ! CHECK: %[[shapex:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[boxx:[0-9].*]] = fir.embox %[[zerox]](%[[shapex]]) : (!fir.heap<!fir.array<?x!fir.complex<4>>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>
+ ! CHECK: fir.store %[[boxx]] to %[[asx]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.complex<4>>>>>
+ asi = 3
+ return
+! CHECK-LABEL: func @_QPashapex(
+entry ashapex(asx)
+ ! CHECK: %[[asi:[0-9]*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: %[[asc:[0-9]*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?x!fir.char<1>>>>
+ ! CHECK: %[[zeroc:[0-9]*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[shapec:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[boxc:[0-9]*]] = fir.embox %[[zeroc]](%[[shapec]]) : (!fir.heap<!fir.array<?x!fir.char<1>>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?x!fir.char<1>>>>
+ ! CHECK: fir.store %[[boxc]] to %[[asc]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1>>>>>
+ ! CHECK: %[[zeroi:[0-9]*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+ ! CHECK: %[[shapei:[0-9]*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
+ ! CHECK: %[[boxi:[0-9].*]] = fir.embox %[[zeroi]](%[[shapei]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: fir.store %[[boxi]] to %[[asi]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+ asx = (2.0,-2.0)
+end
+
+! CHECK-LABEL: func @_QPlevel3a(
+subroutine level3a(a, b, m)
+ ! CHECK: fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: fir.alloca i32 {bindc_name = "n", uniq_name = "_QFlevel3aEn"}
+ integer :: a(m), b(a(m)), m
+ integer :: x(n), y(x(n)), n
+1 print*, m
+ print*, a
+ print*, b
+ if (m == 3) return
+! CHECK-LABEL: func @_QPlevel3b(
+entry level3b(x, y, n)
+ ! CHECK: fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: fir.alloca i32 {bindc_name = "m", uniq_name = "_QFlevel3aEm"}
+ print*, n
+ print*, x
+ print*, y
+ if (n /= 3) goto 1
+end
+
+! CHECK-LABEL: @_QPf1
+function f1(n1) result(res1)
+ ! CHECK: %[[V_0:[0-9]+]] = fir.convert %arg0 : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "n2", uniq_name = "_QFf1En2"}
+ ! CHECK: %[[V_2:[0-9]+]] = fir.alloca tuple<!fir.boxchar<1>, !fir.boxchar<1>>
+ ! CHECK: %[[V_3:[0-9]+]] = fir.coordinate_of %[[V_2]], %c0{{.*}}_i32 : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_4:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.store %[[V_4]] to %[[V_3]] : !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_5:[0-9]+]] = fir.coordinate_of %[[V_2]], %c1{{.*}}_i32 : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_6:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.store %[[V_6]] to %[[V_5]] : !fir.ref<!fir.boxchar<1>>
+ ! CHECK: br ^bb1
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: %[[V_7:[0-9]+]] = fir.address_of(@_QQcl.6120612061) : !fir.ref<!fir.char<1,5>>
+ ! CHECK: %[[V_8:[0-9]+]] = arith.cmpi slt, %c5{{.*}}, %c5{{.*}} : index
+ ! CHECK: %[[V_9:[0-9]+]] = arith.select %[[V_8]], %c5{{.*}}, %c5{{.*}} : index
+ ! CHECK: %[[V_10:[0-9]+]] = fir.convert %[[V_9]] : (index) -> i64
+ ! CHECK: %[[V_11:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_10]] : i64
+ ! CHECK: %[[V_12:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_7]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_12]], %[[V_13]], %[[V_11]], %false{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+ ! CHECK: %[[V_14:[0-9]+]] = arith.subi %c5{{.*}}, %c1{{.*}} : index
+ ! CHECK: %[[V_15:[0-9]+]] = fir.undefined !fir.char<1>
+ ! CHECK: %[[V_16:[0-9]+]] = fir.insert_value %[[V_15]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+ ! CHECK: fir.do_loop %arg3 = %[[V_9]] to %[[V_14]] step %c1{{.*}} {
+ ! CHECK: %[[V_32:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[V_33:[0-9]+]] = fir.coordinate_of %[[V_32]], %arg3 : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+ ! CHECK: fir.store %[[V_16]] to %[[V_33]] : !fir.ref<!fir.char<1>>
+ ! CHECK: }
+ ! CHECK: %[[V_17:[0-9]+]] = fir.load %arg2 : !fir.ref<i32>
+ ! CHECK: %[[V_18:[0-9]+]] = arith.cmpi eq, %[[V_17]], %c1{{.*}}_i32_4 : i32
+ ! CHECK: cond_br %[[V_18]], ^bb2, ^bb3
+ ! CHECK: ^bb2: // 2 preds: ^bb1, ^bb3
+ ! CHECK: br ^bb5
+ ! CHECK: ^bb3: // pred: ^bb1
+ ! CHECK: fir.call @_QFf1Ps2(%[[V_2]]) : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>) -> ()
+ ! CHECK: %[[V_19:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
+ ! CHECK: %[[V_20:[0-9]+]] = arith.cmpi eq, %[[V_19]], %c2{{.*}}_i32 : i32
+ ! CHECK: cond_br %[[V_20]], ^bb2, ^bb4
+ ! CHECK: ^bb4: // pred: ^bb3
+ ! CHECK: %[[V_21:[0-9]+]] = fir.address_of(@_QQcl.4320432043) : !fir.ref<!fir.char<1,5>>
+ ! CHECK: %[[V_22:[0-9]+]] = arith.cmpi slt, %c5{{.*}}, %c5{{.*}} : index
+ ! CHECK: %[[V_23:[0-9]+]] = arith.select %[[V_22]], %c5{{.*}}, %c5{{.*}} : index
+ ! CHECK: %[[V_24:[0-9]+]] = fir.convert %[[V_23]] : (index) -> i64
+ ! CHECK: %[[V_25:[0-9]+]] = arith.muli %c1{{.*}}_i64_6, %[[V_24]] : i64
+ ! CHECK: %[[V_26:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK: %[[V_27:[0-9]+]] = fir.convert %[[V_21]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_26]], %[[V_27]], %[[V_25]], %false{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+ ! CHECK: %[[V_28:[0-9]+]] = arith.subi %c5{{.*}}, %c1{{.*}} : index
+ ! CHECK: %[[V_29:[0-9]+]] = fir.undefined !fir.char<1>
+ ! CHECK: %[[V_30:[0-9]+]] = fir.insert_value %[[V_29]], %c32{{.*}}_i8_9, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+ ! CHECK: fir.do_loop %arg3 = %[[V_23]] to %[[V_28]] step %c1{{.*}} {
+ ! CHECK: %[[V_32]] = fir.convert %[[V_0]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[V_33]] = fir.coordinate_of %[[V_32]], %arg3 : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+ ! CHECK: fir.store %[[V_30]] to %[[V_33]] : !fir.ref<!fir.char<1>>
+ ! CHECK: }
+ ! CHECK: fir.call @_QFf1Ps3(%[[V_2]]) : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>) -> ()
+ ! CHECK: br ^bb5
+ ! CHECK: ^bb5: // 2 preds: ^bb2, ^bb4
+ ! CHECK: %[[V_31:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: return %[[V_31]] : !fir.boxchar<1>
+ ! CHECK: }
+ character(5) res1, f2, f3
+ res1 = 'a a a'
+ if (n1 == 1) return
+
+! CHECK-LABEL: @_QPf2
+entry f2(n2)
+ ! CHECK: %[[V_0:[0-9]+]] = fir.convert %arg0 : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "n1", uniq_name = "_QFf1En1"}
+ ! CHECK: %[[V_2:[0-9]+]] = fir.alloca tuple<!fir.boxchar<1>, !fir.boxchar<1>>
+ ! CHECK: %[[V_3:[0-9]+]] = fir.coordinate_of %[[V_2]], %c0{{.*}}_i32 : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_4:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.store %[[V_4]] to %[[V_3]] : !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_5:[0-9]+]] = fir.coordinate_of %[[V_2]], %c1{{.*}}_i32 : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_6:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.store %[[V_6]] to %[[V_5]] : !fir.ref<!fir.boxchar<1>>
+ ! CHECK: br ^bb1
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: fir.call @_QFf1Ps2(%[[V_2]]) : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>) -> ()
+ ! CHECK: %[[V_7:[0-9]+]] = fir.load %arg2 : !fir.ref<i32>
+ ! CHECK: %[[V_8:[0-9]+]] = arith.cmpi eq, %[[V_7]], %c2{{.*}}_i32 : i32
+ ! CHECK: cond_br %[[V_8]], ^bb2, ^bb3
+ ! CHECK: ^bb2: // pred: ^bb1
+ ! CHECK: br ^bb4
+ ! CHECK: ^bb3: // pred: ^bb1
+ ! CHECK: %[[V_9:[0-9]+]] = fir.address_of(@_QQcl.4320432043) : !fir.ref<!fir.char<1,5>>
+ ! CHECK: %[[V_10:[0-9]+]] = arith.cmpi slt, %c5{{.*}}, %c5{{.*}} : index
+ ! CHECK: %[[V_11:[0-9]+]] = arith.select %[[V_10]], %c5{{.*}}, %c5{{.*}} : index
+ ! CHECK: %[[V_12:[0-9]+]] = fir.convert %[[V_11]] : (index) -> i64
+ ! CHECK: %[[V_13:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_12]] : i64
+ ! CHECK: %[[V_14:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK: %[[V_15:[0-9]+]] = fir.convert %[[V_9]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_14]], %[[V_15]], %[[V_13]], %false{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+ ! CHECK: %[[V_16:[0-9]+]] = arith.subi %c5{{.*}}, %c1{{.*}} : index
+ ! CHECK: %[[V_17:[0-9]+]] = fir.undefined !fir.char<1>
+ ! CHECK: %[[V_18:[0-9]+]] = fir.insert_value %[[V_17]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+ ! CHECK: fir.do_loop %arg3 = %[[V_11]] to %[[V_16]] step %c1{{.*}} {
+ ! CHECK: %[[V_20:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[V_21:[0-9]+]] = fir.coordinate_of %[[V_20]], %arg3 : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+ ! CHECK: fir.store %[[V_18]] to %[[V_21]] : !fir.ref<!fir.char<1>>
+ ! CHECK: }
+ ! CHECK: fir.call @_QFf1Ps3(%[[V_2]]) : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>) -> ()
+ ! CHECK: br ^bb4
+ ! CHECK: ^bb4: // 2 preds: ^bb2, ^bb3
+ ! CHECK: %[[V_19:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: return %[[V_19]] : !fir.boxchar<1>
+ ! CHECK: }
+ call s2
+ if (n2 == 2) return
+
+! CHECK-LABEL: @_QPf3
+entry f3
+ ! CHECK: %[[V_0:[0-9]+]] = fir.convert %arg0 : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "n1", uniq_name = "_QFf1En1"}
+ ! CHECK: %[[V_2:[0-9]+]] = fir.alloca i32 {bindc_name = "n2", uniq_name = "_QFf1En2"}
+ ! CHECK: %[[V_3:[0-9]+]] = fir.alloca tuple<!fir.boxchar<1>, !fir.boxchar<1>>
+ ! CHECK: %[[V_4:[0-9]+]] = fir.coordinate_of %[[V_3]], %c0{{.*}}_i32 : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_5:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.store %[[V_5]] to %[[V_4]] : !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_6:[0-9]+]] = fir.coordinate_of %[[V_3]], %c1{{.*}}_i32 : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_7:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.store %[[V_7]] to %[[V_6]] : !fir.ref<!fir.boxchar<1>>
+ ! CHECK: br ^bb1
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: %[[V_8:[0-9]+]] = fir.address_of(@_QQcl.4320432043) : !fir.ref<!fir.char<1,5>>
+ ! CHECK: %[[V_9:[0-9]+]] = arith.cmpi slt, %c5{{.*}}, %c5{{.*}} : index
+ ! CHECK: %[[V_10:[0-9]+]] = arith.select %[[V_9]], %c5{{.*}}, %c5{{.*}} : index
+ ! CHECK: %[[V_11:[0-9]+]] = fir.convert %[[V_10]] : (index) -> i64
+ ! CHECK: %[[V_12:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_11]] : i64
+ ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK: %[[V_14:[0-9]+]] = fir.convert %[[V_8]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_13]], %[[V_14]], %[[V_12]], %false{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+ ! CHECK: %[[V_15:[0-9]+]] = arith.subi %c5{{.*}}, %c1{{.*}} : index
+ ! CHECK: %[[V_16:[0-9]+]] = fir.undefined !fir.char<1>
+ ! CHECK: %[[V_17:[0-9]+]] = fir.insert_value %[[V_16]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+ ! CHECK: fir.do_loop %arg2 = %[[V_10]] to %[[V_15]] step %c1{{.*}} {
+ ! CHECK: %[[V_19:[0-9]+]] = fir.convert %[[V_0]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[V_20:[0-9]+]] = fir.coordinate_of %[[V_19]], %arg2 : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+ ! CHECK: fir.store %[[V_17]] to %[[V_20]] : !fir.ref<!fir.char<1>>
+ ! CHECK: }
+ ! CHECK: fir.call @_QFf1Ps3(%[[V_3]]) : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>) -> ()
+ ! CHECK: br ^bb2
+ ! CHECK: ^bb2: // pred: ^bb1
+ ! CHECK: %[[V_18:[0-9]+]] = fir.emboxchar %[[V_0]], %c5{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: return %[[V_18]] : !fir.boxchar<1>
+ ! CHECK: }
+ f3 = "C C C"
+ call s3
+contains
+ ! CHECK-LABEL: @_QFf1Ps2
+ subroutine s2
+ ! CHECK: %[[V_0:[0-9]+]] = fir.coordinate_of %arg0, %c0{{.*}}_i32 : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_1:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_2:[0-9]+]]:2 = fir.unboxchar %[[V_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ ! CHECK: %[[V_3:[0-9]+]] = fir.address_of(@_QQcl.6220622062) : !fir.ref<!fir.char<1,5>>
+ ! CHECK: %[[V_4:[0-9]+]] = arith.cmpi slt, %[[V_2]]#1, %c5{{.*}} : index
+ ! CHECK: %[[V_5:[0-9]+]] = arith.select %[[V_4]], %[[V_2]]#1, %c5{{.*}} : index
+ ! CHECK: %[[V_6:[0-9]+]] = fir.convert %[[V_5]] : (index) -> i64
+ ! CHECK: %[[V_7:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_6]] : i64
+ ! CHECK: %[[V_8:[0-9]+]] = fir.convert %[[V_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK: %[[V_9:[0-9]+]] = fir.convert %[[V_3]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_8]], %[[V_9]], %[[V_7]], %false{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+ ! CHECK: %[[V_10:[0-9]+]] = arith.subi %[[V_2]]#1, %c1{{.*}} : index
+ ! CHECK: %[[V_11:[0-9]+]] = fir.undefined !fir.char<1>
+ ! CHECK: %[[V_12:[0-9]+]] = fir.insert_value %[[V_11]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+ ! CHECK: fir.do_loop %arg1 = %[[V_5]] to %[[V_10]] step %c1{{.*}} {
+ ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_13]], %arg1 : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+ ! CHECK: fir.store %[[V_12]] to %[[V_14]] : !fir.ref<!fir.char<1>>
+ ! CHECK: }
+ ! CHECK: return
+ ! CHECK: }
+ f2 = 'b b b'
+ end
+
+ ! CHECK-LABEL: @_QFf1Ps3
+ subroutine s3
+ ! CHECK: %[[V_0:[0-9]+]] = fir.coordinate_of %arg0, %c1{{.*}}_i32 : (!fir.ref<tuple<!fir.boxchar<1>, !fir.boxchar<1>>>, i32) -> !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_1:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.boxchar<1>>
+ ! CHECK: %[[V_2:[0-9]+]]:2 = fir.unboxchar %[[V_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ ! CHECK: %[[V_3:[0-9]+]] = fir.address_of(@_QQcl.6320632063) : !fir.ref<!fir.char<1,5>>
+ ! CHECK: %[[V_4:[0-9]+]] = arith.cmpi slt, %[[V_2]]#1, %c5{{.*}} : index
+ ! CHECK: %[[V_5:[0-9]+]] = arith.select %[[V_4]], %[[V_2]]#1, %c5{{.*}} : index
+ ! CHECK: %[[V_6:[0-9]+]] = fir.convert %[[V_5]] : (index) -> i64
+ ! CHECK: %[[V_7:[0-9]+]] = arith.muli %c1{{.*}}_i64, %[[V_6]] : i64
+ ! CHECK: %[[V_8:[0-9]+]] = fir.convert %[[V_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK: %[[V_9:[0-9]+]] = fir.convert %[[V_3]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<i8>
+ ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[V_8]], %[[V_9]], %[[V_7]], %false{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
+ ! CHECK: %[[V_10:[0-9]+]] = arith.subi %[[V_2]]#1, %c1{{.*}} : index
+ ! CHECK: %[[V_11:[0-9]+]] = fir.undefined !fir.char<1>
+ ! CHECK: %[[V_12:[0-9]+]] = fir.insert_value %[[V_11]], %c32{{.*}}_i8, [0 : index] : (!fir.char<1>, i8) -> !fir.char<1>
+ ! CHECK: fir.do_loop %arg1 = %[[V_5]] to %[[V_10]] step %c1{{.*}} {
+ ! CHECK: %[[V_13:[0-9]+]] = fir.convert %[[V_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[V_14:[0-9]+]] = fir.coordinate_of %[[V_13]], %arg1 : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+ ! CHECK: fir.store %[[V_12]] to %[[V_14]] : !fir.ref<!fir.char<1>>
+ ! CHECK: }
+ ! CHECK: return
+ ! CHECK: }
+ f3 = 'c c c'
+ end
+end
+
+! CHECK-LABEL: func @_QPassumed_size() {
+subroutine assumed_size()
+ real :: x(*)
+! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>>
+! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
+! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK: br ^bb1
+! CHECK: ^bb1:
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func @_QPentry_with_assumed_size(
+ entry entry_with_assumed_size(x)
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+! CHECK: br ^bb1
+! CHECK: ^bb1:
+! CHECK: return
+! CHECK: }
+end subroutine
More information about the flang-commits
mailing list