[flang] Handle common block with different sizes in same file

[jeanPerier]

Summary

Semantics is not preventing a named common block to appear with
different size in a same file (named common block should always have
the same storage size (see Fortran 2018 8.10.2.5), but it is a common
extension to accept different sizes).

Lowering was not coping with this well, since it just use the first
common block appearance, starting with BLOCK DATAs to define common
blocks (this also was an issue with the blank common block, which can
legally appear with different size in different scoping units).

Semantics is also not preventing named common from being initialized
outside of a BLOCK DATA, and lowering was dealing badly with this,
since it only gave an initial value to common blocks Globals if the
first common block appearance, starting with BLOCK DATAs had an initial
value.

Semantics is also allowing blank common to be initialized, while
lowering was assuming this would never happen, and was never creating
an initial value for it.

Lastly, semantics was not complaining if a COMMON block was initialized
in several scoping unit in a same file, while lowering can only generate
one of these initial value.

To fix this, add a structure to keep track of COMMON block properties
(biggest size, and initial value if any) at the Program level. Once the
size of a common block appearance is know, the common block appearance
is checked against this information. It allows semantics to emit an error
in case of multiple initialization in different scopes of a same common
block, and to warn in case named common blocks appears with different
sizes. Lastly, this allows lowering to use the Program level info about
common blocks to emit the right GlobalOp for a Common Block, regardless
of the COMMON Block appearances order: It emits a GlobalOp with the
biggest size, whose lowest bytes are initialized with the initial value
if any is given in a scope where the common block appears.

Lowering is updated to go emit the common blocks before anything else so
that the related GlobalOps are available when lowering the scopes where
common block appear. It is also updated to not assume that blank common
are never initialized.

[klausler]

Looks great. Could you add comments to docs/Extensions.md to describe that (1) initializations of common outside BLOCK DATA and (2) initializations of blank COMMON are both non-standard, but are near-universal extensions that we have to support? Thanks.

flang/include/flang/Lower/PFTBuilder.h

33

It seems a little risky to define this typedef in two distinct header files; what if one of them changes?

flang/include/flang/Semantics/semantics.h

208

"depend on" or "depend upon"

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

20

"appearance"

[jeanPerier]

Could you add comments to docs/Extensions.md to describe that (1) initializations of common outside BLOCK DATA and (2) initializations of blank COMMON are both non-standard, but are near-universal extensions that we have to support?

Thanks for the reminder. (2) was already describe there, I added (1) right next to it.

flang/include/flang/Lower/PFTBuilder.h

33

In this specific case, both definitions are visible in PFTBuilder.cpp file, so if there is a conflict, the C++ compiler (at least clang) would raise "error: type alias redefinition with different types".

But I agree it is more maintenance to maintain two definition, I included semantics.h. It is not too template heavy, so there is little point avoiding to include it here.

flang/include/flang/Semantics/semantics.h

208

Thanks

[jeanPerier]

• Add note in docs/Extensions.md.
• Inlcude semantics.h in PFTBuilder.h instead of redefining the typdef
• Fix typos

flang/docs/Extensions.md

* We support some combinations of specific procedures in generic
   when their calls must nonetheless be distinguishable.
   Specifically, `ALLOCATABLE` dummy arguments are distinguishing
   if an actual argument acceptable to one could not be passed to
   the other & vice versa because exactly one is polymorphic or
   exactly one is unlimited polymorphic).
 * External unit 0 is predefined and connected to the standard error output,
   and defined as `ERROR_UNIT` in the intrinsic `ISO_FORTRAN_ENV` module.
 * Objects in blank COMMON may be initialized.
+* Initialization of COMMON blocks outside of BLOCK DATA subprograms.
 * Multiple specifications of the SAVE attribute on the same object
   are allowed, with a warning.
 * Specific intrinsic functions BABS, IIABS, JIABS, KIABS, ZABS, and CDABS.
 * A `POINTER` component's type need not be a sequence type when
   the component appears in a derived type with `SEQUENCE`.
   (This case should probably be an exception to constraint C740 in
   the standard.)
 * Format expressions that have type but are not character and not

flang/include/flang/Lower/ConvertVariable.h

void instantiateVariable(AbstractConverter &, const pft::Variable &var,
                          SymMap &symMap, AggregateStoreMap &storeMap);
 
 /// Create a fir::GlobalOp given a module variable definition. This is intended
 /// to be used when lowering a module definition, not when lowering variables
 /// used from a module. For used variables instantiateVariable must directly be
 /// called.
 void defineModuleVariable(AbstractConverter &, const pft::Variable &var);
 
