[flang-commits] [flang] 2c14334 - [flang] Block construct
V Donaldson via flang-commits
flang-commits at lists.llvm.org
Tue Feb 28 09:55:27 PST 2023
Author: V Donaldson
Date: 2023-02-28T09:55:10-08:00
New Revision: 2c1433453d1670f668220670b8f2df60f9dc9949
URL: https://github.com/llvm/llvm-project/commit/2c1433453d1670f668220670b8f2df60f9dc9949
DIFF: https://github.com/llvm/llvm-project/commit/2c1433453d1670f668220670b8f2df60f9dc9949.diff
LOG: [flang] Block construct
A block construct is an execution control construct that supports
declaration scopes contained within a parent subprogram scope or another
block scope. (blocks may be nested.) This is implemented by applying
basic scope processing to the block level.
Name uniquing/mangling is extended to support this. The term "block" is
heavily overloaded in Fortran standards. Prior name uniquing used tag `B`
for common block objects. Existing tag choices were modified to free up `B`
for block construct entities, and `C` for common blocks, and resolve
additional issues with other tags. The "old tag -> new tag" changes can
be summarized as:
-> B -- block construct -> new
B -> C -- common block
C -> YI -- intrinsic type descriptor; not currently generated
CT -> Y -- nonintrinsic type descriptor; not currently generated
G -> N -- namelist group
L -> -- block data; not needed -> deleted
Existing name uniquing components consist of a tag followed by a name
from user source code, such as a module, subprogram, or variable name.
Block constructs are different in that they may be anonymous. (Like other
constructs, a block may have a `block-construct-name` that can be used
in exit statements, but this name is optional.) So blocks are given a
numeric compiler-generated preorder index starting with `B1`, `B2`,
and so on, on a per-procedure basis.
Name uniquing is also modified to include component names for all
containing procedures rather than for just the immediate host. This
fixes an existing name clash bug with same-named entities in same-named
host subprograms contained in different-named containing subprograms,
and variations of the bug involving modules and submodules.
F18 clause 9.7.3.1 (Deallocation of allocatable variables) paragraph 1
has a requirement that an allocated, unsaved allocatable local variable
must be deallocated on procedure exit. The following paragraph 2 states:
When a BLOCK construct terminates, any unsaved allocated allocatable
local variable of the construct is deallocated.
Similarly, F18 clause 7.5.6.3 (When finalization occurs) paragraph 3
has a requirement that a nonpointer, nonallocatable object must be
finalized on procedure exit. The following paragraph 4 states:
A nonpointer nonallocatable local variable of a BLOCK construct
is finalized immediately before it would become undefined due to
termination of the BLOCK construct.
These deallocation and finalization requirements, along with stack
restoration requirements, require knowledge of block exits. In addition
to normal block termination at an end-block-stmt, a block may be
terminated by executing a branching statement that targets a statement
outside of the block. This includes
Single-target branch statements:
- goto
- exit
- cycle
- return
Bounded multiple-target branch statements:
- arithmetic goto
- IO statement with END, EOR, or ERR specifiers
Unbounded multiple-target branch statements:
- call with alternate return specs
- computed goto
- assigned goto
Lowering code is extended to determine if one of these branches exits
one or more relevant blocks or other constructs, and adds a mechanism to
insert any necessary deallocation, finalization, or stack restoration
code at the source of the branch. For a single-target branch it suffices
to generate the exit code just prior to taking the indicated branch.
Each target of a multiple-target branch must be analyzed individually.
Where necessary, the code must first branch to an intermediate basic
block that contains exit code, followed by a branch to the original target
statement.
This patch implements an `activeConstructStack` construct exit mechanism
that queries a new `activeConstruct` PFT bit to insert stack restoration
code at block exits. It ties in to existing code in ConvertVariable.cpp
routine `instantiateLocal` which has code for finalization, making block
exit finalization on par with subprogram exit finalization. Deallocation
is as yet unimplemented for subprograms or blocks. This may result in
memory leaks for affected objects at either the subprogram or block level.
Deallocation cases can be addressed uniformly for both scopes in a future
patch, presumably with code insertion in routine `instantiateLocal`.
The exit code mechanism is not limited to block construct exits. It is
also available for use with other constructs. In particular, it is used
to replace custom deallocation code for a select case construct character
selector expression where applicable. This functionality is also added
to select type and associate constructs. It is available for use with
other constructs, such as select rank and image control constructs,
if that turns out to be necessary.
Overlapping nonfunctional changes include eliminating "FIR" from some
routine names and eliminating obsolete spaces in comments.
Added:
flang/test/Lower/block.f90
Modified:
flang/docs/BijectiveInternalNameUniquing.md
flang/include/flang/Lower/AbstractConverter.h
flang/include/flang/Lower/IterationSpace.h
flang/include/flang/Lower/Mangler.h
flang/include/flang/Lower/PFTBuilder.h
flang/include/flang/Lower/StatementContext.h
flang/include/flang/Optimizer/Support/InternalNames.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertType.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Lower/IO.cpp
flang/lib/Lower/IterationSpace.cpp
flang/lib/Lower/Mangler.cpp
flang/lib/Lower/PFTBuilder.cpp
flang/lib/Optimizer/Support/InternalNames.cpp
flang/test/Fir/external-mangling.fir
flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90
flang/test/Lower/HLFIR/statement-functions.f90
flang/test/Lower/OpenMP/threadprivate-commonblock.f90
flang/test/Lower/OpenMP/threadprivate-use-association.f90
flang/test/Lower/arithmetic-goto.f90
flang/test/Lower/array.f90
flang/test/Lower/common-block-2.f90
flang/test/Lower/common-block.f90
flang/test/Lower/computed-goto.f90
flang/test/Lower/equivalence-2.f90
flang/test/Lower/explicit-interface-results-2.f90
flang/test/Lower/forall/array-constructor.f90
flang/test/Lower/host-associated-globals.f90
flang/test/Lower/module_definition.f90
flang/test/Lower/module_use.f90
flang/test/Lower/module_use_in_same_file.f90
flang/test/Lower/namelist-common-block.f90
flang/test/Lower/parent-component.f90
flang/test/Lower/pointer-assignments.f90
flang/test/Lower/pointer-initial-target-2.f90
flang/test/Lower/program-units-fir-mangling.f90
flang/test/Lower/select-case-statement.f90
flang/unittests/Optimizer/InternalNamesTest.cpp
Removed:
################################################################################
diff --git a/flang/docs/BijectiveInternalNameUniquing.md b/flang/docs/BijectiveInternalNameUniquing.md
index 7a6e8a4f4e644..996c490e7e194 100644
--- a/flang/docs/BijectiveInternalNameUniquing.md
+++ b/flang/docs/BijectiveInternalNameUniquing.md
@@ -1,3 +1,11 @@
+<!--===- docs/Aliasing.md
+
+ Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+ See https://llvm.org/LICENSE.txt for license information.
+ SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+-->
+
# Bijective Internal Name Uniquing
```eval_rst
@@ -5,35 +13,33 @@
:local:
```
-FIR has a flat namespace. No two objects may have the same name at
-the module level. (These would be functions, globals, etc.)
-This necessitates some sort of encoding scheme to unique
-symbols from the front-end into FIR.
+FIR has a flat namespace. No two objects may have the same name at the module
+level. (These would be functions, globals, etc.) This necessitates some sort
+of encoding scheme to unique symbols from the front-end into FIR.
-Another requirement is
-to be able to reverse these unique names and recover the associated
-symbol in the symbol table.
+Another requirement is to be able to reverse these unique names and recover
+the associated symbol in the symbol table.
-Fortran is case insensitive, which allows the compiler to convert the
-user's identifiers to all lower case. Such a universal conversion implies
-that all upper case letters are available for use in uniquing.
+Fortran is case insensitive, which allows the compiler to convert the user's
+identifiers to all lower case. Such a universal conversion implies that all
+upper case letters are available for use in uniquing.
## Prefix `_Q`
-All uniqued names have the prefix sequence `_Q` to indicate the name has
-been uniqued. (Q is chosen because it is a
-[low frequency letter](http://pi.math.cornell.edu/~mec/2003-2004/cryptography/subs/frequencies.html)
+All uniqued names have the prefix sequence `_Q` to indicate the name has been
+uniqued. (Q is chosen because it is a [low frequency letter](http://pi.math.cornell.edu/~mec/2003-2004/cryptography/subs/frequencies.html)
in English.)
## Scope Building
-Symbols can be scoped by the module, submodule, or procedure that contains
-that symbol. After the `_Q` sigil, names are constructed from outermost to
-innermost scope as
+Symbols are scoped by any module, submodule, procedure, and block that
+contains that symbol. After the `_Q` sigil, names are constructed from
+outermost to innermost scope as
* Module name prefixed with `M`
- * Submodule name prefixed with `S`
- * Procedure name prefixed with `F`
+ * Submodule name/s prefixed with `S`
+ * Procedure name/s prefixed with `F`
+ * Innermost block index prefixed with `B`
Given:
```
@@ -50,18 +56,39 @@ The uniqued name of `fun` becomes:
_QMmodSs1modSs2modFsubPfun
```
+## Prefix tag summary
+
+| Tag | Description
+| ----| --------------------------------------------------------- |
+| B | Block ("name" is a compiler generated integer index)
+| C | Common block
+| D | Dispatch table (compiler internal)
+| E | variable Entity
+| EC | Constant Entity
+| F | procedure/Function (as a prefix)
+| K | Kind
+| KN | Negative Kind
+| M | Module
+| N | Namelist group
+| P | Procedure/function (as itself)
+| Q | uniQue mangled name tag
+| S | Submodule
+| T | derived Type
+| Y | tYpe descriptor (compiler internal)
+| YI | tYpe descriptor for an Intrinsic type (compiler internal)
+
## Common blocks
- * A common block name will be prefixed with `B`
+ * A common block name will be prefixed with `C`
Given:
```
- common /variables/ i, j
+ common /work/ i, j
```
-The uniqued name of `variables` becomes:
+The uniqued name of `work` becomes:
```
- _QBvariables
+ _QCwork
```
Given:
@@ -71,7 +98,7 @@ Given:
The uniqued name in case of `blank common block` becomes:
```
- _QB
+ _QC
```
## Module scope global data
@@ -97,20 +124,70 @@ The uniqued name of `pi` becomes:
_QMmodECpi
```
-## Procedures/Subprograms
+## Procedures
- * A procedure/subprogram is prefixed with `P`
+ * A procedure/subprogram as itself is prefixed with `P`
+ * A procedure/subprogram as an ancestor name is prefixed with `F`
+
+Procedures are the only names that are themselves uniqued, as well as
+appearing as a prefix component of other uniqued names.
Given:
```
subroutine sub
+ real, save :: x(1000)
+ ...
```
The uniqued name of `sub` becomes:
```
_QPsub
```
+The uniqued name of `x` becomes:
+```
+ _QFsubEx
+```
+
+## Blocks
+
+ * A block is prefixed with `B`; the block "name" is a compiler generated
+ index
+
+Each block has a per-procedure preorder index. The prefix for the immediately
+containing block construct is unique within the procedure.
+
+Given:
+```
+ subroutine sub
+ block
+ block
+ real, save :: x(1000)
+ ...
+ end block
+ ...
+ end block
+```
+The uniqued name of `x` becomes:
+```
+ _QFsubB2Ex
+```
+
+## Namelist groups
+
+ * A namelist group is prefixed with `N`
+
+Given:
+```
+ subroutine sub
+ real, save :: x(1000)
+ namelist /temps/ x
+ ...
+```
+The uniqued name of `temps` becomes:
+```
+ _QFsubNtemps
+```
-## Derived types and related
+## Derived types
* A derived type is prefixed with `T`
* If a derived type has KIND parameters, they are listed in a consistent
@@ -146,16 +223,15 @@ The uniqued name of `yourtype` where `k1=4` and `k2=-6` (at compile-time):
_QTyourtypeK4KN6
```
- * A derived type dispatch table is prefixed with `D`. The dispatch table
+ * A derived type dispatch table is prefixed with `D`. The dispatch table
for `type t` would be `_QDTt`
- * A type descriptor instance is prefixed with `C`. Intrinsic types can
- be encoded with their names and kinds. The type descriptor for the
- type `yourtype` above would be `_QCTyourtypeK4KN6`. The type
+ * A type descriptor instance is prefixed with `C`. Intrinsic types can
+ be encoded with their names and kinds. The type descriptor for the
+ type `yourtype` above would be `_QCTyourtypeK4KN6`. The type
descriptor for `REAL(4)` would be `_QCrealK4`.
-## Compiler generated names
+## Compiler internal names
-Compiler generated names do not have to be mapped back to Fortran. These
-names will be prefixed with `_QQ` and followed by a unique compiler
-generated identifier. There is, of course, no mapping back to a symbol
-derived from the input source in this case as no such symbol exists.
+Compiler generated names do not have to be mapped back to Fortran. This
+includes names prefixed with `_QQ`, tag `D` for a type bound procedure
+dispatch table, and tags `Y` and `YI` for runtime type descriptors.
diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h
index cd512e9d9f7ee..8c428da37dc87 100644
--- a/flang/include/flang/Lower/AbstractConverter.h
+++ b/flang/include/flang/Lower/AbstractConverter.h
@@ -28,11 +28,6 @@ class KindMapping;
class FirOpBuilder;
} // namespace fir
-namespace fir {
-class KindMapping;
-class FirOpBuilder;
-} // namespace fir
-
namespace Fortran {
namespace common {
template <typename>
@@ -233,6 +228,9 @@ class AbstractConverter {
virtual mlir::MLIRContext &getMLIRContext() = 0;
/// Unique a symbol
virtual std::string mangleName(const Fortran::semantics::Symbol &) = 0;
+ /// Unique a derived type
+ virtual std::string
+ mangleName(const Fortran::semantics::DerivedTypeSpec &) = 0;
/// Get the KindMap.
virtual const fir::KindMapping &getKindMap() = 0;
diff --git a/flang/include/flang/Lower/IterationSpace.h b/flang/include/flang/Lower/IterationSpace.h
index 1c413a5f0c115..f05a23ba3e33e 100644
--- a/flang/include/flang/Lower/IterationSpace.h
+++ b/flang/include/flang/Lower/IterationSpace.h
@@ -191,7 +191,7 @@ class StackableConstructExpr {
assert(!empty());
stack.pop_back();
if (empty()) {
- stmtCtx.finalize();
+ stmtCtx.finalizeAndReset();
vmap.clear();
}
}
@@ -522,7 +522,7 @@ class ExplicitIterSpace {
const ExplicitIterSpace &);
/// Finalize the current body statement context.
- void finalizeContext() { stmtCtx.finalize(); }
+ void finalizeContext() { stmtCtx.finalizeAndReset(); }
void appendLoops(const llvm::SmallVector<fir::DoLoopOp> &loops) {
loopStack.push_back(loops);
diff --git a/flang/include/flang/Lower/Mangler.h b/flang/include/flang/Lower/Mangler.h
index 11a8e961b1c5e..9e6f82bc19598 100644
--- a/flang/include/flang/Lower/Mangler.h
+++ b/flang/include/flang/Lower/Mangler.h
@@ -26,22 +26,29 @@ class Reference;
}
namespace semantics {
+class Scope;
class Symbol;
class DerivedTypeSpec;
} // namespace semantics
namespace lower::mangle {
-/// Convert a front-end Symbol to an internal name.
-/// If \p keepExternalInScope is true, the mangling of external symbols
-/// retains the scope of the symbol declaring externals. Otherwise,
-/// external symbols are mangled outside of any scope. Keeping the scope is
-/// useful in attributes where all the Fortran context is to be maintained.
+using ScopeBlockIdMap =
+ llvm::DenseMap<Fortran::semantics::Scope *, std::int64_t>;
+
+/// Convert a front-end symbol to a unique internal name.
+/// A symbol that could be in a block scope must provide a ScopeBlockIdMap.
+/// If \p keepExternalInScope is true, mangling an external symbol retains
+/// the scope of the symbol. This is useful when setting the attributes of
+/// a symbol where all the Fortran context is needed. Otherwise, external
+/// symbols are mangled outside of any scope.
+std::string mangleName(const semantics::Symbol &, ScopeBlockIdMap &,
+ bool keepExternalInScope = false);
std::string mangleName(const semantics::Symbol &,
bool keepExternalInScope = false);
/// Convert a derived type instance to an internal name.
-std::string mangleName(const semantics::DerivedTypeSpec &);
+std::string mangleName(const semantics::DerivedTypeSpec &, ScopeBlockIdMap &);
/// Recover the bare name of the original symbol from an internal name.
std::string demangleName(llvm::StringRef name);
diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h
index ef513c2e19064..30d7da763344e 100644
--- a/flang/include/flang/Lower/PFTBuilder.h
+++ b/flang/include/flang/Lower/PFTBuilder.h
@@ -205,7 +205,7 @@ using EvaluationTuple =
/// from EvaluationTuple type (std::tuple<A, B, ...>).
using EvaluationVariant = MakeReferenceVariant<EvaluationTuple>;
-/// Function-like units contain lists of evaluations. These can be simple
+/// Function-like units contain lists of evaluations. These can be simple
/// statements or constructs, where a construct contains its own evaluations.
struct Evaluation : EvaluationVariant {
@@ -308,35 +308,36 @@ struct Evaluation : EvaluationVariant {
bool lowerAsStructured() const;
bool lowerAsUnstructured() const;
+ bool forceAsUnstructured() const;
// FIR generation looks primarily at PFT ActionStmt and ConstructStmt leaf
- // nodes. Members such as lexicalSuccessor and block are applicable only
- // to these nodes, plus some directives. The controlSuccessor member is
- // used for nonlexical successors, such as linking to a GOTO target. For
- // multiway branches, it is set to the first target. Successor and exit
- // links always target statements or directives. An internal Construct
+ // nodes. Members such as lexicalSuccessor and block are applicable only
+ // to these nodes, plus some directives. The controlSuccessor member is
+ // used for nonlexical successors, such as linking to a GOTO target. For
+ // multiway branches, it is set to the first target. Successor and exit
+ // links always target statements or directives. An internal Construct
// node has a constructExit link that applies to exits from anywhere within
// the construct.
//
- // An unstructured construct is one that contains some form of goto. This
+ // An unstructured construct is one that contains some form of goto. This
// is indicated by the isUnstructured member flag, which may be set on a
- // statement and propagated to enclosing constructs. This distinction allows
+ // statement and propagated to enclosing constructs. This distinction allows
// a structured IF or DO statement to be materialized with custom structured
- // FIR operations. An unstructured statement is materialized as mlir
+ // FIR operations. An unstructured statement is materialized as mlir
// operation sequences that include explicit branches.
//
- // The block member is set for statements that begin a new block. This
- // block is the target of any branch to the statement. Statements may have
+ // The block member is set for statements that begin a new block. This
+ // block is the target of any branch to the statement. Statements may have
// additional (unstructured) "local" blocks, but such blocks cannot be the
- // target of any explicit branch. The primary example of an (unstructured)
+ // target of any explicit branch. The primary example of an (unstructured)
// statement that may have multiple associated blocks is NonLabelDoStmt,
// which may have a loop preheader block for loop initialization code (the
// block member), and always has a "local" header block that is the target
- // of the loop back edge. If the NonLabelDoStmt is a concurrent loop, it
+ // of the loop back edge. If the NonLabelDoStmt is a concurrent loop, it
// may be associated with an arbitrary number of nested preheader, header,
// and mask blocks.
//
- // The printIndex member is only set for statements. It is used for dumps
+ // The printIndex member is only set for statements. It is used for dumps
// (and debugging) and does not affect FIR generation.
PftNode parent;
@@ -350,6 +351,7 @@ struct Evaluation : EvaluationVariant {
bool isNewBlock{false}; // evaluation begins a new basic block
bool isUnstructured{false}; // evaluation has unstructured control flow
bool negateCondition{false}; // If[Then]Stmt condition must be negated
+ bool activeConstruct{false}; // temporarily set for some constructs
mlir::Block *block{nullptr}; // isNewBlock block (ActionStmt, ConstructStmt)
int printIndex{0}; // (ActionStmt, ConstructStmt) evaluation index for dumps
};
@@ -692,16 +694,16 @@ struct FunctionLikeUnit : public ProgramUnit {
LabelEvalMap labelEvaluationMap;
SymbolLabelMap assignSymbolLabelMap;
std::list<FunctionLikeUnit> nestedFunctions;
- /// <Symbol, Evaluation> pairs for each entry point. The pair at index 0
+ /// <Symbol, Evaluation> pairs for each entry point. The pair at index 0
/// is the primary entry point; remaining pairs are alternate entry points.
/// The primary entry point symbol is Null for an anonymous program.
- /// A named program symbol has MainProgramDetails. Other symbols have
- /// SubprogramDetails. Evaluations are filled in for alternate entries.
+ /// A named program symbol has MainProgramDetails. Other symbols have
+ /// SubprogramDetails. Evaluations are filled in for alternate entries.
llvm::SmallVector<std::pair<const semantics::Symbol *, Evaluation *>, 1>
entryPointList{std::pair{nullptr, nullptr}};
- /// Current index into entryPointList. Index 0 is the primary entry point.
+ /// Current index into entryPointList. Index 0 is the primary entry point.
int activeEntry = 0;
- /// Primary result for function subprograms with alternate entries. This
+ /// 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};
/// Terminal basic block (if any)
@@ -830,9 +832,9 @@ namespace Fortran::lower {
///
/// A PFT is a light weight tree over the parse tree that is used to create FIR.
/// The PFT captures pointers back into the parse tree, so the parse tree must
-/// not be changed between the construction of the PFT and its last use. The
-/// PFT captures a structured view of a program. A program is a list of units.
-/// A function like unit contains a list of evaluations. An evaluation is
+/// not be changed between the construction of the PFT and its last use. The
+/// PFT captures a structured view of a program. A program is a list of units.
+/// A function like unit contains a list of evaluations. An evaluation is
/// either a statement, or a construct with a nested list of evaluations.
std::unique_ptr<pft::Program>
createPFT(const parser::Program &root,
diff --git a/flang/include/flang/Lower/StatementContext.h b/flang/include/flang/Lower/StatementContext.h
index 9ee304af13073..cec9641d43a08 100644
--- a/flang/include/flang/Lower/StatementContext.h
+++ b/flang/include/flang/Lower/StatementContext.h
@@ -21,11 +21,19 @@
namespace Fortran::lower {
/// When lowering a statement, temporaries for intermediate results may be
-/// allocated on the heap. A StatementContext enables their deallocation
-/// either explicitly with finalize() calls, or implicitly at the end of
-/// the context. A context may prohibit temporary allocation. Otherwise,
-/// an initial "outer" context scope may have nested context scopes, which
-/// must make explicit subscope finalize() calls.
+/// allocated on the heap. A StatementContext enables their deallocation
+/// with one of several explicit finalize calls, or with an implicit
+/// call to finalizeAndPop() at the end of the context. A context may prohibit
+/// temporary allocation. Otherwise, an initial "outer" context scope may have
+/// nested context scopes, which must make explicit subscope finalize calls.
+///
+/// In addition to being useful for individual action statement contexts, a
+/// StatementContext is also useful for construct blocks delimited by a pair
+/// of statements such as (block-stmt, end-block-stmt), or a program unit
+/// delimited by a pair of statements such as (subroutine-stmt, end-subroutine-
+/// stmt). Attached cleanup code for these contexts may include stack
+/// management code, deallocation code, and finalization of derived type
+/// entities in the context.
class StatementContext {
public:
explicit StatementContext(bool cleanupProhibited = false) {
@@ -62,29 +70,29 @@ class StatementContext {
}
}
- /// Make cleanup calls. Retain the stack top list for a repeat call.
+ /// Make cleanup calls. Retain the stack top list for a repeat call.
void finalizeAndKeep() {
assert(!cufs.empty() && "invalid finalize statement context");
if (cufs.back())
(*cufs.back())();
}
- /// Make cleanup calls. Pop the stack top list.
- void finalizeAndPop() {
+ /// Make cleanup calls. Clear the stack top list.
+ void finalizeAndReset() {
finalizeAndKeep();
- cufs.pop_back();
+ cufs.back().reset();
}
- /// Make cleanup calls. Clear the stack top list.
- void finalize() {
+ /// Make cleanup calls. Pop the stack top list.
+ void finalizeAndPop() {
finalizeAndKeep();
- cufs.back().reset();
+ cufs.pop_back();
}
- bool workListIsEmpty() const {
- return cufs.empty() || llvm::all_of(cufs, [](auto &opt) -> bool {
- return !opt.has_value();
- });
+ bool hasCode() const {
+ return !cufs.empty() && llvm::any_of(cufs, [](auto &opt) -> bool {
+ return opt.has_value();
+ });
}
private:
diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h
index 9463a81328264..d6e28f4d360f7 100644
--- a/flang/include/flang/Optimizer/Support/InternalNames.h
+++ b/flang/include/flang/Optimizer/Support/InternalNames.h
@@ -43,23 +43,25 @@ struct NameUniquer {
DISPATCH_TABLE,
GENERATED,
INTRINSIC_TYPE_DESC,
+ NAMELIST_GROUP,
PROCEDURE,
TYPE_DESC,
- VARIABLE,
- NAMELIST_GROUP
+ VARIABLE
};
/// Components of an unparsed unique name
struct DeconstructedName {
DeconstructedName(llvm::StringRef name) : name{name} {}
DeconstructedName(llvm::ArrayRef<std::string> modules,
- std::optional<std::string> host, llvm::StringRef name,
- llvm::ArrayRef<std::int64_t> kinds)
- : modules{modules.begin(), modules.end()}, host{host}, name{name},
- kinds{kinds.begin(), kinds.end()} {}
+ llvm::ArrayRef<std::string> procs, std::int64_t blockId,
+ llvm::StringRef name, llvm::ArrayRef<std::int64_t> kinds)
+ : modules{modules.begin(), modules.end()}, procs{procs.begin(),
+ procs.end()},
+ blockId{blockId}, name{name}, kinds{kinds.begin(), kinds.end()} {}
llvm::SmallVector<std::string> modules;
- std::optional<std::string> host;
+ llvm::SmallVector<std::string> procs;
+ std::int64_t blockId;
std::string name;
llvm::SmallVector<std::int64_t> kinds;
};
@@ -67,18 +69,15 @@ struct NameUniquer {
/// Unique a common block name
static std::string doCommonBlock(llvm::StringRef name);
- /// Unique a block data unit name
- static std::string doBlockData(llvm::StringRef name);
-
/// Unique a (global) constant name
static std::string doConstant(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name);
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t block, llvm::StringRef name);
/// Unique a dispatch table name
static std::string doDispatchTable(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name,
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t block, llvm::StringRef name,
llvm::ArrayRef<std::int64_t> kinds);
/// Unique a compiler generated name
@@ -87,39 +86,40 @@ struct NameUniquer {
/// Unique an intrinsic type descriptor
static std::string
doIntrinsicTypeDescriptor(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- IntrinsicType type, std::int64_t kind);
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t block, IntrinsicType type,
+ std::int64_t kind);
/// Unique a procedure name
static std::string doProcedure(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
+ llvm::ArrayRef<llvm::StringRef> procs,
llvm::StringRef name);
/// Unique a derived type name
static std::string doType(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name,
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t block, llvm::StringRef name,
llvm::ArrayRef<std::int64_t> kinds);
/// Unique a (derived) type descriptor name
static std::string doTypeDescriptor(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name,
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t block, llvm::StringRef name,
llvm::ArrayRef<std::int64_t> kinds);
static std::string doTypeDescriptor(llvm::ArrayRef<std::string> modules,
- std::optional<std::string> host,
- llvm::StringRef name,
+ llvm::ArrayRef<std::string> procs,
+ std::int64_t block, llvm::StringRef name,
llvm::ArrayRef<std::int64_t> kinds);
/// Unique a (global) variable name. A variable with save attribute
/// defined inside a subprogram also needs to be handled here
static std::string doVariable(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name);
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t block, llvm::StringRef name);
/// Unique a namelist group name
static std::string doNamelistGroup(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
+ llvm::ArrayRef<llvm::StringRef> procs,
llvm::StringRef name);
/// Entry point for the PROGRAM (called by the runtime)
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index b690ad3959b47..887ce66565c0e 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -118,6 +118,17 @@ struct IncrementLoopInfo {
mlir::Block *exitBlock = nullptr; // loop exit target block
};
+/// Information to support stack management, object deallocation, and
+/// object finalization at early and normal construct exits.
+struct ConstructContext {
+ explicit ConstructContext(Fortran::lower::pft::Evaluation &eval,
+ Fortran::lower::StatementContext &stmtCtx)
+ : eval{eval}, stmtCtx{stmtCtx} {}
+
+ Fortran::lower::pft::Evaluation &eval; // construct eval
+ Fortran::lower::StatementContext &stmtCtx; // construct exit code
+};
+
/// Helper class to generate the runtime type info global data. This data
/// is required to describe the derived type to the runtime so that it can
/// operate over it. It must be ensured this data will be generated for every
@@ -185,10 +196,11 @@ class DispatchTableConverter {
};
public:
- void registerTypeSpec(mlir::Location loc,
+ void registerTypeSpec(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc,
const Fortran::semantics::DerivedTypeSpec *typeSpec) {
assert(typeSpec && "type spec is null");
- std::string dtName = Fortran::lower::mangle::mangleName(*typeSpec);
+ std::string dtName = converter.mangleName(*typeSpec);
if (seen.contains(dtName) || dtName.find("__fortran") != std::string::npos)
return;
seen.insert(dtName);
@@ -197,13 +209,12 @@ class DispatchTableConverter {
void createDispatchTableOps(Fortran::lower::AbstractConverter &converter) {
for (const DispatchTableInfo &info : registeredDispatchTableInfo) {
- std::string dtName = Fortran::lower::mangle::mangleName(*info.typeSpec);
+ std::string dtName = converter.mangleName(*info.typeSpec);
const Fortran::semantics::DerivedTypeSpec *parent =
Fortran::evaluate::GetParentTypeSpec(*info.typeSpec);
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
fir::DispatchTableOp dt = builder.createDispatchTableOp(
- info.loc, dtName,
- parent ? Fortran::lower::mangle::mangleName(*parent) : "");
+ info.loc, dtName, parent ? converter.mangleName(*parent) : "");
auto insertPt = builder.saveInsertionPoint();
const Fortran::semantics::Scope *scope = info.typeSpec->scope();
if (!scope)
@@ -217,8 +228,7 @@ class DispatchTableConverter {
for (const Fortran::semantics::SymbolRef &binding : bindings) {
const auto *details =
binding.get().detailsIf<Fortran::semantics::ProcBindingDetails>();
- std::string bindingName =
- Fortran::lower::mangle::mangleName(details->symbol());
+ std::string bindingName = converter.mangleName(details->symbol());
builder.create<fir::DTEntryOp>(
info.loc,
mlir::StringAttr::get(builder.getContext(),
@@ -667,7 +677,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::StatementContext stmtCtx;
Fortran::lower::createSomeArrayAssignment(*this, lhs, rhs, localSymbols,
stmtCtx);
- stmtCtx.finalize();
+ stmtCtx.finalizeAndReset();
} else if (hexv.getBoxOf<fir::CharBoxValue>()) {
fir::factory::CharacterExprHelper{*builder, loc}.createAssign(lhs, rhs);
} else if (hexv.getBoxOf<fir::MutableBoxValue>()) {
@@ -745,14 +755,23 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
std::string
mangleName(const Fortran::semantics::Symbol &symbol) override final {
- return Fortran::lower::mangle::mangleName(symbol);
+ return Fortran::lower::mangle::mangleName(symbol, scopeBlockIdMap);
+ }
+ std::string mangleName(
+ const Fortran::semantics::DerivedTypeSpec &derivedType) override final {
+ return Fortran::lower::mangle::mangleName(derivedType, scopeBlockIdMap);
}
const fir::KindMapping &getKindMap() override final {
return bridge.getKindMap();
}
+ /// Return the current function context, which may be a nested BLOCK context
+ /// or a full subprogram context.
Fortran::lower::StatementContext &getFctCtx() override final {
+ if (!activeConstructStack.empty() &&
+ activeConstructStack.back().eval.isA<Fortran::parser::BlockConstruct>())
+ return activeConstructStack.back().stmtCtx;
return bridge.fctCtx();
}
@@ -773,7 +792,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
void registerDispatchTableInfo(
mlir::Location loc,
const Fortran::semantics::DerivedTypeSpec *typeSpec) override final {
- dispatchTableConverter.registerTypeSpec(loc, typeSpec);
+ dispatchTableConverter.registerTypeSpec(*this, loc, typeSpec);
}
private:
@@ -913,7 +932,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
return cat == Fortran::common::TypeCategory::Derived;
}
- /// Insert a new block before \p block. Leave the insertion point unchanged.
+ /// Insert a new block before \p block. Leave the insertion point unchanged.
mlir::Block *insertBlock(mlir::Block *block) {
mlir::OpBuilder::InsertPoint insertPt = builder->saveInsertionPoint();
mlir::Block *newBlock = builder->createBlock(block);
@@ -921,24 +940,21 @@ class FirConverter : public Fortran::lower::AbstractConverter {
return newBlock;
}
- mlir::Block *blockOfLabel(Fortran::lower::pft::Evaluation &eval,
- Fortran::parser::Label label) {
+ Fortran::lower::pft::Evaluation &evalOfLabel(Fortran::parser::Label label) {
const Fortran::lower::pft::LabelEvalMap &labelEvaluationMap =
- eval.getOwningProcedure()->labelEvaluationMap;
+ getEval().getOwningProcedure()->labelEvaluationMap;
const auto iter = labelEvaluationMap.find(label);
assert(iter != labelEvaluationMap.end() && "label missing from map");
- mlir::Block *block = iter->second->block;
- assert(block && "missing labeled evaluation block");
- return block;
+ return *iter->second;
}
- void genFIRBranch(mlir::Block *targetBlock) {
+ void genBranch(mlir::Block *targetBlock) {
assert(targetBlock && "missing unconditional target block");
builder->create<mlir::cf::BranchOp>(toLocation(), targetBlock);
}
- void genFIRConditionalBranch(mlir::Value cond, mlir::Block *trueTarget,
- mlir::Block *falseTarget) {
+ void genConditionalBranch(mlir::Value cond, mlir::Block *trueTarget,
+ mlir::Block *falseTarget) {
assert(trueTarget && "missing conditional branch true block");
assert(falseTarget && "missing conditional branch false block");
mlir::Location loc = toLocation();
@@ -946,28 +962,183 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder->create<mlir::cf::CondBranchOp>(loc, bcc, trueTarget, std::nullopt,
falseTarget, std::nullopt);
}
- void genFIRConditionalBranch(mlir::Value cond,
- Fortran::lower::pft::Evaluation *trueTarget,
- Fortran::lower::pft::Evaluation *falseTarget) {
- genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block);
+ void genConditionalBranch(mlir::Value cond,
+ Fortran::lower::pft::Evaluation *trueTarget,
+ Fortran::lower::pft::Evaluation *falseTarget) {
+ genConditionalBranch(cond, trueTarget->block, falseTarget->block);
}
- void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr,
- mlir::Block *trueTarget,
- mlir::Block *falseTarget) {
+ void genConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr,
+ mlir::Block *trueTarget, mlir::Block *falseTarget) {
Fortran::lower::StatementContext stmtCtx;
mlir::Value cond =
createFIRExpr(toLocation(), Fortran::semantics::GetExpr(expr), stmtCtx);
- stmtCtx.finalize();
- genFIRConditionalBranch(cond, trueTarget, falseTarget);
+ stmtCtx.finalizeAndReset();
+ genConditionalBranch(cond, trueTarget, falseTarget);
}
- void genFIRConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr,
- Fortran::lower::pft::Evaluation *trueTarget,
- Fortran::lower::pft::Evaluation *falseTarget) {
+ void genConditionalBranch(const Fortran::parser::ScalarLogicalExpr &expr,
+ Fortran::lower::pft::Evaluation *trueTarget,
+ Fortran::lower::pft::Evaluation *falseTarget) {
Fortran::lower::StatementContext stmtCtx;
mlir::Value cond =
createFIRExpr(toLocation(), Fortran::semantics::GetExpr(expr), stmtCtx);
- stmtCtx.finalize();
- genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block);
+ stmtCtx.finalizeAndReset();
+ genConditionalBranch(cond, trueTarget->block, falseTarget->block);
+ }
+
+ /// Return the nearest active ancestor construct of \p eval, or nullptr.
+ Fortran::lower::pft::Evaluation *
+ getActiveAncestor(const Fortran::lower::pft::Evaluation &eval) {
+ Fortran::lower::pft::Evaluation *ancestor = eval.parentConstruct;
+ for (; ancestor; ancestor = ancestor->parentConstruct)
+ if (ancestor->activeConstruct)
+ break;
+ return ancestor;
+ }
+
+ /// Return the predicate: "a branch to \p targetEval has exit code".
+ bool hasExitCode(const Fortran::lower::pft::Evaluation &targetEval) {
+ Fortran::lower::pft::Evaluation *activeAncestor =
+ getActiveAncestor(targetEval);
+ for (auto it = activeConstructStack.rbegin(),
+ rend = activeConstructStack.rend();
+ it != rend; ++it) {
+ if (&it->eval == activeAncestor)
+ break;
+ if (it->stmtCtx.hasCode())
+ return true;
+ }
+ return false;
+ }
+
+ /// Generate a branch to \p targetEval after generating on-exit code for
+ /// any enclosing construct scopes that are exited by taking the branch.
+ void
+ genConstructExitBranch(const Fortran::lower::pft::Evaluation &targetEval) {
+ Fortran::lower::pft::Evaluation *activeAncestor =
+ getActiveAncestor(targetEval);
+ for (auto it = activeConstructStack.rbegin(),
+ rend = activeConstructStack.rend();
+ it != rend; ++it) {
+ if (&it->eval == activeAncestor)
+ break;
+ it->stmtCtx.finalizeAndKeep();
+ }
+ genBranch(targetEval.block);
+ }
+
+ /// Generate a SelectOp or branch sequence that compares \p selector against
+ /// values in \p valueList and targets corresponding labels in \p labelList.
+ /// If no value matches the selector, branch to \p defaultEval.
+ ///
+ /// There are two special cases. If \p inIoErrContext, the ERR label branch
+ /// is an inverted comparison (ne vs. eq 0). An empty \p valueList indicates
+ /// an ArithmeticIfStmt context that requires two comparisons against 0,
+ /// and the selector may have either INTEGER or REAL type.
+ ///
+ /// If this is not an ArithmeticIfStmt and no targets have exit code,
+ /// generate a SelectOp. Otherwise, for each target, if it has exit code,
+ /// branch to a new block, insert exit code, and then branch to the target.
+ /// Otherwise, branch directly to the target.
+ void genMultiwayBranch(mlir::Value selector,
+ llvm::SmallVector<int64_t> valueList,
+ llvm::SmallVector<Fortran::parser::Label> labelList,
+ const Fortran::lower::pft::Evaluation &defaultEval,
+ bool inIoErrContext = false) {
+ bool inArithmeticIfContext = valueList.empty();
+ assert(((inArithmeticIfContext && labelList.size() == 2) ||
+ (valueList.size() && labelList.size() == valueList.size())) &&
+ "mismatched multiway branch targets");
+ bool defaultHasExitCode = hasExitCode(defaultEval);
+ bool hasAnyExitCode = defaultHasExitCode;
+ if (!hasAnyExitCode)
+ for (auto label : labelList)
+ if (hasExitCode(evalOfLabel(label))) {
+ hasAnyExitCode = true;
+ break;
+ }
+ mlir::Location loc = toLocation();
+ size_t branchCount = labelList.size();
+ if (!inArithmeticIfContext && !hasAnyExitCode &&
+ !getEval().forceAsUnstructured()) { // from -no-structured-fir option
+ // Generate a SelectOp.
+ llvm::SmallVector<mlir::Block *> blockList;
+ for (auto label : labelList)
+ blockList.push_back(evalOfLabel(label).block);
+ blockList.push_back(defaultEval.block);
+ if (inIoErrContext) { // Swap ERR and default fallthrough blocks.
+ assert(!valueList[branchCount - 1] && "invalid IO ERR value");
+ std::swap(blockList[branchCount - 1], blockList[branchCount]);
+ }
+ builder->create<fir::SelectOp>(loc, selector, valueList, blockList);
+ return;
+ }
+ mlir::Type selectorType = selector.getType();
+ bool realSelector = selectorType.isa<mlir::FloatType>();
+ assert((inArithmeticIfContext || !realSelector) && "invalid selector type");
+ mlir::Value zero;
+ if (inArithmeticIfContext)
+ zero =
+ realSelector
+ ? builder->create<mlir::arith::ConstantOp>(
+ loc, selectorType, builder->getFloatAttr(selectorType, 0.0))
+ : builder->createIntegerConstant(loc, selectorType, 0);
+ for (auto label : llvm::enumerate(labelList)) {
+ mlir::Value cond;
+ if (realSelector) // inArithmeticIfContext
+ cond = builder->create<mlir::arith::CmpFOp>(
+ loc,
+ label.index() == 0 ? mlir::arith::CmpFPredicate::OLT
+ : mlir::arith::CmpFPredicate::OGT,
+ selector, zero);
+ else if (inArithmeticIfContext)
+ cond = builder->create<mlir::arith::CmpIOp>(
+ loc,
+ label.index() == 0 ? mlir::arith::CmpIPredicate::slt
+ : mlir::arith::CmpIPredicate::sgt,
+ selector, zero);
+ else
+ cond = builder->create<mlir::arith::CmpIOp>(
+ loc,
+ inIoErrContext && valueList[label.index()] == 0
+ ? mlir::arith::CmpIPredicate::ne
+ : mlir::arith::CmpIPredicate::eq,
+ selector,
+ builder->createIntegerConstant(loc, selectorType,
+ valueList[label.index()]));
+ // Branch to a new block with exit code and then to the target, or branch
+ // directly to the target. defaultEval acts as an "else" target.
+ bool lastBranch = label.index() == branchCount - 1;
+ mlir::Block *nextBlock =
+ lastBranch && !defaultHasExitCode
+ ? defaultEval.block
+ : builder->getBlock()->splitBlock(builder->getInsertionPoint());
+ if (hasExitCode(evalOfLabel(label.value()))) {
+ mlir::Block *jumpBlock =
+ builder->getBlock()->splitBlock(builder->getInsertionPoint());
+ genConditionalBranch(cond, jumpBlock, nextBlock);
+ startBlock(jumpBlock);
+ genConstructExitBranch(evalOfLabel(label.value()));
+ } else {
+ genConditionalBranch(cond, evalOfLabel(label.value()).block, nextBlock);
+ }
+ if (!lastBranch) {
+ startBlock(nextBlock);
+ } else if (defaultHasExitCode) {
+ startBlock(nextBlock);
+ genConstructExitBranch(defaultEval);
+ }
+ }
+ }
+
+ void pushActiveConstruct(Fortran::lower::pft::Evaluation &eval,
+ Fortran::lower::StatementContext &stmtCtx) {
+ activeConstructStack.push_back(ConstructContext{eval, stmtCtx});
+ eval.activeConstruct = true;
+ }
+ void popActiveConstruct() {
+ assert(!activeConstructStack.empty() && "invalid active construct stack");
+ activeConstructStack.back().eval.activeConstruct = false;
+ activeConstructStack.pop_back();
}
//===--------------------------------------------------------------------===//
@@ -1008,7 +1179,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
mlir::Type resultRefType = builder->getRefType(resultType);
// A function with multiple entry points returning
diff erent types
// tags all result variables with one of the largest types to allow
- // them to share the same storage. Convert this to the actual type.
+ // them to share the same storage. Convert this to the actual type.
if (resultRef.getType() != resultRefType)
resultRef = builder->createConvert(loc, resultRefType, resultRef);
return builder->create<fir::LoadOp>(loc, resultRef);
@@ -1062,7 +1233,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::semantics::GetExpr(
std::get<Fortran::parser::ScalarLogicalExpr>(stmt->t)),
stmtCtx);
- stmtCtx.finalize();
+ stmtCtx.finalizeAndReset();
mlir::Value cond =
builder->createConvert(loc, builder->getI1Type(), condExpr);
if (negate)
@@ -1101,12 +1272,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
*this, *stmt.typedCall, explicitIterSpace, implicitIterSpace,
localSymbols, stmtCtx, /*isUserDefAssignment=*/false);
}
+ stmtCtx.finalizeAndReset();
if (!res)
return; // "Normal" subroutine call.
// Call with alternate return specifiers.
// The call returns an index that selects an alternate return branch target.
llvm::SmallVector<int64_t> indexList;
- llvm::SmallVector<mlir::Block *> blockList;
+ llvm::SmallVector<Fortran::parser::Label> labelList;
int64_t index = 0;
for (const Fortran::parser::ActualArgSpec &arg :
std::get<std::list<Fortran::parser::ActualArgSpec>>(stmt.v.t)) {
@@ -1114,12 +1286,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (const auto *altReturn =
std::get_if<Fortran::parser::AltReturnSpec>(&actual.u)) {
indexList.push_back(++index);
- blockList.push_back(blockOfLabel(eval, altReturn->v));
+ labelList.push_back(altReturn->v);
}
}
- blockList.push_back(eval.nonNopSuccessor().block); // default = fallthrough
- stmtCtx.finalize();
- builder->create<fir::SelectOp>(toLocation(), res, indexList, blockList);
+ genMultiwayBranch(res, indexList, labelList, eval.nonNopSuccessor());
}
void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) {
@@ -1130,66 +1300,37 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::semantics::GetExpr(
std::get<Fortran::parser::ScalarIntExpr>(stmt.t)),
stmtCtx);
- stmtCtx.finalize();
+ stmtCtx.finalizeAndReset();
llvm::SmallVector<int64_t> indexList;
- llvm::SmallVector<mlir::Block *> blockList;
+ llvm::SmallVector<Fortran::parser::Label> labelList;
int64_t index = 0;
for (Fortran::parser::Label label :
std::get<std::list<Fortran::parser::Label>>(stmt.t)) {
indexList.push_back(++index);
- blockList.push_back(blockOfLabel(eval, label));
+ labelList.push_back(label);
}
- blockList.push_back(eval.nonNopSuccessor().block); // default
- builder->create<fir::SelectOp>(toLocation(), selectExpr, indexList,
- blockList);
+ genMultiwayBranch(selectExpr, indexList, labelList, eval.nonNopSuccessor());
}
void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) {
Fortran::lower::StatementContext stmtCtx;
- Fortran::lower::pft::Evaluation &eval = getEval();
mlir::Value expr = createFIRExpr(
toLocation(),
Fortran::semantics::GetExpr(std::get<Fortran::parser::Expr>(stmt.t)),
stmtCtx);
- stmtCtx.finalize();
- mlir::Type exprType = expr.getType();
- mlir::Location loc = toLocation();
- if (exprType.isSignlessInteger()) {
- // Arithmetic expression has Integer type. Generate a SelectCaseOp
- // with ranges {(-inf:-1], 0=default, [1:inf)}.
- mlir::MLIRContext *context = builder->getContext();
- llvm::SmallVector<mlir::Attribute> attrList;
- llvm::SmallVector<mlir::Value> valueList;
- llvm::SmallVector<mlir::Block *> blockList;
- attrList.push_back(fir::UpperBoundAttr::get(context));
- valueList.push_back(builder->createIntegerConstant(loc, exprType, -1));
- blockList.push_back(blockOfLabel(eval, std::get<1>(stmt.t)));
- attrList.push_back(fir::LowerBoundAttr::get(context));
- valueList.push_back(builder->createIntegerConstant(loc, exprType, 1));
- blockList.push_back(blockOfLabel(eval, std::get<3>(stmt.t)));
- attrList.push_back(mlir::UnitAttr::get(context)); // 0 is the "default"
- blockList.push_back(blockOfLabel(eval, std::get<2>(stmt.t)));
- builder->create<fir::SelectCaseOp>(loc, expr, attrList, valueList,
- blockList);
- return;
- }
- // Arithmetic expression has Real type. Generate
- // sum = expr + expr [ raise an exception if expr is a NaN ]
- // if (sum < 0.0) goto L1 else if (sum > 0.0) goto L3 else goto L2
- auto sum = builder->create<mlir::arith::AddFOp>(loc, expr, expr);
- auto zero = builder->create<mlir::arith::ConstantOp>(
- loc, exprType, builder->getFloatAttr(exprType, 0.0));
- auto cond1 = builder->create<mlir::arith::CmpFOp>(
- loc, mlir::arith::CmpFPredicate::OLT, sum, zero);
- mlir::Block *elseIfBlock =
- builder->getBlock()->splitBlock(builder->getInsertionPoint());
- genFIRConditionalBranch(cond1, blockOfLabel(eval, std::get<1>(stmt.t)),
- elseIfBlock);
- startBlock(elseIfBlock);
- auto cond2 = builder->create<mlir::arith::CmpFOp>(
- loc, mlir::arith::CmpFPredicate::OGT, sum, zero);
- genFIRConditionalBranch(cond2, blockOfLabel(eval, std::get<3>(stmt.t)),
- blockOfLabel(eval, std::get<2>(stmt.t)));
+ stmtCtx.finalizeAndReset();
+ // Raise an exception if REAL expr is a NaN.
+ if (expr.getType().isa<mlir::FloatType>())
+ expr = builder->create<mlir::arith::AddFOp>(toLocation(), expr, expr);
+ llvm::SmallVector<int64_t> valueList;
+ llvm::SmallVector<Fortran::parser::Label> labelList;
+ labelList.push_back(std::get<1>(stmt.t));
+ labelList.push_back(std::get<3>(stmt.t));
+ const Fortran::lower::pft::LabelEvalMap &labelEvaluationMap =
+ getEval().getOwningProcedure()->labelEvaluationMap;
+ const auto iter = labelEvaluationMap.find(std::get<2>(stmt.t));
+ assert(iter != labelEvaluationMap.end() && "label missing from map");
+ genMultiwayBranch(expr, valueList, labelList, *iter->second);
}
void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) {
@@ -1213,33 +1354,30 @@ class FirConverter : public Fortran::lower::AbstractConverter {
auto iter = symbolLabelMap.find(symbol);
if (iter == symbolLabelMap.end()) {
// Fail for a nonconforming program unit that does not have any ASSIGN
- // statements. The front end should check for this.
+ // statements. The front end should check for this.
mlir::emitError(loc, "(semantics issue) no assigned goto targets");
exit(1);
}
auto labelSet = iter->second;
- llvm::SmallVector<int64_t> indexList;
- llvm::SmallVector<mlir::Block *> blockList;
- auto addLabel = [&](Fortran::parser::Label label) {
- indexList.push_back(label);
- blockList.push_back(blockOfLabel(eval, label));
- };
- // Add labels from an explicit list. The list may have duplicates.
+ llvm::SmallVector<int64_t> valueList;
+ llvm::SmallVector<Fortran::parser::Label> labelList;
+ // Add labels from an explicit list. The list may have duplicates.
for (Fortran::parser::Label label :
std::get<std::list<Fortran::parser::Label>>(stmt.t)) {
- if (labelSet.count(label) &&
- !llvm::is_contained(indexList, label)) { // ignore duplicates
- addLabel(label);
+ // Ignore duplicates.
+ if (labelSet.count(label) && !llvm::is_contained(labelList, label)) {
+ valueList.push_back(label); // label as an integer
+ labelList.push_back(label);
}
}
// Absent an explicit list, add all possible label targets.
- if (indexList.empty())
- for (auto &label : labelSet)
- addLabel(label);
- // Add a nop/fallthrough branch to the switch for a nonconforming program
- // unit that violates the program requirement above.
- blockList.push_back(eval.nonNopSuccessor().block); // default
- builder->create<fir::SelectOp>(loc, selectExpr, indexList, blockList);
+ if (labelList.empty())
+ for (auto &label : labelSet) {
+ valueList.push_back(label); // label as an integer
+ labelList.push_back(label);
+ }
+ // Add a nop/fallthrough branch for a nonconforming program.
+ genMultiwayBranch(selectExpr, valueList, labelList, eval.nonNopSuccessor());
}
/// Collect DO CONCURRENT or FORALL loop control information.
@@ -1270,7 +1408,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
return incrementLoopNestInfo;
}
- /// Generate FIR for a DO construct. There are six variants:
+ /// Generate FIR for a DO construct. There are six variants:
/// - unstructured infinite and while loops
/// - structured and unstructured increment loops
/// - structured and unstructured concurrent loops
@@ -1309,7 +1447,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
assert(unstructuredContext && "while loop must be unstructured");
maybeStartBlock(preheaderBlock); // no block or empty block
startBlock(headerBlock);
- genFIRConditionalBranch(*whileCondition, bodyBlock, exitBlock);
+ genConditionalBranch(*whileCondition, bodyBlock, exitBlock);
} else if (const auto *bounds =
std::get_if<Fortran::parser::LoopControl::Bounds>(
&loopControl->u)) {
@@ -1337,9 +1475,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
maybeStartBlock(preheaderBlock);
for (IncrementLoopInfo &info : incrementLoopNestInfo) {
// The original loop body provides the body and latch blocks of the
- // innermost dimension. The (first) body block of a non-innermost
+ // innermost dimension. The (first) body block of a non-innermost
// dimension is the preheader block of the immediately enclosed
- // dimension. The latch block of a non-innermost dimension is the
+ // dimension. The latch block of a non-innermost dimension is the
// exit block of the immediately enclosed dimension.
auto createNextExitBlock = [&]() {
// Create unstructured loop exit blocks, outermost to innermost.
@@ -1356,7 +1494,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
}
- // Increment loop begin code. (Infinite/while code was already generated.)
+ // Increment loop begin code. (Infinite/while code was already generated.)
if (!infiniteLoop && !whileCondition)
genFIRIncrementLoopBegin(incrementLoopNestInfo);
@@ -1373,7 +1511,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// Loop end code.
if (infiniteLoop || whileCondition)
- genFIRBranch(headerBlock);
+ genBranch(headerBlock);
else
genFIRIncrementLoopEnd(incrementLoopNestInfo);
@@ -1449,7 +1587,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (info.maskExpr) {
Fortran::lower::StatementContext stmtCtx;
mlir::Value maskCond = createFIRExpr(loc, info.maskExpr, stmtCtx);
- stmtCtx.finalize();
+ stmtCtx.finalizeAndReset();
mlir::Value maskCondCast =
builder->createConvert(loc, builder->getI1Type(), maskCond);
auto ifOp = builder->create<fir::IfOp>(loc, maskCondCast,
@@ -1471,7 +1609,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder->create<mlir::arith::DivFOp>(loc,
diff 2, info.stepValue);
tripCount =
builder->createConvert(loc, builder->getIndexType(), tripCount);
-
} else {
auto
diff 1 =
builder->create<mlir::arith::SubIOp>(loc, upperValue, lowerValue);
@@ -1501,16 +1638,16 @@ class FirConverter : public Fortran::lower::AbstractConverter {
auto cond = builder->create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::sgt, tripCount, zero);
if (info.maskExpr) {
- genFIRConditionalBranch(cond, info.maskBlock, info.exitBlock);
+ genConditionalBranch(cond, info.maskBlock, info.exitBlock);
startBlock(info.maskBlock);
mlir::Block *latchBlock = getEval().getLastNestedEvaluation().block;
assert(latchBlock && "missing masked concurrent loop latch block");
Fortran::lower::StatementContext stmtCtx;
mlir::Value maskCond = createFIRExpr(loc, info.maskExpr, stmtCtx);
- stmtCtx.finalize();
- genFIRConditionalBranch(maskCond, info.bodyBlock, latchBlock);
+ stmtCtx.finalizeAndReset();
+ genConditionalBranch(maskCond, info.bodyBlock, latchBlock);
} else {
- genFIRConditionalBranch(cond, info.bodyBlock, info.exitBlock);
+ genConditionalBranch(cond, info.bodyBlock, info.exitBlock);
if (&info != &incrementLoopNestInfo.back()) // not innermost
startBlock(info.bodyBlock); // preheader block of enclosed dimension
}
@@ -1574,7 +1711,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder->create<mlir::arith::AddIOp>(loc, value, info.stepValue);
builder->create<fir::StoreOp>(loc, value, info.loopVariable);
- genFIRBranch(info.headerBlock);
+ genBranch(info.headerBlock);
if (&info != &incrementLoopNestInfo.front()) // not outermost
startBlock(info.exitBlock); // latch block of enclosing dimension
}
@@ -1619,10 +1756,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations()) {
auto genIfBranch = [&](mlir::Value cond) {
if (e.lexicalSuccessor == e.controlSuccessor) // empty block -> exit
- genFIRConditionalBranch(cond, e.parentConstruct->constructExit,
- e.controlSuccessor);
+ genConditionalBranch(cond, e.parentConstruct->constructExit,
+ e.controlSuccessor);
else // non-empty block
- genFIRConditionalBranch(cond, e.lexicalSuccessor, e.controlSuccessor);
+ genConditionalBranch(cond, e.lexicalSuccessor, e.controlSuccessor);
};
if (auto *s = e.getIf<Fortran::parser::IfThenStmt>()) {
maybeStartBlock(e.block);
@@ -1640,8 +1777,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
void genFIR(const Fortran::parser::CaseConstruct &) {
+ Fortran::lower::pft::Evaluation &eval = getEval();
+ Fortran::lower::StatementContext stmtCtx;
+ pushActiveConstruct(eval, stmtCtx);
for (Fortran::lower::pft::Evaluation &e : getEval().getNestedEvaluations())
genFIR(e);
+ popActiveConstruct();
}
template <typename A>
@@ -1912,16 +2053,21 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
/// Generate FIR for a SELECT CASE statement.
- /// The type may be CHARACTER, INTEGER, or LOGICAL.
+ /// The selector may have CHARACTER, INTEGER, or LOGICAL type.
void genFIR(const Fortran::parser::SelectCaseStmt &stmt) {
Fortran::lower::pft::Evaluation &eval = getEval();
- mlir::MLIRContext *context = builder->getContext();
- mlir::Location loc = toLocation();
- Fortran::lower::StatementContext stmtCtx;
+ Fortran::lower::pft::Evaluation *parentConstruct = eval.parentConstruct;
+ assert(!activeConstructStack.empty() &&
+ &activeConstructStack.back().eval == parentConstruct &&
+ "select case construct is not active");
+ Fortran::lower::StatementContext &stmtCtx =
+ activeConstructStack.back().stmtCtx;
const Fortran::lower::SomeExpr *expr = Fortran::semantics::GetExpr(
std::get<Fortran::parser::Scalar<Fortran::parser::Expr>>(stmt.t));
bool isCharSelector = isCharacterCategory(expr->GetType()->category());
bool isLogicalSelector = isLogicalCategory(expr->GetType()->category());
+ mlir::MLIRContext *context = builder->getContext();
+ mlir::Location loc = toLocation();
auto charValue = [&](const Fortran::lower::SomeExpr *expr) {
fir::ExtendedValue exv = genExprAddr(*expr, stmtCtx, &loc);
return exv.match(
@@ -1946,7 +2092,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
llvm::SmallVector<mlir::Attribute> attrList;
llvm::SmallVector<mlir::Value> valueList;
llvm::SmallVector<mlir::Block *> blockList;
- mlir::Block *defaultBlock = eval.parentConstruct->constructExit->block;
+ mlir::Block *defaultBlock = parentConstruct->constructExit->block;
using CaseValue = Fortran::parser::Scalar<Fortran::parser::ConstantExpr>;
auto addValue = [&](const CaseValue &caseValue) {
const Fortran::lower::SomeExpr *expr =
@@ -1998,20 +2144,19 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
// Skip a logical default block that can never be referenced.
if (isLogicalSelector && attrList.size() == 2)
- defaultBlock = eval.parentConstruct->constructExit->block;
+ defaultBlock = parentConstruct->constructExit->block;
attrList.push_back(mlir::UnitAttr::get(context));
blockList.push_back(defaultBlock);
- // Generate a fir::SelectCaseOp.
- // Explicit branch code is better for the LOGICAL type. The CHARACTER type
- // does not yet have downstream support, and also uses explicit branch code.
- // The -no-structured-fir option can be used to force generation of INTEGER
- // type branch code.
- if (!isLogicalSelector && !isCharSelector && eval.lowerAsStructured()) {
- // Numeric selector is a ssa register, all temps that may have
- // been generated while evaluating it can be cleaned-up before the
- // fir.select_case.
- stmtCtx.finalize();
+ // Generate a fir::SelectCaseOp. Explicit branch code is better for the
+ // LOGICAL type. The CHARACTER type does not have downstream SelectOp
+ // support. The -no-structured-fir option can be used to force generation
+ // of INTEGER type branch code.
+ if (!isLogicalSelector && !isCharSelector &&
+ !getEval().forceAsUnstructured()) {
+ // The selector is in an ssa register. Any temps that may have been
+ // generated while evaluating it can be cleaned up now.
+ stmtCtx.finalizeAndReset();
builder->create<fir::SelectCaseOp>(loc, selector, attrList, valueList,
blockList);
return;
@@ -2020,12 +2165,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// Generate a sequence of case value comparisons and branches.
auto caseValue = valueList.begin();
auto caseBlock = blockList.begin();
- bool skipFinalization = false;
- for (const auto &attr : llvm::enumerate(attrList)) {
- if (attr.value().isa<mlir::UnitAttr>()) {
- if (attrList.size() == 1)
- stmtCtx.finalize();
- genFIRBranch(*caseBlock++);
+ for (mlir::Attribute attr : attrList) {
+ if (attr.isa<mlir::UnitAttr>()) {
+ genBranch(*caseBlock++);
break;
}
auto genCond = [&](mlir::Value rhs,
@@ -2035,59 +2177,40 @@ class FirConverter : public Fortran::lower::AbstractConverter {
fir::factory::CharacterExprHelper charHelper{*builder, loc};
std::pair<mlir::Value, mlir::Value> lhsVal =
charHelper.createUnboxChar(selector);
- mlir::Value &lhsAddr = lhsVal.first;
- mlir::Value &lhsLen = lhsVal.second;
std::pair<mlir::Value, mlir::Value> rhsVal =
charHelper.createUnboxChar(rhs);
- mlir::Value &rhsAddr = rhsVal.first;
- mlir::Value &rhsLen = rhsVal.second;
- mlir::Value result = fir::runtime::genCharCompare(
- *builder, loc, pred, lhsAddr, lhsLen, rhsAddr, rhsLen);
- if (stmtCtx.workListIsEmpty() || skipFinalization)
- return result;
- if (attr.index() == attrList.size() - 2) {
- stmtCtx.finalize();
- return result;
- }
- fir::IfOp ifOp = builder->create<fir::IfOp>(loc, result,
- /*withElseRegion=*/false);
- builder->setInsertionPointToStart(&ifOp.getThenRegion().front());
- stmtCtx.finalizeAndKeep();
- builder->setInsertionPointAfter(ifOp);
- return result;
+ return fir::runtime::genCharCompare(*builder, loc, pred, lhsVal.first,
+ lhsVal.second, rhsVal.first,
+ rhsVal.second);
};
mlir::Block *newBlock = insertBlock(*caseBlock);
- if (attr.value().isa<fir::ClosedIntervalAttr>()) {
+ if (attr.isa<fir::ClosedIntervalAttr>()) {
mlir::Block *newBlock2 = insertBlock(*caseBlock);
- skipFinalization = true;
mlir::Value cond =
genCond(*caseValue++, mlir::arith::CmpIPredicate::sge);
- genFIRConditionalBranch(cond, newBlock, newBlock2);
+ genConditionalBranch(cond, newBlock, newBlock2);
builder->setInsertionPointToEnd(newBlock);
- skipFinalization = false;
mlir::Value cond2 =
genCond(*caseValue++, mlir::arith::CmpIPredicate::sle);
- genFIRConditionalBranch(cond2, *caseBlock++, newBlock2);
+ genConditionalBranch(cond2, *caseBlock++, newBlock2);
builder->setInsertionPointToEnd(newBlock2);
continue;
}
mlir::arith::CmpIPredicate pred;
- if (attr.value().isa<fir::PointIntervalAttr>()) {
+ if (attr.isa<fir::PointIntervalAttr>()) {
pred = mlir::arith::CmpIPredicate::eq;
- } else if (attr.value().isa<fir::LowerBoundAttr>()) {
+ } else if (attr.isa<fir::LowerBoundAttr>()) {
pred = mlir::arith::CmpIPredicate::sge;
} else {
- assert(attr.value().isa<fir::UpperBoundAttr>() &&
- "unexpected predicate");
+ assert(attr.isa<fir::UpperBoundAttr>() && "unexpected predicate");
pred = mlir::arith::CmpIPredicate::sle;
}
mlir::Value cond = genCond(*caseValue++, pred);
- genFIRConditionalBranch(cond, *caseBlock++, newBlock);
+ genConditionalBranch(cond, *caseBlock++, newBlock);
builder->setInsertionPointToEnd(newBlock);
}
assert(caseValue == valueList.end() && caseBlock == blockList.end() &&
"select case list mismatch");
- assert(stmtCtx.workListIsEmpty() && "statement context must be empty");
}
fir::ExtendedValue
@@ -2102,8 +2225,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
void genFIR(const Fortran::parser::AssociateConstruct &) {
- Fortran::lower::StatementContext stmtCtx;
Fortran::lower::pft::Evaluation &eval = getEval();
+ Fortran::lower::StatementContext stmtCtx;
+ pushActiveConstruct(eval, stmtCtx);
for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations()) {
if (auto *stmt = e.getIf<Fortran::parser::AssociateStmt>()) {
if (eval.lowerAsUnstructured())
@@ -2120,23 +2244,52 @@ class FirConverter : public Fortran::lower::AbstractConverter {
} else if (e.getIf<Fortran::parser::EndAssociateStmt>()) {
if (eval.lowerAsUnstructured())
maybeStartBlock(e.block);
- stmtCtx.finalize();
localSymbols.popScope();
} else {
genFIR(e);
}
}
+ popActiveConstruct();
}
void genFIR(const Fortran::parser::BlockConstruct &blockConstruct) {
- setCurrentPositionAt(blockConstruct);
- TODO(toLocation(), "BlockConstruct implementation");
- }
- void genFIR(const Fortran::parser::BlockStmt &) {
- TODO(toLocation(), "BlockStmt implementation");
- }
- void genFIR(const Fortran::parser::EndBlockStmt &) {
- TODO(toLocation(), "EndBlockStmt implementation");
+ Fortran::lower::pft::Evaluation &eval = getEval();
+ Fortran::lower::StatementContext stmtCtx;
+ pushActiveConstruct(eval, stmtCtx);
+ for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations()) {
+ if (e.getIf<Fortran::parser::BlockStmt>()) {
+ if (eval.lowerAsUnstructured())
+ maybeStartBlock(e.block);
+ setCurrentPosition(e.position);
+ const Fortran::parser::CharBlock &endPosition =
+ eval.getLastNestedEvaluation().position;
+ localSymbols.pushScope();
+ mlir::func::FuncOp stackSave = fir::factory::getLlvmStackSave(*builder);
+ mlir::func::FuncOp stackRestore =
+ fir::factory::getLlvmStackRestore(*builder);
+ mlir::Value stackPtr =
+ builder->create<fir::CallOp>(toLocation(), stackSave).getResult(0);
+ mlir::Location endLoc = genLocation(endPosition);
+ stmtCtx.attachCleanup([=]() {
+ builder->create<fir::CallOp>(endLoc, stackRestore, stackPtr);
+ });
+ Fortran::semantics::Scope &scope =
+ bridge.getSemanticsContext().FindScope(endPosition);
+ scopeBlockIdMap.try_emplace(&scope, ++blockId);
+ Fortran::lower::AggregateStoreMap storeMap;
+ for (const Fortran::lower::pft::Variable &var :
+ Fortran::lower::pft::getScopeVariableList(scope))
+ instantiateVar(var, storeMap);
+ } else if (e.getIf<Fortran::parser::EndBlockStmt>()) {
+ if (eval.lowerAsUnstructured())
+ maybeStartBlock(e.block);
+ setCurrentPosition(e.position);
+ localSymbols.popScope();
+ } else {
+ genFIR(e);
+ }
+ }
+ popActiveConstruct();
}
void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) {
@@ -2195,6 +2348,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
typeCaseScopes.push_back(&scope);
}
+ pushActiveConstruct(getEval(), stmtCtx);
for (Fortran::lower::pft::Evaluation &eval :
getEval().getNestedEvaluations()) {
if (auto *selectTypeStmt =
@@ -2385,11 +2539,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
genFIR(eval);
if (hasLocalScope)
localSymbols.popScope();
- stmtCtx.finalize();
} else {
genFIR(eval);
}
}
+ popActiveConstruct();
}
//===--------------------------------------------------------------------===//
@@ -2448,49 +2602,47 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (!iostat)
return;
- mlir::Block *endBlock = nullptr;
- mlir::Block *eorBlock = nullptr;
- mlir::Block *errBlock = nullptr;
+ Fortran::parser::Label endLabel{};
+ Fortran::parser::Label eorLabel{};
+ Fortran::parser::Label errLabel{};
for (const auto &spec : specList) {
std::visit(Fortran::common::visitors{
[&](const Fortran::parser::EndLabel &label) {
- endBlock = blockOfLabel(eval, label.v);
+ endLabel = label.v;
},
[&](const Fortran::parser::EorLabel &label) {
- eorBlock = blockOfLabel(eval, label.v);
+ eorLabel = label.v;
},
[&](const Fortran::parser::ErrLabel &label) {
- errBlock = blockOfLabel(eval, label.v);
+ errLabel = label.v;
},
[](const auto &) {}},
spec.u);
}
- if (!endBlock && !eorBlock && !errBlock)
+ if (!endLabel && !eorLabel && !errLabel)
return;
- mlir::Location loc = toLocation();
- mlir::Type indexType = builder->getIndexType();
- mlir::Value selector = builder->createConvert(loc, indexType, iostat);
+ mlir::Value selector =
+ builder->createConvert(toLocation(), builder->getIndexType(), iostat);
llvm::SmallVector<int64_t> indexList;
- llvm::SmallVector<mlir::Block *> blockList;
- if (eorBlock) {
+ llvm::SmallVector<Fortran::parser::Label> labelList;
+ if (eorLabel) {
indexList.push_back(Fortran::runtime::io::IostatEor);
- blockList.push_back(eorBlock);
+ labelList.push_back(eorLabel);
}
- if (endBlock) {
+ if (endLabel) {
indexList.push_back(Fortran::runtime::io::IostatEnd);
- blockList.push_back(endBlock);
+ labelList.push_back(endLabel);
}
- if (errBlock) {
+ if (errLabel) {
+ // IostatEor and IostatEnd are fixed negative values. IOSTAT ERR values
+ // are positive. Placing the ERR value last allows recognition of an
+ // unexpected negative value as an error.
indexList.push_back(0);
- blockList.push_back(eval.nonNopSuccessor().block);
- // ERR label statement is the default successor.
- blockList.push_back(errBlock);
- } else {
- // Fallthrough successor statement is the default successor.
- blockList.push_back(eval.nonNopSuccessor().block);
+ labelList.push_back(errLabel);
}
- builder->create<fir::SelectOp>(loc, selector, indexList, blockList);
+ genMultiwayBranch(selector, indexList, labelList, eval.nonNopSuccessor(),
+ /*inIoErrContext=*/errLabel != Fortran::parser::Label{});
}
//===--------------------------------------------------------------------===//
@@ -2966,7 +3118,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
mlir::Value val = fir::getBase(rhs);
// A function with multiple entry points returning
diff erent
// types tags all result variables with one of the largest
- // types to allow them to share the same storage. Assignment
+ // types to allow them to share the same storage. Assignment
// to a result variable of one of the other types requires
// conversion to the actual type.
mlir::Type toTy = genType(assign.lhs);
@@ -3163,6 +3315,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::pft::FunctionLikeUnit *funit =
getEval().getOwningProcedure();
assert(funit && "not inside main program, function or subroutine");
+ for (auto it = activeConstructStack.rbegin(),
+ rend = activeConstructStack.rend();
+ it != rend; ++it) {
+ it->stmtCtx.finalizeAndKeep();
+ }
if (funit->isMainProgram()) {
bridge.fctCtx().finalizeAndKeep();
genExitRoutine();
@@ -3172,7 +3329,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (stmt.v) {
// Alternate return statement - If this is a subroutine where some
// alternate entries have alternate returns, but the active entry point
- // does not, ignore the alternate return value. Otherwise, assign it
+ // does not, ignore the alternate return value. Otherwise, assign it
// to the compiler-generated result variable.
const Fortran::semantics::Symbol &symbol = funit->getSubprogramSymbol();
if (Fortran::semantics::HasAlternateReturns(symbol)) {
@@ -3196,13 +3353,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
void genFIR(const Fortran::parser::CycleStmt &) {
- genFIRBranch(getEval().controlSuccessor->block);
+ genConstructExitBranch(*getEval().controlSuccessor);
}
void genFIR(const Fortran::parser::ExitStmt &) {
- genFIRBranch(getEval().controlSuccessor->block);
+ genConstructExitBranch(*getEval().controlSuccessor);
}
void genFIR(const Fortran::parser::GotoStmt &) {
- genFIRBranch(getEval().controlSuccessor->block);
+ genConstructExitBranch(*getEval().controlSuccessor);
}
// Nop statements - No code, or code is generated at the construct level.
@@ -3211,11 +3368,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// generating a branch to end a block. So these calls may still be required
// for that functionality.
void genFIR(const Fortran::parser::AssociateStmt &) {} // nop
+ void genFIR(const Fortran::parser::BlockStmt &) {} // nop
void genFIR(const Fortran::parser::CaseStmt &) {} // nop
void genFIR(const Fortran::parser::ContinueStmt &) {} // nop
void genFIR(const Fortran::parser::ElseIfStmt &) {} // nop
void genFIR(const Fortran::parser::ElseStmt &) {} // nop
void genFIR(const Fortran::parser::EndAssociateStmt &) {} // nop
+ void genFIR(const Fortran::parser::EndBlockStmt &) {} // nop
void genFIR(const Fortran::parser::EndDoStmt &) {} // nop
void genFIR(const Fortran::parser::EndFunctionStmt &) {} // nop
void genFIR(const Fortran::parser::EndIfStmt &) {} // nop
@@ -3262,11 +3421,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (successor->isIntermediateConstructStmt() &&
successor->parentConstruct->lowerAsUnstructured())
// Exit from an intermediate unstructured IF or SELECT construct block.
- genFIRBranch(successor->parentConstruct->constructExit->block);
+ genBranch(successor->parentConstruct->constructExit->block);
else if (unstructuredContext && eval.isConstructStmt() &&
successor == eval.controlSuccessor)
// Exit from a degenerate, empty construct block.
- genFIRBranch(eval.parentConstruct->constructExit->block);
+ genBranch(eval.parentConstruct->constructExit->block);
}
}
@@ -3337,6 +3496,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder->setFastMathFlags(bridge.getLoweringOptions().getMathOptions());
builder->setInsertionPointToStart(&func.front());
func.setVisibility(mlir::SymbolTable::Visibility::Public);
+ assert(blockId == 0 && "invalid blockId");
+ assert(activeConstructStack.empty() && "invalid construct stack state");
mapDummiesAndResults(funit, callee);
@@ -3446,18 +3607,18 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (Fortran::lower::pft::Evaluation *alternateEntryEval =
funit.getEntryEval())
- genFIRBranch(alternateEntryEval->lexicalSuccessor->block);
+ genBranch(alternateEntryEval->lexicalSuccessor->block);
}
- /// Create global blocks for the current function. This eliminates the
+ /// Create global blocks for the current function. This eliminates the
/// distinction between forward and backward targets when generating
- /// branches. A block is "global" if it can be the target of a GOTO or
- /// other source code branch. A block that can only be targeted by a
- /// compiler generated branch is "local". For example, a DO loop preheader
- /// block containing loop initialization code is global. A loop header
- /// block, which is the target of the loop back edge, is local. Blocks
- /// belong to a region. Any block within a nested region must be replaced
- /// with a block belonging to that region. Branches may not cross region
+ /// branches. A block is "global" if it can be the target of a GOTO or
+ /// other source code branch. A block that can only be targeted by a
+ /// compiler generated branch is "local". For example, a DO loop preheader
+ /// block containing loop initialization code is global. A loop header
+ /// block, which is the target of the loop back edge, is local. Blocks
+ /// belong to a region. Any block within a nested region must be replaced
+ /// with a block belonging to that region. Branches may not cross region
/// boundaries.
void createEmptyBlocks(
std::list<Fortran::lower::pft::Evaluation> &evaluationList) {
@@ -3492,10 +3653,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// Default termination for the current block is a fallthrough branch to
// the new block.
if (blockIsUnterminated())
- genFIRBranch(newBlock);
+ genBranch(newBlock);
// Some blocks may be re/started more than once, and might not be empty.
// If the new block already has (only) a terminator, set the insertion
- // point to the start of the block. Otherwise set it to the end.
+ // point to the start of the block. Otherwise set it to the end.
builder->setInsertionPointToStart(newBlock);
if (blockIsUnterminated())
builder->setInsertionPointToEnd(newBlock);
@@ -3530,6 +3691,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
builder = nullptr;
hostAssocTuple = mlir::Value{};
localSymbols.clear();
+ blockId = 0;
}
/// Helper to generate GlobalOps when the builder is not positioned in any
@@ -3874,13 +4036,20 @@ class FirConverter : public Fortran::lower::AbstractConverter {
RuntimeTypeInfoConverter runtimeTypeInfoConverter;
DispatchTableConverter dispatchTableConverter;
- /// WHERE statement/construct mask expression stack.
- Fortran::lower::ImplicitIterSpace implicitIterSpace;
+ // Stack to manage object deallocation and finalization at construct exits.
+ llvm::SmallVector<ConstructContext> activeConstructStack;
+
+ /// BLOCK name mangling component map
+ int blockId = 0;
+ Fortran::lower::mangle::ScopeBlockIdMap scopeBlockIdMap;
- /// FORALL context
+ /// FORALL statement/construct context
Fortran::lower::ExplicitIterSpace explicitIterSpace;
- /// Tuple of host assoicated variables.
+ /// WHERE statement/construct mask expression stack
+ Fortran::lower::ImplicitIterSpace implicitIterSpace;
+
+ /// Tuple of host associated variables
mlir::Value hostAssocTuple;
};
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 85d438c959637..9e86541660685 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -28,15 +28,15 @@
//===----------------------------------------------------------------------===//
// Return the binding label (from BIND(C...)) or the mangled name of a symbol.
-static std::string getMangledName(mlir::Location loc,
+static std::string getMangledName(Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &symbol) {
const std::string *bindName = symbol.GetBindName();
// TODO: update GetBindName so that it does not return a label for internal
// procedures.
if (bindName && Fortran::semantics::ClassifyProcedure(symbol) ==
Fortran::semantics::ProcedureDefinitionClass::Internal)
- TODO(loc, "BIND(C) internal procedures");
- return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol);
+ TODO(converter.getCurrentLocation(), "BIND(C) internal procedures");
+ return bindName ? *bindName : converter.mangleName(symbol);
}
mlir::Type Fortran::lower::getUntypedBoxProcType(mlir::MLIRContext *context) {
@@ -73,8 +73,7 @@ bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
std::string Fortran::lower::CallerInterface::getMangledName() const {
const Fortran::evaluate::ProcedureDesignator &proc = procRef.proc();
if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol())
- return ::getMangledName(converter.getCurrentLocation(),
- symbol->GetUltimate());
+ return ::getMangledName(converter, symbol->GetUltimate());
assert(proc.GetSpecificIntrinsic() &&
"expected intrinsic procedure in designator");
return proc.GetName();
@@ -421,8 +420,7 @@ bool Fortran::lower::CalleeInterface::hasAlternateReturns() const {
std::string Fortran::lower::CalleeInterface::getMangledName() const {
if (funit.isMainProgram())
return fir::NameUniquer::doProgramEntry().str();
- return ::getMangledName(converter.getCurrentLocation(),
- funit.getSubprogramSymbol());
+ return ::getMangledName(converter, funit.getSubprogramSymbol());
}
const Fortran::semantics::Symbol *
@@ -490,8 +488,7 @@ void Fortran::lower::CalleeInterface::setFuncAttrs(
}
//===----------------------------------------------------------------------===//
-// CallInterface implementation: this part is common to both caller and caller
-// sides.
+// CallInterface implementation: this part is common to both caller and callee.
//===----------------------------------------------------------------------===//
static void addSymbolAttribute(mlir::func::FuncOp func,
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index d701749e76574..21de165e01762 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -315,8 +315,7 @@ struct TypeBuilderImpl {
if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol))
return ty;
- auto rec = fir::RecordType::get(context,
- Fortran::lower::mangle::mangleName(tySpec));
+ auto rec = fir::RecordType::get(context, converter.mangleName(tySpec));
// Maintain the stack of types for recursive references.
derivedTypeInConstruction.emplace_back(typeSymbol, rec);
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 40c1cdc29f5f0..9a19e422ba454 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -417,13 +417,13 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
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
+ // with a tensor mlir type. This optimization currently only supports
// rank-1 Fortran arrays of integer, real, or logical. The tensor
// type does not support nested structures which are needed for
// complex numbers.
// To get multidimensional arrays to work, we will have to use column major
// array ordering with the tensor type (so it matches column major ordering
- // with the Fortran fir.array). By default, tensor types assume row major
+ // with the Fortran fir.array). By default, tensor types assume row major
// ordering. How to create this tensor type is to be determined.
if (symTy.isa<fir::SequenceType>() && sym.Rank() == 1 &&
!Fortran::semantics::IsAllocatableOrPointer(sym)) {
@@ -543,7 +543,7 @@ static void instantiateGlobal(Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &sym = var.getSymbol();
assert(!var.isAlias() && "must be handled in instantiateAlias");
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- std::string globalName = Fortran::lower::mangle::mangleName(sym);
+ std::string globalName = converter.mangleName(sym);
mlir::Location loc = genLocation(converter, sym);
fir::GlobalOp global = builder.getNamedGlobal(globalName);
mlir::StringAttr linkage = getLinkageAttribute(builder, var);
@@ -576,7 +576,7 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
if (preAlloc)
return preAlloc;
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- std::string nm = Fortran::lower::mangle::mangleName(var.getSymbol());
+ std::string nm = converter.mangleName(var.getSymbol());
mlir::Type ty = converter.genType(var);
const Fortran::semantics::Symbol &ultimateSymbol =
var.getSymbol().GetUltimate();
@@ -814,8 +814,9 @@ getAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
/// Build the name for the storage of a global equivalence.
static std::string mangleGlobalAggregateStore(
+ Fortran::lower::AbstractConverter &converter,
const Fortran::lower::pft::Variable::AggregateStore &st) {
- return Fortran::lower::mangle::mangleName(st.getNamingSymbol());
+ return converter.mangleName(st.getNamingSymbol());
}
/// Build the type for the storage of an equivalence.
@@ -907,7 +908,8 @@ instantiateAggregateStore(Fortran::lower::AbstractConverter &converter,
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
mlir::IntegerType i8Ty = builder.getIntegerType(8);
mlir::Location loc = converter.getCurrentLocation();
- std::string aggName = mangleGlobalAggregateStore(var.getAggregateStore());
+ std::string aggName =
+ mangleGlobalAggregateStore(converter, var.getAggregateStore());
if (var.isGlobal()) {
fir::GlobalOp global;
auto &aggregate = var.getAggregateStore();
@@ -1084,7 +1086,7 @@ static fir::GlobalOp
getCommonBlockGlobal(Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &common) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- std::string commonName = Fortran::lower::mangle::mangleName(common);
+ std::string commonName = converter.mangleName(common);
fir::GlobalOp global = builder.getNamedGlobal(commonName);
// Common blocks are lowered before any subprograms to deal with common
// whose size may not be the same in every subprograms.
@@ -1104,7 +1106,7 @@ declareCommonBlock(Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &common,
std::size_t commonSize) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- std::string commonName = Fortran::lower::mangle::mangleName(common);
+ std::string commonName = converter.mangleName(common);
fir::GlobalOp global = builder.getNamedGlobal(commonName);
if (global)
return std::nullopt;
@@ -1461,7 +1463,7 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
llvm::SmallVector<mlir::Value> lenParams;
if (len)
lenParams.emplace_back(len);
- auto name = Fortran::lower::mangle::mangleName(sym);
+ auto name = converter.mangleName(sym);
fir::FortranVariableFlagsAttr attributes =
Fortran::lower::translateSymbolAttributes(builder.getContext(), sym);
auto newBase = builder.create<hlfir::DeclareOp>(
@@ -1503,7 +1505,7 @@ void Fortran::lower::genDeclareSymbol(
const mlir::Location loc = genLocation(converter, sym);
fir::FortranVariableFlagsAttr attributes =
Fortran::lower::translateSymbolAttributes(builder.getContext(), sym);
- auto name = Fortran::lower::mangle::mangleName(sym);
+ auto name = converter.mangleName(sym);
hlfir::EntityWithAttributes declare =
hlfir::genDeclare(loc, builder, exv, name, attributes);
symMap.addVariableDefinition(sym, declare.getIfVariableInterface(), force);
@@ -1558,10 +1560,10 @@ static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
}
/// Lower specification expressions and attributes of variable \p var and
-/// 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
+/// 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.
+/// 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,
@@ -1658,24 +1660,24 @@ 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
+ // 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,
+ // - 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
+ // 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.
+ // 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"
+ // - 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
+ // - 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 = [&]() {
@@ -1911,7 +1913,7 @@ void Fortran::lower::defineModuleVariable(
if (var.isAggregateStore()) {
const Fortran::lower::pft::Variable::AggregateStore &aggregate =
var.getAggregateStore();
- std::string aggName = mangleGlobalAggregateStore(aggregate);
+ std::string aggName = mangleGlobalAggregateStore(converter, aggregate);
defineGlobalAggregateStore(converter, aggregate, aggName, linkage);
return;
}
@@ -1924,7 +1926,7 @@ void Fortran::lower::defineModuleVariable(
} else if (var.isAlias()) {
// Do nothing. Mapping will be done on user side.
} else {
- std::string globalName = Fortran::lower::mangle::mangleName(sym);
+ std::string globalName = converter.mangleName(sym);
defineGlobal(converter, var, globalName, linkage);
}
}
@@ -1975,7 +1977,7 @@ void Fortran::lower::mapCallInterfaceSymbols(
if (hostDetails && !var.isModuleOrSubmoduleVariable()) {
// The callee is an internal procedure `A` whose result properties
// depend on host variables. The caller may be the host, or another
- // internal procedure `B` contained in the same host. In the first
+ // internal procedure `B` contained in the same host. In the first
// case, the host symbol is obviously mapped, in the second case, it
// must also be mapped because
// HostAssociations::internalProcedureBindings that was called when
@@ -2015,7 +2017,7 @@ void Fortran::lower::createRuntimeTypeInfoGlobal(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
const Fortran::semantics::Symbol &typeInfoSym) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- std::string globalName = Fortran::lower::mangle::mangleName(typeInfoSym);
+ std::string globalName = converter.mangleName(typeInfoSym);
auto var = Fortran::lower::pft::Variable(typeInfoSym, /*global=*/true);
mlir::StringAttr linkage = getLinkageAttribute(builder, var);
defineGlobal(converter, var, globalName, linkage);
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 9f38f03310aab..6f30da290a6d5 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -108,9 +108,9 @@ static constexpr std::tuple<
} // namespace Fortran::lower
namespace {
-/// IO statements may require exceptional condition handling. A statement that
+/// IO statements may require exceptional condition handling. A statement that
/// encounters an exceptional condition may branch to a label given on an ERR
-/// (error), END (end-of-file), or EOR (end-of-record) specifier. An IOSTAT
+/// (error), END (end-of-file), or EOR (end-of-record) specifier. An IOSTAT
/// specifier variable may be set to a value that indicates some condition,
/// and an IOMSG specifier variable may be set to a description of a condition.
struct ConditionSpecInfo {
@@ -125,7 +125,7 @@ struct ConditionSpecInfo {
bool hasErrorConditionSpec() const { return ioStatExpr != nullptr || hasErr; }
/// Check for any condition specifier that applies to data transfer items
- /// in a PRINT, READ, WRITE, or WAIT statement. (WAIT may be irrelevant.)
+ /// in a PRINT, READ, WRITE, or WAIT statement. (WAIT may be irrelevant.)
bool hasTransferConditionSpec() const {
return hasErrorConditionSpec() || hasEnd || hasEor;
}
@@ -176,7 +176,7 @@ static mlir::func::FuncOp getIORuntimeFunc(mlir::Location loc,
return func;
}
-/// Generate calls to end an IO statement. Return the IOSTAT value, if any.
+/// Generate calls to end an IO statement. Return the IOSTAT value, if any.
/// It is the caller's responsibility to generate branches on that value.
static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter,
mlir::Location loc, mlir::Value cookie,
@@ -218,7 +218,7 @@ static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter,
/// Make the next call in the IO statement conditional on runtime result `ok`.
/// If a call returns `ok==false`, further suboperation calls for an IO
-/// statement will be skipped. This may generate branch heavy, deeply nested
+/// statement will be skipped. This may generate branch heavy, deeply nested
/// conditionals for IO statements with a large number of suboperations.
static void makeNextConditionalOn(fir::FirOpBuilder &builder,
mlir::Location loc, bool checkResult,
@@ -227,7 +227,7 @@ static void makeNextConditionalOn(fir::FirOpBuilder &builder,
// Either no IO calls need to be checked, or this will be the first call.
return;
- // A previous IO call for a statement returned the bool `ok`. If this call
+ // A previous IO call for a statement returned the bool `ok`. If this call
// is in a fir.iterate_while loop, the result must be propagated up to the
// loop scope as an extra ifOp result. (The propagation is done in genIoLoop.)
mlir::TypeRange resTy;
@@ -241,7 +241,7 @@ static void makeNextConditionalOn(fir::FirOpBuilder &builder,
/// Retrieve or generate a runtime description of NAMELIST group `symbol`.
/// The form of the description is defined in runtime header file namelist.h.
/// Static descriptors are generated for global objects; local descriptors for
-/// local objects. If all descriptors are static, the NamelistGroup is static.
+/// local objects. If all descriptors are static, the NamelistGroup is static.
static mlir::Value
getNamelistGroup(Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &symbol,
@@ -605,7 +605,8 @@ static mlir::Value createIoRuntimeCallForItem(mlir::Location loc,
llvm::SmallVector<mlir::Value> inputFuncArgs = {cookie};
if (argType.isa<fir::BaseBoxType>()) {
mlir::Value box = fir::getBase(item);
- assert(box.getType().isa<fir::BaseBoxType>() && "must be previously emboxed");
+ assert(box.getType().isa<fir::BaseBoxType>() &&
+ "must be previously emboxed");
inputFuncArgs.push_back(builder.createConvert(loc, argType, box));
} else {
mlir::Value itemAddr = fir::getBase(item);
@@ -1493,9 +1494,9 @@ lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter &converter,
return {buff, len, mlir::Value{}};
}
-/// Generate a reference to a format string. There are four cases - a format
+/// Generate a reference to a format string. There are four cases - a format
/// statement label, a character format expression, an integer that holds the
-/// label of a format statement, and the * case. The first three are done here.
+/// label of a format statement, and the * case. The first three are done here.
/// The * case is done elsewhere.
static std::tuple<mlir::Value, mlir::Value, mlir::Value>
genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
@@ -2022,7 +2023,7 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
}
// Generate end statement call/s.
mlir::Value result = genEndIO(converter, loc, cookie, csi, stmtCtx);
- stmtCtx.finalize();
+ stmtCtx.finalizeAndReset();
return result;
}
diff --git a/flang/lib/Lower/IterationSpace.cpp b/flang/lib/Lower/IterationSpace.cpp
index 0c6009216119c..8c629d44962f2 100644
--- a/flang/lib/Lower/IterationSpace.cpp
+++ b/flang/lib/Lower/IterationSpace.cpp
@@ -847,7 +847,7 @@ void Fortran::lower::ExplicitIterSpace::conditionalCleanup() {
if (forallContextOpen == 0) {
// Exiting the outermost FORALL context.
// Cleanup any residual mask buffers.
- outermostContext().finalize();
+ outermostContext().finalizeAndReset();
// Clear and reset all the cached information.
symbolStack.clear();
lhsBases.clear();
diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index a154b915e6916..807d9ebff6c49 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -16,85 +16,85 @@
#include "llvm/ADT/ArrayRef.h"
#include "llvm/ADT/SmallVector.h"
#include "llvm/ADT/StringRef.h"
-#include "llvm/ADT/Twine.h"
#include "llvm/Support/MD5.h"
-#include <optional>
-
-// recursively build the vector of module scopes
-static void moduleNames(const Fortran::semantics::Scope &scope,
- llvm::SmallVector<llvm::StringRef> &result) {
- if (scope.IsTopLevel())
- return;
- moduleNames(scope.parent(), result);
- if (scope.kind() == Fortran::semantics::Scope::Kind::Module)
- if (const Fortran::semantics::Symbol *symbol = scope.symbol())
- result.emplace_back(toStringRef(symbol->name()));
-}
-
-static llvm::SmallVector<llvm::StringRef>
-moduleNames(const Fortran::semantics::Symbol &symbol) {
- const Fortran::semantics::Scope &scope = symbol.owner();
- llvm::SmallVector<llvm::StringRef> result;
- moduleNames(scope, result);
- return result;
-}
-static std::optional<llvm::StringRef>
-hostName(const Fortran::semantics::Symbol &symbol) {
- const Fortran::semantics::Scope *scope = &symbol.owner();
- if (symbol.has<Fortran::semantics::AssocEntityDetails>())
- // Associate/Select construct scopes are not part of the mangling. This can
- // result in
diff erent construct selector being mangled with the same name.
- // This is not an issue since these are not global symbols.
- while (!scope->IsTopLevel() &&
- (scope->kind() != Fortran::semantics::Scope::Kind::Subprogram &&
- scope->kind() != Fortran::semantics::Scope::Kind::MainProgram))
- scope = &scope->parent();
- if (scope->kind() == Fortran::semantics::Scope::Kind::Subprogram) {
- assert(scope->symbol() && "subprogram scope must have a symbol");
- return toStringRef(scope->symbol()->name());
+/// Return all ancestor module and submodule scope names; all host procedure
+/// and statement function scope names; and the innermost blockId containing
+/// \p symbol.
+static std::tuple<llvm::SmallVector<llvm::StringRef>,
+ llvm::SmallVector<llvm::StringRef>, std::int64_t>
+ancestors(const Fortran::semantics::Symbol &symbol,
+ Fortran::lower::mangle::ScopeBlockIdMap &scopeBlockIdMap) {
+ llvm::SmallVector<const Fortran::semantics::Scope *> scopes;
+ for (auto *scp = &symbol.owner(); !scp->IsGlobal(); scp = &scp->parent())
+ scopes.push_back(scp);
+ llvm::SmallVector<llvm::StringRef> modules;
+ llvm::SmallVector<llvm::StringRef> procs;
+ std::int64_t blockId = 0;
+ for (auto iter = scopes.rbegin(), rend = scopes.rend(); iter != rend;
+ ++iter) {
+ auto *scp = *iter;
+ switch (scp->kind()) {
+ case Fortran::semantics::Scope::Kind::Module:
+ modules.emplace_back(toStringRef(scp->symbol()->name()));
+ break;
+ case Fortran::semantics::Scope::Kind::Subprogram:
+ procs.emplace_back(toStringRef(scp->symbol()->name()));
+ break;
+ case Fortran::semantics::Scope::Kind::MainProgram:
+ // Do not use the main program name, if any, because it may collide
+ // with a procedure of the same name in another compilation unit.
+ // This is nonconformant, but universally allowed.
+ procs.emplace_back(llvm::StringRef(""));
+ break;
+ case Fortran::semantics::Scope::Kind::BlockConstruct: {
+ auto it = scopeBlockIdMap.find(scp);
+ assert(it != scopeBlockIdMap.end() && it->second &&
+ "invalid block identifier");
+ blockId = it->second;
+ } break;
+ default:
+ break;
+ }
}
- if (scope->kind() == Fortran::semantics::Scope::Kind::MainProgram)
- // Do not use the main program name, if any, because it may lead to name
- // collision with procedures with the same name in other compilation units
- // (technically illegal, but all compilers are able to compile and link
- // properly these programs).
- return llvm::StringRef("");
- return {};
+ return {modules, procs, blockId};
}
-// Mangle the name of `symbol` to make it unique within FIR's symbol table using
-// the FIR name mangler, `mangler`
+// Mangle the name of \p symbol to make it globally unique.
std::string
Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
+ ScopeBlockIdMap &scopeBlockIdMap,
bool keepExternalInScope) {
- // Resolve host and module association before mangling
+ // Resolve module and host associations before mangling.
const auto &ultimateSymbol = symbol.GetUltimate();
- auto symbolName = toStringRef(ultimateSymbol.name());
- // The Fortran and BIND(C) namespaces are counterintuitive. A
- // BIND(C) name is substituted early having precedence over the
- // Fortran name of the subprogram. By side-effect, this allows
- // multiple subprocedures with identical Fortran names to be legally
- // present in the program. Assume the BIND(C) name is unique.
+ // The Fortran and BIND(C) namespaces are counterintuitive. A BIND(C) name is
+ // substituted early, and has precedence over the Fortran name. This allows
+ // multiple procedures or objects with identical Fortran names to legally
+ // coexist. The BIND(C) name is unique.
if (auto *overrideName = ultimateSymbol.GetBindName())
return *overrideName;
- // TODO: the case of procedure that inherits the BIND(C) through another
- // interface (procedure(iface)), should be dealt within GetBindName()
- // directly, or some semantics wrapper.
+
+ // TODO: A procedure that inherits BIND(C) through another interface
+ // (procedure(iface)) should be dealt with in GetBindName() or some wrapper.
if (!Fortran::semantics::IsPointer(ultimateSymbol) &&
Fortran::semantics::IsBindCProcedure(ultimateSymbol) &&
Fortran::semantics::ClassifyProcedure(symbol) !=
Fortran::semantics::ProcedureDefinitionClass::Internal)
return ultimateSymbol.name().ToString();
+ llvm::StringRef symbolName = toStringRef(ultimateSymbol.name());
+ llvm::SmallVector<llvm::StringRef> modules;
+ llvm::SmallVector<llvm::StringRef> procs;
+ std::int64_t blockId;
+
// mangle ObjectEntityDetails or AssocEntityDetails symbols.
auto mangleObject = [&]() -> std::string {
- llvm::SmallVector<llvm::StringRef> modNames = moduleNames(ultimateSymbol);
- std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
+ std::tie(modules, procs, blockId) =
+ ancestors(ultimateSymbol, scopeBlockIdMap);
if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
- return fir::NameUniquer::doConstant(modNames, optHost, symbolName);
- return fir::NameUniquer::doVariable(modNames, optHost, symbolName);
+ return fir::NameUniquer::doConstant(modules, procs, blockId, symbolName);
+ return fir::NameUniquer::doVariable(modules, procs, blockId, symbolName);
};
return std::visit(
@@ -115,21 +115,21 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
interface->owner().IsSubmodule() && !subpDetails.isInterface())
interface = subpDetails.moduleInterface();
assert(interface && "Separate module procedure must be declared");
- llvm::SmallVector<llvm::StringRef> modNames =
- moduleNames(*interface);
- return fir::NameUniquer::doProcedure(modNames, hostName(*interface),
- symbolName);
+ std::tie(modules, procs, blockId) =
+ ancestors(*interface, scopeBlockIdMap);
+ return fir::NameUniquer::doProcedure(modules, procs, symbolName);
},
[&](const Fortran::semantics::ProcEntityDetails &) {
- // Mangle procedure pointers and dummy procedures as variables
+ // Mangle procedure pointers and dummy procedures as variables.
if (Fortran::semantics::IsPointer(ultimateSymbol) ||
- Fortran::semantics::IsDummy(ultimateSymbol))
- return fir::NameUniquer::doVariable(moduleNames(ultimateSymbol),
- hostName(ultimateSymbol),
+ Fortran::semantics::IsDummy(ultimateSymbol)) {
+ std::tie(modules, procs, blockId) =
+ ancestors(ultimateSymbol, scopeBlockIdMap);
+ return fir::NameUniquer::doVariable(modules, procs, blockId,
symbolName);
- // Otherwise, this is an external procedure, even if it does not
- // have an explicit EXTERNAL attribute. Mangle it without any
- // prefix.
+ }
+ // Otherwise, this is an external procedure, with or without an
+ // explicit EXTERNAL attribute. Mangle it without any prefix.
return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt,
symbolName);
},
@@ -140,38 +140,52 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
return mangleObject();
},
[&](const Fortran::semantics::NamelistDetails &) {
- llvm::SmallVector<llvm::StringRef> modNames =
- moduleNames(ultimateSymbol);
- std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
- return fir::NameUniquer::doNamelistGroup(modNames, optHost,
+ std::tie(modules, procs, blockId) =
+ ancestors(ultimateSymbol, scopeBlockIdMap);
+ return fir::NameUniquer::doNamelistGroup(modules, procs,
symbolName);
},
[&](const Fortran::semantics::CommonBlockDetails &) {
return fir::NameUniquer::doCommonBlock(symbolName);
},
+ [&](const Fortran::semantics::ProcBindingDetails &procBinding) {
+ return mangleName(procBinding.symbol(), scopeBlockIdMap,
+ keepExternalInScope);
+ },
[&](const Fortran::semantics::DerivedTypeDetails &) -> std::string {
- // Derived type mangling must used mangleName(DerivedTypeSpec&) so
+ // Derived type mangling must use mangleName(DerivedTypeSpec) so
// that kind type parameter values can be mangled.
llvm::report_fatal_error(
"only derived type instances can be mangled");
},
- [&](const Fortran::semantics::ProcBindingDetails &procBinding)
- -> std::string {
- return mangleName(procBinding.symbol(), keepExternalInScope);
- },
[](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); },
},
ultimateSymbol.details());
}
+std::string
+Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
+ bool keepExternalInScope) {
+ assert(symbol.owner().kind() !=
+ Fortran::semantics::Scope::Kind::BlockConstruct &&
+ "block object mangling must specify a scopeBlockIdMap");
+ ScopeBlockIdMap scopeBlockIdMap;
+ return mangleName(symbol, scopeBlockIdMap, keepExternalInScope);
+}
+
std::string Fortran::lower::mangle::mangleName(
- const Fortran::semantics::DerivedTypeSpec &derivedType) {
- // Resolve host and module association before mangling
+ const Fortran::semantics::DerivedTypeSpec &derivedType,
+ ScopeBlockIdMap &scopeBlockIdMap) {
+ // Resolve module and host associations before mangling.
const Fortran::semantics::Symbol &ultimateSymbol =
derivedType.typeSymbol().GetUltimate();
+
llvm::StringRef symbolName = toStringRef(ultimateSymbol.name());
- llvm::SmallVector<llvm::StringRef> modNames = moduleNames(ultimateSymbol);
- std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
+ llvm::SmallVector<llvm::StringRef> modules;
+ llvm::SmallVector<llvm::StringRef> procs;
+ std::int64_t blockId;
+ std::tie(modules, procs, blockId) =
+ ancestors(ultimateSymbol, scopeBlockIdMap);
llvm::SmallVector<std::int64_t> kinds;
for (const auto ¶m :
Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) {
@@ -190,7 +204,7 @@ std::string Fortran::lower::mangle::mangleName(
kinds.emplace_back(*init);
}
}
- return fir::NameUniquer::doType(modNames, optHost, symbolName, kinds);
+ return fir::NameUniquer::doType(modules, procs, blockId, symbolName, kinds);
}
std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index d7bc7c132f4c6..98f02620bedde 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -69,7 +69,7 @@ void dumpScope(const semantics::Scope *scope, int depth = -1);
#endif
/// The instantiation of a parse tree visitor (Pre and Post) is extremely
-/// expensive in terms of compile and link time. So one goal here is to
+/// expensive in terms of compile and link time. So one goal here is to
/// limit the bridge to one such instantiation.
class PFTBuilder {
public:
@@ -126,10 +126,10 @@ class PFTBuilder {
/// first statement of the construct.
void convertIfStmt(const parser::IfStmt &ifStmt, parser::CharBlock position,
std::optional<parser::Label> label) {
- // Generate a skeleton IfConstruct parse node. Its components are never
- // referenced. The actual components are available via the IfConstruct
+ // Generate a skeleton IfConstruct parse node. Its components are never
+ // referenced. The actual components are available via the IfConstruct
// evaluation's nested evaluationList, with the ifStmt in the position of
- // the otherwise normal IfThenStmt. Caution: All other PFT nodes reference
+ // the otherwise normal IfThenStmt. Caution: All other PFT nodes reference
// front end generated parse nodes; this is an exceptional case.
static const auto ifConstruct = parser::IfConstruct{
parser::Statement<parser::IfThenStmt>{
@@ -445,7 +445,7 @@ class PFTBuilder {
}
/// Rewrite IfConstructs containing a GotoStmt or CycleStmt to eliminate an
- /// unstructured branch and a trivial basic block. The pre-branch-analysis
+ /// unstructured branch and a trivial basic block. The pre-branch-analysis
/// code:
///
/// <<IfConstruct>>
@@ -467,20 +467,20 @@ class PFTBuilder {
/// <<End IfConstruct>>
/// 6 Statement: L ...
///
- /// The If[Then]Stmt condition is implicitly negated. It is not modified
- /// in the PFT. It must be negated when generating FIR. The GotoStmt or
+ /// The If[Then]Stmt condition is implicitly negated. It is not modified
+ /// in the PFT. It must be negated when generating FIR. The GotoStmt or
/// CycleStmt is deleted.
///
/// The transformation is only valid for forward branch targets at the same
- /// construct nesting level as the IfConstruct. The result must not violate
- /// construct nesting requirements or contain an EntryStmt. The result
- /// is subject to normal un/structured code classification analysis. The
+ /// construct nesting level as the IfConstruct. The result must not violate
+ /// construct nesting requirements or contain an EntryStmt. The result
+ /// is subject to normal un/structured code classification analysis. The
/// result is allowed to violate the F18 Clause 11.1.2.1 prohibition on
/// transfer of control into the interior of a construct block, as that does
- /// not compromise correct code generation. When two transformation
- /// candidates overlap, at least one must be disallowed. In such cases,
+ /// not compromise correct code generation. When two transformation
+ /// candidates overlap, at least one must be disallowed. In such cases,
/// the current heuristic favors simple code generation, which happens to
- /// favor later candidates over earlier candidates. That choice is probably
+ /// favor later candidates over earlier candidates. That choice is probably
/// not significant, but could be changed.
///
void rewriteIfGotos() {
@@ -799,8 +799,8 @@ class PFTBuilder {
},
[&](const parser::AssignedGotoStmt &) {
// Although this statement is a branch, it doesn't have any
- // explicit control successors. So the code at the end of the
- // loop won't mark the successor. Do that here.
+ // explicit control successors. So the code at the end of the
+ // loop won't mark the successor. Do that here.
eval.isUnstructured = true;
markSuccessorAsNewBlock(eval);
},
@@ -1022,7 +1022,7 @@ class PFTBuilder {
const semantics::SemanticsContext &semanticsContext;
/// functionList points to the internal or module procedure function list
- /// of a FunctionLikeUnit or a ModuleLikeUnit. It may be null.
+ /// of a FunctionLikeUnit or a ModuleLikeUnit. It may be null.
std::list<lower::pft::FunctionLikeUnit> *functionList{};
std::vector<lower::pft::Evaluation *> constructAndDirectiveStack{};
std::vector<lower::pft::Evaluation *> doConstructStack{};
@@ -1059,7 +1059,10 @@ void dumpScope(const semantics::Scope *scope, int depth) {
LLVM_DEBUG(llvm::dbgs() << "IntrinsicModules (no detail)\n");
return;
}
- LLVM_DEBUG(llvm::dbgs() << "[anonymous]\n");
+ if (scope->kind() == Fortran::semantics::Scope::Kind::BlockConstruct)
+ LLVM_DEBUG(llvm::dbgs() << "[block]\n");
+ else
+ LLVM_DEBUG(llvm::dbgs() << "[anonymous]\n");
}
}
for (const auto &scp : scope->children())
@@ -1312,6 +1315,10 @@ bool Fortran::lower::pft::Evaluation::lowerAsUnstructured() const {
return isUnstructured || clDisableStructuredFir;
}
+bool Fortran::lower::pft::Evaluation::forceAsUnstructured() const {
+ return clDisableStructuredFir;
+}
+
lower::pft::FunctionLikeUnit *
Fortran::lower::pft::Evaluation::getOwningProcedure() const {
return parent.visit(common::visitors{
@@ -1441,7 +1448,7 @@ struct SymbolDependenceAnalysis {
(semantics::IsProcedure(sym) && IsDummy(sym));
// A procedure argument in a subprogram with multiple entry points might
// need a layeredVarList entry to trigger creation of a symbol map entry
- // in some cases. Non-dummy procedures don't.
+ // in some cases. Non-dummy procedures don't.
if (semantics::IsProcedure(sym) && !isProcedurePointerOrDummy)
return 0;
semantics::Symbol ultimate = sym.GetUltimate();
diff --git a/flang/lib/Optimizer/Support/InternalNames.cpp b/flang/lib/Optimizer/Support/InternalNames.cpp
index 29596998bc0c4..df99cc7243f00 100644
--- a/flang/lib/Optimizer/Support/InternalNames.cpp
+++ b/flang/lib/Optimizer/Support/InternalNames.cpp
@@ -26,22 +26,22 @@ constexpr std::int64_t badValue = -1;
inline std::string prefix() { return "_Q"; }
-static std::string doModules(llvm::ArrayRef<llvm::StringRef> mods) {
- std::string result;
- auto *token = "M";
- for (auto mod : mods) {
- result.append(token).append(mod.lower());
- token = "S";
+/// Generate a mangling prefix from module, submodule, procedure, and
+/// statement function names, plus an (innermost) block scope id.
+static std::string doAncestors(llvm::ArrayRef<llvm::StringRef> modules,
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t blockId = 0) {
+ std::string prefix;
+ const char *tag = "M";
+ for (auto mod : modules) {
+ prefix.append(tag).append(mod.lower());
+ tag = "S";
}
- return result;
-}
-
-static std::string doModulesHost(llvm::ArrayRef<llvm::StringRef> mods,
- std::optional<llvm::StringRef> host) {
- std::string result = doModules(mods);
- if (host)
- result.append("F").append(host->lower());
- return result;
+ for (auto proc : procs)
+ prefix.append("F").append(proc.lower());
+ if (blockId)
+ prefix.append("B").append(std::to_string(blockId));
+ return prefix;
}
inline llvm::SmallVector<llvm::StringRef>
@@ -101,30 +101,25 @@ std::string fir::NameUniquer::doKinds(llvm::ArrayRef<std::int64_t> kinds) {
std::string fir::NameUniquer::doCommonBlock(llvm::StringRef name) {
std::string result = prefix();
- return result.append("B").append(toLower(name));
-}
-
-std::string fir::NameUniquer::doBlockData(llvm::StringRef name) {
- std::string result = prefix();
- return result.append("L").append(toLower(name));
+ return result.append("C").append(toLower(name));
}
std::string
fir::NameUniquer::doConstant(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name) {
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t blockId, llvm::StringRef name) {
std::string result = prefix();
- result.append(doModulesHost(modules, host)).append("EC");
+ result.append(doAncestors(modules, procs, blockId)).append("EC");
return result.append(toLower(name));
}
std::string
fir::NameUniquer::doDispatchTable(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name,
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t blockId, llvm::StringRef name,
llvm::ArrayRef<std::int64_t> kinds) {
std::string result = prefix();
- result.append(doModulesHost(modules, host)).append("DT");
+ result.append(doAncestors(modules, procs, blockId)).append("DT");
return result.append(toLower(name)).append(doKinds(kinds));
}
@@ -135,8 +130,8 @@ std::string fir::NameUniquer::doGenerated(llvm::StringRef name) {
std::string fir::NameUniquer::doIntrinsicTypeDescriptor(
llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host, IntrinsicType type,
- std::int64_t kind) {
+ llvm::ArrayRef<llvm::StringRef> procs, std::int64_t blockId,
+ IntrinsicType type, std::int64_t kind) {
const char *name = nullptr;
switch (type) {
case IntrinsicType::CHARACTER:
@@ -157,61 +152,63 @@ std::string fir::NameUniquer::doIntrinsicTypeDescriptor(
}
assert(name && "unknown intrinsic type");
std::string result = prefix();
- result.append(doModulesHost(modules, host)).append("C");
+ result.append(doAncestors(modules, procs, blockId)).append("YI");
return result.append(name).append(doKind(kind));
}
std::string
fir::NameUniquer::doProcedure(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
+ llvm::ArrayRef<llvm::StringRef> procs,
llvm::StringRef name) {
std::string result = prefix();
- result.append(doModulesHost(modules, host)).append("P");
+ result.append(doAncestors(modules, procs)).append("P");
return result.append(toLower(name));
}
std::string fir::NameUniquer::doType(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name,
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t blockId, llvm::StringRef name,
llvm::ArrayRef<std::int64_t> kinds) {
std::string result = prefix();
- result.append(doModulesHost(modules, host)).append("T");
+ result.append(doAncestors(modules, procs, blockId)).append("T");
return result.append(toLower(name)).append(doKinds(kinds));
}
std::string
fir::NameUniquer::doTypeDescriptor(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name,
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t blockId, llvm::StringRef name,
llvm::ArrayRef<std::int64_t> kinds) {
std::string result = prefix();
- result.append(doModulesHost(modules, host)).append("CT");
+ result.append(doAncestors(modules, procs, blockId)).append("CT");
return result.append(toLower(name)).append(doKinds(kinds));
}
-std::string fir::NameUniquer::doTypeDescriptor(
- llvm::ArrayRef<std::string> modules, std::optional<std::string> host,
- llvm::StringRef name, llvm::ArrayRef<std::int64_t> kinds) {
+std::string
+fir::NameUniquer::doTypeDescriptor(llvm::ArrayRef<std::string> modules,
+ llvm::ArrayRef<std::string> procs,
+ std::int64_t blockId, llvm::StringRef name,
+ llvm::ArrayRef<std::int64_t> kinds) {
auto rmodules = convertToStringRef(modules);
- auto rhost = convertToStringRef(host);
- return doTypeDescriptor(rmodules, rhost, name, kinds);
+ auto rprocs = convertToStringRef(procs);
+ return doTypeDescriptor(rmodules, rprocs, blockId, name, kinds);
}
std::string
fir::NameUniquer::doVariable(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
- llvm::StringRef name) {
+ llvm::ArrayRef<llvm::StringRef> procs,
+ std::int64_t blockId, llvm::StringRef name) {
std::string result = prefix();
- result.append(doModulesHost(modules, host)).append("E");
+ result.append(doAncestors(modules, procs, blockId)).append("E");
return result.append(toLower(name));
}
std::string
fir::NameUniquer::doNamelistGroup(llvm::ArrayRef<llvm::StringRef> modules,
- std::optional<llvm::StringRef> host,
+ llvm::ArrayRef<llvm::StringRef> procs,
llvm::StringRef name) {
std::string result = prefix();
- result.append(doModulesHost(modules, host)).append("G");
+ result.append(doAncestors(modules, procs)).append("N");
return result.append(toLower(name));
}
@@ -225,81 +222,79 @@ std::pair<fir::NameUniquer::NameKind, fir::NameUniquer::DeconstructedName>
fir::NameUniquer::deconstruct(llvm::StringRef uniq) {
if (uniq.startswith("_Q")) {
llvm::SmallVector<std::string> modules;
- std::optional<std::string> host;
+ llvm::SmallVector<std::string> procs;
+ std::int64_t blockId = 0;
std::string name;
llvm::SmallVector<std::int64_t> kinds;
NameKind nk = NameKind::NOT_UNIQUED;
for (std::size_t i = 2, end{uniq.size()}; i != end;) {
switch (uniq[i]) {
- case 'B':
+ case 'B': // Block
+ blockId = readInt(uniq, i, i + 1, end);
+ break;
+ case 'C': // Common block
nk = NameKind::COMMON;
name = readName(uniq, i, i + 1, end);
break;
- case 'C':
- if (uniq[i + 1] == 'T') {
- nk = NameKind::TYPE_DESC;
- name = readName(uniq, i, i + 2, end);
- } else {
- nk = NameKind::INTRINSIC_TYPE_DESC;
- name = readName(uniq, i, i + 1, end);
- }
- break;
- case 'D':
+ case 'D': // Dispatch table
nk = NameKind::DISPATCH_TABLE;
assert(uniq[i + 1] == 'T');
name = readName(uniq, i, i + 2, end);
break;
case 'E':
- if (uniq[i + 1] == 'C') {
+ if (uniq[i + 1] == 'C') { // Constant Entity
nk = NameKind::CONSTANT;
name = readName(uniq, i, i + 2, end);
- } else {
+ } else { // variable Entity
nk = NameKind::VARIABLE;
name = readName(uniq, i, i + 1, end);
}
break;
- case 'L':
- nk = NameKind::BLOCK_DATA_NAME;
+ case 'F': // procedure/Function ancestor component of a mangled prefix
+ procs.push_back(readName(uniq, i, i + 1, end));
+ break;
+ case 'K':
+ if (uniq[i + 1] == 'N') // Negative Kind
+ kinds.push_back(-readInt(uniq, i, i + 2, end));
+ else // [positive] Kind
+ kinds.push_back(readInt(uniq, i, i + 1, end));
+ break;
+ case 'M': // Module
+ case 'S': // Submodule
+ modules.push_back(readName(uniq, i, i + 1, end));
+ break;
+ case 'N': // Namelist group
+ nk = NameKind::NAMELIST_GROUP;
name = readName(uniq, i, i + 1, end);
break;
- case 'P':
+ case 'P': // Procedure/function (itself)
nk = NameKind::PROCEDURE;
name = readName(uniq, i, i + 1, end);
break;
- case 'Q':
+ case 'Q': // UniQue mangle name tag
nk = NameKind::GENERATED;
name = uniq;
i = end;
break;
- case 'T':
+ case 'T': // derived Type
nk = NameKind::DERIVED_TYPE;
name = readName(uniq, i, i + 1, end);
break;
-
- case 'M':
- case 'S':
- modules.push_back(readName(uniq, i, i + 1, end));
- break;
- case 'F':
- host = readName(uniq, i, i + 1, end);
- break;
- case 'K':
- if (uniq[i + 1] == 'N')
- kinds.push_back(-readInt(uniq, i, i + 2, end));
- else
- kinds.push_back(readInt(uniq, i, i + 1, end));
- break;
- case 'G':
- nk = NameKind::NAMELIST_GROUP;
- name = readName(uniq, i, i + 1, end);
+ case 'Y':
+ if (uniq[i + 1] == 'I') { // tYpe descriptor for an Intrinsic type
+ nk = NameKind::INTRINSIC_TYPE_DESC;
+ name = readName(uniq, i, i + 1, end);
+ } else { // tYpe descriptor
+ nk = NameKind::TYPE_DESC;
+ name = readName(uniq, i, i + 2, end);
+ }
break;
-
default:
assert(false && "unknown uniquing code");
break;
}
}
- return {nk, DeconstructedName(modules, host, name, kinds)};
+ return {nk, DeconstructedName(modules, procs, blockId, name, kinds)};
}
return {NameKind::NOT_UNIQUED, DeconstructedName(uniq)};
}
@@ -310,7 +305,7 @@ bool fir::NameUniquer::isExternalFacingUniquedName(
return (deconstructResult.first == NameKind::PROCEDURE ||
deconstructResult.first == NameKind::COMMON) &&
deconstructResult.second.modules.empty() &&
- !deconstructResult.second.host;
+ deconstructResult.second.procs.empty();
}
bool fir::NameUniquer::needExternalNameMangling(llvm::StringRef uniquedName) {
@@ -348,10 +343,11 @@ static std::string getDerivedTypeObjectName(llvm::StringRef mangledTypeName,
llvm::SmallVector<llvm::StringRef> modules;
for (const std::string &mod : result.second.modules)
modules.push_back(mod);
- std::optional<llvm::StringRef> host;
- if (result.second.host)
- host = *result.second.host;
- return fir::NameUniquer::doVariable(modules, host, varName);
+ llvm::SmallVector<llvm::StringRef> procs;
+ for (const std::string &proc : result.second.procs)
+ procs.push_back(proc);
+ return fir::NameUniquer::doVariable(modules, procs, result.second.blockId,
+ varName);
}
std::string
diff --git a/flang/test/Fir/external-mangling.fir b/flang/test/Fir/external-mangling.fir
index 3673cad583394..71dbbe2d666fb 100644
--- a/flang/test/Fir/external-mangling.fir
+++ b/flang/test/Fir/external-mangling.fir
@@ -7,11 +7,11 @@
func.func @_QPfoo() {
%c0 = arith.constant 0 : index
- %0 = fir.address_of(@_QBa) : !fir.ref<!fir.array<4xi8>>
+ %0 = fir.address_of(@_QCa) : !fir.ref<!fir.array<4xi8>>
%1 = fir.convert %0 : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
%2 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
%3 = fir.convert %2 : (!fir.ref<i8>) -> !fir.ref<i32>
- %4 = fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
+ %4 = fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
%5 = fir.convert %4 : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
%6 = fir.coordinate_of %5, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
%7 = fir.convert %6 : (!fir.ref<i8>) -> !fir.ref<f32>
@@ -19,8 +19,8 @@ func.func @_QPfoo() {
fir.call @_QPbar2(%7) : (!fir.ref<f32>) -> ()
return
}
-fir.global common @_QBa(dense<0> : vector<4xi8>) : !fir.array<4xi8>
-fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+fir.global common @_QCa(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+fir.global common @_QC(dense<0> : vector<4xi8>) : !fir.array<4xi8>
func.func private @_QPbar(!fir.ref<i32>)
func.func private @_QPbar2(!fir.ref<f32>)
diff --git a/flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90 b/flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90
index 361d72277cfea..75062df2b8baf 100644
--- a/flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90
+++ b/flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90
@@ -84,7 +84,7 @@ subroutine alloc_comp(x)
! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index
! CHECK: %[[VAL_10:.*]] = arith.cmpi sgt, %[[VAL_8]], %[[VAL_9]] : index
! CHECK: %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index
-! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]] {fir.must_be_heap = true, uniq_name = "_QEa.alloc"}
+! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]] {fir.must_be_heap = true, uniq_name = "_QFalloc_compEa.alloc"}
! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_12]](%[[VAL_13]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
! CHECK: fir.store %[[VAL_14]] to %[[VAL_6]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
diff --git a/flang/test/Lower/HLFIR/statement-functions.f90 b/flang/test/Lower/HLFIR/statement-functions.f90
index 246334278b0b6..bb02daaa0a8a4 100644
--- a/flang/test/Lower/HLFIR/statement-functions.f90
+++ b/flang/test/Lower/HLFIR/statement-functions.f90
@@ -30,6 +30,6 @@ subroutine char_test(c, n)
! CHECK: %[[VAL_15:.*]] = arith.constant 0 : i32
! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_14]], %[[VAL_15]] : i32
! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_14]], %[[VAL_15]] : i32
-! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_13]]#0 typeparams %[[VAL_17]] {uniq_name = "_QFstmt_funcEchar_stmt_func_dummy_arg"} : (!fir.ref<!fir.char<1,?>>, i32) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_13]]#0 typeparams %[[VAL_17]] {uniq_name = "_QFchar_testFstmt_funcEchar_stmt_func_dummy_arg"} : (!fir.ref<!fir.char<1,?>>, i32) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
! CHECK: %[[VAL_19:.*]] = arith.constant 10 : i64
! CHECK: %[[VAL_20:.*]] = hlfir.set_length %[[VAL_18]]#0 len %[[VAL_19]] : (!fir.boxchar<1>, i64) -> !hlfir.expr<!fir.char<1,10>>
diff --git a/flang/test/Lower/OpenMP/threadprivate-commonblock.f90 b/flang/test/Lower/OpenMP/threadprivate-commonblock.f90
index 39ea0c1cbd266..5cecb372e630b 100644
--- a/flang/test/Lower/OpenMP/threadprivate-commonblock.f90
+++ b/flang/test/Lower/OpenMP/threadprivate-commonblock.f90
@@ -12,11 +12,11 @@ module test
!$omp threadprivate(/blk/)
-!CHECK: fir.global common @_QBblk(dense<0> : vector<103xi8>) : !fir.array<103xi8>
+!CHECK: fir.global common @_QCblk(dense<0> : vector<103xi8>) : !fir.array<103xi8>
contains
subroutine sub()
-!CHECK: [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<103xi8>>
+!CHECK: [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<103xi8>>
!CHECK: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.array<103xi8>> -> !fir.ref<!fir.array<103xi8>>
!CHECK-DAG: [[ADDR1:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref<!fir.array<103xi8>>) -> !fir.ref<!fir.array<?xi8>>
!CHECK-DAG: [[C0:%.*]] = arith.constant 0 : index
diff --git a/flang/test/Lower/OpenMP/threadprivate-use-association.f90 b/flang/test/Lower/OpenMP/threadprivate-use-association.f90
index a8ecfd13c46d1..2a4649259d36f 100644
--- a/flang/test/Lower/OpenMP/threadprivate-use-association.f90
+++ b/flang/test/Lower/OpenMP/threadprivate-use-association.f90
@@ -3,7 +3,7 @@
!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s
-!CHECK-DAG: fir.global common @_QBblk(dense<0> : vector<24xi8>) : !fir.array<24xi8>
+!CHECK-DAG: fir.global common @_QCblk(dense<0> : vector<24xi8>) : !fir.array<24xi8>
!CHECK-DAG: fir.global @_QMtestEy : f32 {
module test
@@ -16,7 +16,7 @@ module test
contains
subroutine sub()
! CHECK-LABEL: @_QMtestPsub
-!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<24xi8>>
+!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<24xi8>>
!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.array<24xi8>> -> !fir.ref<!fir.array<24xi8>>
!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref<f32>
!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref<f32> -> !fir.ref<f32>
@@ -49,9 +49,9 @@ program main
call sub()
! CHECK-LABEL: @_QQmain()
-!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<24xi8>>
+!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<24xi8>>
!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.array<24xi8>> -> !fir.ref<!fir.array<24xi8>>
-!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<24xi8>>
+!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<24xi8>>
!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref<!fir.array<24xi8>> -> !fir.ref<!fir.array<24xi8>>
!CHECK-DAG: [[ADDR2:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref<f32>
!CHECK-DAG: [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref<f32> -> !fir.ref<f32>
diff --git a/flang/test/Lower/arithmetic-goto.f90 b/flang/test/Lower/arithmetic-goto.f90
index 7686ac4cf9384..eaf3d0c14c7ac 100644
--- a/flang/test/Lower/arithmetic-goto.f90
+++ b/flang/test/Lower/arithmetic-goto.f90
@@ -2,7 +2,25 @@
! CHECK-LABEL: func @_QPkagi
function kagi(index)
- ! CHECK: fir.select_case %{{.}} : i32 [#fir.upper, %c-1_i32, ^bb{{.}}, #fir.lower, %c1_i32, ^bb{{.}}, unit, ^bb{{.}}]
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "kagi"
+ ! CHECK: %[[V_1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK: %[[V_2:[0-9]+]] = arith.cmpi slt, %[[V_1]], %c0{{.*}} : i32
+ ! CHECK: cf.cond_br %[[V_2]], ^bb2, ^bb1
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: %[[V_3:[0-9]+]] = arith.cmpi sgt, %[[V_1]], %c0{{.*}} : i32
+ ! CHECK: cf.cond_br %[[V_3]], ^bb4, ^bb3
+ ! CHECK: ^bb2: // pred: ^bb0
+ ! CHECK: fir.store %c1{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb3: // pred: ^bb1
+ ! CHECK: fir.store %c2{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb4: // pred: ^bb1
+ ! CHECK: fir.store %c3{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb5: // 3 preds: ^bb2, ^bb3, ^bb4
+ ! CHECK: %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: return %[[V_4]] : i32
if (index) 7, 8, 9
kagi = 0; return
7 kagi = 1; return
@@ -12,12 +30,29 @@ function kagi(index)
! CHECK-LABEL: func @_QPkagf
function kagf(findex)
- ! CHECK: %[[zero:.+]] = arith.constant 0.0
- ! CHECK: %{{.+}} = arith.cmpf olt, %{{.+}}, %[[zero]] : f32
- ! CHECK: cond_br %
- ! CHECK: %{{.+}} = arith.cmpf ogt, %{{.+}}, %[[zero]] : f32
- ! CHECK: cond_br %
- ! CHECK: br ^
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "kagf"
+ ! CHECK: %[[V_1:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+ ! CHECK: %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+ ! CHECK: %[[V_3:[0-9]+]] = arith.addf %[[V_1]], %[[V_2]] {{.*}} : f32
+ ! CHECK: %[[V_4:[0-9]+]] = arith.addf %[[V_3]], %[[V_3]] {{.*}} : f32
+ ! CHECK: %cst = arith.constant 0.000000e+00 : f32
+ ! CHECK: %[[V_5:[0-9]+]] = arith.cmpf olt, %[[V_4]], %cst : f32
+ ! CHECK: cf.cond_br %[[V_5]], ^bb2, ^bb1
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: %[[V_6:[0-9]+]] = arith.cmpf ogt, %[[V_4]], %cst : f32
+ ! CHECK: cf.cond_br %[[V_6]], ^bb4, ^bb3
+ ! CHECK: ^bb2: // pred: ^bb0
+ ! CHECK: fir.store %c1{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb3: // pred: ^bb1
+ ! CHECK: fir.store %c2{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb4: // pred: ^bb1
+ ! CHECK: fir.store %c3{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb5: // 3 preds: ^bb2, ^bb3, ^bb4
+ ! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: return %[[V_7]] : i32
if (findex+findex) 7, 8, 9
kagf = 0; return
7 kagf = 1; return
diff --git a/flang/test/Lower/array.f90 b/flang/test/Lower/array.f90
index 862337c884fad..9d15b3b301156 100644
--- a/flang/test/Lower/array.f90
+++ b/flang/test/Lower/array.f90
@@ -1,6 +1,6 @@
! RUN: bbc -o - %s | FileCheck %s
-! CHECK-LABEL: fir.global @_QBblock
+! CHECK-LABEL: fir.global @_QCblock
! CHECK-DAG: %[[VAL_1:.*]] = arith.constant 1.000000e+00 : f32
! CHECK-DAG: %[[VAL_2:.*]] = arith.constant 2.400000e+00 : f32
! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 0.000000e+00 : f32
diff --git a/flang/test/Lower/block.f90 b/flang/test/Lower/block.f90
new file mode 100644
index 0000000000000..520af068c5b74
--- /dev/null
+++ b/flang/test/Lower/block.f90
@@ -0,0 +1,79 @@
+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: func @_QQmain
+program bb ! block stack management and exits
+ ! CHECK: %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"}
+ integer :: i, j
+ ! CHECK: fir.store %c0{{.*}} to %[[V_1]] : !fir.ref<i32>
+ i = 0
+ ! CHECK: %[[V_3:[0-9]+]] = fir.call @llvm.stacksave()
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: br ^bb1
+ ! CHECK: ^bb1: // 2 preds: ^bb0, ^bb15
+ ! CHECK: cond_br %{{.*}}, ^bb2, ^bb16
+ ! CHECK: ^bb2: // pred: ^bb1
+ ! CHECK: %[[V_11:[0-9]+]] = fir.call @llvm.stacksave()
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: cond_br %{{.*}}, ^bb3, ^bb4
+ ! CHECK: ^bb3: // pred: ^bb2
+ ! CHECK: br ^bb10
+ ! CHECK: ^bb4: // pred: ^bb2
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: cond_br %{{.*}}, ^bb5, ^bb6
+ ! CHECK: ^bb5: // pred: ^bb4
+ ! CHECK: br ^bb7
+ ! CHECK: ^bb6: // pred: ^bb4
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: cond_br %{{.*}}, ^bb7, ^bb8
+ ! CHECK: ^bb7: // 3 preds: ^bb5, ^bb6, ^bb12
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_11]])
+ ! CHECK: br ^bb14
+ ! CHECK: ^bb8: // pred: ^bb6
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: cond_br %{{.*}}, ^bb9, ^bb10
+ ! CHECK: ^bb9: // pred: ^bb8
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_11]])
+ ! CHECK: br ^bb15
+ ! CHECK: ^bb10: // 2 preds: ^bb3, ^bb8
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: cond_br %{{.*}}, ^bb11, ^bb12
+ ! CHECK: ^bb11: // pred: ^bb10
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_11]])
+ ! CHECK: br ^bb17
+ ! CHECK: ^bb12: // pred: ^bb10
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: cond_br %{{.*}}, ^bb13, ^bb7
+ ! CHECK: ^bb13: // pred: ^bb12
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_11]])
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_3]])
+ ! CHECK: br ^bb18
+ ! CHECK: ^bb14: // pred: ^bb7
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: br ^bb15
+ ! CHECK: ^bb15: // 2 preds: ^bb9, ^bb14
+ ! CHECK: br ^bb1
+ ! CHECK: ^bb16: // pred: ^bb1
+ ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+ ! CHECK: br ^bb17
+ ! CHECK: ^bb17: // 2 preds: ^bb11, ^bb16
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_3]])
+ ! CHECK: br ^bb18
+ ! CHECK: ^bb18: // 2 preds: ^bb13, ^bb17
+ ! CHECK: return
+ block
+ i = i + 1 ! 1 increment
+ do j = 1, 5
+ block
+ i = i + 1; if (j == 1) goto 1 ! inner block - 5 increments, 1 goto
+ i = i + 1; if (j == 2) goto 2 ! inner block - 4 increments, 1 goto
+ i = i + 1; if (j == 3) goto 10 ! outer block - 3 increments, 1 goto
+ i = i + 1; if (j == 4) goto 11 ! outer block - 2 increments, 1 goto
+1 i = i + 1; if (j == 5) goto 12 ! outer block - 2 increments, 1 goto
+ i = i + 1; if (j == 6) goto 100 ! program - 1 increment
+2 end block
+10 i = i + 1 ! 3 increments
+11 end do
+ i = i + 1 ! 0 increments
+12 end block
+100 print*, i ! expect 21
+end
diff --git a/flang/test/Lower/common-block-2.f90 b/flang/test/Lower/common-block-2.f90
index 937b92e3d933f..80bb7411bb4f8 100644
--- a/flang/test/Lower/common-block-2.f90
+++ b/flang/test/Lower/common-block-2.f90
@@ -5,12 +5,12 @@
! - A blank common that is initialized
! - A common block that is initialized outside of a BLOCK DATA.
-! CHECK-LABEL: fir.global @_QB : tuple<i32, !fir.array<8xi8>> {
+! CHECK-LABEL: fir.global @_QC : tuple<i32, !fir.array<8xi8>> {
! CHECK: %[[undef:.*]] = fir.undefined tuple<i32, !fir.array<8xi8>>
! CHECK: %[[init:.*]] = fir.insert_value %[[undef]], %c42{{.*}}, [0 : index] : (tuple<i32, !fir.array<8xi8>>, i32) -> tuple<i32, !fir.array<8xi8>>
! CHECK: fir.has_value %[[init]] : tuple<i32, !fir.array<8xi8>>
-! CHECK-LABEL: fir.global @_QBa : tuple<i32, !fir.array<8xi8>> {
+! CHECK-LABEL: fir.global @_QCa : tuple<i32, !fir.array<8xi8>> {
! CHECK: %[[undef:.*]] = fir.undefined tuple<i32, !fir.array<8xi8>>
! CHECK: %[[init:.*]] = fir.insert_value %[[undef]], %c42{{.*}}, [0 : index] : (tuple<i32, !fir.array<8xi8>>, i32) -> tuple<i32, !fir.array<8xi8>>
! CHECK: fir.has_value %[[init]] : tuple<i32, !fir.array<8xi8>>
diff --git a/flang/test/Lower/common-block.f90 b/flang/test/Lower/common-block.f90
index d569adb79dba4..a09181bfd78f0 100644
--- a/flang/test/Lower/common-block.f90
+++ b/flang/test/Lower/common-block.f90
@@ -1,18 +1,18 @@
! RUN: bbc %s -o - | tco | FileCheck %s
! RUN: %flang -emit-llvm -S -mmlir -disable-external-name-interop %s -o - | FileCheck %s
-! CHECK: @_QB = common global [8 x i8] zeroinitializer
-! CHECK: @_QBrien = common global [1 x i8] zeroinitializer
-! CHECK: @_QBwith_empty_equiv = common global [8 x i8] zeroinitializer
-! CHECK: @_QBx = global { float, float } { float 1.0{{.*}}, float 2.0{{.*}} }
-! CHECK: @_QBy = common global [12 x i8] zeroinitializer
-! CHECK: @_QBz = global { i32, [4 x i8], float } { i32 42, [4 x i8] undef, float 3.000000e+00 }
+! CHECK: @_QC = common global [8 x i8] zeroinitializer
+! CHECK: @_QCrien = common global [1 x i8] zeroinitializer
+! CHECK: @_QCwith_empty_equiv = common global [8 x i8] zeroinitializer
+! CHECK: @_QCx = global { float, float } { float 1.0{{.*}}, float 2.0{{.*}} }
+! CHECK: @_QCy = common global [12 x i8] zeroinitializer
+! CHECK: @_QCz = global { i32, [4 x i8], float } { i32 42, [4 x i8] undef, float 3.000000e+00 }
! CHECK-LABEL: _QPs0
subroutine s0
common // a0, b0
- ! CHECK: call void @_QPs(ptr @_QB, ptr getelementptr (i8, ptr @_QB, i64 4))
+ ! CHECK: call void @_QPs(ptr @_QC, ptr getelementptr (i8, ptr @_QC, i64 4))
call s(a0, b0)
end subroutine s0
@@ -21,7 +21,7 @@ subroutine s1
common /x/ a1, b1
data a1 /1.0/, b1 /2.0/
- ! CHECK: call void @_QPs(ptr @_QBx, ptr getelementptr (i8, ptr @_QBx, i64 4))
+ ! CHECK: call void @_QPs(ptr @_QCx, ptr getelementptr (i8, ptr @_QCx, i64 4))
call s(a1, b1)
end subroutine s1
@@ -29,7 +29,7 @@ end subroutine s1
subroutine s2
common /y/ a2, b2, c2
- ! CHECK: call void @_QPs(ptr @_QBy, ptr getelementptr (i8, ptr @_QBy, i64 4))
+ ! CHECK: call void @_QPs(ptr @_QCy, ptr getelementptr (i8, ptr @_QCy, i64 4))
call s(a2, b2)
end subroutine s2
@@ -54,9 +54,9 @@ module mod_with_common
! CHECK-LABEL: _QPs4
subroutine s4
use mod_with_common
- ! CHECK: load i32, ptr @_QBc_in_mod
+ ! CHECK: load i32, ptr @_QCc_in_mod
print *, i
- ! CHECK: load i32, ptr getelementptr (i8, ptr @_QBc_in_mod, i64 4)
+ ! CHECK: load i32, ptr getelementptr (i8, ptr @_QCc_in_mod, i64 4)
print *, j
end subroutine s4
diff --git a/flang/test/Lower/computed-goto.f90 b/flang/test/Lower/computed-goto.f90
index 49640390b6974..b9dddd37900c9 100644
--- a/flang/test/Lower/computed-goto.f90
+++ b/flang/test/Lower/computed-goto.f90
@@ -2,17 +2,153 @@
! CHECK-LABEL: func @_QPm
function m(index)
- ! CHECK: fir.select %{{.}} : i32 [1, ^bb{{.}}, 2, ^bb{{.}}, 3, ^bb{{.}}, 4, ^bb{{.}}, 5, ^bb{{.}}, unit, ^bb{{.}}]
- goto (9,7,5,3,1) index ! + 1
- m = 0; return
-1 m = 1; return
-3 m = 3; return
-5 m = 5; return
-7 m = 7; return
-9 m = 9; return
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "m"
+ ! CHECK: %[[V_1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK: fir.select %[[V_1]] : i32 [1, ^bb6, 2, ^bb5, 3, ^bb4, 4, ^bb3, 5, ^bb2, unit, ^bb1]
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: fir.store %c0{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb2: // pred: ^bb0
+ ! CHECK: fir.store %c1{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb3: // pred: ^bb0
+ ! CHECK: fir.store %c3{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb4: // pred: ^bb0
+ ! CHECK: fir.store %c5{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb5: // pred: ^bb0
+ ! CHECK: fir.store %c7{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb6: // pred: ^bb0
+ ! CHECK: fir.store %c9{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb7: // 6 preds: ^bb1, ^bb2, ^bb3, ^bb4, ^bb5, ^bb6
+ ! CHECK: %[[V_2:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: return %[[V_2]] : i32
+ goto (9,7,5,3,1) index ! + 1
+ m = 0; return
+1 m = 1; return
+3 m = 3; return
+5 m = 5; return
+7 m = 7; return
+9 m = 9; return
end
-! print*, m(-3); print*, m(0)
-! print*, m(1); print*, m(2); print*, m(3); print*, m(4); print*, m(5)
-! print*, m(6); print*, m(9)
+! CHECK-LABEL: func @_QPm1
+function m1(index)
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "m1"
+ ! CHECK: %[[V_1:[0-9]+]] = fir.call @llvm.stacksave()
+ ! CHECK: %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK: %[[V_3:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c1{{.*}} : i32
+ ! CHECK: cf.cond_br %[[V_3]], ^bb1, ^bb2
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: cf.br ^bb3
+ ! CHECK: ^bb2: // pred: ^bb0
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: fir.store %c0{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb4
+ ! CHECK: ^bb3: // pred: ^bb1
+ ! CHECK: fir.store %c10{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb4
+ ! CHECK: ^bb4: // 2 preds: ^bb2, ^bb3
+ ! CHECK: %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: return %[[V_4]] : i32
+ block
+ goto (10) index
+ end block
+ m1 = 0; return
+10 m1 = 10; return
+end
+
+! CHECK-LABEL: func @_QPm2
+function m2(index)
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "m2"
+ ! CHECK: %[[V_1:[0-9]+]] = fir.call @llvm.stacksave()
+ ! CHECK: %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK: %[[V_3:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c1{{.*}} : i32
+ ! CHECK: cf.cond_br %[[V_3]], ^bb1, ^bb2
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb2: // pred: ^bb0
+ ! CHECK: %[[V_4:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c2{{.*}} : i32
+ ! CHECK: cf.cond_br %[[V_4]], ^bb3, ^bb4
+ ! CHECK: ^bb3: // pred: ^bb2
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: cf.br ^bb6
+ ! CHECK: ^bb4: // pred: ^bb2
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: fir.store %c0{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb5: // pred: ^bb1
+ ! CHECK: fir.store %c10{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb6: // pred: ^bb3
+ ! CHECK: fir.store %c20{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb7: // 3 preds: ^bb4, ^bb5, ^bb6
+ ! CHECK: %[[V_5:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: return %[[V_5]] : i32
+ block
+ goto (10,20) index
+ end block
+ m2 = 0; return
+10 m2 = 10; return
+20 m2 = 20; return
+end
+
+! CHECK-LABEL: func @_QPm3
+function m3(index)
+ ! CHECK: %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "m3"
+ ! CHECK: %[[V_1:[0-9]+]] = fir.call @llvm.stacksave()
+ ! CHECK: %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+ ! CHECK: %[[V_3:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c1{{.*}} : i32
+ ! CHECK: cf.cond_br %[[V_3]], ^bb1, ^bb2
+ ! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: cf.br ^bb7
+ ! CHECK: ^bb2: // pred: ^bb0
+ ! CHECK: %[[V_4:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c2{{.*}} : i32
+ ! CHECK: cf.cond_br %[[V_4]], ^bb3, ^bb4
+ ! CHECK: ^bb3: // pred: ^bb2
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: cf.br ^bb8
+ ! CHECK: ^bb4: // pred: ^bb2
+ ! CHECK: %[[V_5:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c3{{.*}} : i32
+ ! CHECK: cf.cond_br %[[V_5]], ^bb5, ^bb6
+ ! CHECK: ^bb5: // pred: ^bb4
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: cf.br ^bb9
+ ! CHECK: ^bb6: // pred: ^bb4
+ ! CHECK: fir.call @llvm.stackrestore(%[[V_1]])
+ ! CHECK: fir.store %c0{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb10
+ ! CHECK: ^bb7: // pred: ^bb1
+ ! CHECK: fir.store %c10{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb10
+ ! CHECK: ^bb8: // pred: ^bb3
+ ! CHECK: fir.store %c20{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb10
+ ! CHECK: ^bb9: // pred: ^bb5
+ ! CHECK: fir.store %c30{{.*}} to %[[V_0]] : !fir.ref<i32>
+ ! CHECK: cf.br ^bb10
+ ! CHECK: ^bb10: // 4 preds: ^bb6, ^bb7, ^bb8, ^bb9
+ ! CHECK: %[[V_6:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+ ! CHECK: return %[[V_6]] : i32
+ block
+ goto (10,20,30) index
+ end block
+ m3 = 0; return
+10 m3 = 10; return
+20 m3 = 20; return
+30 m3 = 30; return
+end
+
+program cg
+ print*, m(-3), m(1), m(2), m(3), m(4), m(5), m(9) ! 0 9 7 5 3 1 0
+ print*, m1(0), m1(1), m1(2) ! 0 10 0
+ print*, m2(0), m2(1), m2(2), m2(3) ! 0 10 20 0
+ print*, m3(0), m3(1), m3(2), m3(3), m3(4) ! 0 10 20 30 0
end
diff --git a/flang/test/Lower/equivalence-2.f90 b/flang/test/Lower/equivalence-2.f90
index 7b556f0b3691f..e53f265c63045 100644
--- a/flang/test/Lower/equivalence-2.f90
+++ b/flang/test/Lower/equivalence-2.f90
@@ -111,7 +111,7 @@ subroutine eq_and_comm_same_offset
equivalence(arr3,arr4)
! CHECK: %[[arr4Store:.*]] = fir.alloca !fir.array<70756xi8> {uniq_name = "_QFeq_and_comm_same_offsetEarr3"}
- ! CHECK: %[[mcbAddr:.*]] = fir.address_of(@_QBmy_common_block) : !fir.ref<!fir.array<1064xi8>>
+ ! CHECK: %[[mcbAddr:.*]] = fir.address_of(@_QCmy_common_block) : !fir.ref<!fir.array<1064xi8>>
! CHECK: %[[mcbCast:.*]] = fir.convert %[[mcbAddr]] : (!fir.ref<!fir.array<1064xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[c0:.*]] = arith.constant 0 : index
! CHECK: %[[mcbCoor:.*]] = fir.coordinate_of %[[mcbCast]], %[[c0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
diff --git a/flang/test/Lower/explicit-interface-results-2.f90 b/flang/test/Lower/explicit-interface-results-2.f90
index 9b650c4a30559..59bebb0cb5034 100644
--- a/flang/test/Lower/explicit-interface-results-2.f90
+++ b/flang/test/Lower/explicit-interface-results-2.f90
@@ -140,7 +140,7 @@ subroutine host7()
common /mycom/ n_common
call takes_array(return_array())
! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index
-! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
+! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QCmycom) : !fir.ref<!fir.array<4xi8>>
! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<i32>
@@ -162,7 +162,7 @@ subroutine host8()
implicit none
call takes_array(return_array())
! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index
-! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
+! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref<!fir.array<4xi8>>
! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
@@ -190,7 +190,7 @@ subroutine host9()
! CHECK-LABEL: func @_QFhost9Pinternal_proc_a
subroutine internal_proc_a()
! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index
-! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
+! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref<!fir.array<4xi8>>
! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
@@ -217,7 +217,7 @@ subroutine host10()
subroutine internal_proc_a()
call takes_array(return_array())
! CHECK: %[[VAL_0:.*]] = arith.constant 0 : index
-! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
+! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref<!fir.array<4xi8>>
! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
diff --git a/flang/test/Lower/forall/array-constructor.f90 b/flang/test/Lower/forall/array-constructor.f90
index 8eec83fadc82e..5632edb3704c7 100644
--- a/flang/test/Lower/forall/array-constructor.f90
+++ b/flang/test/Lower/forall/array-constructor.f90
@@ -116,7 +116,7 @@ end subroutine ac1
! CHECK-LABEL: func @_QFac1Pfunc(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "a"}) -> i32 {
-! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "func", uniq_name = "_QFfuncEfunc"}
+! CHECK: %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "func", uniq_name = "_QFac1FfuncEfunc"}
! CHECK: %[[VAL_2:.*]] = arith.constant 1 : i64
! CHECK: %[[VAL_3:.*]] = arith.constant 1 : i64
! CHECK: %[[VAL_4:.*]] = arith.subi %[[VAL_2]], %[[VAL_3]] : i64
@@ -262,7 +262,7 @@ end subroutine ac2
! CHECK-LABEL: func @_QFac2Pfunc(
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "a"}) -> !fir.array<3xi32> {
! CHECK: %[[VAL_1:.*]] = arith.constant 3 : index
-! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<3xi32> {bindc_name = "func", uniq_name = "_QFfuncEfunc"}
+! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<3xi32> {bindc_name = "func", uniq_name = "_QFac2FfuncEfunc"}
! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_4:.*]] = fir.array_load %[[VAL_2]](%[[VAL_3]]) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.array<3xi32>
! CHECK: %[[VAL_5:.*]] = arith.constant 1 : i64
diff --git a/flang/test/Lower/host-associated-globals.f90 b/flang/test/Lower/host-associated-globals.f90
index cd607e0b417e2..2899f82ad6289 100644
--- a/flang/test/Lower/host-associated-globals.f90
+++ b/flang/test/Lower/host-associated-globals.f90
@@ -38,7 +38,7 @@ subroutine bar()
end subroutine
end subroutine
! CHECK-LABEL: func.func @_QFtest_commonPbar() attributes {fir.internal_proc} {
-! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QBx) : !fir.ref<!fir.array<12xi8>>
+! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QCx) : !fir.ref<!fir.array<12xi8>>
! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<12xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[VAL_2:.*]] = arith.constant 4 : index
! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
diff --git a/flang/test/Lower/module_definition.f90 b/flang/test/Lower/module_definition.f90
index 5acf645861212..f79bb4cf03f3e 100644
--- a/flang/test/Lower/module_definition.f90
+++ b/flang/test/Lower/module_definition.f90
@@ -12,15 +12,15 @@ module modCommonNoInit1
real :: x_named1
common /named1/ x_named1
end module
-! CHECK-LABEL: fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8>
-! CHECK-LABEL: fir.global common @_QBnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+! CHECK-LABEL: fir.global common @_QC(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+! CHECK-LABEL: fir.global common @_QCnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8>
! Module defines variable in common block with initialization
module modCommonInit1
integer :: i_named2 = 42
common /named2/ i_named2
end module
-! CHECK-LABEL: fir.global @_QBnamed2 : tuple<i32> {
+! CHECK-LABEL: fir.global @_QCnamed2 : tuple<i32> {
! CHECK: %[[init:.*]] = fir.insert_value %{{.*}}, %c42{{.*}}, [0 : index] : (tuple<i32>, i32) -> tuple<i32>
! CHECK: fir.has_value %[[init]] : tuple<i32>
diff --git a/flang/test/Lower/module_use.f90 b/flang/test/Lower/module_use.f90
index 6188a0064ce4c..c7f23c20ada9c 100644
--- a/flang/test/Lower/module_use.f90
+++ b/flang/test/Lower/module_use.f90
@@ -5,9 +5,9 @@
! The modules are defined in module_definition.f90
! The first runs ensures the module file is generated.
-! CHECK: fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8>
-! CHECK-NEXT: fir.global common @_QBnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8>
-! CHECK-NEXT: fir.global common @_QBnamed2(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+! CHECK: fir.global common @_QC(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+! CHECK-NEXT: fir.global common @_QCnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+! CHECK-NEXT: fir.global common @_QCnamed2(dense<0> : vector<4xi8>) : !fir.array<4xi8>
! CHECK-LABEL: func @_QPm1use()
real function m1use()
@@ -32,9 +32,9 @@ real function m1use()
real function modCommon1Use()
use modCommonInit1
use modCommonNoInit1
- ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref<!fir.array<4xi8>>
- ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
- ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref<!fir.array<4xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref<!fir.array<4xi8>>
+ ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref<!fir.array<4xi8>>
modCommon1Use = x_blank + x_named1 + i_named2
end function
diff --git a/flang/test/Lower/module_use_in_same_file.f90 b/flang/test/Lower/module_use_in_same_file.f90
index f380abde33c42..ea4ca3d0f7388 100644
--- a/flang/test/Lower/module_use_in_same_file.f90
+++ b/flang/test/Lower/module_use_in_same_file.f90
@@ -79,26 +79,26 @@ module modCommon2
contains
! CHECK-LABEL: func @_QMmodcommon2Pfoo()
real function foo()
- ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref<tuple<i32>>
- ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
- ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref<!fir.array<40xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref<tuple<i32>>
+ ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref<!fir.array<40xi8>>
foo = x_blank + x_named1(5) + i_named2
end function
end module
! CHECK-LABEL: func @_QPmodcommon2use()
real function modCommon2use()
use modCommon2
- ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref<tuple<i32>>
- ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
- ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref<!fir.array<40xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref<tuple<i32>>
+ ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref<!fir.array<40xi8>>
modCommon2use = x_blank + x_named1(5) + i_named2
end function
! CHECK-LABEL: func @_QPmodcommon2use_rename()
real function modCommon2use_rename()
use modCommon2, only : renamed0 => x_blank, renamed1 => x_named1, renamed2 => i_named2
- ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref<tuple<i32>>
- ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
- ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref<!fir.array<40xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref<tuple<i32>>
+ ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref<!fir.array<40xi8>>
modCommon2use_rename = renamed0 + renamed1(5) + renamed2
end function
diff --git a/flang/test/Lower/namelist-common-block.f90 b/flang/test/Lower/namelist-common-block.f90
index f0362d7f61434..39deb7b51059c 100644
--- a/flang/test/Lower/namelist-common-block.f90
+++ b/flang/test/Lower/namelist-common-block.f90
@@ -17,8 +17,8 @@ subroutine print_t()
end subroutine
end
-! CHECK-LABEL: fir.global linkonce @_QFGt.list constant : !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>> {
-! CHECK: %[[CB_ADDR:.*]] = fir.address_of(@_QBc) : !fir.ref<!fir.array<56xi8>>
+! CHECK-LABEL: fir.global linkonce @_QFNt.list constant : !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>> {
+! CHECK: %[[CB_ADDR:.*]] = fir.address_of(@_QCc) : !fir.ref<!fir.array<56xi8>>
! CHECK: %[[CB_CAST:.*]] = fir.convert %[[CB_ADDR]] : (!fir.ref<!fir.array<56xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[OFFSET:.*]] = arith.constant 8 : index
! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[CB_CAST]], %[[OFFSET]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
@@ -26,4 +26,3 @@ subroutine print_t()
! CHECK: %[[CAST_BOX_NONE:.*]] = fir.convert %[[CAST_BOX]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> !fir.ref<!fir.box<none>>
! CHECK: %[[RES:.*]] = fir.insert_value %{{.*}}, %[[CAST_BOX_NONE]], [1 : index, 1 : index] : (!fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>, !fir.ref<!fir.box<none>>) -> !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
! CHECK: fir.has_value %[[RES]] : !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
-
diff --git a/flang/test/Lower/parent-component.f90 b/flang/test/Lower/parent-component.f90
index 88c7df000050d..071ed53ae7876 100644
--- a/flang/test/Lower/parent-component.f90
+++ b/flang/test/Lower/parent-component.f90
@@ -43,7 +43,7 @@ subroutine init_with_slice()
print*,y(:)%p
end subroutine
! CHECK-LABEL: func.func @_QFPinit_with_slice()
- ! CHECK: %[[Y:.*]] = fir.address_of(@_QFinit_with_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
+ ! CHECK: %[[Y:.*]] = fir.address_of(@_QFFinit_with_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
! CHECK: %[[C2:.*]] = arith.constant 2 : index
! CHECK: %[[C1:.*]] = arith.constant 1 : index
! CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
@@ -81,7 +81,7 @@ subroutine init_no_slice()
print*,y%p
end subroutine
! CHECK-LABEL: func.func @_QFPinit_no_slice()
- ! CHECK: %[[Y:.*]] = fir.address_of(@_QFinit_no_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
+ ! CHECK: %[[Y:.*]] = fir.address_of(@_QFFinit_no_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
! CHECK: %[[C2:.*]] = arith.constant 2 : index
! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
@@ -119,9 +119,9 @@ subroutine init_allocatable()
end subroutine
! CHECK-LABEL: func.func @_QFPinit_allocatable()
- ! CHECK: %[[ALLOC:.*]] = fir.alloca !fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>> {uniq_name = "_QFinit_allocatableEy.addr"}
- ! CHECK: %[[LB0:.*]] = fir.alloca index {uniq_name = "_QFinit_allocatableEy.lb0"}
- ! CHECK: %[[EXT0:.*]] = fir.alloca index {uniq_name = "_QFinit_allocatableEy.ext0"}
+ ! CHECK: %[[ALLOC:.*]] = fir.alloca !fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>> {uniq_name = "_QFFinit_allocatableEy.addr"}
+ ! CHECK: %[[LB0:.*]] = fir.alloca index {uniq_name = "_QFFinit_allocatableEy.lb0"}
+ ! CHECK: %[[EXT0:.*]] = fir.alloca index {uniq_name = "_QFFinit_allocatableEy.ext0"}
! CHECK-COUNT-6: %{{.*}} = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
! CHECK: %[[LOAD_LB0:.*]] = fir.load %[[LB0]] : !fir.ref<index>
! CHECK: %[[LOAD_EXT0:.*]] = fir.load %[[EXT0]] : !fir.ref<index>
@@ -166,7 +166,7 @@ subroutine init_scalar()
end subroutine
! CHECK-LABEL: func.func @_QFPinit_scalar()
- ! CHECK: %[[S:.*]] = fir.address_of(@_QFinit_scalarEs) : !fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>
+ ! CHECK: %[[S:.*]] = fir.address_of(@_QFFinit_scalarEs) : !fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>
! CHECK: %[[CAST:.*]] = fir.convert %[[S]] : (!fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>) -> !fir.ref<!fir.type<_QFTp{a:i32}>>
! CHECK: fir.call @_QFPprint_scalar(%[[CAST]]) {{.*}}: (!fir.ref<!fir.type<_QFTp{a:i32}>>) -> ()
@@ -207,7 +207,7 @@ subroutine init_existing_field()
! CHECK-LABEL: func.func @_QFPinit_existing_field
! CHECK: %[[C2:.*]] = arith.constant 2 : index
- ! CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.array<2x!fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{a:i32,b:i32}>}>> {bindc_name = "y", uniq_name = "_QFinit_existing_fieldEy"}
+ ! CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.array<2x!fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{a:i32,b:i32}>}>> {bindc_name = "y", uniq_name = "_QFFinit_existing_fieldEy"}
! CHECK: %[[FIELD_C:.*]] = fir.field_index c, !fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{a:i32,b:i32}>}>
! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
! CHECK: %[[C1:.*]] = arith.constant 1 : index
diff --git a/flang/test/Lower/pointer-assignments.f90 b/flang/test/Lower/pointer-assignments.f90
index d4e63435b1983..4fc4e2c863eee 100644
--- a/flang/test/Lower/pointer-assignments.f90
+++ b/flang/test/Lower/pointer-assignments.f90
@@ -364,7 +364,7 @@ subroutine issue1180(x)
integer, target :: x
integer, pointer :: p
common /some_common/ p
- ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBsome_common) : !fir.ref<!fir.array<24xi8>>
+ ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCsome_common) : !fir.ref<!fir.array<24xi8>>
! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<24xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index
! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
diff --git a/flang/test/Lower/pointer-initial-target-2.f90 b/flang/test/Lower/pointer-initial-target-2.f90
index 102f8e8c84794..2889d58d385c2 100644
--- a/flang/test/Lower/pointer-initial-target-2.f90
+++ b/flang/test/Lower/pointer-initial-target-2.f90
@@ -11,7 +11,7 @@
real, save, target :: b
common /a/ p
data p /b/
-! CHECK-LABEL: fir.global @_QBa : tuple<!fir.box<!fir.ptr<f32>>>
+! CHECK-LABEL: fir.global @_QCa : tuple<!fir.box<!fir.ptr<f32>>>
! CHECK: %[[undef:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<f32>>>
! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref<f32>
! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref<f32>) -> !fir.box<f32>
@@ -29,10 +29,10 @@ block data tied
real, pointer :: p2 => x1
common /c1/ x1, p1
common /c2/ x2, p2
-! CHECK-LABEL: fir.global @_QBc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
- ! CHECK: fir.address_of(@_QBc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
-! CHECK-LABEL: fir.global @_QBc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
- ! CHECK: fir.address_of(@_QBc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
+! CHECK-LABEL: fir.global @_QCc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
+ ! CHECK: fir.address_of(@_QCc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
+! CHECK-LABEL: fir.global @_QCc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
+ ! CHECK: fir.address_of(@_QCc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
end block data
! Test pointer in a common with initial target in the same common.
@@ -40,9 +40,9 @@ block data bdsnake
integer, target :: b = 42
integer, pointer :: p => b
common /snake/ p, b
-! CHECK-LABEL: fir.global @_QBsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
+! CHECK-LABEL: fir.global @_QCsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
! CHECK: %[[tuple0:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<i32>>, i32>
- ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
+ ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QCsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ref<i32>
@@ -72,7 +72,7 @@ module some_mod_2
save :: /com/
real, pointer :: p(:) => y
! CHECK-LABEL: fir.global @_QMsome_mod_2Ep : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
- ! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref<!fir.array<1200xi8>>
+ ! CHECK: %[[c:.*]] = fir.address_of(@_QCcom) : !fir.ref<!fir.array<1200xi8>>
! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref<!fir.array<1200xi8>>) -> !fir.ref<!fir.array<?xi8>>
! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<200xf32>>
diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90
index 348849fb829ba..36631979141a0 100644
--- a/flang/test/Lower/program-units-fir-mangling.f90
+++ b/flang/test/Lower/program-units-fir-mangling.f90
@@ -92,34 +92,32 @@ module function erase()
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
+submodule (color_points) color_points_a
+contains
+ ! CHECK-LABEL: func @_QMcolor_pointsScolor_points_aPsub() {
+ subroutine sub
+ end subroutine
+ ! CHECK: }
+end submodule
+
+submodule (color_points:color_points_a) impl
+contains
+ ! CHECK-LABEL: func @_QMcolor_pointsScolor_points_aSimplPfoo()
+ subroutine foo
+ contains
+ ! CHECK-LABEL: func @_QMcolor_pointsScolor_points_aSimplFfooPbar() {
+ subroutine bar
+ ! CHECK: }
+ end subroutine
+ end subroutine
+ ! CHECK-LABEL: func @_QMcolor_pointsPdraw() {
+ module subroutine draw()
+ end subroutine
+ !FIXME func @_QMcolor_pointsPerase() -> i32 {
+ module procedure erase
+ ! CHECK: }
+ end procedure
+end submodule
! CHECK-LABEL: func @_QPshould_not_collide() {
subroutine should_not_collide()
@@ -222,4 +220,31 @@ subroutine s2() bind(c,name=foo//'5')
end subroutine
end module
+
+! CHECK-LABEL: func @_QPnest1
+subroutine nest1
+ ! CHECK: fir.call @_QFnest1Pinner()
+ call inner
+contains
+ ! CHECK-LABEL: func @_QFnest1Pinner
+ subroutine inner
+ ! CHECK: %[[V_0:[0-9]+]] = fir.address_of(@_QFnest1FinnerEkk) : !fir.ref<i32>
+ integer, save :: kk = 1
+ print*, 'qq:inner', kk
+ end
+end
+
+! CHECK-LABEL: func @_QPnest2
+subroutine nest2
+ ! CHECK: fir.call @_QFnest2Pinner()
+ call inner
+contains
+ ! CHECK-LABEL: func @_QFnest2Pinner
+ subroutine inner
+ ! CHECK: %[[V_0:[0-9]+]] = fir.address_of(@_QFnest2FinnerEkk) : !fir.ref<i32>
+ integer, save :: kk = 77
+ print*, 'ss:inner', kk
+ end
+end
+
! CHECK-LABEL: fir.global internal @_QFfooEpi : f32 {
diff --git a/flang/test/Lower/select-case-statement.f90 b/flang/test/Lower/select-case-statement.f90
index 5db675af0d2c6..d7f6a51d82bdf 100644
--- a/flang/test/Lower/select-case-statement.f90
+++ b/flang/test/Lower/select-case-statement.f90
@@ -176,9 +176,6 @@ subroutine scharacter1(s)
! CHECK: %[[V_20:[0-9]+]] = fir.box_addr %[[V_18]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
! CHECK: %[[V_42:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_43:[0-9]+]] = arith.cmpi eq, %[[V_42]], %c0{{.*}} : i32
- ! CHECK: fir.if %[[V_43]] {
- ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
- ! CHECK: }
! CHECK: cond_br %[[V_43]], ^bb3, ^bb2
! CHECK: ^bb2: // pred: ^bb1
select case(trim(s))
@@ -190,9 +187,6 @@ subroutine scharacter1(s)
! CHECK: %[[V_48:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_49:[0-9]+]] = arith.cmpi eq, %[[V_48]], %c0{{.*}} : i32
- ! CHECK: fir.if %[[V_49]] {
- ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
- ! CHECK: }
! CHECK: cond_br %[[V_49]], ^bb6, ^bb5
! CHECK: ^bb3: // pred: ^bb1
! CHECK: fir.store %c1{{.*}} to %[[V_1]] : !fir.ref<i32>
@@ -203,9 +197,6 @@ subroutine scharacter1(s)
! CHECK: %[[V_54:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_55:[0-9]+]] = arith.cmpi eq, %[[V_54]], %c0{{.*}} : i32
- ! CHECK: fir.if %[[V_55]] {
- ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
- ! CHECK: }
! CHECK: cond_br %[[V_55]], ^bb8, ^bb7
! CHECK: ^bb6: // pred: ^bb2
! CHECK: fir.store %c2{{.*}} to %[[V_1]] : !fir.ref<i32>
@@ -223,9 +214,6 @@ subroutine scharacter1(s)
! CHECK: ^bb9: // pred: ^bb7
! CHECK: %[[V_66:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_67:[0-9]+]] = arith.cmpi sle, %[[V_66]], %c0{{.*}} : i32
- ! CHECK: fir.if %[[V_67]] {
- ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
- ! CHECK: }
! CHECK: cond_br %[[V_67]], ^bb14, ^bb10
! CHECK: ^bb10: // 2 preds: ^bb7, ^bb9
! CHECK: %[[V_72:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
@@ -234,18 +222,15 @@ subroutine scharacter1(s)
! CHECK: ^bb11: // pred: ^bb10
! CHECK: %[[V_78:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_79:[0-9]+]] = arith.cmpi sle, %[[V_78]], %c0{{.*}} : i32
- ! CHECK: fir.if %[[V_79]] {
- ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
- ! CHECK: }
! CHECK: ^bb12: // 2 preds: ^bb10, ^bb11
! CHECK: %[[V_84:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
! CHECK: %[[V_85:[0-9]+]] = arith.cmpi sge, %[[V_84]], %c0{{.*}} : i32
- ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
! CHECK: cond_br %[[V_85]], ^bb14, ^bb13
! CHECK: ^bb13: // pred: ^bb12
! CHECK: ^bb14: // 3 preds: ^bb9, ^bb11, ^bb12
! CHECK: fir.store %c4{{.*}} to %[[V_1]] : !fir.ref<i32>
! CHECK: ^bb15: // 5 preds: ^bb3, ^bb4, ^bb6, ^bb8, ^bb14
+ ! CHECK: fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
end select
end if
! CHECK: %[[V_89:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
@@ -257,28 +242,28 @@ subroutine scharacter2(s)
! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
! CHECK: %[[V_1:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
character(len=3) :: s
- n = 0
+ n = -10
! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
! CHECK: %[[V_13:[0-9]+]] = fir.box_addr %[[V_12]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
- ! CHECK: fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>>
! CHECK: br ^bb1
! CHECK: ^bb1: // pred: ^bb0
+ ! CHECK: fir.store %c9{{.*}}
! CHECK: br ^bb2
- n = -10
+ ! CHECK: ^bb2: // pred: ^bb1
+ ! CHECK: fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>>
select case(trim(s))
case default
n = 9
end select
print*, n
- ! CHECK: ^bb2: // pred: ^bb1
+ n = -2
! CHECK: %[[V_28:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
! CHECK: %[[V_29:[0-9]+]] = fir.box_addr %[[V_28]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
- ! CHECK: fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>>
! CHECK: br ^bb3
! CHECK: ^bb3: // pred: ^bb2
- n = -2
+ ! CHECK: fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>>
select case(trim(s))
end select
print*, n
diff --git a/flang/unittests/Optimizer/InternalNamesTest.cpp b/flang/unittests/Optimizer/InternalNamesTest.cpp
index ecfefaabc4244..28e49fc515472 100644
--- a/flang/unittests/Optimizer/InternalNamesTest.cpp
+++ b/flang/unittests/Optimizer/InternalNamesTest.cpp
@@ -16,23 +16,23 @@ using llvm::SmallVector;
using llvm::StringRef;
struct DeconstructedName {
+ DeconstructedName(llvm::StringRef name) : name{name} {}
DeconstructedName(llvm::ArrayRef<std::string> modules,
- std::optional<std::string> host, llvm::StringRef name,
- llvm::ArrayRef<std::int64_t> kinds)
- : modules{modules.begin(), modules.end()}, host{host}, name{name},
- kinds{kinds.begin(), kinds.end()} {}
+ llvm::ArrayRef<std::string> procs, std::int64_t blockId,
+ llvm::StringRef name, llvm::ArrayRef<std::int64_t> kinds)
+ : modules{modules.begin(), modules.end()}, procs{procs.begin(),
+ procs.end()},
+ blockId{blockId}, name{name}, kinds{kinds.begin(), kinds.end()} {}
bool isObjEqual(const NameUniquer::DeconstructedName &actualObj) {
- if ((actualObj.name == name) && (actualObj.modules == modules) &&
- (actualObj.host == host) && (actualObj.kinds == kinds)) {
- return true;
- }
- return false;
+ return actualObj.modules == modules && actualObj.procs == procs &&
+ actualObj.blockId == blockId && actualObj.name == name &&
+ actualObj.kinds == kinds;
}
-private:
llvm::SmallVector<std::string> modules;
- std::optional<std::string> host;
+ llvm::SmallVector<std::string> procs;
+ std::int64_t blockId;
std::string name;
llvm::SmallVector<std::int64_t> kinds;
};
@@ -47,20 +47,11 @@ void validateDeconstructedName(
<< "Possible error: DeconstructedName mismatch";
}
-TEST(InternalNamesTest, doBlockDataTest) {
- std::string actual = NameUniquer::doBlockData("blockdatatest");
- std::string actualBlank = NameUniquer::doBlockData("");
- std::string expectedMangledName = "_QLblockdatatest";
- std::string expectedMangledNameBlank = "_QL";
- ASSERT_EQ(actual, expectedMangledName);
- ASSERT_EQ(actualBlank, expectedMangledNameBlank);
-}
-
TEST(InternalNamesTest, doCommonBlockTest) {
std::string actual = NameUniquer::doCommonBlock("hello");
std::string actualBlank = NameUniquer::doCommonBlock("");
- std::string expectedMangledName = "_QBhello";
- std::string expectedMangledNameBlank = "_QB";
+ std::string expectedMangledName = "_QChello";
+ std::string expectedMangledNameBlank = "_QC";
ASSERT_EQ(actual, expectedMangledName);
ASSERT_EQ(actualBlank, expectedMangledNameBlank);
}
@@ -81,7 +72,7 @@ TEST(InternalNamesTest, doGeneratedTest) {
TEST(InternalNamesTest, doConstantTest) {
std::string actual =
- NameUniquer::doConstant({"mod1", "mod2"}, {"foo"}, "Hello");
+ NameUniquer::doConstant({"mod1", "mod2"}, {"foo"}, 0, "Hello");
std::string expectedMangledName = "_QMmod1Smod2FfooEChello";
ASSERT_EQ(actual, expectedMangledName);
}
@@ -93,66 +84,59 @@ TEST(InternalNamesTest, doProcedureTest) {
}
TEST(InternalNamesTest, doTypeTest) {
- std::string actual = NameUniquer::doType({}, {}, "mytype", {4, -1});
+ std::string actual = NameUniquer::doType({}, {}, 0, "mytype", {4, -1});
std::string expectedMangledName = "_QTmytypeK4KN1";
ASSERT_EQ(actual, expectedMangledName);
}
TEST(InternalNamesTest, doIntrinsicTypeDescriptorTest) {
using IntrinsicType = fir::NameUniquer::IntrinsicType;
- std::string actual =
- NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, 42);
- std::string expectedMangledName = "_QCrealK42";
+ std::string actual = NameUniquer::doIntrinsicTypeDescriptor(
+ {}, {}, 0, IntrinsicType::REAL, 42);
+ std::string expectedMangledName = "_QYIrealK42";
ASSERT_EQ(actual, expectedMangledName);
- actual =
- NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, {});
- expectedMangledName = "_QCrealK0";
+ actual = NameUniquer::doIntrinsicTypeDescriptor(
+ {}, {}, 0, IntrinsicType::REAL, {});
+ expectedMangledName = "_QYIrealK0";
ASSERT_EQ(actual, expectedMangledName);
- actual =
- NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::INTEGER, 3);
- expectedMangledName = "_QCintegerK3";
+ actual = NameUniquer::doIntrinsicTypeDescriptor(
+ {}, {}, 0, IntrinsicType::INTEGER, 3);
+ expectedMangledName = "_QYIintegerK3";
ASSERT_EQ(actual, expectedMangledName);
- actual =
- NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::LOGICAL, 2);
- expectedMangledName = "_QClogicalK2";
+ actual = NameUniquer::doIntrinsicTypeDescriptor(
+ {}, {}, 0, IntrinsicType::LOGICAL, 2);
+ expectedMangledName = "_QYIlogicalK2";
ASSERT_EQ(actual, expectedMangledName);
actual = NameUniquer::doIntrinsicTypeDescriptor(
- {}, {}, IntrinsicType::CHARACTER, 4);
- expectedMangledName = "_QCcharacterK4";
+ {}, {}, 0, IntrinsicType::CHARACTER, 4);
+ expectedMangledName = "_QYIcharacterK4";
ASSERT_EQ(actual, expectedMangledName);
- actual =
- NameUniquer::doIntrinsicTypeDescriptor({}, {}, IntrinsicType::COMPLEX, 4);
- expectedMangledName = "_QCcomplexK4";
+ actual = NameUniquer::doIntrinsicTypeDescriptor(
+ {}, {}, 0, IntrinsicType::COMPLEX, 4);
+ expectedMangledName = "_QYIcomplexK4";
ASSERT_EQ(actual, expectedMangledName);
}
TEST(InternalNamesTest, doDispatchTableTest) {
std::string actual =
- NameUniquer::doDispatchTable({}, {}, "MyTYPE", {2, 8, 18});
+ NameUniquer::doDispatchTable({}, {}, 0, "MyTYPE", {2, 8, 18});
std::string expectedMangledName = "_QDTmytypeK2K8K18";
ASSERT_EQ(actual, expectedMangledName);
}
-TEST(InternalNamesTest, doTypeDescriptorTest) {
- std::string actual = NameUniquer::doTypeDescriptor(
- {StringRef("moD1")}, {StringRef("foo")}, "MyTYPE", {2, 8});
- std::string expectedMangledName = "_QMmod1FfooCTmytypeK2K8";
- ASSERT_EQ(actual, expectedMangledName);
-}
-
TEST(InternalNamesTest, doVariableTest) {
std::string actual = NameUniquer::doVariable(
- {"mod1", "mod2"}, {""}, "intvar"); // Function is present and is blank.
+ {"mod1", "mod2"}, {""}, 0, "intvar"); // Function is present and is blank.
std::string expectedMangledName = "_QMmod1Smod2FEintvar";
ASSERT_EQ(actual, expectedMangledName);
std::string actual2 = NameUniquer::doVariable(
- {"mod1", "mod2"}, {}, "intVariable"); // Function is not present.
+ {"mod1", "mod2"}, {}, 0, "intVariable"); // Function is not present.
std::string expectedMangledName2 = "_QMmod1Smod2Eintvariable";
ASSERT_EQ(actual2, expectedMangledName2);
}
@@ -165,15 +149,15 @@ TEST(InternalNamesTest, doProgramEntry) {
TEST(InternalNamesTest, doNamelistGroup) {
std::string actual = NameUniquer::doNamelistGroup({"mod1"}, {}, "nlg");
- std::string expectedMangledName = "_QMmod1Gnlg";
+ std::string expectedMangledName = "_QMmod1Nnlg";
ASSERT_EQ(actual, expectedMangledName);
}
TEST(InternalNamesTest, deconstructTest) {
- std::pair actual = NameUniquer::deconstruct("_QBhello");
+ std::pair actual = NameUniquer::deconstruct("_QChello");
auto expectedNameKind = NameUniquer::NameKind::COMMON;
struct DeconstructedName expectedComponents {
- {}, {}, "hello", {}
+ {}, {}, 0, "hello", {}
};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
}
@@ -183,42 +167,42 @@ TEST(InternalNamesTest, complexdeconstructTest) {
std::pair actual = NameUniquer::deconstruct("_QMmodSs1modSs2modFsubPfun");
auto expectedNameKind = NameKind::PROCEDURE;
struct DeconstructedName expectedComponents = {
- {"mod", "s1mod", "s2mod"}, {"sub"}, "fun", {}};
+ {"mod", "s1mod", "s2mod"}, {"sub"}, 0, "fun", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
actual = NameUniquer::deconstruct("_QPsub");
expectedNameKind = NameKind::PROCEDURE;
- expectedComponents = {{}, {}, "sub", {}};
+ expectedComponents = {{}, {}, 0, "sub", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
- actual = NameUniquer::deconstruct("_QBvariables");
+ actual = NameUniquer::deconstruct("_QCvariables");
expectedNameKind = NameKind::COMMON;
- expectedComponents = {{}, {}, "variables", {}};
+ expectedComponents = {{}, {}, 0, "variables", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
actual = NameUniquer::deconstruct("_QMmodEintvar");
expectedNameKind = NameKind::VARIABLE;
- expectedComponents = {{"mod"}, {}, "intvar", {}};
+ expectedComponents = {{"mod"}, {}, 0, "intvar", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
actual = NameUniquer::deconstruct("_QMmodECpi");
expectedNameKind = NameKind::CONSTANT;
- expectedComponents = {{"mod"}, {}, "pi", {}};
+ expectedComponents = {{"mod"}, {}, 0, "pi", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
actual = NameUniquer::deconstruct("_QTyourtypeK4KN6");
expectedNameKind = NameKind::DERIVED_TYPE;
- expectedComponents = {{}, {}, "yourtype", {4, -6}};
+ expectedComponents = {{}, {}, 0, "yourtype", {4, -6}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
actual = NameUniquer::deconstruct("_QDTt");
expectedNameKind = NameKind::DISPATCH_TABLE;
- expectedComponents = {{}, {}, "t", {}};
+ expectedComponents = {{}, {}, 0, "t", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
- actual = NameUniquer::deconstruct("_QFmstartGmpitop");
+ actual = NameUniquer::deconstruct("_QFmstartNmpitop");
expectedNameKind = NameKind::NAMELIST_GROUP;
- expectedComponents = {{}, {"mstart"}, "mpitop", {}};
+ expectedComponents = {{}, {"mstart"}, 0, "mpitop", {}};
validateDeconstructedName(actual, expectedNameKind, expectedComponents);
}
@@ -230,10 +214,10 @@ TEST(InternalNamesTest, needExternalNameMangling) {
ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QDTmytypeK2K8K18"));
ASSERT_FALSE(NameUniquer::needExternalNameMangling("exit_"));
ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QFfooEx"));
- ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QFmstartGmpitop"));
+ ASSERT_FALSE(NameUniquer::needExternalNameMangling("_QFmstartNmpitop"));
ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QPfoo"));
ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QPbar"));
- ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QBa"));
+ ASSERT_TRUE(NameUniquer::needExternalNameMangling("_QCa"));
}
TEST(InternalNamesTest, isExternalFacingUniquedName) {
@@ -252,7 +236,7 @@ TEST(InternalNamesTest, isExternalFacingUniquedName) {
ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
result = NameUniquer::deconstruct("_QPbar");
ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
- result = NameUniquer::deconstruct("_QBa");
+ result = NameUniquer::deconstruct("_QCa");
ASSERT_TRUE(NameUniquer::isExternalFacingUniquedName(result));
}
More information about the flang-commits
mailing list