diff --git a/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp b/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp index 2fcff87fdc393..031a5aeb28d71 100644 --- a/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp +++ b/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp @@ -76,12 +76,49 @@ void ExternalNameConversionPass::runOnOperation() { auto *context = &getContext(); llvm::DenseMap remappings; + mlir::SymbolTable symbolTable(op); auto processFctOrGlobal = [&](mlir::Operation &funcOrGlobal) { auto symName = funcOrGlobal.getAttrOfType( mlir::SymbolTable::getSymbolAttrName()); auto deconstructedName = fir::NameUniquer::deconstruct(symName); if (fir::NameUniquer::isExternalFacingUniquedName(deconstructedName)) { + // Check if this is a private function that would conflict with a common + // block and get its mangled name. + if (auto funcOp = llvm::dyn_cast(funcOrGlobal)) { + if (funcOp.isPrivate()) { + std::string mangledName = + mangleExternalName(deconstructedName, appendUnderscoreOpt); + auto mod = funcOp->getParentOfType(); + bool hasConflictingCommonBlock = false; + + // Check if any existing global has the same mangled name. + if (symbolTable.lookup(mangledName)) + hasConflictingCommonBlock = true; + + // Skip externalization if the function has a conflicting common block + // and is not directly called (i.e. procedure pointers or type + // specifications) + if (hasConflictingCommonBlock) { + bool isDirectlyCalled = false; + std::optional uses = + funcOp.getSymbolUses(mod); + if (uses.has_value()) { + for (auto use : *uses) { + mlir::Operation *user = use.getUser(); + if (mlir::isa(user) || + mlir::isa(user)) { + isDirectlyCalled = true; + break; + } + } + } + if (!isDirectlyCalled) + return; + } + } + } + auto newName = mangleExternalName(deconstructedName, appendUnderscoreOpt); auto newAttr = mlir::StringAttr::get(context, newName); mlir::SymbolTable::setSymbolName(&funcOrGlobal, newAttr); diff --git a/flang/test/Transforms/dummy-procedure-common-block-name.f b/flang/test/Transforms/dummy-procedure-common-block-name.f new file mode 100644 index 0000000000000..2c3ebb965fe49 --- /dev/null +++ b/flang/test/Transforms/dummy-procedure-common-block-name.f @@ -0,0 +1,12 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +subroutine ss5() +common /com_dummy1/ x +! CHECK: fir.global common @com_dummy1_ +interface + subroutine com_dummy1() + end subroutine +end interface +! CHECK: func.func private @_QPcom_dummy1() +print *,fun_sub(com_dummy1) +end