+/// Create fir::GlobalOp for all common blocks, including their initial values
+/// if they have one. This should be called before lowering any scopes so that
+/// common block globals are available when a common appear in a scope.
+void defineCommonBlocks(
+    AbstractConverter &,
+    const std::vector<std::pair<semantics::SymbolRef, std::size_t>>
+        &commonBlocks);
+
 /// Lower a symbol attributes given an optional storage \p and add it to the
 /// provided symbol map. If \preAlloc is not provided, a temporary storage will
 /// be allocated. This is a low level function that should only be used if
 /// instantiateVariable cannot be called.
 void mapSymbolAttributes(AbstractConverter &, const pft::Variable &, SymMap &,
                          StatementContext &, mlir::Value preAlloc = {});
 
 /// Instantiate the variables that appear in the specification expressions

flang/include/flang/Lower/PFTBuilder.h

 
 #include "flang/Common/reference.h"
 #include "flang/Common/template.h"
 #include "flang/Lower/HostAssociations.h"
 #include "flang/Lower/PFTDefs.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Semantics/attr.h"
 #include "flang/Semantics/scope.h"
+#include "flang/Semantics/semantics.h"
 #include "flang/Semantics/symbol.h"
 #include "llvm/Support/ErrorHandling.h"
 #include "llvm/Support/raw_ostream.h"
 
 namespace Fortran::lower::pft {
 
 struct Evaluation;
 struct Program;
 struct ModuleLikeUnit;
 struct FunctionLikeUnit;
 
 using EvaluationList = std::list<Evaluation>;
 using LabelEvalMap = llvm::DenseMap<Fortran::parser::Label, Evaluation *>;
 
struct CompilerDirectiveUnit : public ProgramUnit {
   CompilerDirectiveUnit(const CompilerDirectiveUnit &) = delete;
 };
 
 /// A Program is the top-level root of the PFT.
 struct Program {
   using Units = std::variant<FunctionLikeUnit, ModuleLikeUnit, BlockDataUnit,
                              CompilerDirectiveUnit>;
 
-  Program() = default;
+  Program(semantics::CommonBlockList &&commonBlocks)
+      : commonBlocks{std::move(commonBlocks)} {}
   Program(Program &&) = default;
   Program(const Program &) = delete;
 
   const std::list<Units> &getUnits() const { return units; }
   std::list<Units> &getUnits() { return units; }
+  const semantics::CommonBlockList &getCommonBlocks() const {
+    return commonBlocks;
+  }
 
   /// LLVM dump method on a Program.
   LLVM_DUMP_METHOD void dump() const;
 
 private:
   std::list<Units> units;
+  semantics::CommonBlockList commonBlocks;
 };
 
 /// Return the list of variables that appears in the specification expressions
 /// of a function result.
 std::vector<pft::Variable>
 buildFuncResultDependencyList(const Fortran::semantics::Symbol &);
 
 /// Helper to get location from FunctionLikeUnit/ModuleLikeUnit begin/end

flang/include/flang/Semantics/semantics.h

 struct SelectTypeConstruct;
 struct Variable;
 struct WhereConstruct;
 } // namespace Fortran::parser
 
 namespace Fortran::semantics {
 
 class Symbol;
+class CommonBlockMap;
+using CommonBlockList = std::vector<std::pair<SymbolRef, std::size_t>>;
 
 using ConstructNode = std::variant<const parser::AssociateConstruct *,
     const parser::BlockConstruct *, const parser::CaseConstruct *,
     const parser::ChangeTeamConstruct *, const parser::CriticalConstruct *,
     const parser::DoConstruct *, const parser::ForallConstruct *,
     const parser::IfConstruct *, const parser::SelectRankConstruct *,
     const parser::SelectTypeConstruct *, const parser::WhereConstruct *>;
 using ConstructStack = std::vector<ConstructNode>;
public:
   // Defines builtinsScope_ from the __Fortran_builtins module
   void UseFortranBuiltinsModule();
   const Scope *GetBuiltinsScope() const { return builtinsScope_; }
 
   // Saves a module file's parse tree so that it remains available
   // during semantics.
   parser::Program &SaveParseTree(parser::Program &&);
 
+  // Ensures a common block definition does not conflict with previous
+  // appearances in the program and consolidate information about
+  // common blocks at the program level for later checks and lowering.
+  // This can obviously not check any conflicts between different compilation
+  // units (in case such conflicts exist, the behavior will depend on the
+  // linker).
+  void MapCommonBlockAndCheckConflicts(const Symbol &);
+
+  // Get the list of common blocks appearing in the program. If a common block
+  // appears in several subprograms, only one of its appearance is returned in
+  // the list alongside the biggest byte size of all its appearances.
+  // If a common block is initialized in any of its appearances, the list will
+  // contain the appearance with the initialization, otherwise the appearance
+  // with the biggest size is returned. The extra byte size information allows
+  // handling the case where the common block initialization is not the
+  // appearance with the biggest size: the common block will have the biggest
+  // size with the first bytes initialized with the initial value. This is not
+  // standard, if the initialization and biggest size appearances are in
+  // different compilation units, the behavior will depend on the linker. The
+  // linker may have the behavior described before, but it may also keep the
+  // initialized common symbol without extending its size, or have some other
+  // behavior.
+  CommonBlockList GetCommonBlocks() const;
+
 private:
   void CheckIndexVarRedefine(
       const parser::CharBlock &, const Symbol &, parser::MessageFixedText &&);
   void CheckError(const Symbol &);
 
   const common::IntrinsicTypeDefaultKinds &defaultKinds_;
   const common::LanguageFeatureControl languageFeatures_;
   parser::AllCookedSources &allCookedSources_;
struct IndexVarInfo {
     IndexVarKind kind;
   };
   std::map<SymbolRef, const IndexVarInfo, SymbolAddressCompare>
       activeIndexVars_;
   UnorderedSymbolSet errorSymbols_;
   std::set<std::string> tempNames_;
   const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins
   std::list<parser::Program> modFileParseTrees_;
+  std::unique_ptr<CommonBlockMap> commonBlockMap_;
 };
 
 class Semantics {
 public:
   explicit Semantics(SemanticsContext &context, parser::Program &program,
       bool debugModuleWriter = false)
       : context_{context}, program_{program} {
     context.set_debugModuleWriter(debugModuleWriter);

flang/lib/Lower/Bridge.cpp

 public:
   explicit FirConverter(Fortran::lower::LoweringBridge &bridge)
       : bridge{bridge}, foldingContext{bridge.createFoldingContext()} {}
   virtual ~FirConverter() = default;
 
   /// Convert the PFT to FIR.
   void run(Fortran::lower::pft::Program &pft) {
     // Preliminary translation pass.
+
+    // - Lower common blocks from the PFT common block list that contains a
+    // consolidated list of the common blocks (with the initialization if any in
+    // the Program, and with the common block biggest size in all its
+    // appearance). This is done before lowering any scope declarations because
+    // it is not know at the local scope level what MLIR type common blocks
+    // should have to suit all its usage in the compilation unit.
+    lowerCommonBlocks(pft.getCommonBlocks());
+
     //  - Declare all functions that have definitions so that definition
     //    signatures prevail over call site signatures.
     //  - Define module variables and OpenMP/OpenACC declarative construct so
     //    that they are available before lowering any function that may use
     //    them.
-    //  - Translate block data programs so that common block definitions with
-    //    data initializations take precedence over other definitions.
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
-      std::visit(
-          Fortran::common::visitors{
+      std::visit(Fortran::common::visitors{
                      [&](Fortran::lower::pft::FunctionLikeUnit &f) {
                        declareFunction(f);
                      },
                      [&](Fortran::lower::pft::ModuleLikeUnit &m) {
                        lowerModuleDeclScope(m);
                        for (Fortran::lower::pft::FunctionLikeUnit &f :
                             m.nestedFunctions)
                          declareFunction(f);
                      },
-              [&](Fortran::lower::pft::BlockDataUnit &b) { lowerBlockData(b); },
+                     [&](Fortran::lower::pft::BlockDataUnit &b) {},
                      [&](Fortran::lower::pft::CompilerDirectiveUnit &d) {},
                  },
                  u);
     }
 
     // Primary translation pass.
     for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
       std::visit(
           Fortran::common::visitors{
               [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); },
               [&](Fortran::lower::pft::ModuleLikeUnit &m) { lowerMod(m); },
createGlobalOutsideOfFunctionLowering([&]() {
         if (sym->has<Fortran::semantics::ObjectEntityDetails>()) {
           Fortran::lower::pft::Variable var(*sym, true);
           instantiateVar(var, fakeMap);
         }
       }
     });
   }
 
+  /// Create fir::Global for all the common blocks that appear in the program.
+  void
+  lowerCommonBlocks(const Fortran::semantics::CommonBlockList &commonBlocks) {
+    createGlobalOutsideOfFunctionLowering(
+        [&]() { Fortran::lower::defineCommonBlocks(*this, commonBlocks); });
+  }
+
   /// Lower a procedure (nest).
   void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
     if (!funit.isMainProgram()) {
       const Fortran::semantics::Symbol &procSymbol =
           funit.getSubprogramSymbol();
       if (procSymbol.owner().IsSubmodule()) {
         TODO(toLocation(), "support submodules");
         return;

flang/lib/Lower/ConvertVariable.cpp

for (const Fortran::semantics::EquivalenceObject &obj : set) {
               members.end())
             members.emplace_back(obj.symbol);
         }
       }
     }
   return members;
 }
 
-/// Define a global for a common block if it does not already exist in the
-/// mlir module.
-/// There is no "declare" version since there is not a
-/// scope that owns common blocks more that the others. All scopes using
-/// a common block attempts to define it with common linkage.
+/// Return the fir::GlobalOp that was created of COMMON block \p common.
+/// 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
-defineCommonBlock(Fortran::lower::AbstractConverter &converter,
+getCommonBlockGlobal(Fortran::lower::AbstractConverter &converter,
                      const Fortran::semantics::Symbol &common) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   std::string commonName = Fortran::lower::mangle::mangleName(common);
   fir::GlobalOp global = builder.getNamedGlobal(commonName);
-  if (global)
-    return global;
+  // 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");
+}
+
+/// 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);
+  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::IndexType idxTy = builder.getIndexType();
   mlir::StringAttr linkage = builder.createCommonLinkage();
-  if (!common.name().size() || !commonBlockHasInit(cmnBlkMems)) {
-    // A blank (anonymous) COMMON block must always be initialized to zero.
-    // A named COMMON block sans initializers is also initialized to zero.
+  if (!commonBlockHasInit(cmnBlkMems)) {
+    // A COMMON block sans initializers is initialized to zero.
     // mlir::Vector types must have a strictly positive size, so at least
     // temporarily, force a zero size COMMON block to have one byte.
-    const auto sz = static_cast<fir::SequenceType::Extent>(
-        common.size() > 0 ? common.size() : 1);
+    const auto sz =
+        static_cast<fir::SequenceType::Extent>(commonSize > 0 ? commonSize : 1);
     fir::SequenceType::Shape shape = {sz};
     mlir::IntegerType i8Ty = builder.getIntegerType(8);
     auto commonTy = fir::SequenceType::get(shape, i8Ty);
     auto vecTy = mlir::VectorType::get(sz, i8Ty);
     mlir::Attribute zero = builder.getIntegerAttr(i8Ty, 0);
     auto init = mlir::DenseElementsAttr::get(vecTy, llvm::makeArrayRef(zero));
-    return builder.createGlobal(loc, commonTy, commonName, linkage, init);
-  }
-
-  // Named common with initializer, sort members by offset before generating
-  // the type and initializer.
+    builder.createGlobal(loc, commonTy, commonName, linkage, init);
+    // No need to add any initial value later.
+    return std::nullopt;
+  }
+  // COMMON block with initializer (note that initialized blank common are
+  // accepted as an extension by semantics). Sort members by offset before
+  // generating the type and initializer.
   std::sort(cmnBlkMems.begin(), cmnBlkMems.end(),
             [](auto &s1, auto &s2) { return s1->offset() < s2->offset(); });
   mlir::TupleType commonTy =
-      getTypeOfCommonWithInit(converter, cmnBlkMems, common.size());
+      getTypeOfCommonWithInit(converter, cmnBlkMems, commonSize);
+  // Create the global object, the initial value will be added later.
+  global = builder.createGlobal(loc, commonTy, commonName);
+  return std::make_tuple(global, std::move(cmnBlkMems), loc);
+}
+
+/// Add initial value to a COMMON block fir::GlobalOp \p global given the list
+/// \p cmnBlkMems of the common block member symbols that contains symbols with
+/// an initial value.
+static void finalizeCommonBlockDefinition(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    fir::GlobalOp global,
+    const Fortran::semantics::MutableSymbolVector &cmnBlkMems) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::TupleType commonTy = global.getType().cast<mlir::TupleType>();
   auto initFunc = [&](fir::FirOpBuilder &builder) {
+    mlir::IndexType idxTy = builder.getIndexType();
     mlir::Value cb = builder.create<fir::UndefOp>(loc, commonTy);
     unsigned tupIdx = 0;
     std::size_t offset = 0;
     LLVM_DEBUG(llvm::dbgs() << "block {\n");
     for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
       if (const auto *memDet =
               mem->detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
         if (mem->offset() > offset) {
for (const Fortran::semantics::MutableSymbolRef &mem : cmnBlkMems) {
           ++tupIdx;
           offset = mem->offset() + mem->size();
         }
       }
     }
     LLVM_DEBUG(llvm::dbgs() << "}\n");
     builder.create<fir::HasValueOp>(loc, cb);
   };
