Fix module variables definition vs declaration

The initializer of module variables (if any) must only be emitted when
lowering the compilation unit that defines the module, otherwise, this
lead to conflict at link time.

Current lowering was already accounting for this with the
`var.isDeclaration()` helper to tell if a variable was owned by another
module.

However, it was based on a core assumption that turned out to be wrong.
The core assumption was that any module symbols that was instantiated
and had not `semantics::UseAssoc` details was necessarily being lowered
in the compilation unit defining the module.
It turned out to be wrong for at least the members of a module namelist used
in a another compilation unit, as well as for the type descriptor symbol
of a derived type from another compilation unit used to defined a new
derived type in a module. Both cases have valid reasons to not come
as use associated symbols (in both cases, the user never really used
them).

Part of the need for isDeclaration() came from a "create fir::GlobalOp
once per compilation unit and do not touch it anymore" approach that was
tough because global op initializer can depend on each other in
circular ways.
Instead of relying on this assumption that might be broken in other
cases too, change the approach to define module globals: when using
a module variable (in a when instantiating variables to lower a
function, or the initializer or another variable), do not try to define
it, only create the globalOp with the right linkage if it does not exist
already.
Only create initializer body for module globals when actually lowering
the module. If the fir.global already exist (its address was required
before the it was itself lowered), just create the initializer body at
that point.

This removes some assumptions and allows simplifying the PFT symbol
analysis that was trying to keep track of the "declaration vs definition"
aspects for aggregates.

Author: jeanPerier

flang/include/flang/Lower/PFTBuilder.h

@@ -23,6 +23,7 @@
 #include "flang/Lower/PFTDefs.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/attr.h"
+#include "flang/Semantics/scope.h"
 #include "flang/Semantics/symbol.h"
 #include "llvm/Support/ErrorHandling.h"
 #include "llvm/Support/raw_ostream.h"
