flang/lib/Semantics/mod-file.cpp

   1 //===-- lib/Semantics/mod-file.cpp ----------------------------------------===//
   2 //
   3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4 // See https://llvm.org/LICENSE.txt for license information.
   5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6 //
   7 //===----------------------------------------------------------------------===//
   8
   9 #include "mod-file.h"
  10 #include "resolve-names.h"
  11 #include "flang/Common/restorer.h"
  12 #include "flang/Evaluate/tools.h"
  13 #include "flang/Parser/message.h"
  14 #include "flang/Parser/parsing.h"
  15 #include "flang/Parser/unparse.h"
  16 #include "flang/Semantics/scope.h"
  17 #include "flang/Semantics/semantics.h"
  18 #include "flang/Semantics/symbol.h"
  19 #include "flang/Semantics/tools.h"
  20 #include "llvm/Support/FileSystem.h"
  21 #include "llvm/Support/MemoryBuffer.h"
  22 #include "llvm/Support/raw_ostream.h"
  23 #include <algorithm>
  24 #include <fstream>
  25 #include <set>
  26 #include <string_view>
  27 #include <vector>
  28
  29 namespace Fortran::semantics {
  30
  31 using namespace parser::literals;
  32
  33 // The first line of a file that identifies it as a .mod file.
  34 // The first three bytes are a Unicode byte order mark that ensures
  35 // that the module file is decoded as UTF-8 even if source files
  36 // are using another encoding.
  37 struct ModHeader {
  38   static constexpr const char bom[3 + 1]{"\xef\xbb\xbf"};
  39   static constexpr int magicLen{13};
  40   static constexpr int sumLen{16};
  41   static constexpr const char magic[magicLen + 1]{"!mod$ v1 sum:"};
  42   static constexpr char terminator{'\n'};
  43   static constexpr int len{magicLen + 1 + sumLen};
  44 };
  45
  46 static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);
  47 static void CollectSymbols(const Scope &, SymbolVector &, SymbolVector &);
  48 static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);
  49 static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &,
  50     const parser::Expr *);
  51 static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);
  52 static void PutBound(llvm::raw_ostream &, const Bound &);
  53 static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);
  54 static void PutShape(
  55     llvm::raw_ostream &, const ArraySpec &, char open, char close);
  56
  57 static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
  58 static llvm::raw_ostream &PutType(llvm::raw_ostream &, const DeclTypeSpec &);
  59 static llvm::raw_ostream &PutLower(llvm::raw_ostream &, std::string_view);
  60 static std::error_code WriteFile(
  61     const std::string &, const std::string &, bool = true);
  62 static bool FileContentsMatch(
  63     const std::string &, const std::string &, const std::string &);
  64 static std::string CheckSum(const std::string_view &);
  65
  66 // Collect symbols needed for a subprogram interface
  67 class SubprogramSymbolCollector {
  68 public:
  69   SubprogramSymbolCollector(const Symbol &symbol, const Scope &scope)
  70       : symbol_{symbol}, scope_{scope} {}
  71   const SymbolVector &symbols() const { return need_; }
  72   const std::set<SourceName> &imports() const { return imports_; }
  73   void Collect();
  74
  75 private:
  76   const Symbol &symbol_;
  77   const Scope &scope_;
  78   bool isInterface_{false};
  79   SymbolVector need_; // symbols that are needed
  80   UnorderedSymbolSet needSet_; // symbols already in need_
  81   UnorderedSymbolSet useSet_; // use-associations that might be needed
  82   std::set<SourceName> imports_; // imports from host that are needed
  83
  84   void DoSymbol(const Symbol &);
  85   void DoSymbol(const SourceName &, const Symbol &);
  86   void DoType(const DeclTypeSpec *);
  87   void DoBound(const Bound &);
  88   void DoParamValue(const ParamValue &);
  89   bool NeedImport(const SourceName &, const Symbol &);
  90
  91   template <typename T> void DoExpr(evaluate::Expr<T> expr) {
  92     for (const Symbol &symbol : evaluate::CollectSymbols(expr)) {
  93       DoSymbol(symbol);
  94     }
  95   }
  96 };
  97
  98 bool ModFileWriter::WriteAll() {
  99   // this flag affects character literals: force it to be consistent
 100   auto restorer{
 101       common::ScopedSet(parser::useHexadecimalEscapeSequences, false)};
 102   WriteAll(context_.globalScope());
 103   return !context_.AnyFatalError();
 104 }
 105
 106 void ModFileWriter::WriteAll(const Scope &scope) {
 107   for (const auto &child : scope.children()) {
 108     WriteOne(child);
 109   }
 110 }
 111
 112 void ModFileWriter::WriteOne(const Scope &scope) {
 113   if (scope.kind() == Scope::Kind::Module) {
 114     auto *symbol{scope.symbol()};
 115     if (!symbol->test(Symbol::Flag::ModFile)) {
 116       Write(*symbol);
 117     }
 118     WriteAll(scope); // write out submodules
 119   }
 120 }
 121
 122 // Construct the name of a module file. Non-empty ancestorName means submodule.
 123 static std::string ModFileName(const SourceName &name,
 124     const std::string &ancestorName, const std::string &suffix) {
 125   std::string result{name.ToString() + suffix};
 126   return ancestorName.empty() ? result : ancestorName + '-' + result;
 127 }
 128
 129 // Write the module file for symbol, which must be a module or submodule.
 130 void ModFileWriter::Write(const Symbol &symbol) {
 131   auto *ancestor{symbol.get<ModuleDetails>().ancestor()};
 132   isSubmodule_ = ancestor != nullptr;
 133   auto ancestorName{ancestor ? ancestor->GetName().value().ToString() : ""s};
 134   auto path{context_.moduleDirectory() + '/' +
 135       ModFileName(symbol.name(), ancestorName, context_.moduleFileSuffix())};
 136   PutSymbols(DEREF(symbol.scope()));
 137   if (std::error_code error{
 138           WriteFile(path, GetAsString(symbol), context_.debugModuleWriter())}) {
 139     context_.Say(
 140         symbol.name(), "Error writing %s: %s"_err_en_US, path, error.message());
 141   }
 142 }
 143
 144 // Return the entire body of the module file
 145 // and clear saved uses, decls, and contains.
 146 std::string ModFileWriter::GetAsString(const Symbol &symbol) {
 147   std::string buf;
 148   llvm::raw_string_ostream all{buf};
 149   auto &details{symbol.get<ModuleDetails>()};
 150   if (!details.isSubmodule()) {
 151     all << "module " << symbol.name();
 152   } else {
 153     auto *parent{details.parent()->symbol()};
 154     auto *ancestor{details.ancestor()->symbol()};
 155     all << "submodule(" << ancestor->name();
 156     if (parent != ancestor) {
 157       all << ':' << parent->name();
 158     }
 159     all << ") " << symbol.name();
 160   }
 161   all << '\n' << uses_.str();
 162   uses_.str().clear();
 163   all << useExtraAttrs_.str();
 164   useExtraAttrs_.str().clear();
 165   all << decls_.str();
 166   decls_.str().clear();
 167   auto str{contains_.str()};
 168   contains_.str().clear();
 169   if (!str.empty()) {
 170     all << "contains\n" << str;
 171   }
 172   all << "end\n";
 173   return all.str();
 174 }
 175
 176 // Put out the visible symbols from scope.
 177 void ModFileWriter::PutSymbols(const Scope &scope) {
 178   SymbolVector sorted;
 179   SymbolVector uses;
 180   CollectSymbols(scope, sorted, uses);
 181   std::string buf; // stuff after CONTAINS in derived type
 182   llvm::raw_string_ostream typeBindings{buf};
 183   for (const Symbol &symbol : sorted) {
 184     if (!symbol.test(Symbol::Flag::CompilerCreated)) {
 185       PutSymbol(typeBindings, symbol);
 186     }
 187   }
 188   for (const Symbol &symbol : uses) {
 189     PutUse(symbol);
 190   }
 191   for (const auto &set : scope.equivalenceSets()) {
 192     if (!set.empty() &&
 193         !set.front().symbol.test(Symbol::Flag::CompilerCreated)) {
 194       char punctuation{'('};
 195       decls_ << "equivalence";
 196       for (const auto &object : set) {
 197         decls_ << punctuation << object.AsFortran();
 198         punctuation = ',';
 199       }
 200       decls_ << ")\n";
 201     }
 202   }
 203   CHECK(typeBindings.str().empty());
 204 }
 205
 206 // Emit components in order
 207 bool ModFileWriter::PutComponents(const Symbol &typeSymbol) {
 208   const auto &scope{DEREF(typeSymbol.scope())};
 209   std::string buf; // stuff after CONTAINS in derived type
 210   llvm::raw_string_ostream typeBindings{buf};
 211   UnorderedSymbolSet emitted;
 212   SymbolVector symbols{scope.GetSymbols()};
 213   // Emit type parameters first
 214   for (const Symbol &symbol : symbols) {
 215     if (symbol.has<TypeParamDetails>()) {
 216       PutSymbol(typeBindings, symbol);
 217       emitted.emplace(symbol);
 218     }
 219   }
 220   // Emit components in component order.
 221   const auto &details{typeSymbol.get<DerivedTypeDetails>()};
 222   for (SourceName name : details.componentNames()) {
 223     auto iter{scope.find(name)};
 224     if (iter != scope.end()) {
 225       const Symbol &component{*iter->second};
 226       if (!component.test(Symbol::Flag::ParentComp)) {
 227         PutSymbol(typeBindings, component);
 228       }
 229       emitted.emplace(component);
 230     }
 231   }
 232   // Emit remaining symbols from the type's scope
 233   for (const Symbol &symbol : symbols) {
 234     if (emitted.find(symbol) == emitted.end()) {
 235       PutSymbol(typeBindings, symbol);
 236     }
 237   }
 238   if (auto str{typeBindings.str()}; !str.empty()) {
 239     CHECK(scope.IsDerivedType());
 240     decls_ << "contains\n" << str;
 241     return true;
 242   } else {
 243     return false;
 244   }
 245 }
 246
 247 static llvm::raw_ostream &PutGenericName(
 248     llvm::raw_ostream &os, const Symbol &symbol) {
 249   if (IsGenericDefinedOp(symbol)) {
 250     return os << "operator(" << symbol.name() << ')';
 251   } else {
 252     return os << symbol.name();
 253   }
 254 }
 255
 256 // Emit a symbol to decls_, except for bindings in a derived type (type-bound
 257 // procedures, type-bound generics, final procedures) which go to typeBindings.
 258 void ModFileWriter::PutSymbol(
 259     llvm::raw_ostream &typeBindings, const Symbol &symbol) {
 260   common::visit(
 261       common::visitors{
 262           [&](const ModuleDetails &) { /* should be current module */ },
 263           [&](const DerivedTypeDetails &) { PutDerivedType(symbol); },
 264           [&](const SubprogramDetails &) { PutSubprogram(symbol); },
 265           [&](const GenericDetails &x) {
 266             if (symbol.owner().IsDerivedType()) {
 267               // generic binding
 268               for (const Symbol &proc : x.specificProcs()) {
 269                 PutGenericName(typeBindings << "generic::", symbol)
 270                     << "=>" << proc.name() << '\n';
 271               }
 272             } else {
 273               PutGeneric(symbol);
 274               if (x.specific() && &x.specific()->owner() == &symbol.owner()) {
 275                 PutSymbol(typeBindings, *x.specific());
 276               }
 277               if (x.derivedType() &&
 278                   &x.derivedType()->owner() == &symbol.owner()) {
 279                 PutSymbol(typeBindings, *x.derivedType());
 280               }
 281             }
 282           },
 283           [&](const UseDetails &) { PutUse(symbol); },
 284           [](const UseErrorDetails &) {},
 285           [&](const ProcBindingDetails &x) {
 286             bool deferred{symbol.attrs().test(Attr::DEFERRED)};
 287             typeBindings << "procedure";
 288             if (deferred) {
 289               typeBindings << '(' << x.symbol().name() << ')';
 290             }
 291             PutPassName(typeBindings, x.passName());
 292             auto attrs{symbol.attrs()};
 293             if (x.passName()) {
 294               attrs.reset(Attr::PASS);
 295             }
 296             PutAttrs(typeBindings, attrs);
 297             typeBindings << "::" << symbol.name();
 298             if (!deferred && x.symbol().name() != symbol.name()) {
 299               typeBindings << "=>" << x.symbol().name();
 300             }
 301             typeBindings << '\n';
 302           },
 303           [&](const NamelistDetails &x) {
 304             decls_ << "namelist/" << symbol.name();
 305             char sep{'/'};
 306             for (const Symbol &object : x.objects()) {
 307               decls_ << sep << object.name();
 308               sep = ',';
 309             }
 310             decls_ << '\n';
 311             if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
 312               decls_ << "private::" << symbol.name() << '\n';
 313             }
 314           },
 315           [&](const CommonBlockDetails &x) {
 316             decls_ << "common/" << symbol.name();
 317             char sep = '/';
 318             for (const auto &object : x.objects()) {
 319               decls_ << sep << object->name();
 320               sep = ',';
 321             }
 322             decls_ << '\n';
 323             if (symbol.attrs().test(Attr::BIND_C)) {
 324               PutAttrs(decls_, symbol.attrs(), x.bindName(),
 325                   x.isExplicitBindName(), ""s);
 326               decls_ << "::/" << symbol.name() << "/\n";
 327             }
 328           },
 329           [](const HostAssocDetails &) {},
 330           [](const MiscDetails &) {},
 331           [&](const auto &) {
 332             PutEntity(decls_, symbol);
 333             if (symbol.test(Symbol::Flag::OmpThreadprivate)) {
 334               decls_ << "!$omp threadprivate(" << symbol.name() << ")\n";
 335             }
 336           },
 337       },
 338       symbol.details());
 339 }
 340
 341 void ModFileWriter::PutDerivedType(
 342     const Symbol &typeSymbol, const Scope *scope) {
 343   auto &details{typeSymbol.get<DerivedTypeDetails>()};
 344   if (details.isDECStructure()) {
 345     PutDECStructure(typeSymbol, scope);
 346     return;
 347   }
 348   PutAttrs(decls_ << "type", typeSymbol.attrs());
 349   if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
 350     decls_ << ",extends(" << extends->name() << ')';
 351   }
 352   decls_ << "::" << typeSymbol.name();
 353   if (!details.paramNames().empty()) {
 354     char sep{'('};
 355     for (const auto &name : details.paramNames()) {
 356       decls_ << sep << name;
 357       sep = ',';
 358     }
 359     decls_ << ')';
 360   }
 361   decls_ << '\n';
 362   if (details.sequence()) {
 363     decls_ << "sequence\n";
 364   }
 365   bool contains{PutComponents(typeSymbol)};
 366   if (!details.finals().empty()) {
 367     const char *sep{contains ? "final::" : "contains\nfinal::"};
 368     for (const auto &pair : details.finals()) {
 369       decls_ << sep << pair.second->name();
 370       sep = ",";
 371     }
 372     if (*sep == ',') {
 373       decls_ << '\n';
 374     }
 375   }
 376   decls_ << "end type\n";
 377 }
 378
 379 void ModFileWriter::PutDECStructure(
 380     const Symbol &typeSymbol, const Scope *scope) {
 381   if (emittedDECStructures_.find(typeSymbol) != emittedDECStructures_.end()) {
 382     return;
 383   }
 384   if (!scope && context_.IsTempName(typeSymbol.name().ToString())) {
 385     return; // defer until used
 386   }
 387   emittedDECStructures_.insert(typeSymbol);
 388   decls_ << "structure ";
 389   if (!context_.IsTempName(typeSymbol.name().ToString())) {
 390     decls_ << typeSymbol.name();
 391   }
 392   if (scope && scope->kind() == Scope::Kind::DerivedType) {
 393     // Nested STRUCTURE: emit entity declarations right now
 394     // on the STRUCTURE statement.
 395     bool any{false};
 396     for (const auto &ref : scope->GetSymbols()) {
 397       const auto *object{ref->detailsIf<ObjectEntityDetails>()};
 398       if (object && object->type() &&
 399           object->type()->category() == DeclTypeSpec::TypeDerived &&
 400           &object->type()->derivedTypeSpec().typeSymbol() == &typeSymbol) {
 401         if (any) {
 402           decls_ << ',';
 403         } else {
 404           any = true;
 405         }
 406         decls_ << ref->name();
 407         PutShape(decls_, object->shape(), '(', ')');
 408         PutInit(decls_, *ref, object->init(), nullptr);
 409         emittedDECFields_.insert(*ref);
 410       } else if (any) {
 411         break; // any later use of this structure will use RECORD/str/
 412       }
 413     }
 414   }
 415   decls_ << '\n';
 416   PutComponents(typeSymbol);
 417   decls_ << "end structure\n";
 418 }
 419
 420 // Attributes that may be in a subprogram prefix
 421 static const Attrs subprogramPrefixAttrs{Attr::ELEMENTAL, Attr::IMPURE,
 422     Attr::MODULE, Attr::NON_RECURSIVE, Attr::PURE, Attr::RECURSIVE};
 423
 424 void ModFileWriter::PutSubprogram(const Symbol &symbol) {
 425   auto &details{symbol.get<SubprogramDetails>()};
 426   if (const Symbol * interface{details.moduleInterface()}) {
 427     const Scope *module{FindModuleContaining(interface->owner())};
 428     if (module && module != &symbol.owner()) {
 429       // Interface is in ancestor module
 430     } else {
 431       PutSubprogram(*interface);
 432     }
 433   }
 434   auto attrs{symbol.attrs()};
 435   Attrs bindAttrs{};
 436   if (attrs.test(Attr::BIND_C)) {
 437     // bind(c) is a suffix, not prefix
 438     bindAttrs.set(Attr::BIND_C, true);
 439     attrs.set(Attr::BIND_C, false);
 440   }
 441   bool isAbstract{attrs.test(Attr::ABSTRACT)};
 442   if (isAbstract) {
 443     attrs.set(Attr::ABSTRACT, false);
 444   }
 445   Attrs prefixAttrs{subprogramPrefixAttrs & attrs};
 446   // emit any non-prefix attributes in an attribute statement
 447   attrs &= ~subprogramPrefixAttrs;
 448   std::string ssBuf;
 449   llvm::raw_string_ostream ss{ssBuf};
 450   PutAttrs(ss, attrs);
 451   if (!ss.str().empty()) {
 452     decls_ << ss.str().substr(1) << "::" << symbol.name() << '\n';
 453   }
 454   bool isInterface{details.isInterface()};
 455   llvm::raw_ostream &os{isInterface ? decls_ : contains_};
 456   if (isInterface) {
 457     os << (isAbstract ? "abstract " : "") << "interface\n";
 458   }
 459   PutAttrs(os, prefixAttrs, nullptr, false, ""s, " "s);
 460   os << (details.isFunction() ? "function " : "subroutine ");
 461   os << symbol.name() << '(';
 462   int n = 0;
 463   for (const auto &dummy : details.dummyArgs()) {
 464     if (n++ > 0) {
 465       os << ',';
 466     }
 467     if (dummy) {
 468       os << dummy->name();
 469     } else {
 470       os << "*";
 471     }
 472   }
 473   os << ')';
 474   PutAttrs(os, bindAttrs, details.bindName(), details.isExplicitBindName(),
 475       " "s, ""s);
 476   if (details.isFunction()) {
 477     const Symbol &result{details.result()};
 478     if (result.name() != symbol.name()) {
 479       os << " result(" << result.name() << ')';
 480     }
 481   }
 482   os << '\n';
 483
 484   // walk symbols, collect ones needed for interface
 485   const Scope &scope{
 486       details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};
 487   SubprogramSymbolCollector collector{symbol, scope};
 488   collector.Collect();
 489   std::string typeBindingsBuf;
 490   llvm::raw_string_ostream typeBindings{typeBindingsBuf};
 491   ModFileWriter writer{context_};
 492   for (const Symbol &need : collector.symbols()) {
 493     writer.PutSymbol(typeBindings, need);
 494   }
 495   CHECK(typeBindings.str().empty());
 496   os << writer.uses_.str();
 497   for (const SourceName &import : collector.imports()) {
 498     decls_ << "import::" << import << "\n";
 499   }
 500   os << writer.decls_.str();
 501   os << "end\n";
 502   if (isInterface) {
 503     os << "end interface\n";
 504   }
 505 }
 506
 507 static bool IsIntrinsicOp(const Symbol &symbol) {
 508   if (const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()}) {
 509     return details->kind().IsIntrinsicOperator();
 510   } else {
 511     return false;
 512   }
 513 }
 514
 515 void ModFileWriter::PutGeneric(const Symbol &symbol) {
 516   const auto &genericOwner{symbol.owner()};
 517   auto &details{symbol.get<GenericDetails>()};
 518   PutGenericName(decls_ << "interface ", symbol) << '\n';
 519   for (const Symbol &specific : details.specificProcs()) {
 520     if (specific.owner() == genericOwner) {
 521       decls_ << "procedure::" << specific.name() << '\n';
 522     }
 523   }
 524   decls_ << "end interface\n";
 525   if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
 526     PutGenericName(decls_ << "private::", symbol) << '\n';
 527   }
 528 }
 529
 530 void ModFileWriter::PutUse(const Symbol &symbol) {
 531   auto &details{symbol.get<UseDetails>()};
 532   auto &use{details.symbol()};
 533   const Symbol &module{GetUsedModule(details)};
 534   if (use.owner().parent().IsIntrinsicModules()) {
 535     uses_ << "use,intrinsic::";
 536   } else {
 537     uses_ << "use ";
 538   }
 539   uses_ << module.name() << ",only:";
 540   PutGenericName(uses_, symbol);
 541   // Can have intrinsic op with different local-name and use-name
 542   // (e.g. `operator(<)` and `operator(.lt.)`) but rename is not allowed
 543   if (!IsIntrinsicOp(symbol) && use.name() != symbol.name()) {
 544     PutGenericName(uses_ << "=>", use);
 545   }
 546   uses_ << '\n';
 547   PutUseExtraAttr(Attr::VOLATILE, symbol, use);
 548   PutUseExtraAttr(Attr::ASYNCHRONOUS, symbol, use);
 549   if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
 550     PutGenericName(useExtraAttrs_ << "private::", symbol) << '\n';
 551   }
 552 }
 553
 554 // We have "USE local => use" in this module. If attr was added locally
 555 // (i.e. on local but not on use), also write it out in the mod file.
 556 void ModFileWriter::PutUseExtraAttr(
 557     Attr attr, const Symbol &local, const Symbol &use) {
 558   if (local.attrs().test(attr) && !use.attrs().test(attr)) {
 559     PutAttr(useExtraAttrs_, attr) << "::";
 560     useExtraAttrs_ << local.name() << '\n';
 561   }
 562 }
 563
 564 // When a generic interface has the same name as a derived type
 565 // in the same scope, the generic shadows the derived type.
 566 // If the derived type were declared first, emit the generic
 567 // interface at the position of derived type's declaration.
 568 // (ReplaceName() is not used for this purpose because doing so
 569 // would confusingly position error messages pertaining to the generic
 570 // interface upon the derived type's declaration.)
 571 static inline SourceName NameInModuleFile(const Symbol &symbol) {
 572   if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
 573     if (const auto *derivedTypeOverload{generic->derivedType()}) {
 574       if (derivedTypeOverload->name().begin() < symbol.name().begin()) {
 575         return derivedTypeOverload->name();
 576       }
 577     }
 578   } else if (const auto *use{symbol.detailsIf<UseDetails>()}) {
 579     if (use->symbol().attrs().test(Attr::PRIVATE)) {
 580       // Avoid the use in sorting of names created to access private
 581       // specific procedures as a result of generic resolution;
 582       // they're not in the cooked source.
 583       return use->symbol().name();
 584     }
 585   }
 586   return symbol.name();
 587 }
 588
 589 // Collect the symbols of this scope sorted by their original order, not name.
 590 // Namelists are an exception: they are sorted after other symbols.
 591 void CollectSymbols(
 592     const Scope &scope, SymbolVector &sorted, SymbolVector &uses) {
 593   SymbolVector namelist;
 594   std::size_t commonSize{scope.commonBlocks().size()};
 595   auto symbols{scope.GetSymbols()};
 596   sorted.reserve(symbols.size() + commonSize);
 597   for (SymbolRef symbol : symbols) {
 598     if (!symbol->test(Symbol::Flag::ParentComp)) {
 599       if (symbol->has<NamelistDetails>()) {
 600         namelist.push_back(symbol);
 601       } else {
 602         sorted.push_back(symbol);
 603       }
 604       if (const auto *details{symbol->detailsIf<GenericDetails>()}) {
 605         uses.insert(uses.end(), details->uses().begin(), details->uses().end());
 606       }
 607     }
 608   }
 609   // Sort most symbols by name: use of Symbol::ReplaceName ensures the source
 610   // location of a symbol's name is the first "real" use.
 611   std::sort(sorted.begin(), sorted.end(), [](SymbolRef x, SymbolRef y) {
 612     return NameInModuleFile(x).begin() < NameInModuleFile(y).begin();
 613   });
 614   sorted.insert(sorted.end(), namelist.begin(), namelist.end());
 615   for (const auto &pair : scope.commonBlocks()) {
 616     sorted.push_back(*pair.second);
 617   }
 618   std::sort(
 619       sorted.end() - commonSize, sorted.end(), SymbolSourcePositionCompare{});
 620 }
 621
 622 void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
 623   common::visit(
 624       common::visitors{
 625           [&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },
 626           [&](const ProcEntityDetails &) { PutProcEntity(os, symbol); },
 627           [&](const TypeParamDetails &) { PutTypeParam(os, symbol); },
 628           [&](const auto &) {
 629             common::die("PutEntity: unexpected details: %s",
 630                 DetailsToString(symbol.details()).c_str());
 631           },
 632       },
 633       symbol.details());
 634 }
 635
 636 void PutShapeSpec(llvm::raw_ostream &os, const ShapeSpec &x) {
 637   if (x.lbound().isStar()) {
 638     CHECK(x.ubound().isStar());
 639     os << ".."; // assumed rank
 640   } else {
 641     if (!x.lbound().isColon()) {
 642       PutBound(os, x.lbound());
 643     }
 644     os << ':';
 645     if (!x.ubound().isColon()) {
 646       PutBound(os, x.ubound());
 647     }
 648   }
 649 }
 650 void PutShape(
 651     llvm::raw_ostream &os, const ArraySpec &shape, char open, char close) {
 652   if (!shape.empty()) {
 653     os << open;
 654     bool first{true};
 655     for (const auto &shapeSpec : shape) {
 656       if (first) {
 657         first = false;
 658       } else {
 659         os << ',';
 660       }
 661       PutShapeSpec(os, shapeSpec);
 662     }
 663     os << close;
 664   }
 665 }
 666
 667 void ModFileWriter::PutObjectEntity(
 668     llvm::raw_ostream &os, const Symbol &symbol) {
 669   auto &details{symbol.get<ObjectEntityDetails>()};
 670   if (details.type() &&
 671       details.type()->category() == DeclTypeSpec::TypeDerived) {
 672     const Symbol &typeSymbol{details.type()->derivedTypeSpec().typeSymbol()};
 673     if (typeSymbol.get<DerivedTypeDetails>().isDECStructure()) {
 674       PutDerivedType(typeSymbol, &symbol.owner());
 675       if (emittedDECFields_.find(symbol) != emittedDECFields_.end()) {
 676         return; // symbol was emitted on STRUCTURE statement
 677       }
 678     }
 679   }
 680   PutEntity(
 681       os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },
 682       symbol.attrs());
 683   PutShape(os, details.shape(), '(', ')');
 684   PutShape(os, details.coshape(), '[', ']');
 685   PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit());
 686   os << '\n';
 687 }
 688
 689 void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
 690   if (symbol.attrs().test(Attr::INTRINSIC)) {
 691     os << "intrinsic::" << symbol.name() << '\n';
 692     if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
 693       os << "private::" << symbol.name() << '\n';
 694     }
 695     return;
 696   }
 697   const auto &details{symbol.get<ProcEntityDetails>()};
 698   Attrs attrs{symbol.attrs()};
 699   if (details.passName()) {
 700     attrs.reset(Attr::PASS);
 701   }
 702   PutEntity(
 703       os, symbol,
 704       [&]() {
 705         os << "procedure(";
 706         if (details.procInterface()) {
 707           os << details.procInterface()->name();
 708         } else if (details.type()) {
 709           PutType(os, *details.type());
 710         }
 711         os << ')';
 712         PutPassName(os, details.passName());
 713       },
 714       attrs);
 715   os << '\n';
 716 }
 717
 718 void PutPassName(
 719     llvm::raw_ostream &os, const std::optional<SourceName> &passName) {
 720   if (passName) {
 721     os << ",pass(" << *passName << ')';
 722   }
 723 }
 724
 725 void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
 726   auto &details{symbol.get<TypeParamDetails>()};
 727   PutEntity(
 728       os, symbol,
 729       [&]() {
 730         PutType(os, DEREF(symbol.GetType()));
 731         PutLower(os << ',', common::EnumToString(details.attr()));
 732       },
 733       symbol.attrs());
 734   PutInit(os, details.init());
 735   os << '\n';
 736 }
 737
 738 void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init,
 739     const parser::Expr *unanalyzed) {
 740   if (symbol.attrs().test(Attr::PARAMETER) || symbol.owner().IsDerivedType()) {
 741     const char *assign{symbol.attrs().test(Attr::POINTER) ? "=>" : "="};
 742     if (unanalyzed) {
 743       parser::Unparse(os << assign, *unanalyzed);
 744     } else if (init) {
 745       init->AsFortran(os << assign);
 746     }
 747   }
 748 }
 749
 750 void PutInit(llvm::raw_ostream &os, const MaybeIntExpr &init) {
 751   if (init) {
 752     init->AsFortran(os << '=');
 753   }
 754 }
 755
 756 void PutBound(llvm::raw_ostream &os, const Bound &x) {
 757   if (x.isStar()) {
 758     os << '*';
 759   } else if (x.isColon()) {
 760     os << ':';
 761   } else {
 762     x.GetExplicit()->AsFortran(os);
 763   }
 764 }
 765
 766 // Write an entity (object or procedure) declaration.
 767 // writeType is called to write out the type.
 768 void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
 769     std::function<void()> writeType, Attrs attrs) {
 770   writeType();
 771   PutAttrs(os, attrs, symbol.GetBindName(), symbol.GetIsExplicitBindName());
 772   if (symbol.owner().kind() == Scope::Kind::DerivedType &&
 773       context_.IsTempName(symbol.name().ToString())) {
 774     os << "::%FILL";
 775   } else {
 776     os << "::" << symbol.name();
 777   }
 778 }
 779
 780 // Put out each attribute to os, surrounded by `before` and `after` and
 781 // mapped to lower case.
 782 llvm::raw_ostream &ModFileWriter::PutAttrs(llvm::raw_ostream &os, Attrs attrs,
 783     const std::string *bindName, bool isExplicitBindName, std::string before,
 784     std::string after) const {
 785   attrs.set(Attr::PUBLIC, false); // no need to write PUBLIC
 786   attrs.set(Attr::EXTERNAL, false); // no need to write EXTERNAL
 787   if (isSubmodule_) {
 788     attrs.set(Attr::PRIVATE, false);
 789   }
 790   if (bindName || isExplicitBindName) {
 791     os << before << "bind(c";
 792     if (isExplicitBindName) {
 793       os << ",name=\"" << (bindName ? *bindName : ""s) << '"';
 794     }
 795     os << ')' << after;
 796     attrs.set(Attr::BIND_C, false);
 797   }
 798   for (std::size_t i{0}; i < Attr_enumSize; ++i) {
 799     Attr attr{static_cast<Attr>(i)};
 800     if (attrs.test(attr)) {
 801       PutAttr(os << before, attr) << after;
 802     }
 803   }
 804   return os;
 805 }
 806
 807 llvm::raw_ostream &PutAttr(llvm::raw_ostream &os, Attr attr) {
 808   return PutLower(os, AttrToString(attr));
 809 }
 810
 811 llvm::raw_ostream &PutType(llvm::raw_ostream &os, const DeclTypeSpec &type) {
 812   return PutLower(os, type.AsFortran());
 813 }
 814
 815 llvm::raw_ostream &PutLower(llvm::raw_ostream &os, std::string_view str) {
 816   for (char c : str) {
 817     os << parser::ToLowerCaseLetter(c);
 818   }
 819   return os;
 820 }
 821
 822 struct Temp {
 823   Temp(int fd, std::string path) : fd{fd}, path{path} {}
 824   Temp(Temp &&t) : fd{std::exchange(t.fd, -1)}, path{std::move(t.path)} {}
 825   ~Temp() {
 826     if (fd >= 0) {
 827       llvm::sys::fs::file_t native{llvm::sys::fs::convertFDToNativeFile(fd)};
 828       llvm::sys::fs::closeFile(native);
 829       llvm::sys::fs::remove(path.c_str());
 830     }
 831   }
 832   int fd;
 833   std::string path;
 834 };
 835
 836 // Create a temp file in the same directory and with the same suffix as path.
 837 // Return an open file descriptor and its path.
 838 static llvm::ErrorOr<Temp> MkTemp(const std::string &path) {
 839   auto length{path.length()};
 840   auto dot{path.find_last_of("./")};
 841   std::string suffix{
 842       dot < length && path[dot] == '.' ? path.substr(dot + 1) : ""};
 843   CHECK(length > suffix.length() &&
 844       path.substr(length - suffix.length()) == suffix);
 845   auto prefix{path.substr(0, length - suffix.length())};
 846   int fd;
 847   llvm::SmallString<16> tempPath;
 848   if (std::error_code err{llvm::sys::fs::createUniqueFile(
 849           prefix + "%%%%%%" + suffix, fd, tempPath)}) {
 850     return err;
 851   }
 852   return Temp{fd, tempPath.c_str()};
 853 }
 854
 855 // Write the module file at path, prepending header. If an error occurs,
 856 // return errno, otherwise 0.
 857 static std::error_code WriteFile(
 858     const std::string &path, const std::string &contents, bool debug) {
 859   auto header{std::string{ModHeader::bom} + ModHeader::magic +
 860       CheckSum(contents) + ModHeader::terminator};
 861   if (debug) {
 862     llvm::dbgs() << "Processing module " << path << ": ";
 863   }
 864   if (FileContentsMatch(path, header, contents)) {
 865     if (debug) {
 866       llvm::dbgs() << "module unchanged, not writing\n";
 867     }
 868     return {};
 869   }
 870   llvm::ErrorOr<Temp> temp{MkTemp(path)};
 871   if (!temp) {
 872     return temp.getError();
 873   }
 874   llvm::raw_fd_ostream writer(temp->fd, /*shouldClose=*/false);
 875   writer << header;
 876   writer << contents;
 877   writer.flush();
 878   if (writer.has_error()) {
 879     return writer.error();
 880   }
 881   if (debug) {
 882     llvm::dbgs() << "module written\n";
 883   }
 884   return llvm::sys::fs::rename(temp->path, path);
 885 }
 886
 887 // Return true if the stream matches what we would write for the mod file.
 888 static bool FileContentsMatch(const std::string &path,
 889     const std::string &header, const std::string &contents) {
 890   std::size_t hsize{header.size()};
 891   std::size_t csize{contents.size()};
 892   auto buf_or{llvm::MemoryBuffer::getFile(path)};
 893   if (!buf_or) {
 894     return false;
 895   }
 896   auto buf = std::move(buf_or.get());
 897   if (buf->getBufferSize() != hsize + csize) {
 898     return false;
 899   }
 900   if (!std::equal(header.begin(), header.end(), buf->getBufferStart(),
 901           buf->getBufferStart() + hsize)) {
 902     return false;
 903   }
 904
 905   return std::equal(contents.begin(), contents.end(),
 906       buf->getBufferStart() + hsize, buf->getBufferEnd());
 907 }
 908
 909 // Compute a simple hash of the contents of a module file and
 910 // return it as a string of hex digits.
 911 // This uses the Fowler-Noll-Vo hash function.
 912 static std::string CheckSum(const std::string_view &contents) {
 913   std::uint64_t hash{0xcbf29ce484222325ull};
 914   for (char c : contents) {
 915     hash ^= c & 0xff;
 916     hash *= 0x100000001b3;
 917   }
 918   static const char *digits = "0123456789abcdef";
 919   std::string result(ModHeader::sumLen, '0');
 920   for (size_t i{ModHeader::sumLen}; hash != 0; hash >>= 4) {
 921     result[--i] = digits[hash & 0xf];
 922   }
 923   return result;
 924 }
 925
 926 static bool VerifyHeader(llvm::ArrayRef<char> content) {
 927   std::string_view sv{content.data(), content.size()};
 928   if (sv.substr(0, ModHeader::magicLen) != ModHeader::magic) {
 929     return false;
 930   }
 931   std::string_view expectSum{sv.substr(ModHeader::magicLen, ModHeader::sumLen)};
 932   std::string actualSum{CheckSum(sv.substr(ModHeader::len))};
 933   return expectSum == actualSum;
 934 }
 935
 936 Scope *ModFileReader::Read(const SourceName &name,
 937     std::optional<bool> isIntrinsic, Scope *ancestor, bool silent) {
 938   std::string ancestorName; // empty for module
 939   Symbol *notAModule{nullptr};
 940   bool fatalError{false};
 941   if (ancestor) {
 942     if (auto *scope{ancestor->FindSubmodule(name)}) {
 943       return scope;
 944     }
 945     ancestorName = ancestor->GetName().value().ToString();
 946   }
 947   if (!isIntrinsic.value_or(false) && !ancestor) {
 948     // Already present in the symbol table as a usable non-intrinsic module?
 949     auto it{context_.globalScope().find(name)};
 950     if (it != context_.globalScope().end()) {
 951       Scope *scope{it->second->scope()};
 952       if (scope->kind() == Scope::Kind::Module) {
 953         return scope;
 954       } else {
 955         notAModule = scope->symbol();
 956         // USE, NON_INTRINSIC global name isn't a module?
 957         fatalError = isIntrinsic.has_value();
 958       }
 959     }
 960   }
 961   auto path{ModFileName(name, ancestorName, context_.moduleFileSuffix())};
 962   parser::Parsing parsing{context_.allCookedSources()};
 963   parser::Options options;
 964   options.isModuleFile = true;
 965   options.features.Enable(common::LanguageFeature::BackslashEscapes);
 966   options.features.Enable(common::LanguageFeature::OpenMP);
 967   if (!isIntrinsic.value_or(false) && !notAModule) {
 968     // The search for this module file will scan non-intrinsic module
 969     // directories.  If a directory is in both the intrinsic and non-intrinsic
 970     // directory lists, the intrinsic module directory takes precedence.
 971     options.searchDirectories = context_.searchDirectories();
 972     for (const auto &dir : context_.intrinsicModuleDirectories()) {
 973       options.searchDirectories.erase(
 974           std::remove(options.searchDirectories.begin(),
 975               options.searchDirectories.end(), dir),
 976           options.searchDirectories.end());
 977     }
 978     options.searchDirectories.insert(options.searchDirectories.begin(), "."s);
 979   }
 980   bool foundNonIntrinsicModuleFile{false};
 981   if (!isIntrinsic) {
 982     std::list<std::string> searchDirs;
 983     for (const auto &d : options.searchDirectories) {
 984       searchDirs.push_back(d);
 985     }
 986     foundNonIntrinsicModuleFile =
 987         parser::LocateSourceFile(path, searchDirs).has_value();
 988   }
 989   if (isIntrinsic.value_or(!foundNonIntrinsicModuleFile)) {
 990     // Explicitly intrinsic, or not specified and not found in the search
 991     // path; see whether it's already in the symbol table as an intrinsic
 992     // module.
 993     auto it{context_.intrinsicModulesScope().find(name)};
 994     if (it != context_.intrinsicModulesScope().end()) {
 995       return it->second->scope();
 996     }
 997   }
 998   // We don't have this module in the symbol table yet.
 999   // Find its module file and parse it.  Define or extend the search
1000   // path with intrinsic module directories, if appropriate.
1001   if (isIntrinsic.value_or(true)) {
1002     for (const auto &dir : context_.intrinsicModuleDirectories()) {
1003       options.searchDirectories.push_back(dir);
1004     }
1005   }
1006   const auto *sourceFile{fatalError ? nullptr : parsing.Prescan(path, options)};
1007   if (fatalError || parsing.messages().AnyFatalError()) {
1008     if (!silent) {
1009       if (notAModule) {
1010         // Module is not explicitly INTRINSIC, and there's already a global
1011         // symbol of the same name that is not a module.
1012         context_.SayWithDecl(
1013             *notAModule, name, "'%s' is not a module"_err_en_US, name);
1014       } else {
1015         for (auto &msg : parsing.messages().messages()) {
1016           std::string str{msg.ToString()};
1017           Say(name, ancestorName,
1018               parser::MessageFixedText{str.c_str(), str.size(), msg.severity()},
1019               path);
1020         }
1021       }
1022     }
1023     return nullptr;
1024   }
1025   CHECK(sourceFile);
1026   if (!VerifyHeader(sourceFile->content())) {
1027     Say(name, ancestorName, "File has invalid checksum: %s"_warn_en_US,
1028         sourceFile->path());
1029     return nullptr;
1030   }
1031   llvm::raw_null_ostream NullStream;
1032   parsing.Parse(NullStream);
1033   std::optional<parser::Program> &parsedProgram{parsing.parseTree()};
1034   if (!parsing.messages().empty() || !parsing.consumedWholeFile() ||
1035       !parsedProgram) {
1036     Say(name, ancestorName, "Module file is corrupt: %s"_err_en_US,
1037         sourceFile->path());
1038     return nullptr;
1039   }
1040   parser::Program &parseTree{context_.SaveParseTree(std::move(*parsedProgram))};
1041   Scope *parentScope; // the scope this module/submodule goes into
1042   if (!isIntrinsic.has_value()) {
1043     for (const auto &dir : context_.intrinsicModuleDirectories()) {
1044       if (sourceFile->path().size() > dir.size() &&
1045           sourceFile->path().find(dir) == 0) {
1046         isIntrinsic = true;
1047         break;
1048       }
1049     }
1050   }
1051   Scope &topScope{isIntrinsic.value_or(false) ? context_.intrinsicModulesScope()
1052                                               : context_.globalScope()};
1053   if (!ancestor) {
1054     parentScope = &topScope;
1055   } else if (std::optional<SourceName> parent{GetSubmoduleParent(parseTree)}) {
1056     parentScope = Read(*parent, false /*not intrinsic*/, ancestor, silent);
1057   } else {
1058     parentScope = ancestor;
1059   }
1060   auto pair{parentScope->try_emplace(name, UnknownDetails{})};
1061   if (!pair.second) {
1062     return nullptr;
1063   }
1064   // Process declarations from the module file
1065   Symbol &modSymbol{*pair.first->second};
1066   modSymbol.set(Symbol::Flag::ModFile);
1067   bool wasInModuleFile{context_.foldingContext().inModuleFile()};
1068   context_.foldingContext().set_inModuleFile(true);
1069   ResolveNames(context_, parseTree, topScope);
1070   context_.foldingContext().set_inModuleFile(wasInModuleFile);
1071   CHECK(modSymbol.has<ModuleDetails>());
1072   CHECK(modSymbol.test(Symbol::Flag::ModFile));
1073   if (isIntrinsic.value_or(false)) {
1074     modSymbol.attrs().set(Attr::INTRINSIC);
1075   }
1076   return modSymbol.scope();
1077 }
1078
1079 parser::Message &ModFileReader::Say(const SourceName &name,
1080     const std::string &ancestor, parser::MessageFixedText &&msg,
1081     const std::string &arg) {
1082   return context_.Say(name, "Cannot read module file for %s: %s"_err_en_US,
1083       parser::MessageFormattedText{ancestor.empty()
1084               ? "module '%s'"_en_US
1085               : "submodule '%s' of module '%s'"_en_US,
1086           name, ancestor}
1087           .MoveString(),
1088       parser::MessageFormattedText{std::move(msg), arg}.MoveString());
1089 }
1090
1091 // program was read from a .mod file for a submodule; return the name of the
1092 // submodule's parent submodule, nullptr if none.
1093 static std::optional<SourceName> GetSubmoduleParent(
1094     const parser::Program &program) {
1095   CHECK(program.v.size() == 1);
1096   auto &unit{program.v.front()};
1097   auto &submod{std::get<common::Indirection<parser::Submodule>>(unit.u)};
1098   auto &stmt{
1099       std::get<parser::Statement<parser::SubmoduleStmt>>(submod.value().t)};
1100   auto &parentId{std::get<parser::ParentIdentifier>(stmt.statement.t)};
1101   if (auto &parent{std::get<std::optional<parser::Name>>(parentId.t)}) {
1102     return parent->source;
1103   } else {
1104     return std::nullopt;
1105   }
1106 }
1107
1108 void SubprogramSymbolCollector::Collect() {
1109   const auto &details{symbol_.get<SubprogramDetails>()};
1110   isInterface_ = details.isInterface();
1111   for (const Symbol *dummyArg : details.dummyArgs()) {
1112     if (dummyArg) {
1113       DoSymbol(*dummyArg);
1114     }
1115   }
1116   if (details.isFunction()) {
1117     DoSymbol(details.result());
1118   }
1119   for (const auto &pair : scope_) {
1120     const Symbol &symbol{*pair.second};
1121     if (const auto *useDetails{symbol.detailsIf<UseDetails>()}) {
1122       const Symbol &ultimate{useDetails->symbol().GetUltimate()};
1123       bool needed{useSet_.count(ultimate) > 0};
1124       if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
1125         // The generic may not be needed itself, but the specific procedure
1126         // &/or derived type that it shadows may be needed.
1127         const Symbol *spec{generic->specific()};
1128         const Symbol *dt{generic->derivedType()};
1129         needed = needed || (spec && useSet_.count(*spec) > 0) ||
1130             (dt && useSet_.count(*dt) > 0);
1131       } else if (const auto *subp{ultimate.detailsIf<SubprogramDetails>()}) {
1132         const Symbol *interface { subp->moduleInterface() };
1133         needed = needed || (interface && useSet_.count(*interface) > 0);
1134       }
1135       if (needed) {
1136         need_.push_back(symbol);
1137       }
1138     } else if (symbol.has<SubprogramDetails>()) {
1139       // An internal subprogram is needed if it is used as interface
1140       // for a dummy or return value procedure.
1141       bool needed{false};
1142       const auto hasInterface{[&symbol](const Symbol *s) -> bool {
1143         // Is 's' a procedure with interface 'symbol'?
1144         if (s) {
1145           if (const auto *sDetails{s->detailsIf<ProcEntityDetails>()}) {
1146             if (sDetails->procInterface() == &symbol) {
1147               return true;
1148             }
1149           }
1150         }
1151         return false;
1152       }};
1153       for (const Symbol *dummyArg : details.dummyArgs()) {
1154         needed = needed || hasInterface(dummyArg);
1155       }
1156       needed =
1157           needed || (details.isFunction() && hasInterface(&details.result()));
1158       if (needed && needSet_.insert(symbol).second) {
1159         need_.push_back(symbol);
1160       }
1161     }
1162   }
1163 }
1164
1165 void SubprogramSymbolCollector::DoSymbol(const Symbol &symbol) {
1166   DoSymbol(symbol.name(), symbol);
1167 }
1168
1169 // Do symbols this one depends on; then add to need_
1170 void SubprogramSymbolCollector::DoSymbol(
1171     const SourceName &name, const Symbol &symbol) {
1172   const auto &scope{symbol.owner()};
1173   if (scope != scope_ && !scope.IsDerivedType()) {
1174     if (scope != scope_.parent()) {
1175       useSet_.insert(symbol);
1176     }
1177     if (NeedImport(name, symbol)) {
1178       imports_.insert(name);
1179     }
1180     return;
1181   }
1182   if (!needSet_.insert(symbol).second) {
1183     return; // already done
1184   }
1185   common::visit(common::visitors{
1186                     [this](const ObjectEntityDetails &details) {
1187                       for (const ShapeSpec &spec : details.shape()) {
1188                         DoBound(spec.lbound());
1189                         DoBound(spec.ubound());
1190                       }
1191                       for (const ShapeSpec &spec : details.coshape()) {
1192                         DoBound(spec.lbound());
1193                         DoBound(spec.ubound());
1194                       }
1195                       if (const Symbol * commonBlock{details.commonBlock()}) {
1196                         DoSymbol(*commonBlock);
1197                       }
1198                     },
1199                     [this](const CommonBlockDetails &details) {
1200                       for (const auto &object : details.objects()) {
1201                         DoSymbol(*object);
1202                       }
1203                     },
1204                     [this](const ProcEntityDetails &details) {
1205                       if (details.procInterface()) {
1206                         DoSymbol(*details.procInterface());
1207                       } else {
1208                         DoType(details.type());
1209                       }
1210                     },
1211                     [](const auto &) {},
1212                 },
1213       symbol.details());
1214   if (!symbol.has<UseDetails>()) {
1215     DoType(symbol.GetType());
1216   }
1217   if (!scope.IsDerivedType()) {
1218     need_.push_back(symbol);
1219   }
1220 }
1221
1222 void SubprogramSymbolCollector::DoType(const DeclTypeSpec *type) {
1223   if (!type) {
1224     return;
1225   }
1226   switch (type->category()) {
1227   case DeclTypeSpec::Numeric:
1228   case DeclTypeSpec::Logical:
1229     break; // nothing to do
1230   case DeclTypeSpec::Character:
1231     DoParamValue(type->characterTypeSpec().length());
1232     break;
1233   default:
1234     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
1235       const auto &typeSymbol{derived->typeSymbol()};
1236       if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
1237         DoSymbol(extends->name(), extends->typeSymbol());
1238       }
1239       for (const auto &pair : derived->parameters()) {
1240         DoParamValue(pair.second);
1241       }
1242       for (const auto &pair : *typeSymbol.scope()) {
1243         const Symbol &comp{*pair.second};
1244         DoSymbol(comp);
1245       }
1246       DoSymbol(derived->name(), derived->typeSymbol());
1247     }
1248   }
1249 }
1250
1251 void SubprogramSymbolCollector::DoBound(const Bound &bound) {
1252   if (const MaybeSubscriptIntExpr & expr{bound.GetExplicit()}) {
1253     DoExpr(*expr);
1254   }
1255 }
1256 void SubprogramSymbolCollector::DoParamValue(const ParamValue &paramValue) {
1257   if (const auto &expr{paramValue.GetExplicit()}) {
1258     DoExpr(*expr);
1259   }
1260 }
1261
1262 // Do we need a IMPORT of this symbol into an interface block?
1263 bool SubprogramSymbolCollector::NeedImport(
1264     const SourceName &name, const Symbol &symbol) {
1265   if (!isInterface_) {
1266     return false;
1267   } else if (IsSeparateModuleProcedureInterface(&symbol_)) {
1268     return false; // IMPORT needed only for external and dummy procedure
1269                   // interfaces
1270   } else if (&symbol == scope_.symbol()) {
1271     return false;
1272   } else if (symbol.owner().Contains(scope_)) {
1273     return true;
1274   } else if (const Symbol *found{scope_.FindSymbol(name)}) {
1275     // detect import from ancestor of use-associated symbol
1276     return found->has<UseDetails>() && found->owner() != scope_;
1277   } else {
1278     // "found" can be null in the case of a use-associated derived type's parent
1279     // type
1280     CHECK(symbol.has<DerivedTypeDetails>());
1281     return false;
1282   }
1283 }
1284
1285 } // namespace Fortran::semantics