-  // create the global object
-  return builder.createGlobal(loc, commonTy, commonName,
-                              /*isConstant=*/false, initFunc);
+  createGlobalInitialization(builder, global, initFunc);
 }
+
+void Fortran::lower::defineCommonBlocks(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::semantics::CommonBlockList &commonBlocks) {
+  // Common blocks may depend on another common block address (if they contain
+  // pointers with initial targets). To cover this case, create all common block
+  // fir::Global before creating the initial values (if any).
+  std::vector<std::tuple<fir::GlobalOp, Fortran::semantics::MutableSymbolVector,
+                         mlir::Location>>
+      delayedInitializations;
+  for (const auto [common, size] : commonBlocks)
+    if (auto delayedInit = declareCommonBlock(converter, common, size))
+      delayedInitializations.emplace_back(std::move(*delayedInit));
+  for (auto &[global, cmnBlkMems, loc] : delayedInitializations)
+    finalizeCommonBlockDefinition(loc, converter, global, cmnBlkMems);
+}
+
 /// The COMMON block is a global structure. `var` will be at some offset
 /// within the COMMON block. Adds the address of `var` (COMMON + offset) to
 /// the symbol map.
 static void instantiateCommon(Fortran::lower::AbstractConverter &converter,
                               const Fortran::semantics::Symbol &common,
                               const Fortran::lower::pft::Variable &var,
                               Fortran::lower::SymMap &symMap) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   const Fortran::semantics::Symbol &varSym = var.getSymbol();
   mlir::Location loc = converter.genLocation(varSym.name());
 
   mlir::Value commonAddr;
   if (Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(common))
     commonAddr = symBox.getAddr();
   if (!commonAddr) {
     // introduce a local AddrOf and add it to the map
-    fir::GlobalOp global = defineCommonBlock(converter, common);
+    fir::GlobalOp global = getCommonBlockGlobal(converter, common);
     commonAddr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
                                                global.getSymbol());
 
     symMap.addSymbol(common, commonAddr);
   }
   std::size_t byteOffset = varSym.GetUltimate().offset();
   mlir::IntegerType i8Ty = builder.getIntegerType(8);
   mlir::Type i8Ptr = builder.getRefType(i8Ty);
