From 2c1433453d1670f668220670b8f2df60f9dc9949 Mon Sep 17 00:00:00 2001 From: V Donaldson Date: Mon, 27 Feb 2023 14:05:53 -0800 Subject: [PATCH] [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. --- flang/docs/BijectiveInternalNameUniquing.md | 146 +++-- flang/include/flang/Lower/AbstractConverter.h | 8 +- flang/include/flang/Lower/IterationSpace.h | 4 +- flang/include/flang/Lower/Mangler.h | 19 +- flang/include/flang/Lower/PFTBuilder.h | 46 +- flang/include/flang/Lower/StatementContext.h | 40 +- .../flang/Optimizer/Support/InternalNames.h | 52 +- flang/lib/Lower/Bridge.cpp | 625 +++++++++++++-------- flang/lib/Lower/CallInterface.cpp | 15 +- flang/lib/Lower/ConvertType.cpp | 3 +- flang/lib/Lower/ConvertVariable.cpp | 58 +- flang/lib/Lower/IO.cpp | 23 +- flang/lib/Lower/IterationSpace.cpp | 2 +- flang/lib/Lower/Mangler.cpp | 180 +++--- flang/lib/Lower/PFTBuilder.cpp | 43 +- flang/lib/Optimizer/Support/InternalNames.cpp | 178 +++--- flang/test/Fir/external-mangling.fir | 8 +- .../allocatable-and-pointer-status-change.f90 | 2 +- flang/test/Lower/HLFIR/statement-functions.f90 | 2 +- .../Lower/OpenMP/threadprivate-commonblock.f90 | 4 +- .../Lower/OpenMP/threadprivate-use-association.f90 | 8 +- flang/test/Lower/arithmetic-goto.f90 | 49 +- flang/test/Lower/array.f90 | 2 +- flang/test/Lower/block.f90 | 79 +++ flang/test/Lower/common-block-2.f90 | 4 +- flang/test/Lower/common-block.f90 | 22 +- flang/test/Lower/computed-goto.f90 | 158 +++++- flang/test/Lower/equivalence-2.f90 | 2 +- flang/test/Lower/explicit-interface-results-2.f90 | 8 +- flang/test/Lower/forall/array-constructor.f90 | 4 +- flang/test/Lower/host-associated-globals.f90 | 2 +- flang/test/Lower/module_definition.f90 | 6 +- flang/test/Lower/module_use.f90 | 12 +- flang/test/Lower/module_use_in_same_file.f90 | 18 +- flang/test/Lower/namelist-common-block.f90 | 5 +- flang/test/Lower/parent-component.f90 | 14 +- flang/test/Lower/pointer-assignments.f90 | 2 +- flang/test/Lower/pointer-initial-target-2.f90 | 16 +- flang/test/Lower/program-units-fir-mangling.f90 | 81 ++- flang/test/Lower/select-case-statement.f90 | 29 +- flang/unittests/Optimizer/InternalNamesTest.cpp | 118 ++-- 41 files changed, 1308 insertions(+), 789 deletions(-) create mode 100644 flang/test/Lower/block.f90 diff --git a/flang/docs/BijectiveInternalNameUniquing.md b/flang/docs/BijectiveInternalNameUniquing.md index 7a6e8a4..996c490 100644 --- a/flang/docs/BijectiveInternalNameUniquing.md +++ b/flang/docs/BijectiveInternalNameUniquing.md @@ -1,3 +1,11 @@ + + # 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 cd512e9..8c428da 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 @@ -233,6 +228,9 @@ public: 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 1c413a5..f05a23b 100644 --- a/flang/include/flang/Lower/IterationSpace.h +++ b/flang/include/flang/Lower/IterationSpace.h @@ -191,7 +191,7 @@ protected: assert(!empty()); stack.pop_back(); if (empty()) { - stmtCtx.finalize(); + stmtCtx.finalizeAndReset(); vmap.clear(); } } @@ -522,7 +522,7 @@ public: const ExplicitIterSpace &); /// Finalize the current body statement context. - void finalizeContext() { stmtCtx.finalize(); } + void finalizeContext() { stmtCtx.finalizeAndReset(); } void appendLoops(const llvm::SmallVector &loops) { loopStack.push_back(loops); diff --git a/flang/include/flang/Lower/Mangler.h b/flang/include/flang/Lower/Mangler.h index 11a8e96..9e6f82b 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; + +/// 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 ef513c2..30d7da7 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). using EvaluationVariant = MakeReferenceVariant; -/// 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 nestedFunctions; - /// pairs for each entry point. The pair at index 0 + /// 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, 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 createPFT(const parser::Program &root, diff --git a/flang/include/flang/Lower/StatementContext.h b/flang/include/flang/Lower/StatementContext.h index 9ee304a..cec9641 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 @@ public: } } - /// 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 9463a81..d6e28f4 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 modules, - std::optional host, llvm::StringRef name, - llvm::ArrayRef kinds) - : modules{modules.begin(), modules.end()}, host{host}, name{name}, - kinds{kinds.begin(), kinds.end()} {} + llvm::ArrayRef procs, std::int64_t blockId, + llvm::StringRef name, llvm::ArrayRef kinds) + : modules{modules.begin(), modules.end()}, procs{procs.begin(), + procs.end()}, + blockId{blockId}, name{name}, kinds{kinds.begin(), kinds.end()} {} llvm::SmallVector modules; - std::optional host; + llvm::SmallVector procs; + std::int64_t blockId; std::string name; llvm::SmallVector 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 modules, - std::optional host, - llvm::StringRef name); + llvm::ArrayRef procs, + std::int64_t block, llvm::StringRef name); /// Unique a dispatch table name static std::string doDispatchTable(llvm::ArrayRef modules, - std::optional host, - llvm::StringRef name, + llvm::ArrayRef procs, + std::int64_t block, llvm::StringRef name, llvm::ArrayRef kinds); /// Unique a compiler generated name @@ -87,39 +86,40 @@ struct NameUniquer { /// Unique an intrinsic type descriptor static std::string doIntrinsicTypeDescriptor(llvm::ArrayRef modules, - std::optional host, - IntrinsicType type, std::int64_t kind); + llvm::ArrayRef procs, + std::int64_t block, IntrinsicType type, + std::int64_t kind); /// Unique a procedure name static std::string doProcedure(llvm::ArrayRef modules, - std::optional host, + llvm::ArrayRef procs, llvm::StringRef name); /// Unique a derived type name static std::string doType(llvm::ArrayRef modules, - std::optional host, - llvm::StringRef name, + llvm::ArrayRef procs, + std::int64_t block, llvm::StringRef name, llvm::ArrayRef kinds); /// Unique a (derived) type descriptor name static std::string doTypeDescriptor(llvm::ArrayRef modules, - std::optional host, - llvm::StringRef name, + llvm::ArrayRef procs, + std::int64_t block, llvm::StringRef name, llvm::ArrayRef kinds); static std::string doTypeDescriptor(llvm::ArrayRef modules, - std::optional host, - llvm::StringRef name, + llvm::ArrayRef procs, + std::int64_t block, llvm::StringRef name, llvm::ArrayRef 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 modules, - std::optional host, - llvm::StringRef name); + llvm::ArrayRef procs, + std::int64_t block, llvm::StringRef name); /// Unique a namelist group name static std::string doNamelistGroup(llvm::ArrayRef modules, - std::optional host, + llvm::ArrayRef 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 b690ad3..887ce66 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 @@ public: 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 @@ public: for (const Fortran::semantics::SymbolRef &binding : bindings) { const auto *details = binding.get().detailsIf(); - std::string bindingName = - Fortran::lower::mangle::mangleName(details->symbol()); + std::string bindingName = converter.mangleName(details->symbol()); builder.create( info.loc, mlir::StringAttr::get(builder.getContext(), @@ -667,7 +677,7 @@ public: Fortran::lower::StatementContext stmtCtx; Fortran::lower::createSomeArrayAssignment(*this, lhs, rhs, localSymbols, stmtCtx); - stmtCtx.finalize(); + stmtCtx.finalizeAndReset(); } else if (hexv.getBoxOf()) { fir::factory::CharacterExprHelper{*builder, loc}.createAssign(lhs, rhs); } else if (hexv.getBoxOf()) { @@ -745,14 +755,23 @@ public: } 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()) + return activeConstructStack.back().stmtCtx; return bridge.fctCtx(); } @@ -773,7 +792,7 @@ public: 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 @@ private: 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 @@ private: 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(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 @@ private: builder->create(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 valueList, + llvm::SmallVector 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 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(loc, selector, valueList, blockList); + return; + } + mlir::Type selectorType = selector.getType(); + bool realSelector = selectorType.isa(); + assert((inArithmeticIfContext || !realSelector) && "invalid selector type"); + mlir::Value zero; + if (inArithmeticIfContext) + zero = + realSelector + ? builder->create( + 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( + loc, + label.index() == 0 ? mlir::arith::CmpFPredicate::OLT + : mlir::arith::CmpFPredicate::OGT, + selector, zero); + else if (inArithmeticIfContext) + cond = builder->create( + loc, + label.index() == 0 ? mlir::arith::CmpIPredicate::slt + : mlir::arith::CmpIPredicate::sgt, + selector, zero); + else + cond = builder->create( + 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 @@ private: mlir::Type resultRefType = builder->getRefType(resultType); // A function with multiple entry points returning different 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(loc, resultRef); @@ -1062,7 +1233,7 @@ private: Fortran::semantics::GetExpr( std::get(stmt->t)), stmtCtx); - stmtCtx.finalize(); + stmtCtx.finalizeAndReset(); mlir::Value cond = builder->createConvert(loc, builder->getI1Type(), condExpr); if (negate) @@ -1101,12 +1272,13 @@ private: *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 indexList; - llvm::SmallVector blockList; + llvm::SmallVector labelList; int64_t index = 0; for (const Fortran::parser::ActualArgSpec &arg : std::get>(stmt.v.t)) { @@ -1114,12 +1286,10 @@ private: if (const auto *altReturn = std::get_if(&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(toLocation(), res, indexList, blockList); + genMultiwayBranch(res, indexList, labelList, eval.nonNopSuccessor()); } void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) { @@ -1130,66 +1300,37 @@ private: Fortran::semantics::GetExpr( std::get(stmt.t)), stmtCtx); - stmtCtx.finalize(); + stmtCtx.finalizeAndReset(); llvm::SmallVector indexList; - llvm::SmallVector blockList; + llvm::SmallVector labelList; int64_t index = 0; for (Fortran::parser::Label label : std::get>(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(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(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 attrList; - llvm::SmallVector valueList; - llvm::SmallVector 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(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(loc, expr, expr); - auto zero = builder->create( - loc, exprType, builder->getFloatAttr(exprType, 0.0)); - auto cond1 = builder->create( - 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( - 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()) + expr = builder->create(toLocation(), expr, expr); + llvm::SmallVector valueList; + llvm::SmallVector 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 @@ private: 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 indexList; - llvm::SmallVector 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 valueList; + llvm::SmallVector labelList; + // Add labels from an explicit list. The list may have duplicates. for (Fortran::parser::Label label : std::get>(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(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 @@ private: 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 @@ private: 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( &loopControl->u)) { @@ -1337,9 +1475,9 @@ private: 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 @@ private: } } - // 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 @@ private: // Loop end code. if (infiniteLoop || whileCondition) - genFIRBranch(headerBlock); + genBranch(headerBlock); else genFIRIncrementLoopEnd(incrementLoopNestInfo); @@ -1449,7 +1587,7 @@ private: 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(loc, maskCondCast, @@ -1471,7 +1609,6 @@ private: builder->create(loc, diff2, info.stepValue); tripCount = builder->createConvert(loc, builder->getIndexType(), tripCount); - } else { auto diff1 = builder->create(loc, upperValue, lowerValue); @@ -1501,16 +1638,16 @@ private: auto cond = builder->create( 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 @@ private: builder->create(loc, value, info.stepValue); builder->create(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 @@ private: 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()) { maybeStartBlock(e.block); @@ -1640,8 +1777,12 @@ private: } 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 @@ -1912,16 +2053,21 @@ private: } /// 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>(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 @@ private: llvm::SmallVector attrList; llvm::SmallVector valueList; llvm::SmallVector blockList; - mlir::Block *defaultBlock = eval.parentConstruct->constructExit->block; + mlir::Block *defaultBlock = parentConstruct->constructExit->block; using CaseValue = Fortran::parser::Scalar; auto addValue = [&](const CaseValue &caseValue) { const Fortran::lower::SomeExpr *expr = @@ -1998,20 +2144,19 @@ private: } // 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(loc, selector, attrList, valueList, blockList); return; @@ -2020,12 +2165,9 @@ private: // 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()) { - if (attrList.size() == 1) - stmtCtx.finalize(); - genFIRBranch(*caseBlock++); + for (mlir::Attribute attr : attrList) { + if (attr.isa()) { + genBranch(*caseBlock++); break; } auto genCond = [&](mlir::Value rhs, @@ -2035,59 +2177,40 @@ private: fir::factory::CharacterExprHelper charHelper{*builder, loc}; std::pair lhsVal = charHelper.createUnboxChar(selector); - mlir::Value &lhsAddr = lhsVal.first; - mlir::Value &lhsLen = lhsVal.second; std::pair 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(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()) { + if (attr.isa()) { 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()) { + if (attr.isa()) { pred = mlir::arith::CmpIPredicate::eq; - } else if (attr.value().isa()) { + } else if (attr.isa()) { pred = mlir::arith::CmpIPredicate::sge; } else { - assert(attr.value().isa() && - "unexpected predicate"); + assert(attr.isa() && "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 @@ private: } 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()) { if (eval.lowerAsUnstructured()) @@ -2120,23 +2244,52 @@ private: } else if (e.getIf()) { 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()) { + 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(toLocation(), stackSave).getResult(0); + mlir::Location endLoc = genLocation(endPosition); + stmtCtx.attachCleanup([=]() { + builder->create(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()) { + 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 @@ private: typeCaseScopes.push_back(&scope); } + pushActiveConstruct(getEval(), stmtCtx); for (Fortran::lower::pft::Evaluation &eval : getEval().getNestedEvaluations()) { if (auto *selectTypeStmt = @@ -2385,11 +2539,11 @@ private: genFIR(eval); if (hasLocalScope) localSymbols.popScope(); - stmtCtx.finalize(); } else { genFIR(eval); } } + popActiveConstruct(); } //===--------------------------------------------------------------------===// @@ -2448,49 +2602,47 @@ private: 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 indexList; - llvm::SmallVector blockList; - if (eorBlock) { + llvm::SmallVector 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(loc, selector, indexList, blockList); + genMultiwayBranch(selector, indexList, labelList, eval.nonNopSuccessor(), + /*inIoErrContext=*/errLabel != Fortran::parser::Label{}); } //===--------------------------------------------------------------------===// @@ -2966,7 +3118,7 @@ private: mlir::Value val = fir::getBase(rhs); // A function with multiple entry points returning different // 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 @@ private: 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 @@ private: 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 @@ private: } 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 @@ private: // 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 @@ private: 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 @@ private: 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 @@ private: 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 &evaluationList) { @@ -3492,10 +3653,10 @@ private: // 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 @@ private: 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 @@ private: 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 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 85d438c..9e86541 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 d701749..21de165 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 40c1cdc..9a19e42 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() && 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 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( @@ -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 9f38f03..6f30da2 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 inputFuncArgs = {cookie}; if (argType.isa()) { mlir::Value box = fir::getBase(item); - assert(box.getType().isa() && "must be previously emboxed"); + assert(box.getType().isa() && + "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 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 0c60092..8c629d4 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 a154b91..807d9eb 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 - -// recursively build the vector of module scopes -static void moduleNames(const Fortran::semantics::Scope &scope, - llvm::SmallVector &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 -moduleNames(const Fortran::semantics::Symbol &symbol) { - const Fortran::semantics::Scope &scope = symbol.owner(); - llvm::SmallVector result; - moduleNames(scope, result); - return result; -} -static std::optional -hostName(const Fortran::semantics::Symbol &symbol) { - const Fortran::semantics::Scope *scope = &symbol.owner(); - if (symbol.has()) - // Associate/Select construct scopes are not part of the mangling. This can - // result in different 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, std::int64_t> +ancestors(const Fortran::semantics::Symbol &symbol, + Fortran::lower::mangle::ScopeBlockIdMap &scopeBlockIdMap) { + llvm::SmallVector scopes; + for (auto *scp = &symbol.owner(); !scp->IsGlobal(); scp = &scp->parent()) + scopes.push_back(scp); + llvm::SmallVector modules; + llvm::SmallVector 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 modules; + llvm::SmallVector procs; + std::int64_t blockId; + // mangle ObjectEntityDetails or AssocEntityDetails symbols. auto mangleObject = [&]() -> std::string { - llvm::SmallVector modNames = moduleNames(ultimateSymbol); - std::optional 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 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 modNames = - moduleNames(ultimateSymbol); - std::optional 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 modNames = moduleNames(ultimateSymbol); - std::optional optHost = hostName(ultimateSymbol); + llvm::SmallVector modules; + llvm::SmallVector procs; + std::int64_t blockId; + std::tie(modules, procs, blockId) = + ancestors(ultimateSymbol, scopeBlockIdMap); llvm::SmallVector 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 d7bc7c1..98f0262 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 @@ public: /// first statement of the construct. void convertIfStmt(const parser::IfStmt &ifStmt, parser::CharBlock position, std::optional 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{ @@ -445,7 +445,7 @@ private: } /// 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: /// /// <> @@ -467,20 +467,20 @@ private: /// <> /// 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 @@ private: }, [&](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 @@ private: 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 *functionList{}; std::vector constructAndDirectiveStack{}; std::vector 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 @@ private: (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 2959699..df99cc7 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 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 modules, + llvm::ArrayRef 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 mods, - std::optional 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 @@ -101,30 +101,25 @@ std::string fir::NameUniquer::doKinds(llvm::ArrayRef 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 modules, - std::optional host, - llvm::StringRef name) { + llvm::ArrayRef 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 modules, - std::optional host, - llvm::StringRef name, + llvm::ArrayRef procs, + std::int64_t blockId, llvm::StringRef name, llvm::ArrayRef 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 modules, - std::optional host, IntrinsicType type, - std::int64_t kind) { + llvm::ArrayRef 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 modules, - std::optional host, + llvm::ArrayRef 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 modules, - std::optional host, - llvm::StringRef name, + llvm::ArrayRef procs, + std::int64_t blockId, llvm::StringRef name, llvm::ArrayRef 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 modules, - std::optional host, - llvm::StringRef name, + llvm::ArrayRef procs, + std::int64_t blockId, llvm::StringRef name, llvm::ArrayRef 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 modules, std::optional host, - llvm::StringRef name, llvm::ArrayRef kinds) { +std::string +fir::NameUniquer::doTypeDescriptor(llvm::ArrayRef modules, + llvm::ArrayRef procs, + std::int64_t blockId, llvm::StringRef name, + llvm::ArrayRef 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 modules, - std::optional host, - llvm::StringRef name) { + llvm::ArrayRef 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 modules, - std::optional host, + llvm::ArrayRef 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::deconstruct(llvm::StringRef uniq) { if (uniq.startswith("_Q")) { llvm::SmallVector modules; - std::optional host; + llvm::SmallVector procs; + std::int64_t blockId = 0; std::string name; llvm::SmallVector 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 modules; for (const std::string &mod : result.second.modules) modules.push_back(mod); - std::optional host; - if (result.second.host) - host = *result.second.host; - return fir::NameUniquer::doVariable(modules, host, varName); + llvm::SmallVector 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 3673cad..71dbbe2 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> + %0 = fir.address_of(@_QCa) : !fir.ref> %1 = fir.convert %0 : (!fir.ref>) -> !fir.ref> %2 = fir.coordinate_of %1, %c0 : (!fir.ref>, index) -> !fir.ref %3 = fir.convert %2 : (!fir.ref) -> !fir.ref - %4 = fir.address_of(@_QB) : !fir.ref> + %4 = fir.address_of(@_QC) : !fir.ref> %5 = fir.convert %4 : (!fir.ref>) -> !fir.ref> %6 = fir.coordinate_of %5, %c0 : (!fir.ref>, index) -> !fir.ref %7 = fir.convert %6 : (!fir.ref) -> !fir.ref @@ -19,8 +19,8 @@ func.func @_QPfoo() { fir.call @_QPbar2(%7) : (!fir.ref) -> () 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) func.func private @_QPbar2(!fir.ref) 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 361d722..75062df 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, %[[VAL_11]] {fir.must_be_heap = true, uniq_name = "_QEa.alloc"} +! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.array, %[[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.shape<1>) -> !fir.box>> ! CHECK: fir.store %[[VAL_14]] to %[[VAL_6]] : !fir.ref>>> diff --git a/flang/test/Lower/HLFIR/statement-functions.f90 b/flang/test/Lower/HLFIR/statement-functions.f90 index 2463342..bb02daa 100644 --- a/flang/test/Lower/HLFIR/statement-functions.f90 +++ b/flang/test/Lower/HLFIR/statement-functions.f90 @@ -30,6 +30,6 @@ end subroutine ! 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>, i32) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_13]]#0 typeparams %[[VAL_17]] {uniq_name = "_QFchar_testFstmt_funcEchar_stmt_func_dummy_arg"} : (!fir.ref>, i32) -> (!fir.boxchar<1>, !fir.ref>) ! 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> diff --git a/flang/test/Lower/OpenMP/threadprivate-commonblock.f90 b/flang/test/Lower/OpenMP/threadprivate-commonblock.f90 index 39ea0c1..5cecb37 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> +!CHECK: [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref> !CHECK: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> !CHECK-DAG: [[ADDR1:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref> !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 a8ecfd1..2a46492 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> +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref> !CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> !CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref !CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref -> !fir.ref @@ -49,9 +49,9 @@ program main call sub() ! CHECK-LABEL: @_QQmain() -!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref> +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref> !CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> -!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QBblk) : !fir.ref> +!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QCblk) : !fir.ref> !CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref> -> !fir.ref> !CHECK-DAG: [[ADDR2:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref !CHECK-DAG: [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref -> !fir.ref diff --git a/flang/test/Lower/arithmetic-goto.f90 b/flang/test/Lower/arithmetic-goto.f90 index 7686ac4..eaf3d0c1 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 + ! 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 + ! CHECK: cf.br ^bb5 + ! CHECK: ^bb3: // pred: ^bb1 + ! CHECK: fir.store %c2{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb5 + ! CHECK: ^bb4: // pred: ^bb1 + ! CHECK: fir.store %c3{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb5 + ! CHECK: ^bb5: // 3 preds: ^bb2, ^bb3, ^bb4 + ! CHECK: %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref + ! CHECK: return %[[V_4]] : i32 if (index) 7, 8, 9 kagi = 0; return 7 kagi = 1; return @@ -12,12 +30,29 @@ end ! 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 + ! CHECK: %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref + ! 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 + ! CHECK: cf.br ^bb5 + ! CHECK: ^bb3: // pred: ^bb1 + ! CHECK: fir.store %c2{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb5 + ! CHECK: ^bb4: // pred: ^bb1 + ! CHECK: fir.store %c3{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb5 + ! CHECK: ^bb5: // 3 preds: ^bb2, ^bb3, ^bb4 + ! CHECK: %[[V_7:[0-9]+]] = fir.load %[[V_0]] : !fir.ref + ! 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 862337c..9d15b3b 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 0000000..520af06 --- /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 + i = 0 + ! CHECK: %[[V_3:[0-9]+]] = fir.call @llvm.stacksave() + ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref + ! 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 + ! CHECK: cond_br %{{.*}}, ^bb3, ^bb4 + ! CHECK: ^bb3: // pred: ^bb2 + ! CHECK: br ^bb10 + ! CHECK: ^bb4: // pred: ^bb2 + ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref + ! CHECK: cond_br %{{.*}}, ^bb5, ^bb6 + ! CHECK: ^bb5: // pred: ^bb4 + ! CHECK: br ^bb7 + ! CHECK: ^bb6: // pred: ^bb4 + ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref + ! 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 + ! 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 + ! 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 + ! 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 + ! CHECK: br ^bb15 + ! CHECK: ^bb15: // 2 preds: ^bb9, ^bb14 + ! CHECK: br ^bb1 + ! CHECK: ^bb16: // pred: ^bb1 + ! CHECK: fir.store %{{.*}} to %[[V_1]] : !fir.ref + ! 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 937b92e..80bb741 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> { +! CHECK-LABEL: fir.global @_QC : tuple> { ! CHECK: %[[undef:.*]] = fir.undefined tuple> ! CHECK: %[[init:.*]] = fir.insert_value %[[undef]], %c42{{.*}}, [0 : index] : (tuple>, i32) -> tuple> ! CHECK: fir.has_value %[[init]] : tuple> -! CHECK-LABEL: fir.global @_QBa : tuple> { +! CHECK-LABEL: fir.global @_QCa : tuple> { ! CHECK: %[[undef:.*]] = fir.undefined tuple> ! CHECK: %[[init:.*]] = fir.insert_value %[[undef]], %c42{{.*}}, [0 : index] : (tuple>, i32) -> tuple> ! CHECK: fir.has_value %[[init]] : tuple> diff --git a/flang/test/Lower/common-block.f90 b/flang/test/Lower/common-block.f90 index d569adb..a09181b 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 @@ end module ! 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 4964039..b9dddd3 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 + ! 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 + ! CHECK: cf.br ^bb7 + ! CHECK: ^bb2: // pred: ^bb0 + ! CHECK: fir.store %c1{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb7 + ! CHECK: ^bb3: // pred: ^bb0 + ! CHECK: fir.store %c3{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb7 + ! CHECK: ^bb4: // pred: ^bb0 + ! CHECK: fir.store %c5{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb7 + ! CHECK: ^bb5: // pred: ^bb0 + ! CHECK: fir.store %c7{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb7 + ! CHECK: ^bb6: // pred: ^bb0 + ! CHECK: fir.store %c9{{.*}} to %[[V_0]] : !fir.ref + ! 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 + ! 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 + ! 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 + ! CHECK: cf.br ^bb4 + ! CHECK: ^bb3: // pred: ^bb1 + ! CHECK: fir.store %c10{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb4 + ! CHECK: ^bb4: // 2 preds: ^bb2, ^bb3 + ! CHECK: %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref + ! 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 + ! 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 + ! CHECK: cf.br ^bb7 + ! CHECK: ^bb5: // pred: ^bb1 + ! CHECK: fir.store %c10{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb7 + ! CHECK: ^bb6: // pred: ^bb3 + ! CHECK: fir.store %c20{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb7 + ! CHECK: ^bb7: // 3 preds: ^bb4, ^bb5, ^bb6 + ! CHECK: %[[V_5:[0-9]+]] = fir.load %[[V_0]] : !fir.ref + ! 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 + ! 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 + ! CHECK: cf.br ^bb10 + ! CHECK: ^bb7: // pred: ^bb1 + ! CHECK: fir.store %c10{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb10 + ! CHECK: ^bb8: // pred: ^bb3 + ! CHECK: fir.store %c20{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb10 + ! CHECK: ^bb9: // pred: ^bb5 + ! CHECK: fir.store %c30{{.*}} to %[[V_0]] : !fir.ref + ! CHECK: cf.br ^bb10 + ! CHECK: ^bb10: // 4 preds: ^bb6, ^bb7, ^bb8, ^bb9 + ! CHECK: %[[V_6:[0-9]+]] = fir.load %[[V_0]] : !fir.ref + ! 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 7b556f0..e53f265 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> + ! CHECK: %[[mcbAddr:.*]] = fir.address_of(@_QCmy_common_block) : !fir.ref> ! CHECK: %[[mcbCast:.*]] = fir.convert %[[mcbAddr]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[c0:.*]] = arith.constant 0 : index ! CHECK: %[[mcbCoor:.*]] = fir.coordinate_of %[[mcbCast]], %[[c0]] : (!fir.ref>, index) -> !fir.ref diff --git a/flang/test/Lower/explicit-interface-results-2.f90 b/flang/test/Lower/explicit-interface-results-2.f90 index 9b650c4..59bebb0 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> +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QCmycom) : !fir.ref> ! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_0]] : (!fir.ref>, index) -> !fir.ref ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref) -> !fir.ref @@ -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> +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref> ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref>, index) -> !fir.ref ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref) -> !fir.ref @@ -190,7 +190,7 @@ contains ! 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> +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref> ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref>, index) -> !fir.ref ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref) -> !fir.ref @@ -217,7 +217,7 @@ contains 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> +! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref> ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref>, index) -> !fir.ref ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref) -> !fir.ref diff --git a/flang/test/Lower/forall/array-constructor.f90 b/flang/test/Lower/forall/array-constructor.f90 index 8eec83f..5632edb 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.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.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.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 cd607e0..2899f82 100644 --- a/flang/test/Lower/host-associated-globals.f90 +++ b/flang/test/Lower/host-associated-globals.f90 @@ -38,7 +38,7 @@ contains end subroutine end subroutine ! CHECK-LABEL: func.func @_QFtest_commonPbar() attributes {fir.internal_proc} { -! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QBx) : !fir.ref> +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QCx) : !fir.ref> ! CHECK: %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[VAL_2:.*]] = arith.constant 4 : index ! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref>, index) -> !fir.ref diff --git a/flang/test/Lower/module_definition.f90 b/flang/test/Lower/module_definition.f90 index 5acf645..f79bb4c 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 { +! CHECK-LABEL: fir.global @_QCnamed2 : tuple { ! CHECK: %[[init:.*]] = fir.insert_value %{{.*}}, %c42{{.*}}, [0 : index] : (tuple, i32) -> tuple ! CHECK: fir.has_value %[[init]] : tuple diff --git a/flang/test/Lower/module_use.f90 b/flang/test/Lower/module_use.f90 index 6188a00..c7f23c2 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 @@ end function real function modCommon1Use() use modCommonInit1 use modCommonNoInit1 - ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref> - ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref> - ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref> 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 f380abd..ea4ca3d 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> - ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref> - ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref> 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> - ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref> - ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref> 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> - ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref> - ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref> 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 f0362d7..39deb7b 100644 --- a/flang/test/Lower/namelist-common-block.f90 +++ b/flang/test/Lower/namelist-common-block.f90 @@ -17,8 +17,8 @@ contains end subroutine end -! CHECK-LABEL: fir.global linkonce @_QFGt.list constant : !fir.array<2xtuple, !fir.ref>>> { -! CHECK: %[[CB_ADDR:.*]] = fir.address_of(@_QBc) : !fir.ref> +! CHECK-LABEL: fir.global linkonce @_QFNt.list constant : !fir.array<2xtuple, !fir.ref>>> { +! CHECK: %[[CB_ADDR:.*]] = fir.address_of(@_QCc) : !fir.ref> ! CHECK: %[[CB_CAST:.*]] = fir.convert %[[CB_ADDR]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[OFFSET:.*]] = arith.constant 8 : index ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[CB_CAST]], %[[OFFSET]] : (!fir.ref>, index) -> !fir.ref @@ -26,4 +26,3 @@ end ! CHECK: %[[CAST_BOX_NONE:.*]] = fir.convert %[[CAST_BOX]] : (!fir.ref>>>) -> !fir.ref> ! CHECK: %[[RES:.*]] = fir.insert_value %{{.*}}, %[[CAST_BOX_NONE]], [1 : index, 1 : index] : (!fir.array<2xtuple, !fir.ref>>>, !fir.ref>) -> !fir.array<2xtuple, !fir.ref>>> ! CHECK: fir.has_value %[[RES]] : !fir.array<2xtuple, !fir.ref>>> - diff --git a/flang/test/Lower/parent-component.f90 b/flang/test/Lower/parent-component.f90 index 88c7df0..071ed53 100644 --- a/flang/test/Lower/parent-component.f90 +++ b/flang/test/Lower/parent-component.f90 @@ -43,7 +43,7 @@ contains print*,y(:)%p end subroutine ! CHECK-LABEL: func.func @_QFPinit_with_slice() - ! CHECK: %[[Y:.*]] = fir.address_of(@_QFinit_with_sliceEy) : !fir.ref>> + ! CHECK: %[[Y:.*]] = fir.address_of(@_QFFinit_with_sliceEy) : !fir.ref>> ! CHECK: %[[C2:.*]] = arith.constant 2 : index ! CHECK: %[[C1:.*]] = arith.constant 1 : index ! CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64 @@ -81,7 +81,7 @@ contains print*,y%p end subroutine ! CHECK-LABEL: func.func @_QFPinit_no_slice() - ! CHECK: %[[Y:.*]] = fir.address_of(@_QFinit_no_sliceEy) : !fir.ref>> + ! CHECK: %[[Y:.*]] = fir.address_of(@_QFFinit_no_sliceEy) : !fir.ref>> ! 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 @@ contains end subroutine ! CHECK-LABEL: func.func @_QFPinit_allocatable() - ! CHECK: %[[ALLOC:.*]] = fir.alloca !fir.heap>> {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>> {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 ! CHECK: %[[LOAD_EXT0:.*]] = fir.load %[[EXT0]] : !fir.ref @@ -166,7 +166,7 @@ contains end subroutine ! CHECK-LABEL: func.func @_QFPinit_scalar() - ! CHECK: %[[S:.*]] = fir.address_of(@_QFinit_scalarEs) : !fir.ref> + ! CHECK: %[[S:.*]] = fir.address_of(@_QFFinit_scalarEs) : !fir.ref> ! CHECK: %[[CAST:.*]] = fir.convert %[[S]] : (!fir.ref>) -> !fir.ref> ! CHECK: fir.call @_QFPprint_scalar(%[[CAST]]) {{.*}}: (!fir.ref>) -> () @@ -207,7 +207,7 @@ contains ! 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 d4e6343..4fc4e2c 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> + ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCsome_common) : !fir.ref> ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref>, index) -> !fir.ref diff --git a/flang/test/Lower/pointer-initial-target-2.f90 b/flang/test/Lower/pointer-initial-target-2.f90 index 102f8e8..2889d58 100644 --- a/flang/test/Lower/pointer-initial-target-2.f90 +++ b/flang/test/Lower/pointer-initial-target-2.f90 @@ -11,7 +11,7 @@ block data real, save, target :: b common /a/ p data p /b/ -! CHECK-LABEL: fir.global @_QBa : tuple>> +! CHECK-LABEL: fir.global @_QCa : tuple>> ! CHECK: %[[undef:.*]] = fir.undefined tuple>> ! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref ! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref) -> !fir.box @@ -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, !fir.box>> - ! CHECK: fir.address_of(@_QBc2) : !fir.ref, !fir.box>>> -! CHECK-LABEL: fir.global @_QBc2 : tuple, !fir.box>> - ! CHECK: fir.address_of(@_QBc1) : !fir.ref, !fir.box>>> +! CHECK-LABEL: fir.global @_QCc1 : tuple, !fir.box>> + ! CHECK: fir.address_of(@_QCc2) : !fir.ref, !fir.box>>> +! CHECK-LABEL: fir.global @_QCc2 : tuple, !fir.box>> + ! CHECK: fir.address_of(@_QCc1) : !fir.ref, !fir.box>>> 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>, i32> +! CHECK-LABEL: fir.global @_QCsnake : tuple>, i32> ! CHECK: %[[tuple0:.*]] = fir.undefined tuple>, i32> - ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref>, i32>> + ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QCsnake) : !fir.ref>, i32>> ! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref>, i32>>) -> !fir.ref> ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref>, index) -> !fir.ref ! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref) -> !fir.ref @@ -72,7 +72,7 @@ module some_mod_2 save :: /com/ real, pointer :: p(:) => y ! CHECK-LABEL: fir.global @_QMsome_mod_2Ep : !fir.box>> { - ! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref> + ! CHECK: %[[c:.*]] = fir.address_of(@_QCcom) : !fir.ref> ! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref>) -> !fir.ref> ! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref>, index) -> !fir.ref ! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref) -> !fir.ref> diff --git a/flang/test/Lower/program-units-fir-mangling.f90 b/flang/test/Lower/program-units-fir-mangling.f90 index 348849f..36631979 100644 --- a/flang/test/Lower/program-units-fir-mangling.f90 +++ b/flang/test/Lower/program-units-fir-mangling.f90 @@ -92,34 +92,32 @@ module color_points 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 @@ module testMod3 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 + 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 + 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 5db675a..d7f6a51 100644 --- a/flang/test/Lower/select-case-statement.f90 +++ b/flang/test/Lower/select-case-statement.f90 @@ -176,9 +176,6 @@ ! CHECK: %[[V_20:[0-9]+]] = fir.box_addr %[[V_18]] : (!fir.box>>) -> !fir.heap> ! 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> - ! CHECK: } ! CHECK: cond_br %[[V_43]], ^bb3, ^bb2 ! CHECK: ^bb2: // pred: ^bb1 select case(trim(s)) @@ -190,9 +187,6 @@ ! 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> - ! CHECK: } ! CHECK: cond_br %[[V_49]], ^bb6, ^bb5 ! CHECK: ^bb3: // pred: ^bb1 ! CHECK: fir.store %c1{{.*}} to %[[V_1]] : !fir.ref @@ -203,9 +197,6 @@ ! 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> - ! CHECK: } ! CHECK: cond_br %[[V_55]], ^bb8, ^bb7 ! CHECK: ^bb6: // pred: ^bb2 ! CHECK: fir.store %c2{{.*}} to %[[V_1]] : !fir.ref @@ -223,9 +214,6 @@ ! 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> - ! 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 @@ ! 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> - ! 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> ! 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 ! CHECK: ^bb15: // 5 preds: ^bb3, ^bb4, ^bb6, ^bb8, ^bb14 + ! CHECK: fir.freemem %[[V_20]] : !fir.heap> end select end if ! CHECK: %[[V_89:[0-9]+]] = fir.load %[[V_1]] : !fir.ref @@ -257,28 +242,28 @@ ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box>> ! CHECK: %[[V_1:[0-9]+]] = fir.alloca !fir.box>> character(len=3) :: s - n = 0 + n = -10 ! CHECK: %[[V_12:[0-9]+]] = fir.load %[[V_1]] : !fir.ref>>> ! CHECK: %[[V_13:[0-9]+]] = fir.box_addr %[[V_12]] : (!fir.box>>) -> !fir.heap> - ! CHECK: fir.freemem %[[V_13]] : !fir.heap> ! 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> 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>>> ! CHECK: %[[V_29:[0-9]+]] = fir.box_addr %[[V_28]] : (!fir.box>>) -> !fir.heap> - ! CHECK: fir.freemem %[[V_29]] : !fir.heap> ! CHECK: br ^bb3 ! CHECK: ^bb3: // pred: ^bb2 - n = -2 + ! CHECK: fir.freemem %[[V_29]] : !fir.heap> select case(trim(s)) end select print*, n diff --git a/flang/unittests/Optimizer/InternalNamesTest.cpp b/flang/unittests/Optimizer/InternalNamesTest.cpp index ecfefaa..28e49fc 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 modules, - std::optional host, llvm::StringRef name, - llvm::ArrayRef kinds) - : modules{modules.begin(), modules.end()}, host{host}, name{name}, - kinds{kinds.begin(), kinds.end()} {} + llvm::ArrayRef procs, std::int64_t blockId, + llvm::StringRef name, llvm::ArrayRef 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 modules; - std::optional host; + llvm::SmallVector procs; + std::int64_t blockId; std::string name; llvm::SmallVector 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)); } -- 2.7.4