@@ -391,9 +392,6 @@ struct Variable {
     const semantics::Symbol *symbol{};
 
     bool isGlobal() const { return global; }
-    bool isDeclaration() const {
-      return !symbol || symbol != &symbol->GetUltimate();
-    }
 
     int depth{};
     bool global{};
@@ -413,18 +411,16 @@ struct Variable {
   struct AggregateStore {
     AggregateStore(Interval &&interval,
                    const Fortran::semantics::Symbol &namingSym,
-                   bool isDeclaration = false, bool isGlobal = false)
+                   bool isGlobal = false)
         : interval{std::move(interval)}, namingSymbol{&namingSym},
-          isDecl{isDeclaration}, isGlobalAggregate{isGlobal} {}
+          isGlobalAggregate{isGlobal} {}
     AggregateStore(const semantics::Symbol &initialValueSym,
-                   const semantics::Symbol &namingSym,
-                   bool isDeclaration = false, bool isGlobal = false)
+                   const semantics::Symbol &namingSym, bool isGlobal = false)
         : interval{initialValueSym.offset(), initialValueSym.size()},
           namingSymbol{&namingSym}, initialValueSymbol{&initialValueSym},
-          isDecl{isDeclaration}, isGlobalAggregate{isGlobal} {};
+          isGlobalAggregate{isGlobal} {};
 
     bool isGlobal() const { return isGlobalAggregate; }
-    bool isDeclaration() const { return isDecl; }
     /// Get offset of the aggregate inside its scope.
     std::size_t getOffset() const { return std::get<0>(interval); }
     /// Returns symbols holding the aggregate initial value if any.
@@ -443,8 +439,6 @@ struct Variable {
     const semantics::Symbol *namingSymbol;
     /// Compiler generated symbol with the aggregate initial value if any.
     const semantics::Symbol *initialValueSymbol = nullptr;
-    /// Is this a declaration of a storage defined in another scope ?
-    bool isDecl;
     /// Is this a global aggregate ?
     bool isGlobalAggregate;
   };
@@ -485,9 +479,10 @@ struct Variable {
     return std::visit([](const auto &x) { return x.isGlobal(); }, var);
   }
 
-  /// Is this a declaration of a variable owned by another scope ?
-  bool isDeclaration() const {
-    return std::visit([](const auto &x) { return x.isDeclaration(); }, var);
+  /// Is this a module variable ?
+  bool isModuleVariable() const {
+    const semantics::Scope *scope = getOwningScope();
+    return scope && scope->IsModule();
   }
 
   const Fortran::semantics::Scope *getOwningScope() const {
@@ -700,6 +695,9 @@ struct ModuleLikeUnit : public ProgramUnit {
   /// Get the starting source location for this module like unit.
   parser::CharBlock getStartingSourceLoc() const;
 
+  /// Get the module scope.
+  const Fortran::semantics::Scope &getScope() const;
+
   ModuleStatement beginStmt;
   ModuleStatement endStmt;
   std::list<FunctionLikeUnit> nestedFunctions;

flang/lib/Lower/Bridge.cpp

@@ -2699,8 +2699,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
         fir::NameUniquer::doGenerated("ModuleSham"),
         mlir::FunctionType::get(context, llvm::None, llvm::None));
     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
-    for (const Fortran::lower::pft::Variable &var : mod.getOrderedSymbolTable())
-      Fortran::lower::defineModuleVariable(*this, var);
+    for (const Fortran::lower::pft::Variable &var :
+         mod.getOrderedSymbolTable()) {
+      // Only define the variables owned by this module.
+      const Fortran::semantics::Scope *owningScope = var.getOwningScope();
+      if (!owningScope || mod.getScope() == *owningScope)
+        Fortran::lower::defineModuleVariable(*this, var);
+    }
     if (mlir::Region *region = func.getCallableRegion())
       region->dropAllReferences();
     func.erase();

flang/lib/Lower/ConvertVariable.cpp

@@ -125,6 +125,8 @@ static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
                                    llvm::StringRef globalName,
                                    mlir::StringAttr linkage) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  if (fir::GlobalOp global = builder.getNamedGlobal(globalName))
+    return global;
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   mlir::Location loc = converter.genLocation(sym.name());
   // Resolve potential host and module association before checking that this
@@ -356,6 +358,24 @@ static mlir::Value genDefaultInitializerValue(
   return initialValue;
 }
 
+/// Does this global already have an initializer ?
+static bool globalIsInitialized(fir::GlobalOp global) {
+  return !global.getRegion().empty() || global.initVal();
+}
+
+/// Call \p genInit to generate code inside \p global initializer region.
+static void
+createGlobalInitialization(fir::FirOpBuilder &builder, fir::GlobalOp global,
+                           std::function<void(fir::FirOpBuilder &)> genInit) {
+  mlir::Region &region = global.getRegion();
+  region.push_back(new mlir::Block);
+  mlir::Block &block = region.back();
+  auto insertPt = builder.saveInsertionPoint();
+  builder.setInsertionPointToStart(&block);
+  genInit(builder);
+  builder.restoreInsertionPoint(insertPt);
+}
+
 /// Create the global op and its init if it has one
 static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
                                   const Fortran::lower::pft::Variable &var,
@@ -365,96 +385,96 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   mlir::Location loc = converter.genLocation(sym.name());
   bool isConst = sym.attrs().test(Fortran::semantics::Attr::PARAMETER);
-  fir::GlobalOp global;
+  fir::GlobalOp global = builder.getNamedGlobal(globalName);
+  if (global && globalIsInitialized(global))
+    return global;
+  mlir::Type symTy = converter.genType(var);
+  if (!global)
+    global = builder.createGlobal(loc, symTy, globalName, linkage,
+                                  mlir::Attribute{}, isConst);
   if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
-    mlir::Type symTy = converter.genType(var);
     const auto *details =
         sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
     if (details && details->init()) {
       auto expr = *details->init();
-      auto init = [&](fir::FirOpBuilder &b) {
+      createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
         mlir::Value box =
             Fortran::lower::genInitialDataTarget(converter, loc, symTy, expr);
         b.create<fir::HasValueOp>(loc, box);
-      };
-      global =
-          builder.createGlobal(loc, symTy, globalName, isConst, init, linkage);
+      });
     } else {
       // Create unallocated/disassociated descriptor if no explicit init
-      auto init = [&](fir::FirOpBuilder &b) {
+      createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
         mlir::Value box =
             fir::factory::createUnallocatedBox(b, loc, symTy, llvm::None);
         b.create<fir::HasValueOp>(loc, box);
-      };
-      global =
-          builder.createGlobal(loc, symTy, globalName, isConst, init, linkage);
+      });
     }
 
   } else if (const auto *details =
                  sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
     if (details->init()) {
-      mlir::Type symTy = converter.genType(var);
       if (fir::isa_char(symTy)) {
         // CHARACTER literal
         if (auto chLit = getCharacterLiteralCopy(details->init().value())) {
           mlir::StringAttr init =
               builder.getStringAttr(std::get<std::string>(*chLit));
-          global = builder.createGlobal(loc, symTy, globalName, linkage, init,
-                                        isConst);
+          global->setAttr(global.getInitValAttrName(), init);
         } else {
           fir::emitFatalError(loc, "CHARACTER has unexpected initial value");
         }
       } else {
-        global = builder.createGlobal(
-            loc, symTy, globalName, isConst,
-            [&](fir::FirOpBuilder &builder) {
+        createGlobalInitialization(
+            builder, global, [&](fir::FirOpBuilder &builder) {
               Fortran::lower::StatementContext stmtCtx(/*prohibited=*/true);
               fir::ExtendedValue initVal = genInitializerExprValue(
                   converter, loc, details->init().value(), stmtCtx);
               mlir::Value castTo =
                   builder.createConvert(loc, symTy, fir::getBase(initVal));
               stmtCtx.finalize();
               builder.create<fir::HasValueOp>(loc, castTo);
-            },
-            linkage);
+            });
       }
     } else if (hasDefaultInitialization(sym)) {
-      mlir::Type symTy = converter.genType(var);
-      global = builder.createGlobal(
-          loc, symTy, globalName, isConst,
-          [&](fir::FirOpBuilder &builder) {
+      createGlobalInitialization(
+          builder, global, [&](fir::FirOpBuilder &builder) {
             Fortran::lower::StatementContext stmtCtx(/*prohibited=*/true);
             mlir::Value initVal =
                 genDefaultInitializerValue(converter, loc, sym, symTy, stmtCtx);
-            mlir::Value castTo =
-                builder.createConvert(loc, symTy, fir::getBase(initVal));
+            mlir::Value castTo = builder.createConvert(loc, symTy, initVal);
             stmtCtx.finalize();
             builder.create<fir::HasValueOp>(loc, castTo);
-          },
-          linkage);
+          });
     }
   } else if (sym.has<Fortran::semantics::CommonBlockDetails>()) {
     mlir::emitError(loc, "COMMON symbol processed elsewhere");
   } else {
     TODO(loc, "global"); // Procedure pointer or something else
   }