const Fortran::lower::pft::Variable::AggregateStore &aggregate =
         var.getAggregateStore();
     std::string aggName = mangleGlobalAggregateStore(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())) {
-    // Define common block containing the variable.
-    defineCommonBlock(converter, *common);
+    // 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);
     defineGlobal(converter, var, globalName, linkage);
   }
 }
 

flang/lib/Lower/PFTBuilder.cpp

 };
 
 /// 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
 /// limit the bridge to one such instantiation.
 class PFTBuilder {
 public:
   PFTBuilder(const semantics::SemanticsContext &semanticsContext)
-      : pgm{std::make_unique<lower::pft::Program>()}, semanticsContext{
-                                                          semanticsContext} {
+      : pgm{std::make_unique<lower::pft::Program>(
+            semanticsContext.GetCommonBlocks())},
+        semanticsContext{semanticsContext} {
     lower::pft::PftNode pftRoot{*pgm.get()};
     pftParentStack.push_back(pftRoot);
   }
 
   /// Get the result
   std::unique_ptr<lower::pft::Program> result() { return std::move(pgm); }
 
   template <typename A>

flang/lib/Semantics/compute-offsets.cpp

if (eqIter != equivalenceBlock_.end()) {
       SizeAndAlignment &blockInfo{eqIter->second};
       minSize = std::max(
           minSize, std::max(offset_, eqIter->first->offset() + blockInfo.size));
       minAlignment = std::max(minAlignment, blockInfo.alignment);
     }
   }
   commonBlock.set_size(std::max(minSize, offset_));
   details.set_alignment(std::max(minAlignment, alignment_));
+  context_.MapCommonBlockAndCheckConflicts(commonBlock);
 }
 
 void ComputeOffsetsHelper::DoEquivalenceBlockBase(
     Symbol &symbol, SizeAndAlignment &blockInfo) {
   if (symbol.size() > blockInfo.size) {
     blockInfo.size = symbol.size();
   }
 }

