[flang] Block construct

[vdonaldson]

Summary

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.

[PeteSteinfeld]

Aside from a couple of clang-format diffs, all builds and tests correctly and looks good.

flang/lib/Lower/Bridge.cpp

772

I'm seeing a clang-format diff here.

flang/lib/Lower/Mangler.cpp

96–98

I'm seeing more clang-format diffs here.

[vdonaldson]

clang-format

[vdonaldson]

Done; thanks

[jeanPerier]

It's great to have a generic solution to deal with the clean-ups of construct entities when branching out of them, thanks Val.

[clementval]

LGTM. Great work!

[vdonaldson]

https://reviews.llvm.org/D144916

flang/docs/BijectiveInternalNameUniquing.md

+<!--===- docs/Aliasing.md
+
+   Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+   See https://llvm.org/LICENSE.txt for license information.
+   SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+-->
+
 # Bijective Internal Name Uniquing
 
 ```eval_rst
 .. contents::
    :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.
-
-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.
+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.
+
+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:
 ```
     submodule (mod:s1mod) s2mod
       ...
       subroutine sub
         ...
       contains
         function fun
 ```
 
 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:
 ```
    common i, j
 ```
 
 The uniqued name in case of `blank common block` becomes:
 ```
-    _QB
+    _QC
 ```
 
 ## Module scope global data
 
    * A global data entity is prefixed with `E`
    * A global entity that is constant (parameter) will be prefixed with `EC`
 
 Given:
```
     _QMmodEintvar
 ```
 
 The uniqued name of `pi` becomes:
 ```
     _QMmodECpi
 ```
 
-## Procedures/Subprograms
+## Procedures
+
+   * A procedure/subprogram as itself is prefixed with `P`
+   * A procedure/subprogram as an ancestor name is prefixed with `F`
 
-   * A procedure/subprogram is prefixed with `P`
+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
      canonical order where each takes the form `Ki` and where _i_ is the
      compile-time constant value. (All type parameters are integer.)  If _i_
      is a negative value, the prefix `KN` will be used and _i_ will reflect
      the magnitude of the value.
 
```
     end type
 ```
 
 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.

flang/include/flang/Lower/AbstractConverter.h

 #include "mlir/IR/Operation.h"
 #include "llvm/ADT/ArrayRef.h"
 
 namespace fir {
 class KindMapping;
 class FirOpBuilder;
 } // namespace fir
 
-namespace fir {
-class KindMapping;
-class FirOpBuilder;
-} // namespace fir
-
 namespace Fortran {
 namespace common {
 template <typename>
 class Reference;
 }
 
 namespace evaluate {
 struct DataRef;
public:
   /// Get the OpBuilder
   virtual fir::FirOpBuilder &getFirOpBuilder() = 0;
   /// Get the ModuleOp
   virtual mlir::ModuleOp &getModuleOp() = 0;
   /// Get the MLIRContext
   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;
 
   virtual Fortran::lower::StatementContext &getFctCtx() = 0;
 
   AbstractConverter(const Fortran::lower::LoweringOptions &loweringOptions)
       : loweringOptions(loweringOptions) {}
   virtual ~AbstractConverter() = default;

flang/include/flang/Lower/IterationSpace.h

public:
 
   StatementContext &stmtContext() { return stmtCtx; }
 
 protected:
   void shrinkStack() {
     assert(!empty());
     stack.pop_back();
     if (empty()) {
-      stmtCtx.finalize();
+      stmtCtx.finalizeAndReset();
       vmap.clear();
     }
   }
 
   // The stack for the construct information.
   llvm::SmallVector<A> stack;
 
   // Map each mask expression back to the temporary holding the initial
public:
   // LLVM standard dump method.
   LLVM_DUMP_METHOD void dump() const;
 
   // Pretty-print.
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
                                        const ExplicitIterSpace &);
 
   /// Finalize the current body statement context.
-  void finalizeContext() { stmtCtx.finalize(); }
+  void finalizeContext() { stmtCtx.finalizeAndReset(); }
 
   void appendLoops(const llvm::SmallVector<fir::DoLoopOp> &loops) {
     loopStack.push_back(loops);
   }
 
   void clearLoops() { loopStack.clear(); }
 
   llvm::SmallVector<llvm::SmallVector<fir::DoLoopOp>> getLoopStack() const {

flang/include/flang/Lower/Mangler.h

 
 namespace Fortran {
 namespace common {
 template <typename>
 class Reference;
 }
 
 namespace semantics {
+class Scope;
 class Symbol;
 class DerivedTypeSpec;
 } // namespace semantics
 
 namespace lower::mangle {
 
-/// Convert a front-end Symbol to an internal name.
-/// If \p keepExternalInScope is true, the mangling of external symbols
-/// retains the scope of the symbol declaring externals. Otherwise,
-/// external symbols are mangled outside of any scope. Keeping the scope is
-/// useful in attributes where all the Fortran context is to be maintained.
+using ScopeBlockIdMap =
+    llvm::DenseMap<Fortran::semantics::Scope *, std::int64_t>;
+
+/// Convert a front-end symbol to a unique internal name.
+/// A symbol that could be in a block scope must provide a ScopeBlockIdMap.
+/// If \p keepExternalInScope is true, mangling an external symbol retains
+/// the scope of the symbol. This is useful when setting the attributes of
+/// a symbol where all the Fortran context is needed. Otherwise, external
+/// symbols are mangled outside of any scope.
+std::string mangleName(const semantics::Symbol &, ScopeBlockIdMap &,
+                       bool keepExternalInScope = false);
 std::string mangleName(const semantics::Symbol &,
                        bool keepExternalInScope = false);
 
 /// Convert a derived type instance to an internal name.
-std::string mangleName(const semantics::DerivedTypeSpec &);
+std::string mangleName(const semantics::DerivedTypeSpec &, ScopeBlockIdMap &);
 
 /// Recover the bare name of the original symbol from an internal name.
 std::string demangleName(llvm::StringRef name);
 
 std::string
 mangleArrayLiteral(const uint8_t *addr, size_t size,
                    const Fortran::evaluate::ConstantSubscripts &shape,
                    Fortran::common::TypeCategory cat, int kind = 0,

flang/include/flang/Lower/PFTBuilder.h

 using EvaluationTuple =
     common::CombineTuples<ActionStmts, OtherStmts, ConstructStmts, EndStmts,
                           Constructs, Directives>;
 /// Hide non-nullable pointers to the parse-tree node.
 /// Build type std::variant<const A* const, const B* const, ...>
 /// from EvaluationTuple type (std::tuple<A, B, ...>).
 using EvaluationVariant = MakeReferenceVariant<EvaluationTuple>;
 
-/// Function-like units contain lists of evaluations.  These can be simple
+/// Function-like units contain lists of evaluations. These can be simple
 /// statements or constructs, where a construct contains its own evaluations.
 struct Evaluation : EvaluationVariant {
 
   /// General ctor
   template <typename A>
   Evaluation(const A &a, const PftNode &parent,
              const parser::CharBlock &position,
              const std::optional<parser::Label> &label)
Evaluation &getLastNestedEvaluation() {
     return evaluationList->back();
   }
 
   /// Return the FunctionLikeUnit containing this evaluation (or nullptr).
   FunctionLikeUnit *getOwningProcedure() const;
 
   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;
   parser::CharBlock position{};
   std::optional<parser::Label> label{};
   std::unique_ptr<EvaluationList> evaluationList; // nested evaluations
   Evaluation *parentConstruct{nullptr};  // set for nodes below the top level
   Evaluation *lexicalSuccessor{nullptr}; // set for leaf nodes, some directives
   Evaluation *controlSuccessor{nullptr}; // set for some leaf nodes
   Evaluation *constructExit{nullptr};    // set for constructs
   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
 };
 
 using ProgramVariant =
     ReferenceVariant<parser::MainProgram, parser::FunctionSubprogram,
                      parser::SubroutineSubprogram, parser::Module,
                      parser::Submodule, parser::SeparateModuleSubprogram,
struct FunctionLikeUnit : public ProgramUnit {
   /// Anonymous programs do not have a begin statement.
   std::optional<FunctionStatement> beginStmt;
   FunctionStatement endStmt;
   const semantics::Scope *scope;
   EvaluationList evaluationList;
   LabelEvalMap labelEvaluationMap;
   SymbolLabelMap assignSymbolLabelMap;
   std::list<FunctionLikeUnit> nestedFunctions;
-  /// <Symbol, Evaluation> pairs for each entry point.  The pair at index 0
+  /// <Symbol, Evaluation> pairs for each entry point. The pair at index 0
   /// is the primary entry point; remaining pairs are alternate entry points.
   /// The primary entry point symbol is Null for an anonymous program.
-  /// A named program symbol has MainProgramDetails.  Other symbols have
-  /// SubprogramDetails.  Evaluations are filled in for alternate entries.
+  /// A named program symbol has MainProgramDetails. Other symbols have
+  /// SubprogramDetails. Evaluations are filled in for alternate entries.
   llvm::SmallVector<std::pair<const semantics::Symbol *, Evaluation *>, 1>
       entryPointList{std::pair{nullptr, nullptr}};
-  /// Current index into entryPointList.  Index 0 is the primary entry point.
+  /// Current index into entryPointList. Index 0 is the primary entry point.
   int activeEntry = 0;
-  /// Primary result for function subprograms with alternate entries.  This
+  /// Primary result for function subprograms with alternate entries. This
   /// is one of the largest result values, not necessarily the first one.
   const semantics::Symbol *primaryResult{nullptr};
   /// Terminal basic block (if any)
   mlir::Block *finalBlock{};
   HostAssociations hostAssociations;
 };
 
 /// Module-like units contain a list of function-like units.

 
 } // namespace Fortran::lower::pft
 
 namespace Fortran::lower {
 /// Create a PFT (Pre-FIR Tree) from the parse tree.
 ///
 /// A PFT is a light weight tree over the parse tree that is used to create FIR.
 /// The PFT captures pointers back into the parse tree, so the parse tree must
-/// not be changed between the construction of the PFT and its last use.  The
-/// PFT captures a structured view of a program.  A program is a list of units.
-/// A function like unit contains a list of evaluations.  An evaluation is
+/// not be changed between the construction of the PFT and its last use. The
+/// PFT captures a structured view of a program. A program is a list of units.
+/// A function like unit contains a list of evaluations. An evaluation is
 /// either a statement, or a construct with a nested list of evaluations.
 std::unique_ptr<pft::Program>
 createPFT(const parser::Program &root,
           const Fortran::semantics::SemanticsContext &semanticsContext);
 
 /// Dumper for displaying a PFT.
 void dumpPFT(llvm::raw_ostream &outputStream, const pft::Program &pft);
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_PFTBUILDER_H

flang/include/flang/Lower/StatementContext.h

 #include "llvm/ADT/STLExtras.h"
 #include "llvm/ADT/SmallVector.h"
 #include <functional>
 #include <optional>
 
 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) {
     if (cleanupProhibited)
       return;
     cufs.push_back({});
   }
 
if (cufs.back()) {
         cuf();
         oldCleanup();
       };
     } else {
       cufs.back() = cuf;
     }
   }
 
-  /// 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:
   // A statement context should never be copied or moved.
   StatementContext(const StatementContext &) = delete;
   StatementContext &operator=(const StatementContext &) = delete;
   StatementContext(StatementContext &&) = delete;
 
   // Stack of cleanup function "lists" (nested cleanup function calls).
   llvm::SmallVector<std::optional<CleanupFunction>> cufs;
 };
 
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_STATEMENTCONTEXT_H

flang/include/flang/Optimizer/Support/InternalNames.h

enum class NameKind {
     NOT_UNIQUED,
     BLOCK_DATA_NAME,
     COMMON,
     CONSTANT,
     DERIVED_TYPE,
     DISPATCH_TABLE,
     GENERATED,
     INTRINSIC_TYPE_DESC,
+    NAMELIST_GROUP,
     PROCEDURE,
     TYPE_DESC,
-    VARIABLE,
-    NAMELIST_GROUP
+    VARIABLE
   };
 
   /// Components of an unparsed unique name
   struct DeconstructedName {
     DeconstructedName(llvm::StringRef name) : name{name} {}
     DeconstructedName(llvm::ArrayRef<std::string> modules,
-                      std::optional<std::string> host, llvm::StringRef name,
-                      llvm::ArrayRef<std::int64_t> kinds)
-        : modules{modules.begin(), modules.end()}, host{host}, name{name},
-          kinds{kinds.begin(), kinds.end()} {}
+                      llvm::ArrayRef<std::string> procs, std::int64_t blockId,
+                      llvm::StringRef name, llvm::ArrayRef<std::int64_t> kinds)
+        : modules{modules.begin(), modules.end()}, procs{procs.begin(),
+                                                         procs.end()},
+          blockId{blockId}, name{name}, kinds{kinds.begin(), kinds.end()} {}
 
     llvm::SmallVector<std::string> modules;
-    std::optional<std::string> host;
+    llvm::SmallVector<std::string> procs;
+    std::int64_t blockId;
     std::string name;
     llvm::SmallVector<std::int64_t> kinds;
   };
 
   /// Unique a common block name
   static std::string doCommonBlock(llvm::StringRef name);
 
-  /// Unique a block data unit name
-  static std::string doBlockData(llvm::StringRef name);
-
   /// Unique a (global) constant name
   static std::string doConstant(llvm::ArrayRef<llvm::StringRef> modules,
-                                std::optional<llvm::StringRef> host,
-                                llvm::StringRef name);
+                                llvm::ArrayRef<llvm::StringRef> procs,
+                                std::int64_t block, llvm::StringRef name);
 
   /// Unique a dispatch table name
   static std::string doDispatchTable(llvm::ArrayRef<llvm::StringRef> modules,
-                                     std::optional<llvm::StringRef> host,
-                                     llvm::StringRef name,
+                                     llvm::ArrayRef<llvm::StringRef> procs,
+                                     std::int64_t block, llvm::StringRef name,
                                      llvm::ArrayRef<std::int64_t> kinds);
 
   /// Unique a compiler generated name
   static std::string doGenerated(llvm::StringRef name);
 
   /// Unique an intrinsic type descriptor
   static std::string
   doIntrinsicTypeDescriptor(llvm::ArrayRef<llvm::StringRef> modules,
-                            std::optional<llvm::StringRef> host,
-                            IntrinsicType type, std::int64_t kind);
+                            llvm::ArrayRef<llvm::StringRef> procs,
+                            std::int64_t block, IntrinsicType type,
+                            std::int64_t kind);
 
   /// Unique a procedure name
   static std::string doProcedure(llvm::ArrayRef<llvm::StringRef> modules,
-                                 std::optional<llvm::StringRef> host,
+                                 llvm::ArrayRef<llvm::StringRef> procs,
                                  llvm::StringRef name);
 
   /// Unique a derived type name
   static std::string doType(llvm::ArrayRef<llvm::StringRef> modules,
-                            std::optional<llvm::StringRef> host,
-                            llvm::StringRef name,
+                            llvm::ArrayRef<llvm::StringRef> procs,
+                            std::int64_t block, llvm::StringRef name,
                             llvm::ArrayRef<std::int64_t> kinds);
 
   /// Unique a (derived) type descriptor name
   static std::string doTypeDescriptor(llvm::ArrayRef<llvm::StringRef> modules,
-                                      std::optional<llvm::StringRef> host,
-                                      llvm::StringRef name,
+                                      llvm::ArrayRef<llvm::StringRef> procs,
+                                      std::int64_t block, llvm::StringRef name,
                                       llvm::ArrayRef<std::int64_t> kinds);
   static std::string doTypeDescriptor(llvm::ArrayRef<std::string> modules,
-                                      std::optional<std::string> host,
-                                      llvm::StringRef name,
+                                      llvm::ArrayRef<std::string> procs,
+                                      std::int64_t block, llvm::StringRef name,
                                       llvm::ArrayRef<std::int64_t> kinds);
 
   /// Unique a (global) variable name. A variable with save attribute
   /// defined inside a subprogram also needs to be handled here
   static std::string doVariable(llvm::ArrayRef<llvm::StringRef> modules,
-                                std::optional<llvm::StringRef> host,
-                                llvm::StringRef name);
+                                llvm::ArrayRef<llvm::StringRef> procs,
+                                std::int64_t block, llvm::StringRef name);
 
   /// Unique a namelist group name
   static std::string doNamelistGroup(llvm::ArrayRef<llvm::StringRef> modules,
-                                     std::optional<llvm::StringRef> host,
+                                     llvm::ArrayRef<llvm::StringRef> procs,
                                      llvm::StringRef name);
 
   /// Entry point for the PROGRAM (called by the runtime)
   /// Can be overridden with the `--main-entry-name=<name>` option.
   static llvm::StringRef doProgramEntry();
 
   /// Decompose `uniquedName` into the parse name, symbol type, and scope info
   static std::pair<NameKind, DeconstructedName>

flang/lib/Lower/Bridge.cpp

struct IncrementLoopInfo {
   bool hasRealControl = false;
   mlir::Value tripVariable = nullptr;
   mlir::Block *headerBlock = nullptr; // loop entry and test block
   mlir::Block *maskBlock = nullptr;   // concurrent loop mask block
   mlir::Block *bodyBlock = nullptr;   // first loop body block
   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
 /// derived type lowered in the current translated unit. However, this data
 /// cannot be generated before FuncOp have been created for functions since the
 /// initializers may take their address (e.g for type bound procedures). This
 /// class allows registering all the required runtime type info while it is not
 /// possible to create globals, and to generate this data after function

 
 class DispatchTableConverter {
   struct DispatchTableInfo {
     const Fortran::semantics::DerivedTypeSpec *typeSpec;
     mlir::Location loc;
   };
 
 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);
     registeredDispatchTableInfo.emplace_back(DispatchTableInfo{typeSpec, loc});
   }
 
   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)
         scope = info.typeSpec->typeSymbol().scope();
       Fortran::semantics::SymbolVector bindings =
           Fortran::semantics::CollectBindings(*scope);
 
       if (!bindings.empty())
         builder.createBlock(&dt.getRegion());
 
       for (const Fortran::semantics::SymbolRef &binding : bindings) {
         const auto *details =
             binding.get().detailsIf<Fortran::semantics::ProcBindingDetails>();
-        std::string bindingName =
-            Fortran::lower::mangle::mangleName(details->symbol());
+        std::string bindingName = converter.mangleName(details->symbol());
         builder.create<fir::DTEntryOp>(
             info.loc,
             mlir::StringAttr::get(builder.getContext(),
                                   binding.get().name().ToString()),
             mlir::SymbolRefAttr::get(builder.getContext(), bindingName));
       }
       if (!bindings.empty())
         builder.create<fir::FirEndOp>(info.loc);
void copyHostAssociateVar(
     }
 
     mlir::Location loc = genLocation(sym.name());
     mlir::Type symType = genType(sym);
     if (auto seqTy = symType.dyn_cast<fir::SequenceType>()) {
       Fortran::lower::StatementContext stmtCtx;
       Fortran::lower::createSomeArrayAssignment(*this, lhs, rhs, localSymbols,
                                                 stmtCtx);
-      stmtCtx.finalize();
+      stmtCtx.finalizeAndReset();
     } else if (hexv.getBoxOf<fir::CharBoxValue>()) {
       fir::factory::CharacterExprHelper{*builder, loc}.createAssign(lhs, rhs);
     } else if (hexv.getBoxOf<fir::MutableBoxValue>()) {
       TODO(loc, "firstprivatisation of allocatable variables");
     } else {
       auto loadVal = builder->create<fir::LoadOp>(loc, fir::getBase(rhs));
       builder->create<fir::StoreOp>(loc, loadVal, fir::getBase(lhs));
     }
public:
 
   mlir::ModuleOp &getModuleOp() override final { return bridge.getModule(); }
 
   mlir::MLIRContext &getMLIRContext() override final {
     return bridge.getMLIRContext();
   }
   std::string
   mangleName(const Fortran::semantics::Symbol &symbol) override final {
-    return Fortran::lower::mangle::mangleName(symbol);
+    return Fortran::lower::mangle::mangleName(symbol, scopeBlockIdMap);
+  }
+  std::string mangleName(
+      const Fortran::semantics::DerivedTypeSpec &derivedType) override final {
+    return Fortran::lower::mangle::mangleName(derivedType, scopeBlockIdMap);
   }
 
   const fir::KindMapping &getKindMap() override final {
     return bridge.getKindMap();
   }
 
+  /// Return the current function context, which may be a nested BLOCK context
+  /// or a full subprogram context.
   Fortran::lower::StatementContext &getFctCtx() override final {
+    if (!activeConstructStack.empty() &&
+        activeConstructStack.back().eval.isA<Fortran::parser::BlockConstruct>())
+      return activeConstructStack.back().stmtCtx;
     return bridge.fctCtx();
   }
 
   mlir::Value hostAssocTupleValue() override final { return hostAssocTuple; }
 
   /// Record a binding for the ssa-value of the tuple for this function.
   void bindHostAssocTuple(mlir::Value val) override final {
     assert(!hostAssocTuple && val);
     hostAssocTuple = val;
   }
 
   void registerRuntimeTypeInfo(
       mlir::Location loc,
       Fortran::lower::SymbolRef typeInfoSym) override final {
     runtimeTypeInfoConverter.registerTypeInfoSymbol(*this, loc, typeInfoSym);
   }
 
   void registerDispatchTableInfo(
       mlir::Location loc,
       const Fortran::semantics::DerivedTypeSpec *typeSpec) override final {
-    dispatchTableConverter.registerTypeSpec(loc, typeSpec);
+    dispatchTableConverter.registerTypeSpec(*this, loc, typeSpec);
   }
 
 private:
   FirConverter() = delete;
   FirConverter(const FirConverter &) = delete;
   FirConverter &operator=(const FirConverter &) = delete;
 
   //===--------------------------------------------------------------------===//
private:
   }
   static bool isCharacterCategory(Fortran::common::TypeCategory cat) {
     return cat == Fortran::common::TypeCategory::Character;
   }
   static bool isDerivedCategory(Fortran::common::TypeCategory cat) {
     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);
     builder->restoreInsertionPoint(insertPt);
     return newBlock;
   }
 
-  mlir::Block *blockOfLabel(Fortran::lower::pft::Evaluation &eval,
-                            Fortran::parser::Label label) {
+  Fortran::lower::pft::Evaluation &evalOfLabel(Fortran::parser::Label label) {
     const Fortran::lower::pft::LabelEvalMap &labelEvaluationMap =
-        eval.getOwningProcedure()->labelEvaluationMap;
+        getEval().getOwningProcedure()->labelEvaluationMap;
     const auto iter = labelEvaluationMap.find(label);
     assert(iter != labelEvaluationMap.end() && "label missing from map");
-    mlir::Block *block = iter->second->block;
-    assert(block && "missing labeled evaluation block");
-    return block;
+    return *iter->second;
   }
 
-  void genFIRBranch(mlir::Block *targetBlock) {
+  void genBranch(mlir::Block *targetBlock) {
     assert(targetBlock && "missing unconditional target block");
     builder->create<mlir::cf::BranchOp>(toLocation(), targetBlock);
   }
 
-  void genFIRConditionalBranch(mlir::Value cond, mlir::Block *trueTarget,
-                               mlir::Block *falseTarget) {
+  void genConditionalBranch(mlir::Value cond, mlir::Block *trueTarget,
     assert(trueTarget && "missing conditional branch true block");
     assert(falseTarget && "missing conditional branch false block");
     mlir::Location loc = toLocation();
     mlir::Value bcc = builder->createConvert(loc, builder->getI1Type(), cond);
     builder->create<mlir::cf::CondBranchOp>(loc, bcc, trueTarget, std::nullopt,
                                             falseTarget, std::nullopt);
   }
-  void genFIRConditionalBranch(mlir::Value cond,
-                               Fortran::lower::pft::Evaluation *trueTarget,
-                               Fortran::lower::pft::Evaluation *falseTarget) {
-    genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block);
+  void genConditionalBranch(mlir::Value cond,
+    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::StatementContext stmtCtx;
     mlir::Value cond =
         createFIRExpr(toLocation(), Fortran::semantics::GetExpr(expr), stmtCtx);
-    stmtCtx.finalize();
-    genFIRConditionalBranch(cond, trueTarget->block, falseTarget->block);
+    stmtCtx.finalizeAndReset();
+    genConditionalBranch(cond, trueTarget->block, falseTarget->block);
+  }
+
+  /// Return the nearest active ancestor construct of \p eval, or nullptr.
+  Fortran::lower::pft::Evaluation *
+  getActiveAncestor(const Fortran::lower::pft::Evaluation &eval) {
+    Fortran::lower::pft::Evaluation *ancestor = eval.parentConstruct;
+    for (; ancestor; ancestor = ancestor->parentConstruct)
+      if (ancestor->activeConstruct)
+        break;
+    return ancestor;
+  }
+
+  /// Return the predicate: "a branch to \p targetEval has exit code".
+  bool hasExitCode(const Fortran::lower::pft::Evaluation &targetEval) {
+    Fortran::lower::pft::Evaluation *activeAncestor =
+        getActiveAncestor(targetEval);
+    for (auto it = activeConstructStack.rbegin(),
+              rend = activeConstructStack.rend();
+         it != rend; ++it) {
+      if (&it->eval == activeAncestor)
+        break;
+      if (it->stmtCtx.hasCode())
+        return true;
+    }
+    return false;
+  }
+
+  /// Generate a branch to \p targetEval after generating on-exit code for
+  /// any enclosing construct scopes that are exited by taking the branch.
+  void
+  genConstructExitBranch(const Fortran::lower::pft::Evaluation &targetEval) {
+    Fortran::lower::pft::Evaluation *activeAncestor =
+        getActiveAncestor(targetEval);
+    for (auto it = activeConstructStack.rbegin(),
+              rend = activeConstructStack.rend();
+         it != rend; ++it) {
+      if (&it->eval == activeAncestor)
+        break;
+      it->stmtCtx.finalizeAndKeep();
+    }
+    genBranch(targetEval.block);
+  }
+
+  /// Generate a SelectOp or branch sequence that compares \p selector against
+  /// values in \p valueList and targets corresponding labels in \p labelList.
+  /// If no value matches the selector, branch to \p defaultEval.
+  ///
+  /// There are two special cases. If \p inIoErrContext, the ERR label branch
+  /// is an inverted comparison (ne vs. eq 0). An empty \p valueList indicates
+  /// an ArithmeticIfStmt context that requires two comparisons against 0,
+  /// and the selector may have either INTEGER or REAL type.
+  ///
+  /// If this is not an ArithmeticIfStmt and no targets have exit code,
+  /// generate a SelectOp. Otherwise, for each target, if it has exit code,
+  /// branch to a new block, insert exit code, and then branch to the target.
+  /// Otherwise, branch directly to the target.
+  void genMultiwayBranch(mlir::Value selector,
+                         llvm::SmallVector<int64_t> valueList,
+                         llvm::SmallVector<Fortran::parser::Label> labelList,
+                         const Fortran::lower::pft::Evaluation &defaultEval,
+                         bool inIoErrContext = false) {
+    bool inArithmeticIfContext = valueList.empty();
+    assert(((inArithmeticIfContext && labelList.size() == 2) ||
+            (valueList.size() && labelList.size() == valueList.size())) &&
+           "mismatched multiway branch targets");
+    bool defaultHasExitCode = hasExitCode(defaultEval);
+    bool hasAnyExitCode = defaultHasExitCode;
+    if (!hasAnyExitCode)
+      for (auto label : labelList)
+        if (hasExitCode(evalOfLabel(label))) {
+          hasAnyExitCode = true;
+          break;
+        }
+    mlir::Location loc = toLocation();
+    size_t branchCount = labelList.size();
+    if (!inArithmeticIfContext && !hasAnyExitCode &&
+        !getEval().forceAsUnstructured()) { // from -no-structured-fir option
+      // Generate a SelectOp.
+      llvm::SmallVector<mlir::Block *> blockList;
+      for (auto label : labelList)
+        blockList.push_back(evalOfLabel(label).block);
+      blockList.push_back(defaultEval.block);
+      if (inIoErrContext) { // Swap ERR and default fallthrough blocks.
+        assert(!valueList[branchCount - 1] && "invalid IO ERR value");
+        std::swap(blockList[branchCount - 1], blockList[branchCount]);
+      }
+      builder->create<fir::SelectOp>(loc, selector, valueList, blockList);
+      return;
+    }
+    mlir::Type selectorType = selector.getType();
+    bool realSelector = selectorType.isa<mlir::FloatType>();
+    assert((inArithmeticIfContext || !realSelector) && "invalid selector type");
+    mlir::Value zero;
+    if (inArithmeticIfContext)
+      zero =
+          realSelector
+              ? builder->create<mlir::arith::ConstantOp>(
+                    loc, selectorType, builder->getFloatAttr(selectorType, 0.0))
+              : builder->createIntegerConstant(loc, selectorType, 0);
+    for (auto label : llvm::enumerate(labelList)) {
+      mlir::Value cond;
+      if (realSelector) // inArithmeticIfContext
+        cond = builder->create<mlir::arith::CmpFOp>(
+            loc,
+            label.index() == 0 ? mlir::arith::CmpFPredicate::OLT
+                               : mlir::arith::CmpFPredicate::OGT,
+            selector, zero);
+      else if (inArithmeticIfContext)
+        cond = builder->create<mlir::arith::CmpIOp>(
+            loc,
+            label.index() == 0 ? mlir::arith::CmpIPredicate::slt
+                               : mlir::arith::CmpIPredicate::sgt,
+            selector, zero);
+      else
+        cond = builder->create<mlir::arith::CmpIOp>(
+            loc,
+            inIoErrContext && valueList[label.index()] == 0
+                ? mlir::arith::CmpIPredicate::ne
+                : mlir::arith::CmpIPredicate::eq,
+            selector,
+            builder->createIntegerConstant(loc, selectorType,
+                                           valueList[label.index()]));
+      // Branch to a new block with exit code and then to the target, or branch
+      // directly to the target. defaultEval acts as an "else" target.
+      bool lastBranch = label.index() == branchCount - 1;
+      mlir::Block *nextBlock =
+          lastBranch && !defaultHasExitCode
+              ? defaultEval.block
+              : builder->getBlock()->splitBlock(builder->getInsertionPoint());
+      if (hasExitCode(evalOfLabel(label.value()))) {
+        mlir::Block *jumpBlock =
+            builder->getBlock()->splitBlock(builder->getInsertionPoint());
+        genConditionalBranch(cond, jumpBlock, nextBlock);
+        startBlock(jumpBlock);
+        genConstructExitBranch(evalOfLabel(label.value()));
+      } else {
+        genConditionalBranch(cond, evalOfLabel(label.value()).block, nextBlock);
+      }
+      if (!lastBranch) {
+        startBlock(nextBlock);
+      } else if (defaultHasExitCode) {
+        startBlock(nextBlock);
+        genConstructExitBranch(defaultEval);
+      }
+    }
+  }
+
+  void pushActiveConstruct(Fortran::lower::pft::Evaluation &eval,
+                           Fortran::lower::StatementContext &stmtCtx) {
+    activeConstructStack.push_back(ConstructContext{eval, stmtCtx});
+    eval.activeConstruct = true;
+  }
+  void popActiveConstruct() {
+    assert(!activeConstructStack.empty() && "invalid active construct stack");
+    activeConstructStack.back().eval.activeConstruct = false;
+    activeConstructStack.pop_back();
   }
 
   //===--------------------------------------------------------------------===//
   // Termination of symbolically referenced execution units
   //===--------------------------------------------------------------------===//
 
   /// END of program
   ///
mlir::Value resultVal = resultSymBox.match(
               .createEmboxChar(x.getBuffer(), x.getLen());
         },
         [&](const auto &) -> mlir::Value {
           mlir::Value resultRef = resultSymBox.getAddr();
           mlir::Type resultType = genType(resultSym);
           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<fir::LoadOp>(loc, resultRef);
         });
     bridge.fctCtx().finalizeAndPop();
     builder->create<mlir::func::ReturnOp>(loc, resultVal);
   }
 
private:
   mlir::Value genIfCondition(const A *stmt, bool negate = false) {
     mlir::Location loc = toLocation();
     Fortran::lower::StatementContext stmtCtx;
     mlir::Value condExpr = createFIRExpr(
         loc,
         Fortran::semantics::GetExpr(
             std::get<Fortran::parser::ScalarLogicalExpr>(stmt->t)),
         stmtCtx);
-    stmtCtx.finalize();
+    stmtCtx.finalizeAndReset();
     mlir::Value cond =
         builder->createConvert(loc, builder->getI1Type(), condExpr);
     if (negate)
       cond = builder->create<mlir::arith::XOrIOp>(
           loc, cond, builder->createIntegerConstant(loc, cond.getType(), 1));
     return cond;
   }
 
if (lowerToHighLevelFIR()) {
       if (hlfirRes)
         res = *hlfirRes;
     } else {
       // Call statement lowering shares code with function call lowering.
       res = Fortran::lower::createSubroutineCall(
           *this, *stmt.typedCall, explicitIterSpace, implicitIterSpace,
           localSymbols, stmtCtx, /*isUserDefAssignment=*/false);
     }
+    stmtCtx.finalizeAndReset();
     if (!res)
       return; // "Normal" subroutine call.
     // Call with alternate return specifiers.
     // The call returns an index that selects an alternate return branch target.
     llvm::SmallVector<int64_t> indexList;
-    llvm::SmallVector<mlir::Block *> blockList;
+    llvm::SmallVector<Fortran::parser::Label> labelList;
     int64_t index = 0;
     for (const Fortran::parser::ActualArgSpec &arg :
          std::get<std::list<Fortran::parser::ActualArgSpec>>(stmt.v.t)) {
       const auto &actual = std::get<Fortran::parser::ActualArg>(arg.t);
       if (const auto *altReturn =
               std::get_if<Fortran::parser::AltReturnSpec>(&actual.u)) {
         indexList.push_back(++index);
-        blockList.push_back(blockOfLabel(eval, altReturn->v));
+        labelList.push_back(altReturn->v);
       }
     }
-    blockList.push_back(eval.nonNopSuccessor().block); // default = fallthrough
-    stmtCtx.finalize();
-    builder->create<fir::SelectOp>(toLocation(), res, indexList, blockList);
+    genMultiwayBranch(res, indexList, labelList, eval.nonNopSuccessor());
   }
 
   void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) {
     Fortran::lower::StatementContext stmtCtx;
     Fortran::lower::pft::Evaluation &eval = getEval();
     mlir::Value selectExpr =
         createFIRExpr(toLocation(),
                       Fortran::semantics::GetExpr(
                           std::get<Fortran::parser::ScalarIntExpr>(stmt.t)),
                       stmtCtx);
-    stmtCtx.finalize();
+    stmtCtx.finalizeAndReset();
     llvm::SmallVector<int64_t> indexList;
-    llvm::SmallVector<mlir::Block *> blockList;
+    llvm::SmallVector<Fortran::parser::Label> labelList;
     int64_t index = 0;
     for (Fortran::parser::Label label :
          std::get<std::list<Fortran::parser::Label>>(stmt.t)) {
       indexList.push_back(++index);
-      blockList.push_back(blockOfLabel(eval, label));
+      labelList.push_back(label);
     }
-    blockList.push_back(eval.nonNopSuccessor().block); // default
-    builder->create<fir::SelectOp>(toLocation(), selectExpr, indexList,
-                                   blockList);
+    genMultiwayBranch(selectExpr, indexList, labelList, eval.nonNopSuccessor());
   }
 
   void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) {
     Fortran::lower::StatementContext stmtCtx;
-    Fortran::lower::pft::Evaluation &eval = getEval();
     mlir::Value expr = createFIRExpr(
         toLocation(),
         Fortran::semantics::GetExpr(std::get<Fortran::parser::Expr>(stmt.t)),
         stmtCtx);
-    stmtCtx.finalize();
-    mlir::Type exprType = expr.getType();
-    mlir::Location loc = toLocation();
-    if (exprType.isSignlessInteger()) {
-      // Arithmetic expression has Integer type.  Generate a SelectCaseOp
-      // with ranges {(-inf:-1], 0=default, [1:inf)}.
-      mlir::MLIRContext *context = builder->getContext();
-      llvm::SmallVector<mlir::Attribute> attrList;
-      llvm::SmallVector<mlir::Value> valueList;
-      llvm::SmallVector<mlir::Block *> blockList;
-      attrList.push_back(fir::UpperBoundAttr::get(context));
-      valueList.push_back(builder->createIntegerConstant(loc, exprType, -1));
-      blockList.push_back(blockOfLabel(eval, std::get<1>(stmt.t)));
-      attrList.push_back(fir::LowerBoundAttr::get(context));
-      valueList.push_back(builder->createIntegerConstant(loc, exprType, 1));
-      blockList.push_back(blockOfLabel(eval, std::get<3>(stmt.t)));
-      attrList.push_back(mlir::UnitAttr::get(context)); // 0 is the "default"
-      blockList.push_back(blockOfLabel(eval, std::get<2>(stmt.t)));
-      builder->create<fir::SelectCaseOp>(loc, expr, attrList, valueList,
-                                         blockList);
-      return;
-    }
-    // Arithmetic expression has Real type.  Generate
-    //   sum = expr + expr  [ raise an exception if expr is a NaN ]
-    //   if (sum < 0.0) goto L1 else if (sum > 0.0) goto L3 else goto L2
-    auto sum = builder->create<mlir::arith::AddFOp>(loc, expr, expr);
-    auto zero = builder->create<mlir::arith::ConstantOp>(
-        loc, exprType, builder->getFloatAttr(exprType, 0.0));
-    auto cond1 = builder->create<mlir::arith::CmpFOp>(
-        loc, mlir::arith::CmpFPredicate::OLT, sum, zero);
-    mlir::Block *elseIfBlock =
-        builder->getBlock()->splitBlock(builder->getInsertionPoint());
-    genFIRConditionalBranch(cond1, blockOfLabel(eval, std::get<1>(stmt.t)),
-                            elseIfBlock);
-    startBlock(elseIfBlock);
-    auto cond2 = builder->create<mlir::arith::CmpFOp>(
-        loc, mlir::arith::CmpFPredicate::OGT, sum, zero);
-    genFIRConditionalBranch(cond2, blockOfLabel(eval, std::get<3>(stmt.t)),
-                            blockOfLabel(eval, std::get<2>(stmt.t)));
+    stmtCtx.finalizeAndReset();
+    // Raise an exception if REAL expr is a NaN.
+    if (expr.getType().isa<mlir::FloatType>())
+      expr = builder->create<mlir::arith::AddFOp>(toLocation(), expr, expr);
+    llvm::SmallVector<int64_t> valueList;
+    llvm::SmallVector<Fortran::parser::Label> labelList;
+    labelList.push_back(std::get<1>(stmt.t));
+    labelList.push_back(std::get<3>(stmt.t));
+    const Fortran::lower::pft::LabelEvalMap &labelEvaluationMap =
+        getEval().getOwningProcedure()->labelEvaluationMap;
+    const auto iter = labelEvaluationMap.find(std::get<2>(stmt.t));
+    assert(iter != labelEvaluationMap.end() && "label missing from map");
+    genMultiwayBranch(expr, valueList, labelList, *iter->second);
   }
 
   void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) {
     // Program requirement 1990 8.2.4 -
     //
     //   At the time of execution of an assigned GOTO statement, the integer
     //   variable must be defined with the value of a statement label of a
     //   branch target statement that appears in the same scoping unit.
     //   Note that the variable may be defined with a statement label value
     //   only by an ASSIGN statement in the same scoping unit as the assigned
     //   GOTO statement.
 
     mlir::Location loc = toLocation();
     Fortran::lower::pft::Evaluation &eval = getEval();
     const Fortran::lower::pft::SymbolLabelMap &symbolLabelMap =
         eval.getOwningProcedure()->assignSymbolLabelMap;
     const Fortran::semantics::Symbol &symbol =
         *std::get<Fortran::parser::Name>(stmt.t).symbol;
     auto selectExpr =
         builder->create<fir::LoadOp>(loc, getSymbolAddress(symbol));
     auto iter = symbolLabelMap.find(symbol);
     if (iter == symbolLabelMap.end()) {
       // Fail for a nonconforming program unit that does not have any ASSIGN
-      // statements.  The front end should check for this.
+      // statements. The front end should check for this.
       mlir::emitError(loc, "(semantics issue) no assigned goto targets");
       exit(1);
     }
     auto labelSet = iter->second;
-    llvm::SmallVector<int64_t> indexList;
-    llvm::SmallVector<mlir::Block *> blockList;
-    auto addLabel = [&](Fortran::parser::Label label) {
-      indexList.push_back(label);
-      blockList.push_back(blockOfLabel(eval, label));
-    };
-    // Add labels from an explicit list.  The list may have duplicates.
+    llvm::SmallVector<int64_t> valueList;
+    llvm::SmallVector<Fortran::parser::Label> labelList;
+    // Add labels from an explicit list. The list may have duplicates.
     for (Fortran::parser::Label label :
          std::get<std::list<Fortran::parser::Label>>(stmt.t)) {
-      if (labelSet.count(label) &&
-          !llvm::is_contained(indexList, label)) { // ignore duplicates
-        addLabel(label);
+      // Ignore duplicates.
+      if (labelSet.count(label) && !llvm::is_contained(labelList, label)) {
+        valueList.push_back(label); // label as an integer
+        labelList.push_back(label);
       }
     }
     // Absent an explicit list, add all possible label targets.
-    if (indexList.empty())
-      for (auto &label : labelSet)
-        addLabel(label);
-    // Add a nop/fallthrough branch to the switch for a nonconforming program
-    // unit that violates the program requirement above.
-    blockList.push_back(eval.nonNopSuccessor().block); // default
-    builder->create<fir::SelectOp>(loc, selectExpr, indexList, blockList);
+    if (labelList.empty())
+      for (auto &label : labelSet) {
+        valueList.push_back(label); // label as an integer
+        labelList.push_back(label);
+      }
+    // Add a nop/fallthrough branch for a nonconforming program.
+    genMultiwayBranch(selectExpr, valueList, labelList, eval.nonNopSuccessor());
   }
 
   /// Collect DO CONCURRENT or FORALL loop control information.
   IncrementLoopNestInfo getConcurrentControl(
       const Fortran::parser::ConcurrentHeader &header,
       const std::list<Fortran::parser::LocalitySpec> &localityList = {}) {
     IncrementLoopNestInfo incrementLoopNestInfo;
     for (const Fortran::parser::ConcurrentControl &control :
for (const Fortran::parser::LocalitySpec &x : localityList) {
         for (const Fortran::parser::Name &x : sharedList->v)
           info.sharedSymList.push_back(x.symbol);
       if (std::get_if<Fortran::parser::LocalitySpec::Local>(&x.u))
         TODO(toLocation(), "do concurrent locality specs not implemented");
     }
     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
   void genFIR(const Fortran::parser::DoConstruct &doConstruct) {
     setCurrentPositionAt(doConstruct);
     // Collect loop nest information.
     // Generate begin loop code directly for infinite and while loops.
     Fortran::lower::pft::Evaluation &eval = getEval();
if (infiniteLoop) {
       assert(unstructuredContext && "infinite loop must be unstructured");
       startBlock(headerBlock);
     } else if ((whileCondition =
                     std::get_if<Fortran::parser::ScalarLogicalExpr>(
                         &loopControl->u))) {
       assert(unstructuredContext && "while loop must be unstructured");
       maybeStartBlock(preheaderBlock); // no block or empty block
       startBlock(headerBlock);
-      genFIRConditionalBranch(*whileCondition, bodyBlock, exitBlock);
+      genConditionalBranch(*whileCondition, bodyBlock, exitBlock);
     } else if (const auto *bounds =
                    std::get_if<Fortran::parser::LoopControl::Bounds>(
                        &loopControl->u)) {
       // Non-concurrent increment loop.
       IncrementLoopInfo &info = incrementLoopNestInfo.emplace_back(
           *bounds->name.thing.symbol, bounds->lower, bounds->upper,
           bounds->step);
       if (unstructuredContext) {
if (infiniteLoop) {
       assert(concurrent && "invalid DO loop variant");
       incrementLoopNestInfo = getConcurrentControl(
           std::get<Fortran::parser::ConcurrentHeader>(concurrent->t),
           std::get<std::list<Fortran::parser::LocalitySpec>>(concurrent->t));
       if (unstructuredContext) {
         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.
             return exitBlock = insertBlock(exitBlock);
           };
           bool isInnermost = &info == &incrementLoopNestInfo.back();
           bool isOutermost = &info == &incrementLoopNestInfo.front();
           info.headerBlock = isOutermost ? headerBlock : createNextBeginBlock();
           info.bodyBlock = isInnermost ? bodyBlock : createNextBeginBlock();
           info.exitBlock = isOutermost ? exitBlock : createNextExitBlock();
           if (info.maskExpr)
             info.maskBlock = createNextBeginBlock();
         }
       }
     }
 
-    // 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);
 
     // Loop body code.
     auto iter = eval.getNestedEvaluations().begin();
     for (auto end = --eval.getNestedEvaluations().end(); iter != end; ++iter)
       genFIR(*iter, unstructuredContext);
 
     // An EndDoStmt in unstructured code may start a new block.
     Fortran::lower::pft::Evaluation &endDoEval = *iter;
     assert(endDoEval.getIf<Fortran::parser::EndDoStmt>() && "no enddo stmt");
     if (unstructuredContext)
       maybeStartBlock(endDoEval.block);
 
     // Loop end code.
     if (infiniteLoop || whileCondition)
-      genFIRBranch(headerBlock);
+      genBranch(headerBlock);
     else
       genFIRIncrementLoopEnd(incrementLoopNestInfo);
 
     // This call may generate a branch in some contexts.
     genFIR(endDoEval, unstructuredContext);
   }
 
   /// Generate FIR to begin a structured or unstructured increment loop nest.
for (IncrementLoopInfo &info : incrementLoopNestInfo) {
           builder->setInsertionPointToStart(info.doLoop.getBody());
           loopValue = info.doLoop.getRegionIterArgs()[0];
         }
         // Update the loop variable value in case it has non-index references.
         builder->create<fir::StoreOp>(loc, loopValue, info.loopVariable);
         if (info.maskExpr) {
           Fortran::lower::StatementContext stmtCtx;
           mlir::Value maskCond = createFIRExpr(loc, info.maskExpr, stmtCtx);
-          stmtCtx.finalize();
+          stmtCtx.finalizeAndReset();
           mlir::Value maskCondCast =
               builder->createConvert(loc, builder->getI1Type(), maskCond);
           auto ifOp = builder->create<fir::IfOp>(loc, maskCondCast,
                                                  /*withElseRegion=*/false);
           builder->setInsertionPointToStart(&ifOp.getThenRegion().front());
         }
         handleLocalitySpec(info);
         continue;
       }
 
       // Unstructured loop preheader - initialize tripVariable and loopVariable.
       mlir::Value tripCount;
       if (info.hasRealControl) {
         auto diff1 =
             builder->create<mlir::arith::SubFOp>(loc, upperValue, lowerValue);
         auto diff2 =
             builder->create<mlir::arith::AddFOp>(loc, diff1, info.stepValue);
         tripCount =
             builder->create<mlir::arith::DivFOp>(loc, diff2, info.stepValue);
         tripCount =
             builder->createConvert(loc, builder->getIndexType(), tripCount);
-
       } else {
         auto diff1 =
             builder->create<mlir::arith::SubIOp>(loc, upperValue, lowerValue);
         auto diff2 =
             builder->create<mlir::arith::AddIOp>(loc, diff1, info.stepValue);
         tripCount =
             builder->create<mlir::arith::DivSIOp>(loc, diff2, info.stepValue);
       }
for (IncrementLoopInfo &info : incrementLoopNestInfo) {
       // Note - Currently there is no way to tag a loop as a concurrent loop.
       startBlock(info.headerBlock);
       tripCount = builder->create<fir::LoadOp>(loc, info.tripVariable);
       mlir::Value zero =
           builder->createIntegerConstant(loc, tripCount.getType(), 0);
       auto cond = builder->create<mlir::arith::CmpIOp>(
           loc, mlir::arith::CmpIPredicate::sgt, tripCount, zero);
       if (info.maskExpr) {
-        genFIRConditionalBranch(cond, info.maskBlock, info.exitBlock);
+        genConditionalBranch(cond, info.maskBlock, info.exitBlock);
         startBlock(info.maskBlock);
         mlir::Block *latchBlock = getEval().getLastNestedEvaluation().block;
         assert(latchBlock && "missing masked concurrent loop latch block");
         Fortran::lower::StatementContext stmtCtx;
         mlir::Value maskCond = createFIRExpr(loc, info.maskExpr, stmtCtx);
-        stmtCtx.finalize();
-        genFIRConditionalBranch(maskCond, info.bodyBlock, latchBlock);
+        stmtCtx.finalizeAndReset();
+        genConditionalBranch(maskCond, info.bodyBlock, latchBlock);
       } else {
-        genFIRConditionalBranch(cond, info.bodyBlock, info.exitBlock);
+        genConditionalBranch(cond, info.bodyBlock, info.exitBlock);
         if (&info != &incrementLoopNestInfo.back()) // not innermost
           startBlock(info.bodyBlock); // preheader block of enclosed dimension
       }
       if (!info.localInitSymList.empty()) {
         mlir::OpBuilder::InsertPoint insertPt = builder->saveInsertionPoint();
         builder->setInsertionPointToStart(info.bodyBlock);
         handleLocalitySpec(info);
         builder->restoreInsertionPoint(insertPt);
for (auto it = incrementLoopNestInfo.rbegin(),
       if (info.hasRealControl)
         value =
             builder->create<mlir::arith::AddFOp>(loc, value, info.stepValue);
       else
         value =
             builder->create<mlir::arith::AddIOp>(loc, value, info.stepValue);
       builder->create<fir::StoreOp>(loc, value, info.loopVariable);
 
-      genFIRBranch(info.headerBlock);
+      genBranch(info.headerBlock);
       if (&info != &incrementLoopNestInfo.front()) // not outermost
         startBlock(info.exitBlock); // latch block of enclosing dimension
     }
   }
 
   /// Generate structured or unstructured FIR for an IF construct.
   /// The initial statement may be either an IfStmt or an IfThenStmt.
   void genFIR(const Fortran::parser::IfConstruct &) {
if (eval.lowerAsStructured()) {
       }
       return;
     }
 
     // Unstructured branch sequence.
     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,
         else // non-empty block
-          genFIRConditionalBranch(cond, e.lexicalSuccessor, e.controlSuccessor);
+          genConditionalBranch(cond, e.lexicalSuccessor, e.controlSuccessor);
       };
       if (auto *s = e.getIf<Fortran::parser::IfThenStmt>()) {
         maybeStartBlock(e.block);
         genIfBranch(genIfCondition(s, e.negateCondition));
       } else if (auto *s = e.getIf<Fortran::parser::IfStmt>()) {
         maybeStartBlock(e.block);
         genIfBranch(genIfCondition(s, e.negateCondition));
       } else if (auto *s = e.getIf<Fortran::parser::ElseIfStmt>()) {
         startBlock(e.block);
         genIfBranch(genIfCondition(s));
       } else {
         genFIR(e);
       }
     }
   }
 
   void genFIR(const Fortran::parser::CaseConstruct &) {
+    Fortran::lower::pft::Evaluation &eval = getEval();
+    Fortran::lower::StatementContext stmtCtx;
+    pushActiveConstruct(eval, stmtCtx);
     for (Fortran::lower::pft::Evaluation &e : getEval().getNestedEvaluations())
       genFIR(e);
+    popActiveConstruct();
   }
 
   template <typename A>
   void genNestedStatement(const Fortran::parser::Statement<A> &stmt) {
     setCurrentPosition(stmt.source);
     genFIR(stmt.statement);
   }
 
void genFIR(const Fortran::parser::OpenMPDeclarativeConstruct &ompDecl) {
     mlir::OpBuilder::InsertPoint insertPt = builder->saveInsertionPoint();
     genOpenMPDeclarativeConstruct(*this, getEval(), ompDecl);
     for (Fortran::lower::pft::Evaluation &e : getEval().getNestedEvaluations())
       genFIR(e);
     builder->restoreInsertionPoint(insertPt);
   }
 
   /// Generate FIR for a SELECT CASE statement.
-  /// The type may be CHARACTER, INTEGER, or LOGICAL.
+  /// The selector may have CHARACTER, INTEGER, or LOGICAL type.
   void genFIR(const Fortran::parser::SelectCaseStmt &stmt) {
     Fortran::lower::pft::Evaluation &eval = getEval();
-    mlir::MLIRContext *context = builder->getContext();
-    mlir::Location loc = toLocation();
-    Fortran::lower::StatementContext stmtCtx;
+    Fortran::lower::pft::Evaluation *parentConstruct = eval.parentConstruct;
+    assert(!activeConstructStack.empty() &&
+           &activeConstructStack.back().eval == parentConstruct &&
+           "select case construct is not active");
+    Fortran::lower::StatementContext &stmtCtx =
+        activeConstructStack.back().stmtCtx;
     const Fortran::lower::SomeExpr *expr = Fortran::semantics::GetExpr(
         std::get<Fortran::parser::Scalar<Fortran::parser::Expr>>(stmt.t));
     bool isCharSelector = isCharacterCategory(expr->GetType()->category());
     bool isLogicalSelector = isLogicalCategory(expr->GetType()->category());
+    mlir::MLIRContext *context = builder->getContext();
+    mlir::Location loc = toLocation();
     auto charValue = [&](const Fortran::lower::SomeExpr *expr) {
       fir::ExtendedValue exv = genExprAddr(*expr, stmtCtx, &loc);
       return exv.match(
           [&](const fir::CharBoxValue &cbv) {
             return fir::factory::CharacterExprHelper{*builder, loc}
                 .createEmboxChar(cbv.getAddr(), cbv.getLen());
           },
           [&](auto) {
             fir::emitFatalError(loc, "not a character");
             return mlir::Value{};
           });
     };
     mlir::Value selector;
     if (isCharSelector) {
       selector = charValue(expr);
     } else {
       selector = createFIRExpr(loc, expr, stmtCtx);
       if (isLogicalSelector)
         selector = builder->createConvert(loc, builder->getI1Type(), selector);
     }
     mlir::Type selectType = selector.getType();
     llvm::SmallVector<mlir::Attribute> attrList;
     llvm::SmallVector<mlir::Value> valueList;
     llvm::SmallVector<mlir::Block *> blockList;
-    mlir::Block *defaultBlock = eval.parentConstruct->constructExit->block;
+    mlir::Block *defaultBlock = parentConstruct->constructExit->block;
     using CaseValue = Fortran::parser::Scalar<Fortran::parser::ConstantExpr>;
     auto addValue = [&](const CaseValue &caseValue) {
       const Fortran::lower::SomeExpr *expr =
           Fortran::semantics::GetExpr(caseValue.thing);
       if (isCharSelector)
         valueList.push_back(charValue(expr));
       else if (isLogicalSelector)
         valueList.push_back(builder->createConvert(
for (Fortran::lower::pft::Evaluation *e = eval.controlSuccessor; e;
         } else {
           attrList.push_back(fir::UpperBoundAttr::get(context));
           addValue(*caseRange.upper);
         }
       }
     }
     // Skip a logical default block that can never be referenced.
     if (isLogicalSelector && attrList.size() == 2)
-      defaultBlock = eval.parentConstruct->constructExit->block;
+      defaultBlock = parentConstruct->constructExit->block;
     attrList.push_back(mlir::UnitAttr::get(context));
     blockList.push_back(defaultBlock);
 
-    // Generate a fir::SelectCaseOp.
-    // Explicit branch code is better for the LOGICAL type.  The CHARACTER type
-    // does not yet have downstream support, and also uses explicit branch code.
-    // The -no-structured-fir option can be used to force generation of INTEGER
-    // type branch code.
-    if (!isLogicalSelector && !isCharSelector && eval.lowerAsStructured()) {
-      // Numeric selector is a ssa register, all temps that may have
-      // been generated while evaluating it can be cleaned-up before the
-      // fir.select_case.
-      stmtCtx.finalize();
+    // Generate a fir::SelectCaseOp. Explicit branch code is better for the
+    // LOGICAL type. The CHARACTER type does not have downstream SelectOp
+    // support. The -no-structured-fir option can be used to force generation
+    // of INTEGER type branch code.
+    if (!isLogicalSelector && !isCharSelector &&
+        !getEval().forceAsUnstructured()) {
+      // The selector is in an ssa register. Any temps that may have been
+      // generated while evaluating it can be cleaned up now.
+      stmtCtx.finalizeAndReset();
       builder->create<fir::SelectCaseOp>(loc, selector, attrList, valueList,
                                          blockList);
       return;
     }
 
     // Generate a sequence of case value comparisons and branches.
     auto caseValue = valueList.begin();
     auto caseBlock = blockList.begin();
-    bool skipFinalization = false;
-    for (const auto &attr : llvm::enumerate(attrList)) {
-      if (attr.value().isa<mlir::UnitAttr>()) {
-        if (attrList.size() == 1)
-          stmtCtx.finalize();
-        genFIRBranch(*caseBlock++);
+    for (mlir::Attribute attr : attrList) {
+      if (attr.isa<mlir::UnitAttr>()) {
+        genBranch(*caseBlock++);
         break;
       }
       auto genCond = [&](mlir::Value rhs,
                          mlir::arith::CmpIPredicate pred) -> mlir::Value {
         if (!isCharSelector)
           return builder->create<mlir::arith::CmpIOp>(loc, pred, selector, rhs);
         fir::factory::CharacterExprHelper charHelper{*builder, loc};
         std::pair<mlir::Value, mlir::Value> lhsVal =
             charHelper.createUnboxChar(selector);
-        mlir::Value &lhsAddr = lhsVal.first;
-        mlir::Value &lhsLen = lhsVal.second;
         std::pair<mlir::Value, mlir::Value> rhsVal =
             charHelper.createUnboxChar(rhs);
-        mlir::Value &rhsAddr = rhsVal.first;
-        mlir::Value &rhsLen = rhsVal.second;
-        mlir::Value result = fir::runtime::genCharCompare(
-            *builder, loc, pred, lhsAddr, lhsLen, rhsAddr, rhsLen);
-        if (stmtCtx.workListIsEmpty() || skipFinalization)
-          return result;
-        if (attr.index() == attrList.size() - 2) {
-          stmtCtx.finalize();
-          return result;
-        }
-        fir::IfOp ifOp = builder->create<fir::IfOp>(loc, result,
-                                                    /*withElseRegion=*/false);
-        builder->setInsertionPointToStart(&ifOp.getThenRegion().front());
-        stmtCtx.finalizeAndKeep();
-        builder->setInsertionPointAfter(ifOp);
-        return result;
+        return fir::runtime::genCharCompare(*builder, loc, pred, lhsVal.first,
+                                            lhsVal.second, rhsVal.first,
+                                            rhsVal.second);
       };
       mlir::Block *newBlock = insertBlock(*caseBlock);
-      if (attr.value().isa<fir::ClosedIntervalAttr>()) {
+      if (attr.isa<fir::ClosedIntervalAttr>()) {
         mlir::Block *newBlock2 = insertBlock(*caseBlock);
-        skipFinalization = true;
         mlir::Value cond =
             genCond(*caseValue++, mlir::arith::CmpIPredicate::sge);
-        genFIRConditionalBranch(cond, newBlock, newBlock2);
+        genConditionalBranch(cond, newBlock, newBlock2);
         builder->setInsertionPointToEnd(newBlock);
-        skipFinalization = false;
         mlir::Value cond2 =
             genCond(*caseValue++, mlir::arith::CmpIPredicate::sle);
-        genFIRConditionalBranch(cond2, *caseBlock++, newBlock2);
+        genConditionalBranch(cond2, *caseBlock++, newBlock2);
         builder->setInsertionPointToEnd(newBlock2);
         continue;
       }
       mlir::arith::CmpIPredicate pred;
-      if (attr.value().isa<fir::PointIntervalAttr>()) {
+      if (attr.isa<fir::PointIntervalAttr>()) {
         pred = mlir::arith::CmpIPredicate::eq;
-      } else if (attr.value().isa<fir::LowerBoundAttr>()) {
+      } else if (attr.isa<fir::LowerBoundAttr>()) {
         pred = mlir::arith::CmpIPredicate::sge;
       } else {
-        assert(attr.value().isa<fir::UpperBoundAttr>() &&
-               "unexpected predicate");
+        assert(attr.isa<fir::UpperBoundAttr>() && "unexpected predicate");
         pred = mlir::arith::CmpIPredicate::sle;
       }
       mlir::Value cond = genCond(*caseValue++, pred);
-      genFIRConditionalBranch(cond, *caseBlock++, newBlock);
+      genConditionalBranch(cond, *caseBlock++, newBlock);
       builder->setInsertionPointToEnd(newBlock);
     }
     assert(caseValue == valueList.end() && caseBlock == blockList.end() &&
            "select case list mismatch");
-    assert(stmtCtx.workListIsEmpty() && "statement context must be empty");
   }
 
   fir::ExtendedValue
   genAssociateSelector(const Fortran::lower::SomeExpr &selector,
                        Fortran::lower::StatementContext &stmtCtx) {
     if (lowerToHighLevelFIR())
       return genExprAddr(selector, stmtCtx);
     return Fortran::lower::isArraySectionWithoutVectorSubscript(selector)
                ? Fortran::lower::createSomeArrayBox(*this, selector,
                                                     localSymbols, stmtCtx)
                : genExprAddr(selector, stmtCtx);
   }
 
   void genFIR(const Fortran::parser::AssociateConstruct &) {
-    Fortran::lower::StatementContext stmtCtx;
     Fortran::lower::pft::Evaluation &eval = getEval();
+    Fortran::lower::StatementContext stmtCtx;
+    pushActiveConstruct(eval, stmtCtx);
     for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations()) {
       if (auto *stmt = e.getIf<Fortran::parser::AssociateStmt>()) {
         if (eval.lowerAsUnstructured())
           maybeStartBlock(e.block);
         localSymbols.pushScope();
         for (const Fortran::parser::Association &assoc :
              std::get<std::list<Fortran::parser::Association>>(stmt->t)) {
           Fortran::semantics::Symbol &sym =
               *std::get<Fortran::parser::Name>(assoc.t).symbol;
           const Fortran::lower::SomeExpr &selector =
               *sym.get<Fortran::semantics::AssocEntityDetails>().expr();
           addSymbol(sym, genAssociateSelector(selector, stmtCtx));
         }
       } else if (e.getIf<Fortran::parser::EndAssociateStmt>()) {
         if (eval.lowerAsUnstructured())
           maybeStartBlock(e.block);
-        stmtCtx.finalize();
         localSymbols.popScope();
       } else {
         genFIR(e);
       }
     }
+    popActiveConstruct();
   }
 
   void genFIR(const Fortran::parser::BlockConstruct &blockConstruct) {
-    setCurrentPositionAt(blockConstruct);
-    TODO(toLocation(), "BlockConstruct implementation");
+    Fortran::lower::pft::Evaluation &eval = getEval();
+    Fortran::lower::StatementContext stmtCtx;
+    pushActiveConstruct(eval, stmtCtx);
+    for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations()) {
+      if (e.getIf<Fortran::parser::BlockStmt>()) {
+        if (eval.lowerAsUnstructured())
+          maybeStartBlock(e.block);
+        setCurrentPosition(e.position);
+        const Fortran::parser::CharBlock &endPosition =
+            eval.getLastNestedEvaluation().position;
+        localSymbols.pushScope();
+        mlir::func::FuncOp stackSave = fir::factory::getLlvmStackSave(*builder);
+        mlir::func::FuncOp stackRestore =
+            fir::factory::getLlvmStackRestore(*builder);
+        mlir::Value stackPtr =
+            builder->create<fir::CallOp>(toLocation(), stackSave).getResult(0);
+        mlir::Location endLoc = genLocation(endPosition);
+        stmtCtx.attachCleanup([=]() {
+          builder->create<fir::CallOp>(endLoc, stackRestore, stackPtr);
+        });
+        Fortran::semantics::Scope &scope =
+            bridge.getSemanticsContext().FindScope(endPosition);
+        scopeBlockIdMap.try_emplace(&scope, ++blockId);
+        Fortran::lower::AggregateStoreMap storeMap;
+        for (const Fortran::lower::pft::Variable &var :
+             Fortran::lower::pft::getScopeVariableList(scope))
+          instantiateVar(var, storeMap);
+      } else if (e.getIf<Fortran::parser::EndBlockStmt>()) {
+        if (eval.lowerAsUnstructured())
+          maybeStartBlock(e.block);
+        setCurrentPosition(e.position);
+        localSymbols.popScope();
+      } else {
+        genFIR(e);
       }
-  void genFIR(const Fortran::parser::BlockStmt &) {
-    TODO(toLocation(), "BlockStmt implementation");
     }
-  void genFIR(const Fortran::parser::EndBlockStmt &) {
-    TODO(toLocation(), "EndBlockStmt implementation");
+    popActiveConstruct();
   }
 
   void genFIR(const Fortran::parser::ChangeTeamConstruct &construct) {
     TODO(toLocation(), "ChangeTeamConstruct implementation");
   }
   void genFIR(const Fortran::parser::ChangeTeamStmt &stmt) {
     TODO(toLocation(), "ChangeTeamStmt implementation");
   }
for (const auto &typeCase : typeCaseList) {
       const auto &stmt =
           std::get<Fortran::parser::Statement<Fortran::parser::TypeGuardStmt>>(
               typeCase.t);
       const Fortran::semantics::Scope &scope =
           bridge.getSemanticsContext().FindScope(stmt.source);
       typeCaseScopes.push_back(&scope);
     }
 
+    pushActiveConstruct(getEval(), stmtCtx);
     for (Fortran::lower::pft::Evaluation &eval :
          getEval().getNestedEvaluations()) {
       if (auto *selectTypeStmt =
               eval.getIf<Fortran::parser::SelectTypeStmt>()) {
         // A genFIR(SelectTypeStmt) call would have unwanted side effects.
         maybeStartBlock(eval.block);
         // Retrieve the selector
         const auto &s = std::get<Fortran::parser::Selector>(selectTypeStmt->t);
for (Fortran::lower::pft::Evaluation &eval :
           }
         }
         builder->restoreInsertionPoint(crtInsPt);
         ++typeGuardIdx;
       } else if (eval.getIf<Fortran::parser::EndSelectStmt>()) {
         genFIR(eval);
         if (hasLocalScope)
           localSymbols.popScope();
-        stmtCtx.finalize();
       } else {
         genFIR(eval);
       }
     }
+    popActiveConstruct();
   }
 
   //===--------------------------------------------------------------------===//
   // IO statements (see io.h)
   //===--------------------------------------------------------------------===//
 
   void genFIR(const Fortran::parser::BackspaceStmt &stmt) {
     mlir::Value iostat = genBackspaceStatement(*this, stmt);

   }
 
   template <typename A>
   void genIoConditionBranches(Fortran::lower::pft::Evaluation &eval,
                               const A &specList, mlir::Value iostat) {
     if (!iostat)
       return;
 
-    mlir::Block *endBlock = nullptr;
-    mlir::Block *eorBlock = nullptr;
-    mlir::Block *errBlock = nullptr;
+    Fortran::parser::Label endLabel{};
+    Fortran::parser::Label eorLabel{};
+    Fortran::parser::Label errLabel{};
     for (const auto &spec : specList) {
       std::visit(Fortran::common::visitors{
                      [&](const Fortran::parser::EndLabel &label) {
-                       endBlock = blockOfLabel(eval, label.v);
+                       endLabel = label.v;
                      },
                      [&](const Fortran::parser::EorLabel &label) {
-                       eorBlock = blockOfLabel(eval, label.v);
+                       eorLabel = label.v;
                      },
                      [&](const Fortran::parser::ErrLabel &label) {
-                       errBlock = blockOfLabel(eval, label.v);
+                       errLabel = label.v;
                      },
                      [](const auto &) {}},
                  spec.u);
     }
-    if (!endBlock && !eorBlock && !errBlock)
+    if (!endLabel && !eorLabel && !errLabel)
       return;
 
-    mlir::Location loc = toLocation();
-    mlir::Type indexType = builder->getIndexType();
-    mlir::Value selector = builder->createConvert(loc, indexType, iostat);
+    mlir::Value selector =
+        builder->createConvert(toLocation(), builder->getIndexType(), iostat);
     llvm::SmallVector<int64_t> indexList;
-    llvm::SmallVector<mlir::Block *> blockList;
-    if (eorBlock) {
+    llvm::SmallVector<Fortran::parser::Label> labelList;
+    if (eorLabel) {
       indexList.push_back(Fortran::runtime::io::IostatEor);
-      blockList.push_back(eorBlock);
+      labelList.push_back(eorLabel);
     }
-    if (endBlock) {
+    if (endLabel) {
       indexList.push_back(Fortran::runtime::io::IostatEnd);
-      blockList.push_back(endBlock);
+      labelList.push_back(endLabel);
     }
-    if (errBlock) {
+    if (errLabel) {
+      // IostatEor and IostatEnd are fixed negative values. IOSTAT ERR values
+      // are positive. Placing the ERR value last allows recognition of an
+      // unexpected negative value as an error.
       indexList.push_back(0);
-      blockList.push_back(eval.nonNopSuccessor().block);
-      // ERR label statement is the default successor.
-      blockList.push_back(errBlock);
-    } else {
-      // Fallthrough successor statement is the default successor.
-      blockList.push_back(eval.nonNopSuccessor().block);
+      labelList.push_back(errLabel);
     }
-    builder->create<fir::SelectOp>(loc, selector, indexList, blockList);
+    genMultiwayBranch(selector, indexList, labelList, eval.nonNopSuccessor(),
+                      /*inIoErrContext=*/errLabel != Fortran::parser::Label{});
   }
 
   //===--------------------------------------------------------------------===//
   // Memory allocation and deallocation
   //===--------------------------------------------------------------------===//
 
   void genFIR(const Fortran::parser::AllocateStmt &stmt) {
     Fortran::lower::genAllocateStmt(*this, stmt, toLocation());
std::visit(
                 // Fortran 2018 10.2.1.3 p8 and p9
                 // Conversions should have been inserted by semantic analysis,
                 // but they can be incorrect between the rhs and lhs. Correct
                 // that here.
                 mlir::Value addr = fir::getBase(lhs);
                 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);
                 mlir::Value cast =
                     builder->convertWithSemantics(loc, toTy, val);
                 if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) {
                   assert(isFuncResultDesignator(assign.lhs) && "type mismatch");
                   addr = builder->createConvert(
#endif
   void genFIR(const Fortran::parser::StopStmt &stmt) {
     genStopStatement(*this, stmt);
   }
 
   void genFIR(const Fortran::parser::ReturnStmt &stmt) {
     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();
       return;
     }
     mlir::Location loc = toLocation();
     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)) {
         Fortran::lower::StatementContext stmtCtx;
         const Fortran::lower::SomeExpr *expr =
             Fortran::semantics::GetExpr(*stmt.v);
         assert(expr && "missing alternate return expression");
         mlir::Value altReturnIndex = builder->createConvert(
             loc, builder->getIndexType(), createFIRExpr(loc, expr, stmtCtx));
         builder->create<fir::StoreOp>(loc, altReturnIndex,
                                       getAltReturnResult(symbol));
       }
     }
     // Branch to the last block of the SUBROUTINE, which has the actual return.
     if (!funit->finalBlock) {
       mlir::OpBuilder::InsertPoint insPt = builder->saveInsertionPoint();
       funit->finalBlock = builder->createBlock(&builder->getRegion());
       builder->restoreInsertionPoint(insPt);
     }
     builder->create<mlir::cf::BranchOp>(loc, funit->finalBlock);
   }
 
   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.
   // But note that the genFIR call immediately below that wraps one of these
   // calls does block management, possibly starting a new block, and possibly
   // 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
   void genFIR(const Fortran::parser::EndMpSubprogramStmt &) {} // nop
   void genFIR(const Fortran::parser::EndProgramStmt &) {}      // nop
   void genFIR(const Fortran::parser::EndSelectStmt &) {}       // nop
   void genFIR(const Fortran::parser::EndSubroutineStmt &) {}   // nop
   void genFIR(const Fortran::parser::EntryStmt &) {}           // nop
void genFIR(Fortran::lower::pft::Evaluation &eval,
     // end statement was visited first and generated a branch.
     Fortran::lower::pft::Evaluation *successor =
         eval.isConstruct() ? eval.getLastNestedEvaluation().lexicalSuccessor
                            : eval.lexicalSuccessor;
     if (successor && blockIsUnterminated()) {
       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);
     }
   }
 
   /// Map mlir function block arguments to the corresponding Fortran dummy
   /// variables. When the result is passed as a hidden argument, the Fortran
   /// result is also mapped. The symbol map is used to hold this mapping.
   void mapDummiesAndResults(Fortran::lower::pft::FunctionLikeUnit &funit,
                             const Fortran::lower::CalleeInterface &callee) {
LLVM_DEBUG(llvm::dbgs() << "\n[bridge - startNewFunction]";
                llvm::dbgs() << "\n");
     Fortran::lower::CalleeInterface callee(funit, *this);
     mlir::func::FuncOp func = callee.addEntryBlockAndMapArguments();
     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
     assert(builder && "FirOpBuilder did not instantiate");
     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);
 
     // Map host associated symbols from parent procedure if any.
     if (funit.parentHasHostAssoc())
       funit.parentHostAssoc().internalProcedureBindings(*this, localSymbols);
 
     // Non-primary results of a function with multiple entry points.
if (callee.hasAlternateReturns()) {
           builder->createTemporary(loc, idxTy, toStringRef(symbol.name()));
       addSymbol(symbol, altResult);
       mlir::Value zero = builder->createIntegerConstant(loc, idxTy, 0);
       builder->create<fir::StoreOp>(loc, zero, altResult);
     }
 
     if (Fortran::lower::pft::Evaluation *alternateEntryEval =
             funit.getEntryEval())
-      genFIRBranch(alternateEntryEval->lexicalSuccessor->block);
+      genBranch(alternateEntryEval->lexicalSuccessor->block);
   }
 
-  /// Create global blocks for the current function.  This eliminates the
+  /// Create global blocks for the current function. This eliminates the
   /// distinction between forward and backward targets when generating
-  /// branches.  A block is "global" if it can be the target of a GOTO or
-  /// other source code branch.  A block that can only be targeted by a
-  /// compiler generated branch is "local".  For example, a DO loop preheader
-  /// block containing loop initialization code is global.  A loop header
-  /// block, which is the target of the loop back edge, is local.  Blocks
-  /// belong to a region.  Any block within a nested region must be replaced
-  /// with a block belonging to that region.  Branches may not cross region
+  /// branches. A block is "global" if it can be the target of a GOTO or
+  /// other source code branch. A block that can only be targeted by a
+  /// compiler generated branch is "local". For example, a DO loop preheader
+  /// block containing loop initialization code is global. A loop header
+  /// block, which is the target of the loop back edge, is local. Blocks
+  /// belong to a region. Any block within a nested region must be replaced
+  /// with a block belonging to that region. Branches may not cross region
   /// boundaries.
   void createEmptyBlocks(
       std::list<Fortran::lower::pft::Evaluation> &evaluationList) {
     mlir::Region *region = &builder->getRegion();
     for (Fortran::lower::pft::Evaluation &eval : evaluationList) {
       if (eval.isNewBlock)
         eval.block = builder->createBlock(region);
       if (eval.isConstruct() || eval.isDirective()) {
#endif
   }
 
   /// Unconditionally switch code insertion to a new block.
   void startBlock(mlir::Block *newBlock) {
     assert(newBlock && "missing block");
     // 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);
   }
 
   /// Conditionally switch code insertion to a new block.
   void maybeStartBlock(mlir::Block *newBlock) {
     if (newBlock)
void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     // Eliminate dead code as a prerequisite to calling other IR passes.
     // FIXME: This simplification should happen in a normal pass, not here.
     mlir::IRRewriter rewriter(*builder);
     (void)mlir::simplifyRegions(rewriter, {builder->getRegion()});
     delete builder;
     builder = nullptr;
     hostAssocTuple = mlir::Value{};
     localSymbols.clear();
+    blockId = 0;
   }
 
   /// Helper to generate GlobalOps when the builder is not positioned in any
   /// region block. This is required because the FirOpBuilder assumes it is
   /// always positioned inside a region block when creating globals, the easiest
   /// way comply is to create a dummy function and to throw it afterwards.
   void createGlobalOutsideOfFunctionLowering(
       const std::function<void()> &createGlobals) {

   Fortran::evaluate::FoldingContext foldingContext;
   fir::FirOpBuilder *builder = nullptr;
   Fortran::lower::pft::Evaluation *evalPtr = nullptr;
   Fortran::lower::SymMap localSymbols;
   Fortran::parser::CharBlock currentPosition;
   RuntimeTypeInfoConverter runtimeTypeInfoConverter;
   DispatchTableConverter dispatchTableConverter;
 
-  /// WHERE statement/construct mask expression stack.
-  Fortran::lower::ImplicitIterSpace implicitIterSpace;
+  // Stack to manage object deallocation and finalization at construct exits.
+  llvm::SmallVector<ConstructContext> activeConstructStack;
 
-  /// FORALL context
+  /// BLOCK name mangling component map
+  int blockId = 0;
+  Fortran::lower::mangle::ScopeBlockIdMap scopeBlockIdMap;
+
+  /// 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;
 };
 
 } // namespace
 
 Fortran::evaluate::FoldingContext
 Fortran::lower::LoweringBridge::createFoldingContext() const {
   return {getDefaultKinds(), getIntrinsicTable(), getTargetCharacteristics()};

flang/lib/Lower/CallInterface.cpp

 #include "flang/Semantics/tools.h"
 #include <optional>
 
 //===----------------------------------------------------------------------===//
 // BIND(C) mangling helpers
 //===----------------------------------------------------------------------===//
 
 // 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) {
   llvm::SmallVector<mlir::Type> resultTys;
   llvm::SmallVector<mlir::Type> inputTys;
   auto untypedFunc = mlir::FunctionType::get(context, inputTys, resultTys);
   return fir::BoxProcType::get(context, untypedFunc);
 }

 
 bool Fortran::lower::CallerInterface::hasAlternateReturns() const {
   return procRef.hasAlternateReturns();
 }
 
 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();
 }
 
 const Fortran::semantics::Symbol *
 Fortran::lower::CallerInterface::getProcedureSymbol() const {
   return procRef.proc().GetSymbol();

 bool Fortran::lower::CalleeInterface::hasAlternateReturns() const {
   return !funit.isMainProgram() &&
          Fortran::semantics::HasAlternateReturns(funit.getSubprogramSymbol());
 }
 
 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 *
 Fortran::lower::CalleeInterface::getProcedureSymbol() const {
   if (funit.isMainProgram())
     return funit.getMainProgramSymbol();
   return &funit.getSubprogramSymbol();
 }

 void Fortran::lower::CalleeInterface::setFuncAttrs(
     mlir::func::FuncOp func) const {
   if (funit.parentHasHostAssoc())
     func->setAttr(fir::getInternalProcedureAttrName(),
                   mlir::UnitAttr::get(func->getContext()));
 }
 
 //===----------------------------------------------------------------------===//
-// 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,
                                const Fortran::semantics::Symbol &sym,
                                mlir::MLIRContext &mlirContext) {
   // Only add this on bind(C) functions for which the symbol is not reflected in
   // the current context.
   if (!Fortran::semantics::IsBindCProcedure(sym))

flang/lib/Lower/ConvertType.cpp

struct TypeBuilderImpl {
 
   mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
     std::vector<std::pair<std::string, mlir::Type>> ps;
     std::vector<std::pair<std::string, mlir::Type>> cs;
     const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol();
     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);
 
     // Gather the record type fields.
     // (1) The data components.
     for (const auto &field :
          Fortran::semantics::OrderedComponentIterator(tySpec)) {
       // Lowering is assuming non deferred component lower bounds are always 1.

flang/lib/Lower/ConvertVariable.cpp

static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
 
   if (global && globalIsInitialized(global))
     return global;
 
   if (Fortran::semantics::IsProcedurePointer(sym))
     TODO(loc, "procedure pointer globals");
 
   // If this is an array, check to see if we can use a dense attribute
-  // with a tensor mlir type.  This optimization currently only supports
+  // with a tensor mlir type. This optimization currently only supports
   // rank-1 Fortran arrays of integer, real, or logical. The tensor
   // type does not support nested structures which are needed for
   // complex numbers.
   // To get multidimensional arrays to work, we will have to use column major
   // array ordering with the tensor type (so it matches column major ordering
-  // with the Fortran fir.array).  By default, tensor types assume row major
+  // with the Fortran fir.array). By default, tensor types assume row major
   // ordering. How to create this tensor type is to be determined.
   if (symTy.isa<fir::SequenceType>() && sym.Rank() == 1 &&
       !Fortran::semantics::IsAllocatableOrPointer(sym)) {
     mlir::Type eleTy = symTy.cast<fir::SequenceType>().getEleTy();
     if (eleTy.isa<mlir::IntegerType, mlir::FloatType, fir::LogicalType>()) {
       const auto *details =
           sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
       if (details->init()) {

 /// the global to the ModuleOp as a new uniqued symbol and initialize it with
 /// the correct value. It will be referenced on demand using `fir.addr_of`.
 static void instantiateGlobal(Fortran::lower::AbstractConverter &converter,
                               const Fortran::lower::pft::Variable &var,
                               Fortran::lower::SymMap &symMap) {
   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);
   if (var.isModuleOrSubmoduleVariable()) {
     // A module global was or will be defined when lowering the module. Emit
     // only a declaration if the global does not exist at that point.
     global = declareGlobal(converter, var, globalName, linkage);
   } else {
static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
                                   mlir::Location loc,
                                   const Fortran::lower::pft::Variable &var,
                                   mlir::Value preAlloc,
                                   llvm::ArrayRef<mlir::Value> shape = {},
                                   llvm::ArrayRef<mlir::Value> lenParams = {}) {
   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();
   llvm::StringRef symNm = toStringRef(ultimateSymbol.name());
   bool isTarg = var.isTarget();
   // Let the builder do all the heavy lifting.
   return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
 }
Fortran::lower::AggregateStoreKey key = {alias.getOwningScope(),
                                            alias.getAliasOffset()};
   auto iter = storeMap.find(key);
   assert(iter != storeMap.end());
   return iter->second;
 }
 
 /// 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.
 static mlir::Type
 getAggregateType(Fortran::lower::AbstractConverter &converter,
                  const Fortran::lower::pft::Variable::AggregateStore &st) {
   if (const Fortran::semantics::Symbol *initSym = st.getInitialValueSymbol())
     return converter.genType(*initSym);

 static void
 instantiateAggregateStore(Fortran::lower::AbstractConverter &converter,
                           const Fortran::lower::pft::Variable &var,
                           Fortran::lower::AggregateStoreMap &storeMap) {
   assert(var.isAggregateStore() && "not an interval");
   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();
     mlir::StringAttr linkage = getLinkageAttribute(builder, var);
     if (var.isModuleOrSubmoduleVariable()) {
       // A module global was or will be defined when lowering the module. Emit
       // only a declaration if the global does not exist at that point.
       global = declareGlobalAggregateStore(converter, loc, aggregate, aggName,

 /// It is an error if the fir::GlobalOp was not created before this is
 /// called (it cannot be created on the flight because it is not known here
 /// what mlir type the GlobalOp should have to satisfy all the
 /// appearances in the program).
 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.
   if (!global)
     fir::emitFatalError(converter.genLocation(common.name()),
                         "COMMON block was not lowered before its usage");
   return global;
 }
 
 /// Create the fir::GlobalOp for COMMON block \p common. If \p common has an
 /// initial value, it is not created yet. Instead, the common block list
 /// members is returned to later create the initial value in
 /// finalizeCommonBlockDefinition.
 static std::optional<std::tuple<
     fir::GlobalOp, Fortran::semantics::MutableSymbolVector, mlir::Location>>
 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;
   Fortran::semantics::MutableSymbolVector cmnBlkMems =
       getCommonMembersWithInitAliases(common);
   mlir::Location loc = converter.genLocation(common.name());
   mlir::StringAttr linkage = builder.createCommonLinkage();
   if (!commonBlockHasInit(cmnBlkMems)) {
if (!shape.empty() && !lbounds.empty())
       shapeOrShift = builder.genShape(loc, lbounds, shape);
     else if (!shape.empty())
       shapeOrShift = builder.genShape(loc, shape);
     else if (!lbounds.empty())
       shapeOrShift = builder.genShift(loc, lbounds);
     llvm::SmallVector<mlir::Value> lenParams;
     if (len)
       lenParams.emplace_back(len);
-    auto name = Fortran::lower::mangle::mangleName(sym);
+    auto name = converter.mangleName(sym);
     fir::FortranVariableFlagsAttr attributes =
         Fortran::lower::translateSymbolAttributes(builder.getContext(), sym);
     auto newBase = builder.create<hlfir::DeclareOp>(
         loc, base, name, shapeOrShift, lenParams, attributes);
     symMap.addVariableDefinition(sym, newBase, force);
     return;
   }
 
void Fortran::lower::genDeclareSymbol(
     Fortran::lower::SymMap &symMap, const Fortran::semantics::Symbol &sym,
     const fir::ExtendedValue &exv, bool force) {
   if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
       !Fortran::semantics::IsProcedure(sym)) {
     fir::FirOpBuilder &builder = converter.getFirOpBuilder();
     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);
     return;
   }
   symMap.addSymbol(sym, exv, force);
 }
 
Fortran::lower::genDeclareSymbol(converter, symMap, sym,
                                      std::move(boxValue), replace);
     return;
   }
   symMap.addBoxSymbol(sym, box, lbounds, explicitParams, explicitExtents,
                       replace);
 }
 
 /// 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,
     mlir::Value preAlloc) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   const mlir::Location loc = genLocation(converter, sym);
   mlir::IndexType idxTy = builder.getIndexType();
if (lowerToBoxValue(sym, dummyArg)) {
                            stmtCtx);
       genBoxDeclare(converter, symMap, sym, dummyArg, lbounds, explicitParams,
                     explicitExtents, replace);
       return;
     }
   }
 
   // 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 = [&]() {
     if (isUnusedEntryDummy) {
       assert(!Fortran::semantics::IsAllocatableOrPointer(sym) &&
              "handled above");
       // The box is read right away because lowering code does not expect
       // a non pointer/allocatable symbol to be mapped to a MutableBox.
mlir::StringAttr linkage =
       getLinkageAttribute(converter.getFirOpBuilder(), var);
   if (!var.isGlobal())
     fir::emitFatalError(converter.getCurrentLocation(),
                         "attempting to lower module variable as local");
   // Define aggregate storages for equivalenced objects.
   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;
   }
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   if (const Fortran::semantics::Symbol *common =
           Fortran::semantics::FindCommonBlockContaining(var.getSymbol())) {
     // Nothing to do, common block are generated before everything. Ensure
     // this was done by calling getCommonBlockGlobal.
     getCommonBlockGlobal(converter, *common);
   } 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);
   }
 }
 
 void Fortran::lower::instantiateVariable(AbstractConverter &converter,
                                          const pft::Variable &var,
                                          Fortran::lower::SymMap &symMap,
                                          AggregateStoreMap &storeMap) {
for (Fortran::lower::pft::Variable var :
     const Fortran::semantics::Symbol &sym = var.getSymbol();
     if (&sym == &result)
       continue;
     const auto *hostDetails =
         sym.detailsIf<Fortran::semantics::HostAssocDetails>();
     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
       // lowering `B` will have mapped all host symbols of captured variables
       // to the tuple argument containing the composite of all host associated
       // variables, whether or not the host symbol is actually referred to in
       // `B`. Hence it is possible to simply lookup the variable associated to
       // the host symbol without having to go back to the tuple argument.
void Fortran::lower::mapSymbolAttributes(
   mapSymbolAttributes(converter, pft::Variable{symbol}, symMap, stmtCtx,
                       preAlloc);
 }
 
 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);
 }

flang/lib/Lower/IO.cpp

static constexpr std::tuple<
     mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize),
     mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter),
     mkIOKey(InquireLogical), mkIOKey(InquirePendingId),
     mkIOKey(InquireInteger64), mkIOKey(EndIoStatement), mkIOKey(SetConvert)>
     newIOTable;
 } // 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 {
   const Fortran::lower::SomeExpr *ioStatExpr{};
   std::optional<fir::ExtendedValue> ioMsg;
   bool hasErr{};
   bool hasEnd{};
   bool hasEor{};
   fir::IfOp bigUnitIfOp;
 
   /// Check for any condition specifier that applies to specifier processing.
   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;
   }
 
   /// Check for any condition specifier, including IOMSG.
   bool hasAnyConditionSpec() const {
     return hasTransferConditionSpec() || ioMsg;
   }
static mlir::func::FuncOp getIORuntimeFunc(mlir::Location loc,
   auto funTy = getTypeModel<E>()(builder.getContext());
   func = builder.createFunction(loc, name, funTy);
   func->setAttr(fir::FIROpsDialect::getFirRuntimeAttrName(),
                 builder.getUnitAttr());
   func->setAttr("fir.io", builder.getUnitAttr());
   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,
                             ConditionSpecInfo &csi,
                             Fortran::lower::StatementContext &stmtCtx) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   if (csi.ioMsg) {
     mlir::func::FuncOp getIoMsg =
mlir::Value ioStatResult =
         builder.createConvert(loc, converter.genType(*csi.ioStatExpr), iostat);
     builder.create<fir::StoreOp>(loc, ioStatResult, ioStatVar);
   }
   return csi.hasTransferConditionSpec() ? iostat : mlir::Value{};
 }
 
 /// 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,
                                   mlir::Value ok, bool inLoop = false) {
   if (!checkResult || !ok)
     // 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;
   if (inLoop)
     resTy = builder.getI1Type();
   auto ifOp = builder.create<fir::IfOp>(loc, resTy, ok,
                                         /*withElseRegion=*/inLoop);
   builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
 }
 
 /// 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,
                  Fortran::lower::StatementContext &stmtCtx) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   mlir::Location loc = converter.getCurrentLocation();
   std::string groupMangleName = converter.mangleName(symbol);
   if (auto group = builder.getNamedGlobal(groupMangleName))
static mlir::Value createIoRuntimeCallForItem(mlir::Location loc,
                                               fir::FirOpBuilder &builder,
                                               mlir::func::FuncOp inputFunc,
                                               mlir::Value cookie,
                                               const fir::ExtendedValue &item) {
   mlir::Type argType = inputFunc.getFunctionType().getInput(1);
   llvm::SmallVector<mlir::Value> inputFuncArgs = {cookie};
   if (argType.isa<fir::BaseBoxType>()) {
     mlir::Value box = fir::getBase(item);
-    assert(box.getType().isa<fir::BaseBoxType>() && "must be previously emboxed");
+    assert(box.getType().isa<fir::BaseBoxType>() &&
+           "must be previously emboxed");
     inputFuncArgs.push_back(builder.createConvert(loc, argType, box));
   } else {
     mlir::Value itemAddr = fir::getBase(item);
     mlir::Type itemTy = fir::unwrapPassByRefType(itemAddr.getType());
     inputFuncArgs.push_back(builder.createConvert(loc, argType, itemAddr));
     fir::factory::CharacterExprHelper charHelper{builder, loc};
     if (charHelper.isCharacterScalar(itemTy)) {
       mlir::Value len = fir::getLen(item);
lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter &converter,
 
   // Handle and return the string reference and length selected by the selectOp.
   auto buff = endBlock->getArgument(0);
   auto len = endBlock->getArgument(1);
 
   return {buff, len, mlir::Value{}};
 }
 
-/// Generate a reference to a format string.  There are four cases - a format
+/// Generate a reference to a format string. There are four cases - a format
 /// statement label, a character format expression, an integer that holds the
-/// label of a format statement, and the * case.  The first three are done here.
+/// label of a format statement, and the * case. The first three are done here.
 /// The * case is done elsewhere.
 static std::tuple<mlir::Value, mlir::Value, mlir::Value>
 genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
           const Fortran::parser::Format &format, mlir::Type strTy,
           mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) {
   if (const auto *label = std::get_if<Fortran::parser::Label>(&format.u)) {
     // format statement label
     auto eval = converter.lookupLabel(*label);
genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
 
   builder.restoreInsertionPoint(insertPt);
   if constexpr (hasIOCtrl) {
     genIOReadSize(converter, loc, cookie, stmt.controls,
                   csi.hasErrorConditionSpec());
   }
   // Generate end statement call/s.
   mlir::Value result = genEndIO(converter, loc, cookie, csi, stmtCtx);
-  stmtCtx.finalize();
+  stmtCtx.finalizeAndReset();
   return result;
 }
 
 void Fortran::lower::genPrintStatement(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::parser::PrintStmt &stmt) {
   // PRINT does not take an io-control-spec. It only has a format specifier, so
   // it is a simplified case of WRITE.

flang/lib/Lower/IterationSpace.cpp

 }
 
 void Fortran::lower::ExplicitIterSpace::popLevel() { symbolStack.pop_back(); }
 
 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();
     rhsBases.clear();
     loadBindings.clear();
     ccLoopNest.clear();
     innerArgs.clear();
     outerLoop = std::nullopt;

flang/lib/Lower/Mangler.cpp

 #include "flang/Lower/Support/Utils.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Optimizer/Support/InternalNames.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/ADT/ArrayRef.h"
 #include "llvm/ADT/SmallVector.h"
 #include "llvm/ADT/StringRef.h"
-#include "llvm/ADT/Twine.h"
 #include "llvm/Support/MD5.h"
-#include <optional>
 
-// recursively build the vector of module scopes
-static void moduleNames(const Fortran::semantics::Scope &scope,
-                        llvm::SmallVector<llvm::StringRef> &result) {
-  if (scope.IsTopLevel())
-    return;
-  moduleNames(scope.parent(), result);
-  if (scope.kind() == Fortran::semantics::Scope::Kind::Module)
-    if (const Fortran::semantics::Symbol *symbol = scope.symbol())
-      result.emplace_back(toStringRef(symbol->name()));
-}
-
-static llvm::SmallVector<llvm::StringRef>
-moduleNames(const Fortran::semantics::Symbol &symbol) {
-  const Fortran::semantics::Scope &scope = symbol.owner();
-  llvm::SmallVector<llvm::StringRef> result;
-  moduleNames(scope, result);
-  return result;
-}
-
-static std::optional<llvm::StringRef>
-hostName(const Fortran::semantics::Symbol &symbol) {
-  const Fortran::semantics::Scope *scope = &symbol.owner();
-  if (symbol.has<Fortran::semantics::AssocEntityDetails>())
-    // Associate/Select construct scopes are not part of the mangling. This can
-    // result in 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());
-  }
-  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 all ancestor module and submodule scope names; all host procedure
+/// and statement function scope names; and the innermost blockId containing
+/// \p symbol.
+static std::tuple<llvm::SmallVector<llvm::StringRef>,
+                  llvm::SmallVector<llvm::StringRef>, std::int64_t>
+ancestors(const Fortran::semantics::Symbol &symbol,
+          Fortran::lower::mangle::ScopeBlockIdMap &scopeBlockIdMap) {
+  llvm::SmallVector<const Fortran::semantics::Scope *> scopes;
+  for (auto *scp = &symbol.owner(); !scp->IsGlobal(); scp = &scp->parent())
+    scopes.push_back(scp);
+  llvm::SmallVector<llvm::StringRef> modules;
+  llvm::SmallVector<llvm::StringRef> procs;
+  std::int64_t blockId = 0;
+  for (auto iter = scopes.rbegin(), rend = scopes.rend(); iter != rend;
+       ++iter) {
+    auto *scp = *iter;
+    switch (scp->kind()) {
+    case Fortran::semantics::Scope::Kind::Module:
+      modules.emplace_back(toStringRef(scp->symbol()->name()));
+      break;
+    case Fortran::semantics::Scope::Kind::Subprogram:
+      procs.emplace_back(toStringRef(scp->symbol()->name()));
+      break;
+    case Fortran::semantics::Scope::Kind::MainProgram:
+      // Do not use the main program name, if any, because it may collide
+      // with a procedure of the same name in another compilation unit.
+      // This is nonconformant, but universally allowed.
+      procs.emplace_back(llvm::StringRef(""));
+      break;
+    case Fortran::semantics::Scope::Kind::BlockConstruct: {
+      auto it = scopeBlockIdMap.find(scp);
+      assert(it != scopeBlockIdMap.end() && it->second &&
+             "invalid block identifier");
+      blockId = it->second;
+    } break;
+    default:
+      break;
+    }
+  }
+  return {modules, procs, blockId};
 }
 
-// Mangle the name of `symbol` to make it unique within FIR's symbol table using
-// the FIR name mangler, `mangler`
+// Mangle the name of \p symbol to make it globally unique.
 std::string
 Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
+                                   ScopeBlockIdMap &scopeBlockIdMap,
                                    bool keepExternalInScope) {
-  // Resolve host and module association before mangling
+  // Resolve module and host associations before mangling.
   const auto &ultimateSymbol = symbol.GetUltimate();
-  auto symbolName = toStringRef(ultimateSymbol.name());
 
-  // The Fortran and BIND(C) namespaces are counterintuitive. A
-  // BIND(C) name is substituted early having precedence over the
-  // Fortran name of the subprogram. By side-effect, this allows
-  // multiple subprocedures with identical Fortran names to be legally
-  // present in the program. Assume the BIND(C) name is unique.
+  // The Fortran and BIND(C) namespaces are counterintuitive. A BIND(C) name is
+  // substituted early, and has precedence over the Fortran name. This allows
+  // multiple procedures or objects with identical Fortran names to legally
+  // coexist. The BIND(C) name is unique.
   if (auto *overrideName = ultimateSymbol.GetBindName())
     return *overrideName;
-  // TODO: the case of procedure that inherits the BIND(C) through another
-  // interface (procedure(iface)), should be dealt within GetBindName()
-  // directly, or some semantics wrapper.
+
+  // TODO: A procedure that inherits BIND(C) through another interface
+  // (procedure(iface)) should be dealt with in GetBindName() or some wrapper.
   if (!Fortran::semantics::IsPointer(ultimateSymbol) &&
       Fortran::semantics::IsBindCProcedure(ultimateSymbol) &&
       Fortran::semantics::ClassifyProcedure(symbol) !=
           Fortran::semantics::ProcedureDefinitionClass::Internal)
     return ultimateSymbol.name().ToString();
 
+  llvm::StringRef symbolName = toStringRef(ultimateSymbol.name());
+  llvm::SmallVector<llvm::StringRef> modules;
+  llvm::SmallVector<llvm::StringRef> procs;
+  std::int64_t blockId;
+
   // mangle ObjectEntityDetails or AssocEntityDetails symbols.
   auto mangleObject = [&]() -> std::string {
-    llvm::SmallVector<llvm::StringRef> modNames = moduleNames(ultimateSymbol);
-    std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
+    std::tie(modules, procs, blockId) =
+        ancestors(ultimateSymbol, scopeBlockIdMap);
     if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
-      return fir::NameUniquer::doConstant(modNames, optHost, symbolName);
-    return fir::NameUniquer::doVariable(modNames, optHost, symbolName);
+      return fir::NameUniquer::doConstant(modules, procs, blockId, symbolName);
+    return fir::NameUniquer::doVariable(modules, procs, blockId, symbolName);
   };
 
   return std::visit(
       Fortran::common::visitors{
           [&](const Fortran::semantics::MainProgramDetails &) {
             return fir::NameUniquer::doProgramEntry().str();
           },
           [&](const Fortran::semantics::SubprogramDetails &subpDetails) {
             // Mangle external procedure without any scope prefix.
             if (!keepExternalInScope &&
                 Fortran::semantics::IsExternal(ultimateSymbol))
               return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt,
                                                    symbolName);
             // A separate module procedure must be mangled according to its
             // declaration scope, not its definition scope.
             const Fortran::semantics::Symbol *interface = &ultimateSymbol;
             if (interface->attrs().test(Fortran::semantics::Attr::MODULE) &&
                 interface->owner().IsSubmodule() && !subpDetails.isInterface())
               interface = subpDetails.moduleInterface();
             assert(interface && "Separate module procedure must be declared");
-            llvm::SmallVector<llvm::StringRef> modNames =
-                moduleNames(*interface);
-            return fir::NameUniquer::doProcedure(modNames, hostName(*interface),
-                                                 symbolName);
+            std::tie(modules, procs, blockId) =
+                ancestors(*interface, scopeBlockIdMap);
+            return fir::NameUniquer::doProcedure(modules, procs, symbolName);
           },
           [&](const Fortran::semantics::ProcEntityDetails &) {
-            // Mangle procedure pointers and dummy procedures as variables
+            // Mangle procedure pointers and dummy procedures as variables.
             if (Fortran::semantics::IsPointer(ultimateSymbol) ||
-                Fortran::semantics::IsDummy(ultimateSymbol))
-              return fir::NameUniquer::doVariable(moduleNames(ultimateSymbol),
-                                                  hostName(ultimateSymbol),
+                Fortran::semantics::IsDummy(ultimateSymbol)) {
+              std::tie(modules, procs, blockId) =
+                  ancestors(ultimateSymbol, scopeBlockIdMap);
+              return fir::NameUniquer::doVariable(modules, procs, blockId,
                                                   symbolName);
-            // Otherwise, this is an external procedure, even if it does not
-            // have an explicit EXTERNAL attribute. Mangle it without any
-            // prefix.
+            }
+            // Otherwise, this is an external procedure, with or without an
+            // explicit EXTERNAL attribute. Mangle it without any prefix.
             return fir::NameUniquer::doProcedure(std::nullopt, std::nullopt,
                                                  symbolName);
           },
           [&](const Fortran::semantics::ObjectEntityDetails &) {
             return mangleObject();
           },
           [&](const Fortran::semantics::AssocEntityDetails &) {
             return mangleObject();
           },
           [&](const Fortran::semantics::NamelistDetails &) {
-            llvm::SmallVector<llvm::StringRef> modNames =
-                moduleNames(ultimateSymbol);
-            std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
-            return fir::NameUniquer::doNamelistGroup(modNames, optHost,
+            std::tie(modules, procs, blockId) =
+                ancestors(ultimateSymbol, scopeBlockIdMap);
+            return fir::NameUniquer::doNamelistGroup(modules, procs,
                                                      symbolName);
           },
           [&](const Fortran::semantics::CommonBlockDetails &) {
             return fir::NameUniquer::doCommonBlock(symbolName);
           },
+          [&](const Fortran::semantics::ProcBindingDetails &procBinding) {
+            return mangleName(procBinding.symbol(), scopeBlockIdMap,
+                              keepExternalInScope);
+          },
           [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string {
-            // Derived type mangling must used mangleName(DerivedTypeSpec&) so
+            // Derived type mangling must use mangleName(DerivedTypeSpec) so
             // that kind type parameter values can be mangled.
             llvm::report_fatal_error(
                 "only derived type instances can be mangled");
           },
-          [&](const Fortran::semantics::ProcBindingDetails &procBinding)
-              -> std::string {
-            return mangleName(procBinding.symbol(), keepExternalInScope);
-          },
           [](const auto &) -> std::string { TODO_NOLOC("symbol mangling"); },
       },
       ultimateSymbol.details());
 }
 
+std::string
+Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
+                                   bool keepExternalInScope) {
+  assert(symbol.owner().kind() !=
+             Fortran::semantics::Scope::Kind::BlockConstruct &&
+         "block object mangling must specify a scopeBlockIdMap");
+  ScopeBlockIdMap scopeBlockIdMap;
+  return mangleName(symbol, scopeBlockIdMap, keepExternalInScope);
+}
+
 std::string Fortran::lower::mangle::mangleName(
-    const Fortran::semantics::DerivedTypeSpec &derivedType) {
-  // Resolve host and module association before mangling
+    const Fortran::semantics::DerivedTypeSpec &derivedType,
+    ScopeBlockIdMap &scopeBlockIdMap) {
+  // Resolve module and host associations before mangling.
   const Fortran::semantics::Symbol &ultimateSymbol =
       derivedType.typeSymbol().GetUltimate();
+
   llvm::StringRef symbolName = toStringRef(ultimateSymbol.name());
-  llvm::SmallVector<llvm::StringRef> modNames = moduleNames(ultimateSymbol);
-  std::optional<llvm::StringRef> optHost = hostName(ultimateSymbol);
+  llvm::SmallVector<llvm::StringRef> modules;
+  llvm::SmallVector<llvm::StringRef> procs;
+  std::int64_t blockId;
+  std::tie(modules, procs, blockId) =
+      ancestors(ultimateSymbol, scopeBlockIdMap);
   llvm::SmallVector<std::int64_t> kinds;
   for (const auto &param :
        Fortran::semantics::OrderParameterDeclarations(ultimateSymbol)) {
     const auto &paramDetails =
         param->get<Fortran::semantics::TypeParamDetails>();
     if (paramDetails.attr() == Fortran::common::TypeParamAttr::Kind) {
       const Fortran::semantics::ParamValue *paramValue =
           derivedType.FindParameter(param->name());
       assert(paramValue && "derived type kind parameter value not found");
       const Fortran::semantics::MaybeIntExpr paramExpr =
           paramValue->GetExplicit();
       assert(paramExpr && "derived type kind param not explicit");
       std::optional<int64_t> init =
           Fortran::evaluate::ToInt64(paramValue->GetExplicit());
       assert(init && "derived type kind param is not constant");
       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) {
   auto result = fir::NameUniquer::deconstruct(name);
   return result.second.name;
 }
 
 //===----------------------------------------------------------------------===//

flang/lib/Lower/PFTBuilder.cpp

struct UnwrapStmt<parser::UnlabeledStatement<A>> {
   std::optional<parser::Label> label;
 };
 
 #ifndef NDEBUG
 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:
   PFTBuilder(const semantics::SemanticsContext &semanticsContext)
       : pgm{std::make_unique<lower::pft::Program>(
             semanticsContext.GetCommonBlocks())},
         semanticsContext{semanticsContext} {
     lower::pft::PftNode pftRoot{*pgm.get()};
constexpr bool Pre(const A &a) {
     }
     return true;
   }
 
   /// Convert an IfStmt into an IfConstruct, retaining the IfStmt as the
   /// first statement of the construct.
   void convertIfStmt(const parser::IfStmt &ifStmt, parser::CharBlock position,
                      std::optional<parser::Label> label) {
-    // Generate a skeleton IfConstruct parse node.  Its components are never
-    // referenced.  The actual components are available via the IfConstruct
+    // Generate a skeleton IfConstruct parse node. Its components are never
+    // referenced. The actual components are available via the IfConstruct
     // evaluation's nested evaluationList, with the ifStmt in the position of
-    // the otherwise normal IfThenStmt.  Caution: All other PFT nodes reference
+    // the otherwise normal IfThenStmt. Caution: All other PFT nodes reference
     // front end generated parse nodes; this is an exceptional case.
     static const auto ifConstruct = parser::IfConstruct{
         parser::Statement<parser::IfThenStmt>{
             std::nullopt,
             parser::IfThenStmt{
                 std::optional<parser::Name>{},
                 parser::ScalarLogicalExpr{parser::LogicalExpr{parser::Expr{
                     parser::LiteralConstant{parser::LogicalLiteralConstant{
private:
 
   /// pop the current list and return to the last Evaluation list
   void popEvaluationList() {
     assert(functionList && "not in a function");
     evaluationListStack.pop_back();
   }
 
   /// Rewrite IfConstructs containing a GotoStmt or CycleStmt to eliminate an
-  /// unstructured branch and a trivial basic block.  The pre-branch-analysis
+  /// unstructured branch and a trivial basic block. The pre-branch-analysis
   /// code:
   ///
   ///       <<IfConstruct>>
   ///         1 If[Then]Stmt: if(cond) goto L
   ///         2 GotoStmt: goto L
   ///         3 EndIfStmt
   ///       <<End IfConstruct>>
   ///       4 Statement: ...
   ///       5 Statement: ...
   ///       6 Statement: L ...
   ///
   /// becomes:
   ///
   ///       <<IfConstruct>>
   ///         1 If[Then]Stmt [negate]: if(cond) goto L
   ///         4 Statement: ...
   ///         5 Statement: ...
   ///         3 EndIfStmt
   ///       <<End IfConstruct>>
   ///       6 Statement: L ...
   ///
-  /// The If[Then]Stmt condition is implicitly negated.  It is not modified
-  /// in the PFT.  It must be negated when generating FIR.  The GotoStmt or
+  /// The If[Then]Stmt condition is implicitly negated. It is not modified
+  /// in the PFT. It must be negated when generating FIR. The GotoStmt or
   /// CycleStmt is deleted.
   ///
   /// The transformation is only valid for forward branch targets at the same
-  /// construct nesting level as the IfConstruct.  The result must not violate
-  /// construct nesting requirements or contain an EntryStmt.  The result
-  /// is subject to normal un/structured code classification analysis.  The
+  /// construct nesting level as the IfConstruct. The result must not violate
+  /// construct nesting requirements or contain an EntryStmt. The result
+  /// is subject to normal un/structured code classification analysis. The
   /// result is allowed to violate the F18 Clause 11.1.2.1 prohibition on
   /// transfer of control into the interior of a construct block, as that does
-  /// not compromise correct code generation.  When two transformation
-  /// candidates overlap, at least one must be disallowed.  In such cases,
+  /// not compromise correct code generation. When two transformation
+  /// candidates overlap, at least one must be disallowed. In such cases,
   /// the current heuristic favors simple code generation, which happens to
-  /// favor later candidates over earlier candidates.  That choice is probably
+  /// favor later candidates over earlier candidates. That choice is probably
   /// not significant, but could be changed.
   ///
   void rewriteIfGotos() {
     auto &evaluationList = *evaluationListStack.back();
     if (!evaluationList.size())
       return;
     struct T {
       lower::pft::EvaluationList::iterator ifConstructIt;
for (auto &eval : evaluationList) {
               labelSet.insert(label);
               assignSymbolLabelMap->try_emplace(*sym, labelSet);
             } else {
               iter->second.insert(label);
             }
           },
           [&](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);
           },
 
           // The first executable statement after an EntryStmt is a new block.
           [&](const parser::EntryStmt &) {
             eval.lexicalSuccessor->isNewBlock = true;
           },
void processEntryPoints() {
     unit->setActiveEntry(0);
   }
 
   std::unique_ptr<lower::pft::Program> pgm;
   std::vector<lower::pft::PftNode> pftParentStack;
   const semantics::SemanticsContext &semanticsContext;
 
   /// functionList points to the internal or module procedure function list
-  /// of a FunctionLikeUnit or a ModuleLikeUnit.  It may be null.
+  /// of a FunctionLikeUnit or a ModuleLikeUnit. It may be null.
   std::list<lower::pft::FunctionLikeUnit> *functionList{};
   std::vector<lower::pft::Evaluation *> constructAndDirectiveStack{};
   std::vector<lower::pft::Evaluation *> doConstructStack{};
   /// evaluationListStack is the current nested construct evaluationList state.
   std::vector<lower::pft::EvaluationList *> evaluationListStack{};
   llvm::DenseMap<parser::Label, lower::pft::Evaluation *> *labelEvaluationMap{};
   lower::pft::SymbolLabelMap *assignSymbolLabelMap{};
   std::map<std::string, lower::pft::Evaluation *> constructNameMap{};
if (depth >= 0) {
     LLVM_DEBUG(llvm::dbgs() << w << "<" << scope << "> ");
     if (auto *sym{scope->symbol()}) {
       LLVM_DEBUG(llvm::dbgs() << sym << " " << *sym << "\n");
     } else {
       if (scope->IsIntrinsicModules()) {
         LLVM_DEBUG(llvm::dbgs() << "IntrinsicModules (no detail)\n");
         return;
       }
+      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())
     if (!scp.symbol())
       dumpScope(&scp, depth + 1);
   for (auto iter = scope->begin(); iter != scope->end(); ++iter) {
     common::Reference<semantics::Symbol> sym = iter->second;
     if (auto scp = sym->scope())

 bool Fortran::lower::pft::Evaluation::lowerAsStructured() const {
   return !lowerAsUnstructured();
 }
 
 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{
       [](lower::pft::FunctionLikeUnit &c) { return &c; },
       [&](lower::pft::Evaluation &c) { return c.getOwningProcedure(); },
       [](auto &) -> lower::pft::FunctionLikeUnit * { return nullptr; },
   });
 }
if (!done.second)
       return 0;
     LLVM_DEBUG(llvm::dbgs() << "analyze symbol " << &sym << " in <"
                             << &sym.owner() << ">: " << sym << '\n');
     const bool isProcedurePointerOrDummy =
         semantics::IsProcedurePointer(sym) ||
         (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();
     if (const auto *details =
             ultimate.detailsIf<semantics::NamelistDetails>()) {
       // handle namelist group symbols
       for (const semantics::SymbolRef &s : details->objects())
         analyze(s);

flang/lib/Optimizer/Support/InternalNames.cpp

static llvm::cl::opt<std::string> mainEntryName(
     "main-entry-name",
     llvm::cl::desc("override the name of the default PROGRAM entry (may be "
                    "helpful for using other runtimes)"));
 
 constexpr std::int64_t badValue = -1;
 
 inline std::string prefix() { return "_Q"; }
 
-static std::string doModules(llvm::ArrayRef<llvm::StringRef> mods) {
-  std::string result;
-  auto *token = "M";
-  for (auto mod : mods) {
-    result.append(token).append(mod.lower());
-    token = "S";
-  }
-  return result;
-}
-
-static std::string doModulesHost(llvm::ArrayRef<llvm::StringRef> mods,
-                                 std::optional<llvm::StringRef> host) {
-  std::string result = doModules(mods);
-  if (host)
-    result.append("F").append(host->lower());
-  return result;
+/// Generate a mangling prefix from module, submodule, procedure, and
+/// statement function names, plus an (innermost) block scope id.
+static std::string doAncestors(llvm::ArrayRef<llvm::StringRef> modules,
+                               llvm::ArrayRef<llvm::StringRef> procs,
+                               std::int64_t blockId = 0) {
+  std::string prefix;
+  const char *tag = "M";
+  for (auto mod : modules) {
+    prefix.append(tag).append(mod.lower());
+    tag = "S";
+  }
+  for (auto proc : procs)
+    prefix.append("F").append(proc.lower());
+  if (blockId)
+    prefix.append("B").append(std::to_string(blockId));
+  return prefix;
 }
 
 inline llvm::SmallVector<llvm::StringRef>
 convertToStringRef(llvm::ArrayRef<std::string> from) {
   return {from.begin(), from.end()};
 }
 
 inline std::optional<llvm::StringRef>
std::string fir::NameUniquer::doKinds(llvm::ArrayRef<std::int64_t> kinds) {
   std::string result;
   for (auto i : kinds)
     result.append(doKind(i));
   return result;
 }
 
 std::string fir::NameUniquer::doCommonBlock(llvm::StringRef name) {
   std::string result = prefix();
-  return result.append("B").append(toLower(name));
-}
-
-std::string fir::NameUniquer::doBlockData(llvm::StringRef name) {
-  std::string result = prefix();
-  return result.append("L").append(toLower(name));
+  return result.append("C").append(toLower(name));
 }
 
 std::string
 fir::NameUniquer::doConstant(llvm::ArrayRef<llvm::StringRef> modules,
-                             std::optional<llvm::StringRef> host,
-                             llvm::StringRef name) {
+                             llvm::ArrayRef<llvm::StringRef> procs,
+                             std::int64_t blockId, llvm::StringRef name) {
   std::string result = prefix();
-  result.append(doModulesHost(modules, host)).append("EC");
+  result.append(doAncestors(modules, procs, blockId)).append("EC");
   return result.append(toLower(name));
 }
 
 std::string
 fir::NameUniquer::doDispatchTable(llvm::ArrayRef<llvm::StringRef> modules,
-                                  std::optional<llvm::StringRef> host,
-                                  llvm::StringRef name,
+                                  llvm::ArrayRef<llvm::StringRef> procs,
+                                  std::int64_t blockId, llvm::StringRef name,
                                   llvm::ArrayRef<std::int64_t> kinds) {
   std::string result = prefix();
-  result.append(doModulesHost(modules, host)).append("DT");
+  result.append(doAncestors(modules, procs, blockId)).append("DT");
   return result.append(toLower(name)).append(doKinds(kinds));
 }
 
 std::string fir::NameUniquer::doGenerated(llvm::StringRef name) {
   std::string result = prefix();
   return result.append("Q").append(name);
 }
 
 std::string fir::NameUniquer::doIntrinsicTypeDescriptor(
     llvm::ArrayRef<llvm::StringRef> modules,
-    std::optional<llvm::StringRef> host, IntrinsicType type,
-    std::int64_t kind) {
+    llvm::ArrayRef<llvm::StringRef> procs, std::int64_t blockId,
+    IntrinsicType type, std::int64_t kind) {
   const char *name = nullptr;
   switch (type) {
   case IntrinsicType::CHARACTER:
     name = "character";
     break;
   case IntrinsicType::COMPLEX:
     name = "complex";
     break;
   case IntrinsicType::INTEGER:
     name = "integer";
     break;
   case IntrinsicType::LOGICAL:
     name = "logical";
     break;
   case IntrinsicType::REAL:
     name = "real";
     break;
   }
   assert(name && "unknown intrinsic type");
   std::string result = prefix();
-  result.append(doModulesHost(modules, host)).append("C");
+  result.append(doAncestors(modules, procs, blockId)).append("YI");
   return result.append(name).append(doKind(kind));
 }
 
 std::string
 fir::NameUniquer::doProcedure(llvm::ArrayRef<llvm::StringRef> modules,
-                              std::optional<llvm::StringRef> host,
+                              llvm::ArrayRef<llvm::StringRef> procs,
                               llvm::StringRef name) {
   std::string result = prefix();
-  result.append(doModulesHost(modules, host)).append("P");
+  result.append(doAncestors(modules, procs)).append("P");
   return result.append(toLower(name));
 }
 
 std::string fir::NameUniquer::doType(llvm::ArrayRef<llvm::StringRef> modules,
-                                     std::optional<llvm::StringRef> host,
-                                     llvm::StringRef name,
+                                     llvm::ArrayRef<llvm::StringRef> procs,
+                                     std::int64_t blockId, llvm::StringRef name,
                                      llvm::ArrayRef<std::int64_t> kinds) {
   std::string result = prefix();
-  result.append(doModulesHost(modules, host)).append("T");
+  result.append(doAncestors(modules, procs, blockId)).append("T");
   return result.append(toLower(name)).append(doKinds(kinds));
 }
 
 std::string
 fir::NameUniquer::doTypeDescriptor(llvm::ArrayRef<llvm::StringRef> modules,
-                                   std::optional<llvm::StringRef> host,
-                                   llvm::StringRef name,
+                                   llvm::ArrayRef<llvm::StringRef> procs,
+                                   std::int64_t blockId, llvm::StringRef name,
                                    llvm::ArrayRef<std::int64_t> kinds) {
   std::string result = prefix();
-  result.append(doModulesHost(modules, host)).append("CT");
+  result.append(doAncestors(modules, procs, blockId)).append("CT");
   return result.append(toLower(name)).append(doKinds(kinds));
 }
 
-std::string fir::NameUniquer::doTypeDescriptor(
-    llvm::ArrayRef<std::string> modules, std::optional<std::string> host,
-    llvm::StringRef name, llvm::ArrayRef<std::int64_t> kinds) {
+std::string
+fir::NameUniquer::doTypeDescriptor(llvm::ArrayRef<std::string> modules,
+                                   llvm::ArrayRef<std::string> procs,
+                                   std::int64_t blockId, llvm::StringRef name,
+                                   llvm::ArrayRef<std::int64_t> kinds) {
   auto rmodules = convertToStringRef(modules);
-  auto rhost = convertToStringRef(host);
-  return doTypeDescriptor(rmodules, rhost, name, kinds);
+  auto rprocs = convertToStringRef(procs);
+  return doTypeDescriptor(rmodules, rprocs, blockId, name, kinds);
 }
 
 std::string
 fir::NameUniquer::doVariable(llvm::ArrayRef<llvm::StringRef> modules,
-                             std::optional<llvm::StringRef> host,
-                             llvm::StringRef name) {
+                             llvm::ArrayRef<llvm::StringRef> procs,
+                             std::int64_t blockId, llvm::StringRef name) {
   std::string result = prefix();
-  result.append(doModulesHost(modules, host)).append("E");
+  result.append(doAncestors(modules, procs, blockId)).append("E");
   return result.append(toLower(name));
 }
 
 std::string
 fir::NameUniquer::doNamelistGroup(llvm::ArrayRef<llvm::StringRef> modules,
-                                  std::optional<llvm::StringRef> host,
+                                  llvm::ArrayRef<llvm::StringRef> procs,
                                   llvm::StringRef name) {
   std::string result = prefix();
-  result.append(doModulesHost(modules, host)).append("G");
+  result.append(doAncestors(modules, procs)).append("N");
   return result.append(toLower(name));
 }
 
 llvm::StringRef fir::NameUniquer::doProgramEntry() {
   if (mainEntryName.size())
     return mainEntryName;
   return "_QQmain";
 }
 
 std::pair<fir::NameUniquer::NameKind, fir::NameUniquer::DeconstructedName>
 fir::NameUniquer::deconstruct(llvm::StringRef uniq) {
   if (uniq.startswith("_Q")) {
     llvm::SmallVector<std::string> modules;
-    std::optional<std::string> host;
+    llvm::SmallVector<std::string> procs;
+    std::int64_t blockId = 0;
     std::string name;
     llvm::SmallVector<std::int64_t> kinds;
     NameKind nk = NameKind::NOT_UNIQUED;
     for (std::size_t i = 2, end{uniq.size()}; i != end;) {
       switch (uniq[i]) {
-      case 'B':
-        nk = NameKind::COMMON;
-        name = readName(uniq, i, i + 1, end);
+      case 'B': // Block
+        blockId = readInt(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);
-        }
+      case 'C': // Common block
+        nk = NameKind::COMMON;
         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;
+      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)};
 }
 
 bool fir::NameUniquer::isExternalFacingUniquedName(
     const std::pair<fir::NameUniquer::NameKind,
                     fir::NameUniquer::DeconstructedName> &deconstructResult) {
   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) {
   auto result = fir::NameUniquer::deconstruct(uniquedName);
   return result.first != fir::NameUniquer::NameKind::NOT_UNIQUED &&
          fir::NameUniquer::isExternalFacingUniquedName(result);
 }
 
static std::string getDerivedTypeObjectName(llvm::StringRef mangledTypeName,
   auto result = fir::NameUniquer::deconstruct(mangledTypeName);
   if (result.first != fir::NameUniquer::NameKind::DERIVED_TYPE)
     return "";
   std::string varName = separator.str() + result.second.name +
                         mangleTypeDescriptorKinds(result.second.kinds);
   llvm::SmallVector<llvm::StringRef> modules;
   for (const std::string &mod : result.second.modules)
     modules.push_back(mod);
-  std::optional<llvm::StringRef> host;
-  if (result.second.host)
-    host = *result.second.host;
-  return fir::NameUniquer::doVariable(modules, host, varName);
+  llvm::SmallVector<llvm::StringRef> procs;
+  for (const std::string &proc : result.second.procs)
+    procs.push_back(proc);
+  return fir::NameUniquer::doVariable(modules, procs, result.second.blockId,
+                                      varName);
 }
 
 std::string
 fir::NameUniquer::getTypeDescriptorName(llvm::StringRef mangledTypeName) {
   return getDerivedTypeObjectName(mangledTypeName, typeDescriptorSeparator);
 }
 
 std::string fir::NameUniquer::getTypeDescriptorBindingTableName(
     llvm::StringRef mangledTypeName) {
   return getDerivedTypeObjectName(mangledTypeName, bindingTableSeparator);
 }

flang/test/Fir/external-mangling.fir

 // RUN: fir-opt --external-name-interop="append-underscore=true" %s | FileCheck %s --check-prefix=CHECK-UNDER
 // RUN: fir-opt --external-name-interop="append-underscore=false" %s | FileCheck %s --check-prefix=CHECK-NOUNDER
 // RUN: tco --external-name-interop="append-underscore=true" %s | FileCheck %s --check-prefix=CHECK-UNDER
 // RUN: tco --external-name-interop="append-underscore=false" %s | FileCheck %s --check-prefix=CHECK-NOUNDER
 // RUN: tco --external-name-interop="append-underscore=true" %s | tco --fir-to-llvm-ir | FileCheck %s --check-prefix=LLVMIR-UNDER
 // RUN: tco --external-name-interop="append-underscore=false" %s | tco --fir-to-llvm-ir | FileCheck %s --check-prefix=LLVMIR-NOUNDER
 
 func.func @_QPfoo() {
   %c0 = arith.constant 0 : index
-  %0 = fir.address_of(@_QBa) : !fir.ref<!fir.array<4xi8>>
+  %0 = fir.address_of(@_QCa) : !fir.ref<!fir.array<4xi8>>
   %1 = fir.convert %0 : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
   %2 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
   %3 = fir.convert %2 : (!fir.ref<i8>) -> !fir.ref<i32>
-  %4 = fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
+  %4 = fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
   %5 = fir.convert %4 : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
   %6 = fir.coordinate_of %5, %c0 : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
   %7 = fir.convert %6 : (!fir.ref<i8>) -> !fir.ref<f32>
   fir.call @_QPbar(%3) : (!fir.ref<i32>) -> ()
   fir.call @_QPbar2(%7) : (!fir.ref<f32>) -> ()
   return
 }
-fir.global common @_QBa(dense<0> : vector<4xi8>) : !fir.array<4xi8>
-fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+fir.global common @_QCa(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+fir.global common @_QC(dense<0> : vector<4xi8>) : !fir.array<4xi8>
 func.func private @_QPbar(!fir.ref<i32>)
 func.func private @_QPbar2(!fir.ref<f32>)
 
 // CHECK-UNDER: func @foo_
 // CHECK-UNDER: %{{.*}} = fir.address_of(@a_) : !fir.ref<!fir.array<4xi8>>
 // CHECK-UNDER: %{{.*}} = fir.address_of(@__BLNK__) : !fir.ref<!fir.array<4xi8>>
 // CHECK-UNDER: fir.call @bar_
 // CHECK-UNDER: fir.call @bar2_

flang/test/Lower/HLFIR/allocatable-and-pointer-status-change.f90

 ! CHECK:  %[[VAL_4:.*]] = arith.constant 10 : index
 ! CHECK:  %[[VAL_5:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_4]])  : (!fir.ref<!fir.array<10x!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>, index) -> !fir.ref<!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>
 ! CHECK:  %[[VAL_6:.*]] = hlfir.designate %[[VAL_5]]{"a"}   {fortran_attrs = #fir.var_attrs<allocatable>} : (!fir.ref<!fir.type<_QFalloc_compTt{a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
 ! CHECK:  %[[VAL_7:.*]] = arith.constant 100 : i64
 ! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
 ! CHECK:  %[[VAL_9:.*]] = arith.constant 0 : index
 ! CHECK:  %[[VAL_10:.*]] = arith.cmpi sgt, %[[VAL_8]], %[[VAL_9]] : index
 ! CHECK:  %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index
-! CHECK:  %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]] {fir.must_be_heap = true, uniq_name = "_QEa.alloc"}
+! CHECK:  %[[VAL_12:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_11]] {fir.must_be_heap = true, uniq_name = "_QFalloc_compEa.alloc"}
 ! CHECK:  %[[VAL_13:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
 ! CHECK:  %[[VAL_14:.*]] = fir.embox %[[VAL_12]](%[[VAL_13]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
 ! CHECK:  fir.store %[[VAL_14]] to %[[VAL_6]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
 end subroutine
 
 subroutine ptr_comp_assign(x, ziel)
   type t
      real, pointer :: p(:)

flang/test/Lower/HLFIR/statement-functions.f90

 ! CHECK-LABEL: func.func @_QPchar_test(
 ! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3:.*]]#0 typeparams %[[VAL_3]]#1 {{.*}}c"
 ! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2:[^ ]*]] {{.*}}n"
 ! CHECK:  %[[VAL_13:.*]]:2 = fir.unboxchar %[[VAL_4]]#0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
 ! CHECK:  %[[VAL_14:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref<i32>
 ! CHECK:  %[[VAL_15:.*]] = arith.constant 0 : i32
 ! CHECK:  %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_14]], %[[VAL_15]] : i32
 ! CHECK:  %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_14]], %[[VAL_15]] : i32
-! CHECK:  %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_13]]#0 typeparams %[[VAL_17]] {uniq_name = "_QFstmt_funcEchar_stmt_func_dummy_arg"} : (!fir.ref<!fir.char<1,?>>, i32) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK:  %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_13]]#0 typeparams %[[VAL_17]] {uniq_name = "_QFchar_testFstmt_funcEchar_stmt_func_dummy_arg"} : (!fir.ref<!fir.char<1,?>>, i32) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
 ! CHECK:  %[[VAL_19:.*]] = arith.constant 10 : i64
 ! CHECK:  %[[VAL_20:.*]] = hlfir.set_length %[[VAL_18]]#0 len %[[VAL_19]] : (!fir.boxchar<1>, i64) -> !hlfir.expr<!fir.char<1,10>>

flang/test/Lower/OpenMP/threadprivate-commonblock.f90

 ! This test checks lowering of OpenMP Threadprivate Directive.
 ! Test for common block.
 
 !RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s
 
 module test
   integer:: a
   real :: b(2)
   complex, pointer :: c, d(:)
   character(5) :: e, f(2)
   common /blk/ a, b, c, d, e, f
 
   !$omp threadprivate(/blk/)
 
-!CHECK: fir.global common @_QBblk(dense<0> : vector<103xi8>) : !fir.array<103xi8>
+!CHECK: fir.global common @_QCblk(dense<0> : vector<103xi8>) : !fir.array<103xi8>
 
 contains
   subroutine sub()
-!CHECK:  [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<103xi8>>
+!CHECK:  [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<103xi8>>
 !CHECK:  [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.array<103xi8>> -> !fir.ref<!fir.array<103xi8>>
 !CHECK-DAG:  [[ADDR1:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref<!fir.array<103xi8>>) -> !fir.ref<!fir.array<?xi8>>
 !CHECK-DAG:  [[C0:%.*]] = arith.constant 0 : index
 !CHECK-DAG:  [[ADDR2:%.*]] = fir.coordinate_of [[ADDR1]], [[C0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 !CHECK-DAG:  [[ADDR3:%.*]] = fir.convert [[ADDR2]] : (!fir.ref<i8>) -> !fir.ref<i32>
 !CHECK-DAG:  [[ADDR4:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref<!fir.array<103xi8>>) -> !fir.ref<!fir.array<?xi8>>
 !CHECK-DAG:  [[C1:%.*]] = arith.constant 4 : index
 !CHECK-DAG:  [[ADDR5:%.*]] = fir.coordinate_of [[ADDR4]], [[C1]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>

flang/test/Lower/OpenMP/threadprivate-use-association.f90

 ! This test checks lowering of OpenMP Threadprivate Directive.
 ! Test for threadprivate variable in use association.
 
 !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
   integer :: x
   real :: y, z(5)
   common /blk/ x, z
 
   !$omp threadprivate(y, /blk/)
 
 contains
   subroutine sub()
 ! CHECK-LABEL: @_QMtestPsub
-!CHECK-DAG:   [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<24xi8>>
+!CHECK-DAG:   [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<24xi8>>
 !CHECK-DAG:   [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.array<24xi8>> -> !fir.ref<!fir.array<24xi8>>
 !CHECK-DAG:   [[ADDR1:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref<f32>
 !CHECK-DAG:   [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref<f32> -> !fir.ref<f32>
 
     !$omp parallel
 !CHECK-DAG:    [[ADDR2:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.array<24xi8>> -> !fir.ref<!fir.array<24xi8>>
 !CHECK-DAG:    [[ADDR3:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref<f32> -> !fir.ref<f32>
 !CHECK-DAG:    [[ADDR4:%.*]] = fir.convert [[ADDR2]] : (!fir.ref<!fir.array<24xi8>>) -> !fir.ref<!fir.array<?xi8>>
program main
   real :: z1(5)
   common /blk/ x1, z1
 
   !$omp threadprivate(/blk/)
 
   call sub()
 
 ! CHECK-LABEL: @_QQmain()
-!CHECK-DAG:  [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<24xi8>>
+!CHECK-DAG:  [[ADDR0:%.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<24xi8>>
 !CHECK-DAG:  [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref<!fir.array<24xi8>> -> !fir.ref<!fir.array<24xi8>>
-!CHECK-DAG:  [[ADDR1:%.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<24xi8>>
+!CHECK-DAG:  [[ADDR1:%.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<24xi8>>
 !CHECK-DAG:  [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref<!fir.array<24xi8>> -> !fir.ref<!fir.array<24xi8>>
 !CHECK-DAG:  [[ADDR2:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref<f32>
 !CHECK-DAG:  [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref<f32> -> !fir.ref<f32>
 
   !$omp parallel
 !CHECK-DAG:    [[ADDR4:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref<!fir.array<24xi8>> -> !fir.ref<!fir.array<24xi8>>
 !CHECK-DAG:    [[ADDR5:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref<f32> -> !fir.ref<f32>
 !CHECK-DAG:    [[ADDR6:%.*]] = fir.convert [[ADDR4]] : (!fir.ref<!fir.array<24xi8>>) -> !fir.ref<!fir.array<?xi8>>

flang/test/Lower/arithmetic-goto.f90

 ! RUN: bbc -emit-fir -o - %s | FileCheck %s
 
 ! CHECK-LABEL: func @_QPkagi
 function kagi(index)
-  ! CHECK: fir.select_case %{{.}} : i32 [#fir.upper, %c-1_i32, ^bb{{.}}, #fir.lower, %c1_i32, ^bb{{.}}, unit, ^bb{{.}}]
+  ! CHECK:   %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "kagi"
+  ! CHECK:   %[[V_1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+  ! CHECK:   %[[V_2:[0-9]+]] = arith.cmpi slt, %[[V_1]], %c0{{.*}} : i32
+  ! CHECK:   cf.cond_br %[[V_2]], ^bb2, ^bb1
+  ! CHECK: ^bb1:  // pred: ^bb0
+  ! CHECK:   %[[V_3:[0-9]+]] = arith.cmpi sgt, %[[V_1]], %c0{{.*}} : i32
+  ! CHECK:   cf.cond_br %[[V_3]], ^bb4, ^bb3
+  ! CHECK: ^bb2:  // pred: ^bb0
+  ! CHECK:   fir.store %c1{{.*}} to %[[V_0]] : !fir.ref<i32>
+  ! CHECK:   cf.br ^bb5
+  ! CHECK: ^bb3:  // pred: ^bb1
+  ! CHECK:   fir.store %c2{{.*}} to %[[V_0]] : !fir.ref<i32>
+  ! CHECK:   cf.br ^bb5
+  ! CHECK: ^bb4:  // pred: ^bb1
+  ! CHECK:   fir.store %c3{{.*}} to %[[V_0]] : !fir.ref<i32>
+  ! CHECK:   cf.br ^bb5
+  ! CHECK: ^bb5:  // 3 preds: ^bb2, ^bb3, ^bb4
+  ! CHECK:   %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+  ! CHECK:   return %[[V_4]] : i32
   if (index) 7, 8, 9
   kagi = 0; return
 7 kagi = 1; return
 8 kagi = 2; return
 9 kagi = 3; return
 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<f32>
+  ! CHECK:   %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref<f32>
+  ! CHECK:   %[[V_3:[0-9]+]] = arith.addf %[[V_1]], %[[V_2]] {{.*}} : f32
+  ! CHECK:   %[[V_4:[0-9]+]] = arith.addf %[[V_3]], %[[V_3]] {{.*}} : f32
+  ! CHECK:   %cst = arith.constant 0.000000e+00 : f32
+  ! CHECK:   %[[V_5:[0-9]+]] = arith.cmpf olt, %[[V_4]], %cst : f32
+  ! CHECK:   cf.cond_br %[[V_5]], ^bb2, ^bb1
+  ! CHECK: ^bb1:  // pred: ^bb0
+  ! CHECK:   %[[V_6:[0-9]+]] = arith.cmpf ogt, %[[V_4]], %cst : f32
+  ! CHECK:   cf.cond_br %[[V_6]], ^bb4, ^bb3
+  ! CHECK: ^bb2:  // pred: ^bb0
+  ! CHECK:   fir.store %c1{{.*}} to %[[V_0]] : !fir.ref<i32>
+  ! CHECK:   cf.br ^bb5
+  ! CHECK: ^bb3:  // pred: ^bb1
+  ! CHECK:   fir.store %c2{{.*}} to %[[V_0]] : !fir.ref<i32>
+  ! CHECK:   cf.br ^bb5
+  ! CHECK: ^bb4:  // pred: ^bb1
+  ! CHECK:   fir.store %c3{{.*}} to %[[V_0]] : !fir.ref<i32>
+  ! CHECK:   cf.br ^bb5
+  ! CHECK: ^bb5:  // 3 preds: ^bb2, ^bb3, ^bb4
+  ! CHECK:   %[[V_7:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+  ! CHECK:   return %[[V_7]] : i32
   if (findex+findex) 7, 8, 9
   kagf = 0; return
 7 kagf = 1; return
 8 kagf = 2; return
 9 kagf = 3; return
 end
 
 ! CHECK-LABEL: func @_QQmain

flang/test/Lower/array.f90

 ! 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
 ! CHECK: %[[VAL_4:.*]] = fir.undefined tuple<!fir.array<5x5xf32>>
 ! CHECK: %[[VAL_5:.*]] = fir.undefined !fir.array<5x5xf32>
 ! CHECK: %[[VAL_6:.*]] = fir.insert_on_range %[[VAL_5]], %[[VAL_1]] from (0, 0) to (1, 0) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32>
 ! CHECK: %[[VAL_7:.*]] = fir.insert_on_range %[[VAL_6]], %[[VAL_3]] from (2, 0) to (4, 0) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32>
 ! CHECK: %[[VAL_8:.*]] = fir.insert_on_range %[[VAL_7]], %[[VAL_1]] from (0, 1) to (1, 1) : (!fir.array<5x5xf32>, f32) -> !fir.array<5x5xf32>

flang/test/Lower/block.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: func @_QQmain
+program bb ! block stack management and exits
+    ! CHECK:   %[[V_1:[0-9]+]] = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"}
+    integer :: i, j
+    ! CHECK:   fir.store %c0{{.*}} to %[[V_1]] : !fir.ref<i32>
+    i = 0
+    ! CHECK:   %[[V_3:[0-9]+]] = fir.call @llvm.stacksave()
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   br ^bb1
+    ! CHECK: ^bb1:  // 2 preds: ^bb0, ^bb15
+    ! CHECK:   cond_br %{{.*}}, ^bb2, ^bb16
+    ! CHECK: ^bb2:  // pred: ^bb1
+    ! CHECK:   %[[V_11:[0-9]+]] = fir.call @llvm.stacksave()
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   cond_br %{{.*}}, ^bb3, ^bb4
+    ! CHECK: ^bb3:  // pred: ^bb2
+    ! CHECK:   br ^bb10
+    ! CHECK: ^bb4:  // pred: ^bb2
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   cond_br %{{.*}}, ^bb5, ^bb6
+    ! CHECK: ^bb5:  // pred: ^bb4
+    ! CHECK:   br ^bb7
+    ! CHECK: ^bb6:  // pred: ^bb4
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   cond_br %{{.*}}, ^bb7, ^bb8
+    ! CHECK: ^bb7:  // 3 preds: ^bb5, ^bb6, ^bb12
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_11]])
+    ! CHECK:   br ^bb14
+    ! CHECK: ^bb8:  // pred: ^bb6
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   cond_br %{{.*}}, ^bb9, ^bb10
+    ! CHECK: ^bb9:  // pred: ^bb8
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_11]])
+    ! CHECK:   br ^bb15
+    ! CHECK: ^bb10:  // 2 preds: ^bb3, ^bb8
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   cond_br %{{.*}}, ^bb11, ^bb12
+    ! CHECK: ^bb11:  // pred: ^bb10
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_11]])
+    ! CHECK:   br ^bb17
+    ! CHECK: ^bb12:  // pred: ^bb10
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   cond_br %{{.*}}, ^bb13, ^bb7
+    ! CHECK: ^bb13:  // pred: ^bb12
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_11]])
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_3]])
+    ! CHECK:   br ^bb18
+    ! CHECK: ^bb14:  // pred: ^bb7
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   br ^bb15
+    ! CHECK: ^bb15:  // 2 preds: ^bb9, ^bb14
+    ! CHECK:   br ^bb1
+    ! CHECK: ^bb16:  // pred: ^bb1
+    ! CHECK:   fir.store %{{.*}} to %[[V_1]] : !fir.ref<i32>
+    ! CHECK:   br ^bb17
+    ! CHECK: ^bb17:  // 2 preds: ^bb11, ^bb16
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_3]])
+    ! CHECK:   br ^bb18
+    ! CHECK: ^bb18:  // 2 preds: ^bb13, ^bb17
+    ! CHECK:   return
+    block
+      i = i + 1 ! 1 increment
+      do j = 1, 5
+        block
+          i = i + 1; if (j == 1) goto 1   ! inner block - 5 increments, 1 goto
+          i = i + 1; if (j == 2) goto 2   ! inner block - 4 increments, 1 goto
+          i = i + 1; if (j == 3) goto 10  ! outer block - 3 increments, 1 goto
+          i = i + 1; if (j == 4) goto 11  ! outer block - 2 increments, 1 goto
+1         i = i + 1; if (j == 5) goto 12  ! outer block - 2 increments, 1 goto
+          i = i + 1; if (j == 6) goto 100 ! program     - 1 increment
+2       end block
+10      i = i + 1 ! 3 increments
+11    end do
+      i = i + 1 ! 0 increments
+12  end block
+100 print*, i ! expect 21
+end

flang/test/Lower/common-block-2.f90

 ! RUN: bbc %s -o - | FileCheck %s
 
 ! Test support of non standard features regarding common blocks:
 ! - A named common that appears with different storage sizes
 ! - A blank common that is initialized
 ! - A common block that is initialized outside of a BLOCK DATA.
 
-! CHECK-LABEL: fir.global @_QB : tuple<i32, !fir.array<8xi8>> {
+! CHECK-LABEL: fir.global @_QC : tuple<i32, !fir.array<8xi8>> {
 ! CHECK:  %[[undef:.*]] = fir.undefined tuple<i32, !fir.array<8xi8>>
 ! CHECK:  %[[init:.*]] = fir.insert_value %[[undef]], %c42{{.*}}, [0 : index] : (tuple<i32, !fir.array<8xi8>>, i32) -> tuple<i32, !fir.array<8xi8>>
 ! CHECK:  fir.has_value %[[init]] : tuple<i32, !fir.array<8xi8>>
 
-! CHECK-LABEL: fir.global @_QBa : tuple<i32, !fir.array<8xi8>> {
+! CHECK-LABEL: fir.global @_QCa : tuple<i32, !fir.array<8xi8>> {
 ! CHECK:  %[[undef:.*]] = fir.undefined tuple<i32, !fir.array<8xi8>>
 ! CHECK:  %[[init:.*]] = fir.insert_value %[[undef]], %c42{{.*}}, [0 : index] : (tuple<i32, !fir.array<8xi8>>, i32) -> tuple<i32, !fir.array<8xi8>>
 ! CHECK:  fir.has_value %[[init]] : tuple<i32, !fir.array<8xi8>>
 
 
 subroutine first_appearance
   real :: x, y, xa, ya
   common // x, y

flang/test/Lower/common-block.f90

 ! 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
 
 ! CHECK-LABEL: _QPs1
 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
 
 ! CHECK-LABEL: _QPs2
 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
 
 ! Test that common initialized through aliases of common members are getting
 ! the correct initializer.
 ! CHECK-LABEL: _QPs3
 subroutine s3
  integer :: i = 42
  real :: x
  complex :: c
  real :: glue(2)
  real :: y = 3.
  equivalence (i, x), (glue(1), c), (glue(2), y)
  ! x and c are not directly initialized, but overlapping aliases are.
  common /z/ x, c
 end subroutine s3
 
 module mod_with_common
   integer :: i, j
   common /c_in_mod/ i, j
 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
 
 ! CHECK-LABEL: _QPs5
 subroutine s5
   real r(1:0)
   common /rien/ r
 end subroutine s5
 
 ! CHECK-LABEL: _QPs6
 subroutine s6
   real r1(1:0), r2(1:0), x, y
   common /with_empty_equiv/ x, r1, y
   equivalence(r1, r2)
 end subroutine s6

flang/test/Lower/computed-goto.f90

 ! RUN: bbc -emit-fir -o - %s | FileCheck %s
 
 ! CHECK-LABEL: func @_QPm
 function m(index)
-  ! CHECK: fir.select %{{.}} : i32 [1, ^bb{{.}}, 2, ^bb{{.}}, 3, ^bb{{.}}, 4, ^bb{{.}}, 5, ^bb{{.}}, unit, ^bb{{.}}]
+    ! CHECK:   %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "m"
+    ! CHECK:   %[[V_1:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+    ! CHECK:   fir.select %[[V_1]] : i32 [1, ^bb6, 2, ^bb5, 3, ^bb4, 4, ^bb3, 5, ^bb2, unit, ^bb1]
+    ! CHECK: ^bb1:  // pred: ^bb0
+    ! CHECK:   fir.store %c0{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb2:  // pred: ^bb0
+    ! CHECK:   fir.store %c1{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb3:  // pred: ^bb0
+    ! CHECK:   fir.store %c3{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb4:  // pred: ^bb0
+    ! CHECK:   fir.store %c5{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb5:  // pred: ^bb0
+    ! CHECK:   fir.store %c7{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb6:  // pred: ^bb0
+    ! CHECK:   fir.store %c9{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb7:  // 6 preds: ^bb1, ^bb2, ^bb3, ^bb4, ^bb5, ^bb6
+    ! CHECK:   %[[V_2:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   return %[[V_2]] : i32
     goto (9,7,5,3,1) index ! + 1
     m = 0; return
-1 m = 1; return
-3 m = 3; return
-5 m = 5; return
-7 m = 7; return
-9 m = 9; return
+1   m = 1; return
+3   m = 3; return
+5   m = 5; return
+7   m = 7; return
+9   m = 9; return
 end
 
-! print*, m(-3); print*, m(0)
-! print*, m(1); print*, m(2); print*, m(3); print*, m(4); print*, m(5)
-! print*, m(6); print*, m(9)
+! CHECK-LABEL: func @_QPm1
+function m1(index)
+    ! CHECK:   %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "m1"
+    ! CHECK:   %[[V_1:[0-9]+]] = fir.call @llvm.stacksave()
+    ! CHECK:   %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+    ! CHECK:   %[[V_3:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c1{{.*}} : i32
+    ! CHECK:   cf.cond_br %[[V_3]], ^bb1, ^bb2
+    ! CHECK: ^bb1:  // pred: ^bb0
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   cf.br ^bb3
+    ! CHECK: ^bb2:  // pred: ^bb0
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   fir.store %c0{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb4
+    ! CHECK: ^bb3:  // pred: ^bb1
+    ! CHECK:   fir.store %c10{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb4
+    ! CHECK: ^bb4:  // 2 preds: ^bb2, ^bb3
+    ! CHECK:   %[[V_4:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   return %[[V_4]] : i32
+    block
+      goto (10) index
+    end block
+    m1 =  0; return
+10  m1 = 10; return
+end
+
+! CHECK-LABEL: func @_QPm2
+function m2(index)
+    ! CHECK:   %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "m2"
+    ! CHECK:   %[[V_1:[0-9]+]] = fir.call @llvm.stacksave()
+    ! CHECK:   %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+    ! CHECK:   %[[V_3:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c1{{.*}} : i32
+    ! CHECK:   cf.cond_br %[[V_3]], ^bb1, ^bb2
+    ! CHECK: ^bb1:  // pred: ^bb0
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   cf.br ^bb5
+    ! CHECK: ^bb2:  // pred: ^bb0
+    ! CHECK:   %[[V_4:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c2{{.*}} : i32
+    ! CHECK:   cf.cond_br %[[V_4]], ^bb3, ^bb4
+    ! CHECK: ^bb3:  // pred: ^bb2
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   cf.br ^bb6
+    ! CHECK: ^bb4:  // pred: ^bb2
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   fir.store %c0{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb5:  // pred: ^bb1
+    ! CHECK:   fir.store %c10{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb6:  // pred: ^bb3
+    ! CHECK:   fir.store %c20{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb7:  // 3 preds: ^bb4, ^bb5, ^bb6
+    ! CHECK:   %[[V_5:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   return %[[V_5]] : i32
+    block
+      goto (10,20) index
+    end block
+    m2 =  0; return
+10  m2 = 10; return
+20  m2 = 20; return
+end
+
+! CHECK-LABEL: func @_QPm3
+function m3(index)
+    ! CHECK:   %[[V_0:[0-9]+]] = fir.alloca i32 {bindc_name = "m3"
+    ! CHECK:   %[[V_1:[0-9]+]] = fir.call @llvm.stacksave()
+    ! CHECK:   %[[V_2:[0-9]+]] = fir.load %arg0 : !fir.ref<i32>
+    ! CHECK:   %[[V_3:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c1{{.*}} : i32
+    ! CHECK:   cf.cond_br %[[V_3]], ^bb1, ^bb2
+    ! CHECK: ^bb1:  // pred: ^bb0
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   cf.br ^bb7
+    ! CHECK: ^bb2:  // pred: ^bb0
+    ! CHECK:   %[[V_4:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c2{{.*}} : i32
+    ! CHECK:   cf.cond_br %[[V_4]], ^bb3, ^bb4
+    ! CHECK: ^bb3:  // pred: ^bb2
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   cf.br ^bb8
+    ! CHECK: ^bb4:  // pred: ^bb2
+    ! CHECK:   %[[V_5:[0-9]+]] = arith.cmpi eq, %[[V_2]], %c3{{.*}} : i32
+    ! CHECK:   cf.cond_br %[[V_5]], ^bb5, ^bb6
+    ! CHECK: ^bb5:  // pred: ^bb4
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   cf.br ^bb9
+    ! CHECK: ^bb6:  // pred: ^bb4
+    ! CHECK:   fir.call @llvm.stackrestore(%[[V_1]])
+    ! CHECK:   fir.store %c0{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb10
+    ! CHECK: ^bb7:  // pred: ^bb1
+    ! CHECK:   fir.store %c10{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb10
+    ! CHECK: ^bb8:  // pred: ^bb3
+    ! CHECK:   fir.store %c20{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb10
+    ! CHECK: ^bb9:  // pred: ^bb5
+    ! CHECK:   fir.store %c30{{.*}} to %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   cf.br ^bb10
+    ! CHECK: ^bb10:  // 4 preds: ^bb6, ^bb7, ^bb8, ^bb9
+    ! CHECK:   %[[V_6:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<i32>
+    ! CHECK:   return %[[V_6]] : i32
+    block
+      goto (10,20,30) index
+    end block
+    m3 =  0; return
+10  m3 = 10; return
+20  m3 = 20; return
+30  m3 = 30; return
+end
+
+program cg
+  print*, m(-3), m(1), m(2), m(3), m(4), m(5), m(9) ! 0 9 7 5 3 1 0
+  print*, m1(0), m1(1), m1(2) ! 0 10 0
+  print*, m2(0), m2(1), m2(2), m2(3) ! 0 10 20 0
+  print*, m3(0), m3(1), m3(2), m3(3), m3(4) ! 0 10 20 30 0
 end

flang/test/Lower/equivalence-2.f90

subroutine eq_and_comm_same_offset
   real common_arr1(133),common_arr2(133)
   common /my_common_block/ common_arr1,common_arr2
   real arr1(133),arr2(133)
   real arr3(133,133),arr4(133,133)
   equivalence(arr1,common_arr1),(arr2,common_arr2)
   equivalence(arr3,arr4)
 
   ! CHECK: %[[arr4Store:.*]] = fir.alloca !fir.array<70756xi8> {uniq_name = "_QFeq_and_comm_same_offsetEarr3"}
-  ! CHECK: %[[mcbAddr:.*]] = fir.address_of(@_QBmy_common_block) : !fir.ref<!fir.array<1064xi8>>
+  ! CHECK: %[[mcbAddr:.*]] = fir.address_of(@_QCmy_common_block) : !fir.ref<!fir.array<1064xi8>>
   ! CHECK: %[[mcbCast:.*]] = fir.convert %[[mcbAddr]] : (!fir.ref<!fir.array<1064xi8>>) -> !fir.ref<!fir.array<?xi8>>
   ! CHECK: %[[c0:.*]] = arith.constant 0 : index
   ! CHECK: %[[mcbCoor:.*]] = fir.coordinate_of %[[mcbCast]], %[[c0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
   ! CHECK: %[[mcbCoorCast:.*]] = fir.convert %[[mcbCoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.array<133xf32>>
   ! CHECK: %[[c1:.*]] = arith.constant 0 : index
   ! CHECK: %[[arr4Addr:.*]] = fir.coordinate_of %[[arr4Store]], %[[c1]] : (!fir.ref<!fir.array<70756xi8>>, index) -> !fir.ref<i8>
   ! CHECK: %[[arr4Cast:.*]] = fir.convert %[[arr4Addr]] : (!fir.ref<i8>) -> !fir.ptr<!fir.array<133x133xf32>>
 
   arr1(1) = 1
   ! CHECK:%[[mcbFinalAddr:.*]] = fir.coordinate_of %[[mcbCoorCast]], %{{.*}} : (!fir.ptr<!fir.array<133xf32>>, i64) -> !fir.ref<f32>
   ! CHECK:fir.store %{{.*}} to %[[mcbFinalAddr]] : !fir.ref<f32>
 
   arr4(1,1) = 2
   ! CHECK: %[[arr4FinalAddr:.*]] = fir.coordinate_of %[[arr4Cast]], %{{.*}}, %{{.*}} : (!fir.ptr<!fir.array<133x133xf32>>, i64, i64) -> !fir.ref<f32>
   ! CHECK: fir.store %{{.*}} to %[[arr4FinalAddr]] : !fir.ref<f32>
 end subroutine

flang/test/Lower/explicit-interface-results-2.f90

 ! Result depends on a common block variable declared in the host.
 ! CHECK-LABEL: func @_QPhost7
 subroutine host7()
   implicit none
   integer :: n_common
   common /mycom/ n_common
   call takes_array(return_array())
 ! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
-! CHECK:  %[[VAL_2:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
+! CHECK:  %[[VAL_2:.*]] = fir.address_of(@_QCmycom) : !fir.ref<!fir.array<4xi8>>
 ! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
 ! CHECK:  %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 ! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<i32>
 ! CHECK:  %[[VAL_8:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>
 ! CHECK:  %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index
 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_9]], %{{.*}} : index
 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_9]], %{{.*}} : index
 ! CHECK:  %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
 contains
   function return_array()
     real :: return_array(n_common)
   end function
 end subroutine
 
 ! Test host calling array internal procedure.
 ! Result depends on a common block variable declared in the internal procedure.
 ! CHECK-LABEL: func @_QPhost8
 subroutine host8()
   implicit none
   call takes_array(return_array())
 ! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
-! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
+! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref<!fir.array<4xi8>>
 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
 ! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_6]], %{{.*}} : index
 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_6]], %{{.*}} : index
 ! CHECK:  %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}
subroutine host9()
   implicit none
   integer :: n_common
   common /mycom/ n_common
   call internal_proc_a()
 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<!fir.array<4xi8>>
+! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref<!fir.array<4xi8>>
 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
 ! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
 ! CHECK:  %[[VAL_7:.*]] = arith.cmpi sgt, %[[VAL_6]], %[[VAL_0]] : index
 ! CHECK:  %[[VAL_8:.*]] = arith.select %[[VAL_7]], %[[VAL_6]], %[[VAL_0]] : index
 ! CHECK:  %[[VAL_10:.*]] = fir.alloca !fir.array<?xf32>, %[[VAL_8]] {bindc_name = ".result"}

 subroutine host10()
   implicit none
   call internal_proc_a()
 contains
 ! CHECK-LABEL: func @_QFhost10Pinternal_proc_a
   subroutine internal_proc_a()
     call takes_array(return_array())
 ! CHECK:  %[[VAL_0:.*]] = arith.constant 0 : index
-! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QBmycom) : !fir.ref<!fir.array<4xi8>>
+! CHECK:  %[[VAL_1:.*]] = fir.address_of(@_QCmycom) : !fir.ref<!fir.array<4xi8>>
 ! CHECK:  %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<4xi8>>) -> !fir.ref<!fir.array<?xi8>>
 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
 ! CHECK:  %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
 ! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
 ! CHECK:  %[[CMPI:.*]] = arith.cmpi sgt, %[[VAL_6]], %{{.*}} : index
 ! CHECK:  %[[SELECT:.*]] = arith.select %[[CMPI]], %[[VAL_6]], %{{.*}} : index
 ! CHECK:  %[[VAL_7:.*]] = fir.alloca !fir.array<?xf32>, %[[SELECT]] {bindc_name = ".result"}

flang/test/Lower/forall/array-constructor.f90

 ! CHECK:           fir.result %[[VAL_86:.*]] : !fir.array<?xi32>
 ! CHECK:         }
 ! CHECK:         fir.array_merge_store %[[VAL_11]], %[[VAL_87:.*]] to %[[VAL_0]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?xi32>>
 ! CHECK:         return
 ! CHECK:       }
 
 ! CHECK-LABEL: func @_QFac1Pfunc(
 ! CHECK-SAME:                    %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "a"}) -> i32 {
-! CHECK:         %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "func", uniq_name = "_QFfuncEfunc"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32 {bindc_name = "func", uniq_name = "_QFac1FfuncEfunc"}
 ! CHECK:         %[[VAL_2:.*]] = arith.constant 1 : i64
 ! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : i64
 ! CHECK:         %[[VAL_4:.*]] = arith.subi %[[VAL_2]], %[[VAL_3]] : i64
 ! CHECK:         %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_4]] : (!fir.box<!fir.array<?xi32>>, i64) -> !fir.ref<i32>
 ! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>
 ! CHECK:         fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<i32>
 ! CHECK:         %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
 ! CHECK:         return %[[VAL_7]] : i32

 ! CHECK:         }
 ! CHECK:         fir.array_merge_store %[[VAL_12]], %[[VAL_99:.*]] to %[[VAL_0]] : !fir.array<?xi32>, !fir.array<?xi32>, !fir.box<!fir.array<?xi32>>
 ! CHECK:         return
 ! CHECK:       }
 
 ! CHECK-LABEL: func @_QFac2Pfunc(
 ! CHECK-SAME:                    %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "a"}) -> !fir.array<3xi32> {
 ! CHECK:         %[[VAL_1:.*]] = arith.constant 3 : index
-! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.array<3xi32> {bindc_name = "func", uniq_name = "_QFfuncEfunc"}
+! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.array<3xi32> {bindc_name = "func", uniq_name = "_QFac2FfuncEfunc"}
 ! CHECK:         %[[VAL_3:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
 ! CHECK:         %[[VAL_4:.*]] = fir.array_load %[[VAL_2]](%[[VAL_3]]) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.array<3xi32>
 ! CHECK:         %[[VAL_5:.*]] = arith.constant 1 : i64
 ! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
 ! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : i64
 ! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
 ! CHECK:         %[[VAL_9:.*]] = arith.constant 3 : i64
 ! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index

flang/test/Lower/host-associated-globals.f90

subroutine test_common()
   common /x/ i, not_in_equiv
   call bar()
 contains
  subroutine bar()
     print *, j_in_equiv, not_in_equiv
  end subroutine
 end subroutine
 ! CHECK-LABEL: func.func @_QFtest_commonPbar() attributes {fir.internal_proc} {
-! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QBx) : !fir.ref<!fir.array<12xi8>>
+! CHECK:  %[[VAL_0:.*]] = fir.address_of(@_QCx) : !fir.ref<!fir.array<12xi8>>
 ! CHECK:  %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<12xi8>>) -> !fir.ref<!fir.array<?xi8>>
 ! CHECK:  %[[VAL_2:.*]] = arith.constant 4 : index
 ! CHECK:  %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 ! CHECK:  %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ptr<i32>
 ! CHECK:  %[[VAL_5:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<12xi8>>) -> !fir.ref<!fir.array<?xi8>>
 ! CHECK:  %[[VAL_6:.*]] = arith.constant 8 : index
 ! CHECK:  %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_6]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 ! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<i8>) -> !fir.ref<i32>

flang/test/Lower/module_definition.f90

 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
 
 ! Test lowering of module that defines data that is otherwise not used
 ! in this file.
 
 ! Module defines variable in common block without initializer
 module modCommonNoInit1
   ! Module variable is in blank common
   real :: x_blank
   common // x_blank
   ! Module variable is in named common, no init
   real :: x_named1
   common /named1/ x_named1
 end module
-! CHECK-LABEL: fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8>
-! CHECK-LABEL: fir.global common @_QBnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+! CHECK-LABEL: fir.global common @_QC(dense<0> : vector<4xi8>) : !fir.array<4xi8>
+! CHECK-LABEL: fir.global common @_QCnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8>
 
 ! Module defines variable in common block with initialization
 module modCommonInit1
   integer :: i_named2 = 42
   common /named2/ i_named2
 end module
-! CHECK-LABEL: fir.global @_QBnamed2 : tuple<i32> {
+! CHECK-LABEL: fir.global @_QCnamed2 : tuple<i32> {
   ! CHECK: %[[init:.*]] = fir.insert_value %{{.*}}, %c42{{.*}}, [0 : index] : (tuple<i32>, i32) -> tuple<i32>
   ! CHECK: fir.has_value %[[init]] : tuple<i32>
 
 ! Module m1 defines simple data
 module m1
   real :: x
   integer :: y(100)
 end module

flang/test/Lower/module_use.f90

 ! RUN: bbc -emit-fir %S/module_definition.f90
 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
 
 ! Test use of module data not defined in this file.
 ! 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()
   use m1
   ! CHECK-DAG: fir.address_of(@_QMm1Ex) : !fir.ref<f32>
   ! CHECK-DAG: fir.address_of(@_QMm1Ey) : !fir.ref<!fir.array<100xi32>>
   m1use = x + y(1)
 end function
 
 ! TODO: test equivalences once front-end fix in module file is pushed.
 !! CHECK-LABEL func @_QPmodeq1use()
 !real function modEq1use()
 !  use modEq1
 !  ! CHECK-DAG fir.address_of(@_QMmodeq1Ex1) : !fir.ref<tuple<!fir.array<36xi8>, !fir.array<40xi8>>>
 !  ! CHECK-DAG fir.address_of(@_QMmodeq1Ey1) : !fir.ref<tuple<!fir.array<16xi8>, !fir.array<24xi8>>>
 !  modEq1use = x2(1) + y1
 !end function
 ! CHECK-DAG fir.global @_QMmodeq1Ex1 : tuple<!fir.array<36xi8>, !fir.array<40xi8>>
 ! CHECK-DAG fir.global @_QMmodeq1Ey1 : tuple<!fir.array<16xi8>, !fir.array<24xi8>>
 
 ! CHECK-LABEL: func @_QPmodcommon1use()
 real function modCommon1Use()
   use modCommonInit1
   use modCommonNoInit1
-  ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref<!fir.array<4xi8>>
-  ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
-  ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref<!fir.array<4xi8>>
+  ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref<!fir.array<4xi8>>
+  ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
+  ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref<!fir.array<4xi8>>
   modCommon1Use = x_blank + x_named1 + i_named2 
 end function
 
 
 ! CHECK-DAG: fir.global @_QMm1Ex : f32
 ! CHECK-DAG: fir.global @_QMm1Ey : !fir.array<100xi32>

flang/test/Lower/module_use_in_same_file.f90

module modCommon2
   real :: x_named1(10)
   common /named1/ x_named1
   ! Module variable is in named common, with init
   integer :: i_named2 = 42
   common /named2/ i_named2
 contains
   ! CHECK-LABEL: func @_QMmodcommon2Pfoo()
   real function foo()
-   ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref<tuple<i32>>
-   ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
-   ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref<!fir.array<40xi8>>
+   ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref<tuple<i32>>
+   ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
+   ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref<!fir.array<40xi8>>
    foo = x_blank + x_named1(5) + i_named2
   end function
 end module
 ! CHECK-LABEL: func @_QPmodcommon2use()
 real function modCommon2use()
  use modCommon2
- ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref<tuple<i32>>
- ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
- ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref<!fir.array<40xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref<tuple<i32>>
+ ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref<!fir.array<40xi8>>
  modCommon2use = x_blank + x_named1(5) + i_named2
 end function
 ! CHECK-LABEL: func @_QPmodcommon2use_rename()
 real function modCommon2use_rename()
  use modCommon2, only : renamed0 => x_blank, renamed1 => x_named1, renamed2 => i_named2
- ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref<tuple<i32>>
- ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
- ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref<!fir.array<40xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed2) : !fir.ref<tuple<i32>>
+ ! CHECK-DAG: fir.address_of(@_QC) : !fir.ref<!fir.array<4xi8>>
+ ! CHECK-DAG: fir.address_of(@_QCnamed1) : !fir.ref<!fir.array<40xi8>>
  modCommon2use_rename = renamed0 + renamed1(5) + renamed2
 end function
 
 
 ! Test that there are no conflicts between equivalence use associated and the ones
 ! from the scope
 real function test_no_equiv_conflicts()
   use modEq2

flang/test/Lower/namelist-common-block.f90

program nml_common
   allocate(p(2))
   call print_t()
 contains
   subroutine print_t()
     write(*,t)
   end subroutine
 end
 
-! CHECK-LABEL: fir.global linkonce @_QFGt.list constant : !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>> {
-! CHECK: %[[CB_ADDR:.*]] = fir.address_of(@_QBc) : !fir.ref<!fir.array<56xi8>>
+! CHECK-LABEL: fir.global linkonce @_QFNt.list constant : !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>> {
+! CHECK: %[[CB_ADDR:.*]] = fir.address_of(@_QCc) : !fir.ref<!fir.array<56xi8>>
 ! CHECK: %[[CB_CAST:.*]] = fir.convert %[[CB_ADDR]] : (!fir.ref<!fir.array<56xi8>>) -> !fir.ref<!fir.array<?xi8>>
 ! CHECK: %[[OFFSET:.*]] = arith.constant 8 : index
 ! CHECK: %[[COORD:.*]] = fir.coordinate_of %[[CB_CAST]], %[[OFFSET]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
 ! CHECK: %[[CAST_BOX:.*]] = fir.convert %[[COORD]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
 ! CHECK: %[[CAST_BOX_NONE:.*]] = fir.convert %[[CAST_BOX]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> !fir.ref<!fir.box<none>>
 ! CHECK: %[[RES:.*]] = fir.insert_value %{{.*}}, %[[CAST_BOX_NONE]], [1 : index, 1 : index] : (!fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>, !fir.ref<!fir.box<none>>) -> !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
 ! CHECK: fir.has_value %[[RES]] : !fir.array<2xtuple<!fir.ref<i8>, !fir.ref<!fir.box<none>>>>
-

flang/test/Lower/parent-component.f90

contains
   ! CHECK-LABEL: func.func @_QFPprint_p(%{{.*}}: !fir.ref<!fir.array<2x!fir.type<_QFTp{a:i32}>>> {fir.bindc_name = "a"})
 
   subroutine init_with_slice()
     type(c) :: y(2) = [ c(11, 21), c(12, 22) ]
     call print_p(y(:)%p)
     print*,y(:)%p
   end subroutine
   ! CHECK-LABEL: func.func @_QFPinit_with_slice()
-  ! CHECK: %[[Y:.*]] = fir.address_of(@_QFinit_with_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
+  ! CHECK: %[[Y:.*]] = fir.address_of(@_QFFinit_with_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
   ! CHECK: %[[C2:.*]] = arith.constant 2 : index
   ! CHECK: %[[C1:.*]] = arith.constant 1 : index
   ! CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
   ! CHECK: %[[STRIDE:.*]] = fir.convert %[[C1_I64]] : (i64) -> index
   ! CHECK: %[[ADD:.*]] = arith.addi %[[C1]], %[[C2]] : index
   ! CHECK: %[[UB:.*]] = arith.subi %[[ADD]], %[[C1]] : index
   ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
   ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
contains
   ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}}: (!fir.ref<i8>, !fir.box<none>) -> i1
 
   subroutine init_no_slice()
     type(c) :: y(2) = [ c(11, 21), c(12, 22) ]
     call print_p(y%p)
     print*,y%p
   end subroutine
   ! CHECK-LABEL: func.func @_QFPinit_no_slice()
-  ! CHECK: %[[Y:.*]] = fir.address_of(@_QFinit_no_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
+  ! CHECK: %[[Y:.*]] = fir.address_of(@_QFFinit_no_sliceEy) : !fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>
   ! CHECK: %[[C2:.*]] = arith.constant 2 : index
   ! CHECK: %[[SHAPE:.*]] = fir.shape %[[C2]] : (index) -> !fir.shape<1>
   ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
   ! CHECK: %[[C0:.*]] = arith.constant 0 : index
   ! CHECK: %[[BOX_DIM:.*]]:3 = fir.box_dims %{{.*}}, %[[C0]] : (!fir.box<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>, index) -> (index, index, index)
   ! CHECK: %[[C1:.*]] = arith.constant 1 : index
   ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[BOX_DIM]]#1, %[[C1]] path %[[FIELD]] : (index, index, index, !fir.field) -> !fir.slice<1>
   ! CHECK: %[[BOX:.*]] = fir.embox %[[Y]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.type<_QFTc{a:i32,b:i32}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
subroutine init_allocatable()
     allocate(y(2))
     y(1) = c(11, 21)
     y(2) = c(12, 22)
     call print_p(y%p)
     print*,y%p
   end subroutine
 
   ! CHECK-LABEL: func.func @_QFPinit_allocatable()
-  ! CHECK: %[[ALLOC:.*]] = fir.alloca !fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>> {uniq_name = "_QFinit_allocatableEy.addr"}
-  ! CHECK: %[[LB0:.*]] = fir.alloca index {uniq_name = "_QFinit_allocatableEy.lb0"}
-  ! CHECK: %[[EXT0:.*]] = fir.alloca index {uniq_name = "_QFinit_allocatableEy.ext0"}
+  ! CHECK: %[[ALLOC:.*]] = fir.alloca !fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>> {uniq_name = "_QFFinit_allocatableEy.addr"}
+  ! CHECK: %[[LB0:.*]] = fir.alloca index {uniq_name = "_QFFinit_allocatableEy.lb0"}
+  ! CHECK: %[[EXT0:.*]] = fir.alloca index {uniq_name = "_QFFinit_allocatableEy.ext0"}
   ! CHECK-COUNT-6: %{{.*}} = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
   ! CHECK: %[[LOAD_LB0:.*]] = fir.load %[[LB0]] : !fir.ref<index>
   ! CHECK: %[[LOAD_EXT0:.*]] = fir.load %[[EXT0]] : !fir.ref<index>
   ! CHECK: %[[MEM:.*]] = fir.load %[[ALLOC]] : !fir.ref<!fir.heap<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>>
   ! CHECK: %[[SHAPE_SHIFT:.*]] = fir.shape_shift %[[LOAD_LB0]], %[[LOAD_EXT0]] : (index, index) -> !fir.shapeshift<1>
   ! CHECK: %[[FIELD:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
   ! CHECK: %[[C0:.*]] = arith.constant 0 : index
   ! CHECK: %[[BOX_DIMS:.*]]:3 = fir.box_dims %{{.*}}, %[[C0]] : (!fir.box<!fir.array<?x!fir.type<_QFTc{a:i32,b:i32}>>>, index) -> (index, index, index)
contains
 
   subroutine init_scalar()
     type(c) :: s = c(11, 21)
     call print_scalar(s%p)
     print*,s%p
   end subroutine
 
   ! CHECK-LABEL: func.func @_QFPinit_scalar()
-  ! CHECK: %[[S:.*]] = fir.address_of(@_QFinit_scalarEs) : !fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>
+  ! CHECK: %[[S:.*]] = fir.address_of(@_QFFinit_scalarEs) : !fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>
   ! CHECK: %[[CAST:.*]] = fir.convert %[[S]] : (!fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>) -> !fir.ref<!fir.type<_QFTp{a:i32}>>
   ! CHECK: fir.call @_QFPprint_scalar(%[[CAST]]) {{.*}}: (!fir.ref<!fir.type<_QFTp{a:i32}>>) -> ()
 
   ! CHECK: %[[BOX:.*]] = fir.embox %{{.*}} : (!fir.ref<!fir.type<_QFTc{a:i32,b:i32}>>) -> !fir.box<!fir.type<_QFTp{a:i32}>>
   ! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[BOX]] : (!fir.box<!fir.type<_QFTp{a:i32}>>) -> !fir.box<none>
   ! CHECK: %{{.*}} = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX_NONE]]) {{.*}}: (!fir.ref<i8>, !fir.box<none>) -> i1
 
   subroutine init_assumed(y)
contains
 
   subroutine init_existing_field()
     type(z) :: y(2)
     call print_p(y%c%p)
   end subroutine
 
   ! 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
   ! CHECK: %[[FIELD_A:.*]] = fir.field_index a, !fir.type<_QFTc{a:i32,b:i32}>
   ! CHECK: %[[SLICE:.*]] = fir.slice %[[C1]], %[[C2]], %[[C1]] path %[[FIELD_C]], %[[FIELD_A]] : (index, index, index, !fir.field, !fir.field) -> !fir.slice<1>
   ! CHECK: %{{.*}} = fir.embox %[[ALLOCA]](%[[SHAPE]]) [%[[SLICE]]] : (!fir.ref<!fir.array<2x!fir.type<_QFTz{k:i32,c:!fir.type<_QFTc{a:i32,b:i32}>}>>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<2x!fir.type<_QFTp{a:i32}>>>
 end

flang/test/Lower/pointer-assignments.f90

 end subroutine
 
 ! CHECK-LABEL: func @_QPissue1180(
 ! CHECK-SAME:  %[[VAL_0:.*]]: !fir.ref<i32> {{{.*}}, fir.target}) {
 subroutine issue1180(x)
   integer, target :: x
   integer, pointer :: p
   common /some_common/ p
-  ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBsome_common) : !fir.ref<!fir.array<24xi8>>
+  ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QCsome_common) : !fir.ref<!fir.array<24xi8>>
   ! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<24xi8>>) -> !fir.ref<!fir.array<?xi8>>
   ! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index
   ! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
   ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<i32>>>
   ! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
   ! CHECK: fir.store %[[VAL_6]] to %[[VAL_5]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
   p => x
 end subroutine

flang/test/Lower/pointer-initial-target-2.f90

 ! Test lowering of pointer initial target
 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
 
 ! This tests focus on the scope context of initial data target.
 ! More complete tests regarding the initial data target expression
 ! are done in pointer-initial-target.f90.
 
 ! Test pointer initial data target with pointer in common blocks
 block data
   real, pointer :: p
   real, save, target :: b
   common /a/ p
   data p /b/
-! CHECK-LABEL: fir.global @_QBa : tuple<!fir.box<!fir.ptr<f32>>>
+! CHECK-LABEL: fir.global @_QCa : tuple<!fir.box<!fir.ptr<f32>>>
   ! CHECK: %[[undef:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<f32>>>
   ! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref<f32>
   ! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref<f32>) -> !fir.box<f32>
   ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<f32>) -> !fir.box<!fir.ptr<f32>>
   ! CHECK: %[[a:.*]] = fir.insert_value %[[undef]], %[[rebox]], [0 : index] : (tuple<!fir.box<!fir.ptr<f32>>>, !fir.box<!fir.ptr<f32>>) -> tuple<!fir.box<!fir.ptr<f32>>>
   ! CHECK: fir.has_value %[[a]] : tuple<!fir.box<!fir.ptr<f32>>>
 end block data
 
 ! Test two common depending on each others because of initial data
 ! targets
 block data tied
   real, target :: x1 = 42
   real, target :: x2 = 43
   real, pointer :: p1 => x2
   real, pointer :: p2 => x1
   common /c1/ x1, p1
   common /c2/ x2, p2
-! CHECK-LABEL: fir.global @_QBc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
-  ! CHECK: fir.address_of(@_QBc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
-! CHECK-LABEL: fir.global @_QBc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
-  ! CHECK: fir.address_of(@_QBc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
+! CHECK-LABEL: fir.global @_QCc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
+  ! CHECK: fir.address_of(@_QCc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
+! CHECK-LABEL: fir.global @_QCc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
+  ! CHECK: fir.address_of(@_QCc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
 end block data
 
 ! Test pointer in a common with initial target in the same common.
 block data bdsnake
   integer, target :: b = 42
   integer, pointer :: p => b
   common /snake/ p, b
-! CHECK-LABEL: fir.global @_QBsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
+! CHECK-LABEL: fir.global @_QCsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
   ! CHECK: %[[tuple0:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<i32>>, i32>
-  ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
+  ! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QCsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
   ! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>) -> !fir.ref<!fir.array<?xi8>>
   ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
   ! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ref<i32>
   ! CHECK: %[[box:.*]] = fir.embox %[[bAddr]] : (!fir.ref<i32>) -> !fir.box<i32>
   ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]] : (!fir.box<i32>) -> !fir.box<!fir.ptr<i32>>
   ! CHECK: %[[tuple1:.*]] = fir.insert_value %[[tuple0]], %[[rebox]], [0 : index] : (tuple<!fir.box<!fir.ptr<i32>>, i32>, !fir.box<!fir.ptr<i32>>) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
   ! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple1]], %c42{{.*}}, [1 : index] : (tuple<!fir.box<!fir.ptr<i32>>, i32>, i32) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
   ! CHECK: fir.has_value %[[tuple2]] : tuple<!fir.box<!fir.ptr<i32>>, i32>

 
 ! Test initial data target in a common block
 module some_mod_2
   real, target :: x(100), y(10:209)
   common /com/ x, y
   save :: /com/
   real, pointer :: p(:) => y
 ! CHECK-LABEL: fir.global @_QMsome_mod_2Ep : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
-  ! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref<!fir.array<1200xi8>>
+  ! CHECK: %[[c:.*]] = fir.address_of(@_QCcom) : !fir.ref<!fir.array<1200xi8>>
   ! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref<!fir.array<1200xi8>>) -> !fir.ref<!fir.array<?xi8>>
   ! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
   ! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<200xf32>>
   ! CHECK: %[[shape:.*]] = fir.shape_shift %c10{{.*}}, %c200{{.*}} : (index, index) -> !fir.shapeshift<1>
   ! CHECK: %[[box:.*]] = fir.embox %[[y]](%[[shape]]) : (!fir.ref<!fir.array<200xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<200xf32>>
   ! CHECK: %[[shift:.*]] = fir.shift %c10{{.*}} : (index) -> !fir.shift<1>
   ! CHECK: %[[rebox:.*]] = fir.rebox %[[box]](%[[shift]]) : (!fir.box<!fir.array<200xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
   ! CHECK: fir.has_value %[[rebox]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
 end module

flang/test/Lower/program-units-fir-mangling.f90

interface
     module subroutine draw()
     end subroutine
     module function erase()
       integer(4) :: erase
     end function
   end interface
 end module color_points
 
-! We don't handle lowering of submodules yet.  The following tests are
-! commented out and "CHECK" is changed to "xHECK" to not trigger FileCheck.
-!submodule (color_points) color_points_a
-!contains
-!  ! xHECK-LABEL: func @_QMcolor_pointsScolor_points_aPsub() {
-!  subroutine sub
-!  end subroutine
-!  ! xHECK: }
-!end submodule
-!
-!submodule (color_points:color_points_a) impl
-!contains
-!  ! xHECK-LABEL: func @_QMcolor_pointsScolor_points_aSimplPfoo()
-!  subroutine foo
-!    contains
-!    ! xHECK-LABEL: func @_QMcolor_pointsScolor_points_aSimplFfooPbar() {
-!    subroutine bar
-!    ! xHECK: }
-!    end subroutine
-!  end subroutine
-!  ! xHECK-LABEL: func @_QMcolor_pointsPdraw() {
-!  module subroutine draw()
-!  end subroutine
-!  !FIXME func @_QMcolor_pointsPerase() -> i32 {
-!  module procedure erase
-!  ! xHECK: }
-!  end procedure
-!end submodule
+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()
 ! CHECK: }
 end subroutine
 
 ! CHECK-LABEL: func @_QQmain() attributes {fir.bindc_name = "test"} {
 program test
! CHECK: fir.call @ok2() {{.*}}: () -> ()
     continue ! force end of specification part
 ! CHECK-LABEL: func @ok7() attributes {fir.bindc_name = "ok7"} {
     entry s4() bind(c,name=foo//'7')
 ! CHECK: fir.call @ok2() {{.*}}: () -> ()
     call s1
   end subroutine
 end module
 
+
+! CHECK-LABEL: func @_QPnest1
+subroutine nest1
+  ! CHECK:   fir.call @_QFnest1Pinner()
+  call inner
+contains
+  ! CHECK-LABEL: func @_QFnest1Pinner
+  subroutine inner
+    ! CHECK:   %[[V_0:[0-9]+]] = fir.address_of(@_QFnest1FinnerEkk) : !fir.ref<i32>
+    integer, save :: kk = 1
+    print*, 'qq:inner', kk
+  end
+end
+
+! CHECK-LABEL: func @_QPnest2
+subroutine nest2
+  ! CHECK:   fir.call @_QFnest2Pinner()
+  call inner
+contains
+  ! CHECK-LABEL: func @_QFnest2Pinner
+  subroutine inner
+    ! CHECK:   %[[V_0:[0-9]+]] = fir.address_of(@_QFnest2FinnerEkk) : !fir.ref<i32>
+    integer, save :: kk = 77
+    print*, 'ss:inner', kk
+  end
+end
+
 ! CHECK-LABEL: fir.global internal @_QFfooEpi : f32 {

flang/test/Lower/select-case-statement.f90

subroutine scharacter1(s)
     ! CHECK:     cond_br %[[V_9]], ^bb1, ^bb16
     ! CHECK:   ^bb1:  // pred: ^bb0
     if (lge(s,'00')) then
 
       ! CHECK:   %[[V_18:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
       ! CHECK:   %[[V_20:[0-9]+]] = fir.box_addr %[[V_18]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
       ! CHECK:   %[[V_42:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
       ! CHECK:   %[[V_43:[0-9]+]] = arith.cmpi eq, %[[V_42]], %c0{{.*}} : i32
-      ! CHECK:   fir.if %[[V_43]] {
-      ! CHECK:     fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
-      ! CHECK:   }
       ! CHECK:   cond_br %[[V_43]], ^bb3, ^bb2
       ! CHECK: ^bb2:  // pred: ^bb1
       select case(trim(s))
       case('11')
         n = 1
 
       case default
         continue
 
       ! CHECK:   %[[V_48:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
       ! CHECK:   %[[V_49:[0-9]+]] = arith.cmpi eq, %[[V_48]], %c0{{.*}} : i32
-      ! CHECK:   fir.if %[[V_49]] {
-      ! CHECK:     fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
-      ! CHECK:   }
       ! CHECK:   cond_br %[[V_49]], ^bb6, ^bb5
       ! CHECK: ^bb3:  // pred: ^bb1
       ! CHECK:   fir.store %c1{{.*}} to %[[V_1]] : !fir.ref<i32>
       ! CHECK: ^bb4:  // pred: ^bb13
       ! CHECK: ^bb5:  // pred: ^bb2
       case('22')
         n = 2
 
       ! CHECK:   %[[V_54:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
       ! CHECK:   %[[V_55:[0-9]+]] = arith.cmpi eq, %[[V_54]], %c0{{.*}} : i32
-      ! CHECK:   fir.if %[[V_55]] {
-      ! CHECK:     fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
-      ! CHECK:   }
       ! CHECK:   cond_br %[[V_55]], ^bb8, ^bb7
       ! CHECK: ^bb6:  // pred: ^bb2
       ! CHECK:   fir.store %c2{{.*}} to %[[V_1]] : !fir.ref<i32>
       ! CHECK: ^bb7:  // pred: ^bb5
       case('33')
         n = 3
 
       case('44':'55','66':'77','88':)
         n = 4
       ! CHECK:   %[[V_60:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
       ! CHECK:   %[[V_61:[0-9]+]] = arith.cmpi sge, %[[V_60]], %c0{{.*}} : i32
       ! CHECK:   cond_br %[[V_61]], ^bb9, ^bb10
       ! CHECK: ^bb8:  // pred: ^bb5
       ! CHECK:   fir.store %c3{{.*}} to %[[V_1]] : !fir.ref<i32>
       ! CHECK: ^bb9:  // pred: ^bb7
       ! CHECK:   %[[V_66:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
       ! CHECK:   %[[V_67:[0-9]+]] = arith.cmpi sle, %[[V_66]], %c0{{.*}} : i32
-      ! CHECK:   fir.if %[[V_67]] {
-      ! CHECK:     fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
-      ! CHECK:   }
       ! CHECK:   cond_br %[[V_67]], ^bb14, ^bb10
       ! CHECK: ^bb10:  // 2 preds: ^bb7, ^bb9
       ! CHECK:   %[[V_72:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
       ! CHECK:   %[[V_73:[0-9]+]] = arith.cmpi sge, %[[V_72]], %c0{{.*}} : i32
       ! CHECK:   cond_br %[[V_73]], ^bb11, ^bb12
       ! CHECK: ^bb11:  // pred: ^bb10
       ! CHECK:   %[[V_78:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
       ! CHECK:   %[[V_79:[0-9]+]] = arith.cmpi sle, %[[V_78]], %c0{{.*}} : i32
-      ! CHECK:   fir.if %[[V_79]] {
-      ! CHECK:     fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
-      ! CHECK:   }
       ! CHECK: ^bb12:  // 2 preds: ^bb10, ^bb11
       ! CHECK:   %[[V_84:[0-9]+]] = fir.call @_FortranACharacterCompareScalar1
       ! CHECK:   %[[V_85:[0-9]+]] = arith.cmpi sge, %[[V_84]], %c0{{.*}} : i32
-      ! CHECK:   fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
       ! CHECK:   cond_br %[[V_85]], ^bb14, ^bb13
       ! CHECK: ^bb13:  // pred: ^bb12
       ! CHECK: ^bb14:  // 3 preds: ^bb9, ^bb11, ^bb12
       ! CHECK:   fir.store %c4{{.*}} to %[[V_1]] : !fir.ref<i32>
       ! CHECK: ^bb15:  // 5 preds: ^bb3, ^bb4, ^bb6, ^bb8, ^bb14
+      ! CHECK:   fir.freemem %[[V_20]] : !fir.heap<!fir.char<1,?>>
       end select
     end if
     ! CHECK:     %[[V_89:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<i32>
     print*, n
   end subroutine
 
   ! CHECK-LABEL: func @_QPscharacter2
   subroutine scharacter2(s)
     ! CHECK-DAG: %[[V_0:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
     ! CHECK:   %[[V_1:[0-9]+]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
     character(len=3) :: s
-    n = 0
 
+    n = -10
     ! CHECK:   %[[V_12:[0-9]+]] = fir.load %[[V_1]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
     ! CHECK:   %[[V_13:[0-9]+]] = fir.box_addr %[[V_12]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
-    ! CHECK:   fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>>
     ! CHECK:   br ^bb1
     ! CHECK: ^bb1:  // pred: ^bb0
+    ! CHECK:   fir.store %c9{{.*}}
     ! CHECK:   br ^bb2
-    n = -10
+    ! CHECK: ^bb2:  // pred: ^bb1
+    ! CHECK:   fir.freemem %[[V_13]] : !fir.heap<!fir.char<1,?>>
     select case(trim(s))
     case default
       n = 9
     end select
     print*, n
 
-    ! CHECK: ^bb2:  // pred: ^bb1
+    n = -2
     ! CHECK:   %[[V_28:[0-9]+]] = fir.load %[[V_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
     ! CHECK:   %[[V_29:[0-9]+]] = fir.box_addr %[[V_28]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
-    ! CHECK:   fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>>
     ! CHECK:   br ^bb3
     ! CHECK: ^bb3:  // pred: ^bb2
-    n = -2
+    ! CHECK:   fir.freemem %[[V_29]] : !fir.heap<!fir.char<1,?>>
     select case(trim(s))
     end select
     print*, n
   end subroutine
 
   ! CHECK-LABEL: func @_QPsempty
   ! empty select case blocks
   subroutine sempty(n)

flang/unittests/Optimizer/InternalNamesTest.cpp

 #include <optional>
 #include <string>
 
 using namespace fir;
 using llvm::SmallVector;
 using llvm::StringRef;
 
 struct DeconstructedName {
+  DeconstructedName(llvm::StringRef name) : name{name} {}
   DeconstructedName(llvm::ArrayRef<std::string> modules,
-      std::optional<std::string> host, llvm::StringRef name,
-      llvm::ArrayRef<std::int64_t> kinds)
-      : modules{modules.begin(), modules.end()}, host{host}, name{name},
-        kinds{kinds.begin(), kinds.end()} {}
+      llvm::ArrayRef<std::string> procs, std::int64_t blockId,
+      llvm::StringRef name, llvm::ArrayRef<std::int64_t> kinds)
+      : modules{modules.begin(), modules.end()}, procs{procs.begin(),
+                                                     procs.end()},
+        blockId{blockId}, name{name}, kinds{kinds.begin(), kinds.end()} {}
 
   bool isObjEqual(const NameUniquer::DeconstructedName &actualObj) {
-    if ((actualObj.name == name) && (actualObj.modules == modules) &&
-        (actualObj.host == host) && (actualObj.kinds == kinds)) {
-      return true;
-    }
-    return false;
+    return actualObj.modules == modules && actualObj.procs == procs &&
+        actualObj.blockId == blockId && actualObj.name == name &&
+        actualObj.kinds == kinds;
   }
 
-private:
   llvm::SmallVector<std::string> modules;
-  std::optional<std::string> host;
+  llvm::SmallVector<std::string> procs;
+  std::int64_t blockId;
   std::string name;
   llvm::SmallVector<std::int64_t> kinds;
 };
 
 void validateDeconstructedName(
     std::pair<NameUniquer::NameKind, NameUniquer::DeconstructedName> &actual,
     NameUniquer::NameKind &expectedNameKind,
     struct DeconstructedName &components) {
   EXPECT_EQ(actual.first, expectedNameKind)
       << "Possible error: NameKind mismatch";
   ASSERT_TRUE(components.isObjEqual(actual.second))
       << "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);
 }
 
 TEST(InternalNamesTest, doGeneratedTest) {
   std::string actual = NameUniquer::doGenerated("@MAIN");
   std::string expectedMangledName = "_QQ@MAIN";
   ASSERT_EQ(actual, expectedMangledName);
 
   std::string actual1 = NameUniquer::doGenerated("@_ZNSt8ios_base4InitC1Ev");
   std::string expectedMangledName1 = "_QQ@_ZNSt8ios_base4InitC1Ev";
   ASSERT_EQ(actual1, expectedMangledName1);
 
   std::string actual2 = NameUniquer::doGenerated("_QQ@MAIN");
   std::string expectedMangledName2 = "_QQ_QQ@MAIN";
   ASSERT_EQ(actual2, expectedMangledName2);
 }
 
 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);
 }
 
 TEST(InternalNamesTest, doProcedureTest) {
   std::string actual = NameUniquer::doProcedure({"mod1", "mod2"}, {}, "HeLLo");
   std::string expectedMangledName = "_QMmod1Smod2Phello";
   ASSERT_EQ(actual, expectedMangledName);
 }
 
 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);
 }
 
 TEST(InternalNamesTest, doProgramEntry) {
   llvm::StringRef actual = NameUniquer::doProgramEntry();
   std::string expectedMangledName = "_QQmain";
   ASSERT_EQ(actual.str(), expectedMangledName);
 }
 
 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);
 }
 
 TEST(InternalNamesTest, complexdeconstructTest) {
   using NameKind = fir::NameUniquer::NameKind;
   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);
 }
 
 TEST(InternalNamesTest, needExternalNameMangling) {
   ASSERT_FALSE(
       NameUniquer::needExternalNameMangling("_QMmodSs1modSs2modFsubPfun"));
   ASSERT_FALSE(NameUniquer::needExternalNameMangling("omp_num_thread"));
   ASSERT_FALSE(NameUniquer::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) {
   std::pair result = NameUniquer::deconstruct("_QMmodSs1modSs2modFsubPfun");
 
   ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
   result = NameUniquer::deconstruct("omp_num_thread");
   ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
   result = NameUniquer::deconstruct("");
   ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
   result = NameUniquer::deconstruct("_QDTmytypeK2K8K18");
   ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
   result = NameUniquer::deconstruct("exit_");
   ASSERT_FALSE(NameUniquer::isExternalFacingUniquedName(result));
   result = NameUniquer::deconstruct("_QPfoo");
   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));
 }
 
 TEST(InternalNamesTest, getTypeDescriptorName) {
   std::string derivedTypeName = "_QMdispatch1Tp1";
   std::string expectedBindingTableName = "_QMdispatch1E.dt.p1";
   ASSERT_EQ(expectedBindingTableName,
       fir::NameUniquer::getTypeDescriptorName(derivedTypeName));