-  // Creates undefined initializer for globals without initialziers
-  if (!global) {
-    mlir::Type symTy = converter.genType(var);
-    global = builder.createGlobal(
-        loc, symTy, globalName, isConst,
-        [&](fir::FirOpBuilder &builder) {
+  // Creates undefined initializer for globals without initializers
+  if (!globalIsInitialized(global))
+    createGlobalInitialization(
+        builder, global, [&](fir::FirOpBuilder &builder) {
           builder.create<fir::HasValueOp>(
               loc, builder.create<fir::UndefOp>(loc, symTy));
-        },
-        linkage);
-  }
+        });
   // Set public visibility to prevent global definition to be optimized out
   // even if they have no initializer and are unused in this compilation unit.
   global.setVisibility(mlir::SymbolTable::Visibility::Public);
   return global;
 }
 
+/// Return linkage attribute for \p var.
+static mlir::StringAttr
+getLinkageAttribute(fir::FirOpBuilder &builder,
+                    const Fortran::lower::pft::Variable &var) {
+  if (var.isModuleVariable())
+    return {}; // external linkage
+  // Otherwise, the variable is owned by a procedure and must not be visible in
+  // other compilation units.
+  return builder.createInternalLinkage();
+}
+
 /// Instantiate a global variable. If it hasn't already been processed, add
 /// 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`.