flang/lib/Semantics/semantics.cpp

static bool PerformStatementSemantics(
   StatementSemanticsPass2 pass2{context};
   pass2.Walk(program);
   if (!context.AnyFatalError()) {
     pass2.CompileDataInitializationsIntoInitializers();
   }
   return !context.AnyFatalError();
 }
 
+/// This class keeps track of the common block appearances with the biggest size
+/// and with an initial value (if any) in a program. This allows reporting
+/// conflicting initialization and warning about appearances of a same
+/// named common block with different sizes. The biggest common block size and
+/// initialization (if any) can later be provided so that lowering can generate
+/// the correct symbol size and initial values, even when named common blocks
+/// appears with different sizes and are initialized outside of block data.
+class CommonBlockMap {
+private:
+  struct CommonBlockInfo {
+    // Common block symbol for the appearance with the biggest size.
+    SymbolRef biggestSize;
+    // Common block symbol for the appearance with the initialized members (if
+    // any).
+    std::optional<SymbolRef> initialization;
+  };
+
+public:
+  void MapCommonBlockAndCheckConflicts(
+      SemanticsContext &context, const Symbol &common) {
+    const Symbol *isInitialized{CommonBlockIsInitialized(common)};
+    auto [it, firstAppearance] = commonBlocks_.insert({common.name(),
+        isInitialized ? CommonBlockInfo{common, common}
+                      : CommonBlockInfo{common, std::nullopt}});
+    if (!firstAppearance) {
+      CommonBlockInfo &info{it->second};
+      if (isInitialized) {
+        if (info.initialization.has_value() &&
+            &**info.initialization != &common) {
+          // Use the location of the initialization in the error message because
+          // common block symbols may have no location if they are blank
+          // commons.
+          const Symbol &previousInit{
+              DEREF(CommonBlockIsInitialized(**info.initialization))};
+          context
+              .Say(isInitialized->name(),
+                  "Multiple initialization of COMMON block /%s/"_err_en_US,
+                  common.name())
+              .Attach(previousInit.name(),
+                  "Previous initialization of COMMON block /%s/"_en_US,
+                  common.name());
+        } else {
+          info.initialization = common;
+        }
+      }
+      if (common.size() != info.biggestSize->size() && !common.name().empty()) {
+        context
+            .Say(common.name(),
+                "A named COMMON block should have the same size everywhere it appears (%zd bytes here)"_port_en_US,
+                common.size())
+            .Attach(info.biggestSize->name(),
+                "Previously defined with a size of %zd bytes"_en_US,
+                info.biggestSize->size());
+      }
+      if (common.size() > info.biggestSize->size()) {
+        info.biggestSize = common;
+      }
+    }
+  }
+
+  CommonBlockList GetCommonBlocks() const {
+    CommonBlockList result;
+    for (const auto &[_, blockInfo] : commonBlocks_) {
+      result.emplace_back(
+          std::make_pair(blockInfo.initialization ? *blockInfo.initialization
+                                                  : blockInfo.biggestSize,
+              blockInfo.biggestSize->size()));
+    }
+    return result;
+  }
+
+private:
+  /// Return the symbol of an initialized member if a COMMON block
+  /// is initalized. Otherwise, return nullptr.
+  static Symbol *CommonBlockIsInitialized(const Symbol &common) {
+    const auto &commonDetails =
+        common.get<Fortran::semantics::CommonBlockDetails>();
+
+    for (const auto &member : commonDetails.objects()) {
+      if (IsInitialized(*member)) {
+        return &*member;
+      }
+    }
+
+    // Common block may be initialized via initialized variables that are in an
+    // equivalence with the common block members.
+    for (const Fortran::semantics::EquivalenceSet &set :
+        common.owner().equivalenceSets()) {
+      for (const Fortran::semantics::EquivalenceObject &obj : set) {
+        if (!obj.symbol.test(
+                Fortran::semantics::Symbol::Flag::CompilerCreated)) {
+          if (FindCommonBlockContaining(obj.symbol) == &common &&
+              IsInitialized(obj.symbol)) {
+            return &obj.symbol;
+          }
+        }
+      }
+    }
+    return nullptr;
+  }
+  std::map<SourceName, CommonBlockInfo> commonBlocks_;
+};
+
 SemanticsContext::SemanticsContext(
     const common::IntrinsicTypeDefaultKinds &defaultKinds,
     const common::LanguageFeatureControl &languageFeatures,
     parser::AllCookedSources &allCookedSources)
     : defaultKinds_{defaultKinds}, languageFeatures_{languageFeatures},
       allCookedSources_{allCookedSources},
       intrinsics_{evaluate::IntrinsicProcTable::Configure(defaultKinds_)},
       globalScope_{*this}, intrinsicModulesScope_{globalScope_.MakeScope(
void DoDumpSymbols(llvm::raw_ostream &os, const Scope &scope, int indent) {
   --indent;
 }
 
 static void PutIndent(llvm::raw_ostream &os, int indent) {
   for (int i = 0; i < indent; ++i) {
     os << "  ";
   }
 }
+
+void SemanticsContext::MapCommonBlockAndCheckConflicts(const Symbol &common) {
+  if (!commonBlockMap_) {
+    commonBlockMap_ = std::make_unique<CommonBlockMap>();
+  }
+  commonBlockMap_->MapCommonBlockAndCheckConflicts(*this, common);
+}
+
+CommonBlockList SemanticsContext::GetCommonBlocks() const {
+  if (commonBlockMap_) {
+    return commonBlockMap_->GetCommonBlocks();
+  }
+  return {};
+}
+
 } // namespace Fortran::semantics

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:  %[[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:  %[[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
+  common /a/ xa, ya
+  call foo(x, xa)
+end subroutine
+
+subroutine second_appearance
+  real :: x, y, z, xa, ya, za
+  common // x, y, z
+  common /a/ xa, ya, za
+  call foo(x, xa)
+end subroutine
+
+subroutine third_appearance
+  integer :: x = 42, xa = 42
+  common // x
+  common /a/ xa
+end subroutine

flang/test/Lower/common-block.f90

 ! RUN: bbc %s -o - | tco | 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: @_QBrien = common global [1 x i8] zeroinitializer
-! CHECK: @_QBwith_empty_equiv = common global [8 x i8] zeroinitializer
 
 ! CHECK-LABEL: _QPs0
 subroutine s0
   common // a0, b0
 
   ! CHECK: call void @_QPs(float* bitcast ([8 x i8]* @_QB to float*), float* bitcast (i8* getelementptr inbounds ([8 x i8], [8 x i8]* @_QB, i32 0, i64 4) to float*))
   call s(a0, b0)
 end subroutine s0

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>
+
+! 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: %[[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
 ! CHECK: fir.global @_QMm1Ex : f32
 ! CHECK: fir.global @_QMm1Ey : !fir.array<100xi32>
 

 ! CHECK-LABEL: fir.global @_QMmodeq1Ex1 : !fir.array<76xi8>
 ! CHECK-LABEL: fir.global @_QMmodeq1Ey1 : !fir.array<10xi32> {
   ! CHECK: %[[undef:.*]] = fir.undefined !fir.array<10xi32>
   ! CHECK: %[[v1:.*]] = fir.insert_on_range %0, %c0{{.*}} from (0) to (3) : (!fir.array<10xi32>, i32) -> !fir.array<10xi32>
   ! CHECK: %[[v2:.*]] = fir.insert_value %1, %c1109917696{{.*}}, [4 : index] : (!fir.array<10xi32>, i32) -> !fir.array<10xi32>
   ! CHECK: %[[v3:.*]] = fir.insert_on_range %2, %c0{{.*}} from (5) to (9) : (!fir.array<10xi32>, i32) -> !fir.array<10xi32>
   ! CHECK: fir.has_value %[[v3]] : !fir.array<10xi32>
 
-! 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>
-
-! 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: %[[init:.*]] = fir.insert_value %{{.*}}, %c42{{.*}}, [0 : index] : (tuple<i32>, i32) -> tuple<i32>
-  ! CHECK: fir.has_value %[[init]] : tuple<i32>
-
 ! Test defining two module variables whose initializers depend on each others
 ! addresses.
 module global_init_depending_on_each_other_address
   type a
     type(b), pointer :: pb
   end type
   type b
     type(a), pointer :: pa

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-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
 
real function modCommon1Use()
   ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref<!fir.array<4xi8>>
   ! CHECK-DAG: fir.address_of(@_QBnamed1) : !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>
-! CHECK-DAG: fir.global common @_QBnamed2(dense<0> : vector<4xi8>) : !fir.array<4xi8>
-! CHECK-DAG: fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8>
-! CHECK-DAG: fir.global common @_QBnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8>

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 in modules
-module some_mod
-  real, target :: x(100)
-  real, pointer :: p(:) => x
-! CHECK-LABEL: fir.global @_QMsome_modEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
-  ! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref<!fir.array<100xf32>>
-  ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
-  ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
-  ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
-end module
-
-! 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: %[[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.ptr<!fir.array<?xf32>>>
-  ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
-end module
-
 ! 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: %[[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<!fir.ptr<f32>>
   ! CHECK: %[[a:.*]] = fir.insert_value %[[undef]], %[[box]], [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>>>>
+end block data
+
 ! Test pointer in a common with initial target in the same common.
 block data snake
   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: %[[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: %[[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<!fir.ptr<i32>>
   ! CHECK: %[[tuple1:.*]] = fir.insert_value %[[tuple0]], %[[box]], [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>
 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>>>>
-end block data
+! Test pointer initial data target in modules
+module some_mod
+  real, target :: x(100)
+  real, pointer :: p(:) => x
+! CHECK-LABEL: fir.global @_QMsome_modEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
+  ! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref<!fir.array<100xf32>>
+  ! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
+  ! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+  ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+end module
+
+! 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: %[[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.ptr<!fir.array<?xf32>>>
+  ! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
+end module

flang/test/Semantics/common-blocks-warn.f90

+! RUN: %flang -fsyntax-only 2>&1 %s | FileCheck %s
+
+! Test that a warning is emitted when a named common block appears in
+! several scopes with a different storage size.
+
+subroutine size_1
+  common x, y
+  common /c/ xc, yc
+end subroutine
+
+subroutine size_2
+  ! OK, blank common size may always differ.
+  common x, y, z
+  !CHECK: portability: A named COMMON block should have the same size everywhere it appears (12 bytes here)
+  common /c/ xc, yc, zc
+end subroutine

flang/test/Semantics/common-blocks.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+! Test check that enforce that a common block is initialized
+! only once in a file.
+
+subroutine init_1
+  common x, y
+  common /a/ xa, ya
+  common /b/ xb, yb
+  !CHECK: portability: Blank COMMON object 'x' in a DATA statement is not standard
+  data x /42./, xa /42./, yb/42./
+end subroutine
+
+subroutine init_conflict
+  !ERROR: Multiple initialization of COMMON block //
+  common x, y
+  !ERROR: Multiple initialization of COMMON block /a/
+  common /a/ xa, ya
+  common /b/ xb, yb
+  equivalence (yb, yb_eq)
+  !ERROR: Multiple initialization of COMMON block /b/
+  data x /66./, xa /66./, yb_eq /66./
+end subroutine

flang/test/Semantics/resolve42.f90

module m11
   end type
   type t2
     sequence
     type(t1) :: b
     integer:: c
   end type
   type(t2) :: x2
   !ERROR: Derived type variable 'x2' may not appear in a COMMON block due to ALLOCATABLE component
-  common x2
+  common /c2/ x2
 end
 
 module m12
   type t1
     sequence
     integer :: a = 123
   end type
   type t2
     sequence
     type(t1) :: b
     integer:: c
   end type
   type(t2) :: x2
   !ERROR: Derived type variable 'x2' may not appear in a COMMON block due to component with default initialization
-  common x2
+  common /c3/ x2
 end
 
 subroutine s13
   block
     !ERROR: COMMON statement is not allowed in a BLOCK construct
     common x
   end block
 end
 
 subroutine s14
   !ERROR: 'c' appears as a COMMON block in a BIND statement but not in a COMMON statement
   bind(c) :: /c/
 end