@@ -467,18 +487,13 @@ static void instantiateGlobal(Fortran::lower::AbstractConverter &converter,
   std::string globalName = Fortran::lower::mangle::mangleName(sym);
   mlir::Location loc = converter.genLocation(sym.name());
   fir::GlobalOp global = builder.getNamedGlobal(globalName);
-  if (!global) {
-    if (var.isDeclaration()) {
-      // Using a global from a module not defined in this compilation unit.
-      mlir::StringAttr externalLinkage;
-      global = declareGlobal(converter, var, globalName, externalLinkage);
-    } else {
-      mlir::StringAttr linkage; // external if remains empty.
-      if (!sym.owner().IsModule() &&
-          !Fortran::semantics::FindCommonBlockContaining(sym))
-        linkage = builder.createInternalLinkage();
-      global = defineGlobal(converter, var, globalName, linkage);
-    }
+  mlir::StringAttr linkage = getLinkageAttribute(builder, var);
+  if (var.isModuleVariable()) {
+    // 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 {
+    global = defineGlobal(converter, var, globalName, linkage);
   }
   auto addrOf = builder.create<fir::AddrOfOp>(loc, global.resultType(),
                                               global.getSymbol());
@@ -624,23 +639,27 @@ static fir::GlobalOp defineGlobalAggregateStore(
     StringRef aggName, mlir::StringAttr linkage) {
   assert(aggregate.isGlobal() && "not a global interval");
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  fir::GlobalOp global = builder.getNamedGlobal(aggName);
+  if (global && globalIsInitialized(global))
+    return global;
   mlir::Location loc = converter.getCurrentLocation();
   mlir::Type aggTy = getAggregateType(converter, aggregate);
+  if (!global)
+    global = builder.createGlobal(loc, aggTy, aggName, linkage);
+
   if (const Fortran::semantics::Symbol *initSym =
           aggregate.getInitialValueSymbol())
     if (const auto *objectDetails =
             initSym->detailsIf<Fortran::semantics::ObjectEntityDetails>())
-      if (objectDetails->init()) {
-        auto initFunc = [&](fir::FirOpBuilder &builder) {
-          Fortran::lower::StatementContext stmtCtx;
-          mlir::Value initVal = fir::getBase(genInitializerExprValue(
-              converter, loc, objectDetails->init().value(), stmtCtx));
-          builder.create<fir::HasValueOp>(loc, initVal);
-        };
-        return builder.createGlobal(loc, aggTy, aggName,
-                                    /*isConstant=*/false, initFunc, linkage);
-      }
-  return builder.createGlobal(loc, aggTy, aggName, linkage);
+      if (objectDetails->init())
+        createGlobalInitialization(
+            builder, global, [&](fir::FirOpBuilder &builder) {
+              Fortran::lower::StatementContext stmtCtx;
+              mlir::Value initVal = fir::getBase(genInitializerExprValue(
+                  converter, loc, objectDetails->init().value(), stmtCtx));
+              builder.create<fir::HasValueOp>(loc, initVal);
+            });
+  return global;
 }
 
 /// Declare a GlobalOp for the storage of a global equivalence described
@@ -656,8 +675,11 @@ static fir::GlobalOp declareGlobalAggregateStore(
     const Fortran::lower::pft::Variable::AggregateStore &aggregate,
     StringRef aggName, mlir::StringAttr linkage) {
   assert(aggregate.isGlobal() && "not a global interval");
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  if (fir::GlobalOp global = builder.getNamedGlobal(aggName))
+    return global;
   mlir::Type aggTy = getAggregateType(converter, aggregate);
-  return converter.getFirOpBuilder().createGlobal(loc, aggTy, aggName, linkage);
+  return builder.createGlobal(loc, aggTy, aggName, linkage);
 }
 
 /// This is an aggregate store for a set of EQUIVALENCED variables. Create the
@@ -672,23 +694,17 @@ instantiateAggregateStore(Fortran::lower::AbstractConverter &converter,
   mlir::Location loc = converter.getCurrentLocation();
   std::string aggName = mangleGlobalAggregateStore(var.getAggregateStore());
   if (var.isGlobal()) {
-    // The scope of this aggregate is this procedure.
-    fir::GlobalOp global = builder.getNamedGlobal(aggName);
-    if (!global) {
-      auto &aggregate = var.getAggregateStore();
-      if (var.isDeclaration()) {
-        // Using aggregate from a module not defined in the current
-        // compilation unit.
-        mlir::StringAttr externalLinkage;
-        global = declareGlobalAggregateStore(converter, loc, aggregate, aggName,
-                                             externalLinkage);
-      } else {
-        // The aggregate is owned by a procedure and must not be
-        // visible in other compilation units.
-        mlir::StringAttr internalLinkage = builder.createInternalLinkage();
-        global = defineGlobalAggregateStore(converter, aggregate, aggName,
-                                            internalLinkage);
-      }
+    fir::GlobalOp global;
+    auto &aggregate = var.getAggregateStore();
+    mlir::StringAttr linkage = getLinkageAttribute(builder, var);
+    if (var.isModuleVariable()) {
+      // 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,
+                                           linkage);
+    } else {
+      global =
+          defineGlobalAggregateStore(converter, aggregate, aggName, linkage);
     }
     auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
                                               global.getSymbol());
@@ -1709,9 +1725,6 @@ void Fortran::lower::defineModuleVariable(
   // Use empty linkage for module variables, which makes them available
   // for use in another unit.
   mlir::StringAttr externalLinkage;
-  // Only define variable owned by this module
-  if (var.isDeclaration())
-    return;
   if (!var.isGlobal())
     fir::emitFatalError(converter.genLocation(),
                         "attempting to lower module variable as local");