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 <variant>
28#include <vector>
29
30namespace Fortran::semantics {
31
32using namespace parser::literals;
33
34// The first line of a file that identifies it as a .mod file.
35// The first three bytes are a Unicode byte order mark that ensures
36// that the module file is decoded as UTF-8 even if source files
37// are using another encoding.
38struct ModHeader {
39 static constexpr const char bom[3 + 1]{"\xef\xbb\xbf"};
40 static constexpr int magicLen{13};
41 static constexpr int sumLen{16};
42 static constexpr const char magic[magicLen + 1]{"!mod$ v1 sum:"};
43 static constexpr char terminator{'\n'};
44 static constexpr int len{magicLen + 1 + sumLen};
45 static constexpr int needLen{7};
46 static constexpr const char need[needLen + 1]{"!need$ "};
47};
48
49static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);
50static void CollectSymbols(
51 const Scope &, SymbolVector &, SymbolVector &, SourceOrderedSymbolSet &);
52static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);
53static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &,
54 const parser::Expr *, SemanticsContext &);
55static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);
56static void PutBound(llvm::raw_ostream &, const Bound &);
57static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);
58static void PutShape(
59 llvm::raw_ostream &, const ArraySpec &, char open, char close);
60
61static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
62static llvm::raw_ostream &PutType(llvm::raw_ostream &, const DeclTypeSpec &);
63static llvm::raw_ostream &PutLower(llvm::raw_ostream &, std::string_view);
64static std::error_code WriteFile(const std::string &, const std::string &,
65 ModuleCheckSumType &, bool debug = true);
66static bool FileContentsMatch(
67 const std::string &, const std::string &, const std::string &);
68static ModuleCheckSumType ComputeCheckSum(const std::string_view &);
69static std::string CheckSumString(ModuleCheckSumType);
70
71// Collect symbols needed for a subprogram interface
72class SubprogramSymbolCollector {
73public:
74 SubprogramSymbolCollector(const Symbol &symbol, const Scope &scope)
75 : symbol_{symbol}, scope_{scope} {}
76 const SymbolVector &symbols() const { return need_; }
77 const std::set<SourceName> &imports() const { return imports_; }
78 void Collect();
79
80private:
81 const Symbol &symbol_;
82 const Scope &scope_;
83 bool isInterface_{false};
84 SymbolVector need_; // symbols that are needed
85 UnorderedSymbolSet needSet_; // symbols already in need_
86 UnorderedSymbolSet useSet_; // use-associations that might be needed
87 std::set<SourceName> imports_; // imports from host that are needed
88
89 void DoSymbol(const Symbol &);
90 void DoSymbol(const SourceName &, const Symbol &);
91 void DoType(const DeclTypeSpec *);
92 void DoBound(const Bound &);
93 void DoParamValue(const ParamValue &);
94 bool NeedImport(const SourceName &, const Symbol &);
95
96 template <typename T> void DoExpr(evaluate::Expr<T> expr) {
97 for (const Symbol &symbol : evaluate::CollectSymbols(expr)) {
98 DoSymbol(symbol);
99 }
100 }
101};
102
103bool ModFileWriter::WriteAll() {
104 // this flag affects character literals: force it to be consistent
105 auto restorer{
106 common::ScopedSet(parser::useHexadecimalEscapeSequences, false)};
107 WriteAll(context_.globalScope());
108 return !context_.AnyFatalError();
109}
110
111void ModFileWriter::WriteAll(const Scope &scope) {
112 for (const auto &child : scope.children()) {
113 WriteOne(child);
114 }
115}
116
117void ModFileWriter::WriteOne(const Scope &scope) {
118 if (scope.kind() == Scope::Kind::Module) {
119 auto *symbol{scope.symbol()};
120 if (!symbol->test(Symbol::Flag::ModFile)) {
121 Write(*symbol);
122 }
123 WriteAll(scope); // write out submodules
124 }
125}
126
127// Construct the name of a module file. Non-empty ancestorName means submodule.
128static std::string ModFileName(const SourceName &name,
129 const std::string &ancestorName, const std::string &suffix) {
130 std::string result{name.ToString() + suffix};
131 return ancestorName.empty() ? result : ancestorName + '-' + result;
132}
133
134// Write the module file for symbol, which must be a module or submodule.
135void ModFileWriter::Write(const Symbol &symbol) {
136 const auto &module{symbol.get<ModuleDetails>()};
137 if (module.moduleFileHash()) {
138 return; // already written
139 }
140 const auto *ancestor{module.ancestor()};
141 isSubmodule_ = ancestor != nullptr;
142 auto ancestorName{ancestor ? ancestor->GetName().value().ToString() : ""s};
143 std::string path{context_.moduleDirectory() + '/' +
144 ModFileName(symbol.name(), ancestorName, context_.moduleFileSuffix())};
145
146 std::set<std::string> hermeticModuleNames;
147 hermeticModuleNames.insert(symbol.name().ToString());
148 UnorderedSymbolSet additionalModules;
149 PutSymbols(DEREF(symbol.scope()),
150 hermeticModuleFileOutput_ ? &additionalModules : nullptr);
151 auto asStr{GetAsString(symbol)};
152 while (!additionalModules.empty()) {
153 UnorderedSymbolSet nextPass{std::move(additionalModules)};
154 additionalModules.clear();
155 for (const Symbol &modSym : nextPass) {
156 if (!modSym.owner().IsIntrinsicModules() &&
157 hermeticModuleNames.find(modSym.name().ToString()) ==
158 hermeticModuleNames.end()) {
159 hermeticModuleNames.insert(modSym.name().ToString());
160 PutSymbols(DEREF(modSym.scope()), &additionalModules);
161 asStr += GetAsString(modSym);
162 }
163 }
164 }
165
166 ModuleCheckSumType checkSum;
167 if (std::error_code error{
168 WriteFile(path, asStr, checkSum, context_.debugModuleWriter())}) {
169 context_.Say(
170 symbol.name(), "Error writing %s: %s"_err_en_US, path, error.message());
171 }
172 const_cast<ModuleDetails &>(module).set_moduleFileHash(checkSum);
173}
174
175void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol,
176 UnorderedSymbolSet &nonIntrinsicModulesWritten) {
177 if (!symbol.has<ModuleDetails>() || symbol.owner().IsIntrinsicModules() ||
178 !nonIntrinsicModulesWritten.insert(symbol).second) {
179 return;
180 }
181 PutSymbols(DEREF(symbol.scope()), /*hermeticModules=*/nullptr);
182 needsBuf_.clear(); // omit module checksums
183 auto str{GetAsString(symbol)};
184 for (auto depRef : std::move(usedNonIntrinsicModules_)) {
185 WriteClosure(out, *depRef, nonIntrinsicModulesWritten);
186 }
187 out << std::move(str);
188}
189
190// Return the entire body of the module file
191// and clear saved uses, decls, and contains.
192std::string ModFileWriter::GetAsString(const Symbol &symbol) {
193 std::string buf;
194 llvm::raw_string_ostream all{buf};
195 all << needs_.str();
196 needs_.str().clear();
197 auto &details{symbol.get<ModuleDetails>()};
198 if (!details.isSubmodule()) {
199 all << "module " << symbol.name();
200 } else {
201 auto *parent{details.parent()->symbol()};
202 auto *ancestor{details.ancestor()->symbol()};
203 all << "submodule(" << ancestor->name();
204 if (parent != ancestor) {
205 all << ':' << parent->name();
206 }
207 all << ") " << symbol.name();
208 }
209 all << '\n' << uses_.str();
210 uses_.str().clear();
211 all << useExtraAttrs_.str();
212 useExtraAttrs_.str().clear();
213 all << decls_.str();
214 decls_.str().clear();
215 auto str{contains_.str()};
216 contains_.str().clear();
217 if (!str.empty()) {
218 all << "contains\n" << str;
219 }
220 all << "end\n";
221 return all.str();
222}
223
224// Collect symbols from constant and specification expressions that are being
225// referenced directly from other modules; they may require new USE
226// associations.
227static void HarvestSymbolsNeededFromOtherModules(
228 SourceOrderedSymbolSet &, const Scope &);
229static void HarvestSymbolsNeededFromOtherModules(
230 SourceOrderedSymbolSet &set, const Symbol &symbol, const Scope &scope) {
231 auto HarvestBound{[&](const Bound &bound) {
232 if (const auto &expr{bound.GetExplicit()}) {
233 for (SymbolRef ref : evaluate::CollectSymbols(*expr)) {
234 set.emplace(*ref);
235 }
236 }
237 }};
238 auto HarvestShapeSpec{[&](const ShapeSpec &shapeSpec) {
239 HarvestBound(shapeSpec.lbound());
240 HarvestBound(shapeSpec.ubound());
241 }};
242 auto HarvestArraySpec{[&](const ArraySpec &arraySpec) {
243 for (const auto &shapeSpec : arraySpec) {
244 HarvestShapeSpec(shapeSpec);
245 }
246 }};
247
248 if (symbol.has<DerivedTypeDetails>()) {
249 if (symbol.scope()) {
250 HarvestSymbolsNeededFromOtherModules(set, *symbol.scope());
251 }
252 } else if (const auto &generic{symbol.detailsIf<GenericDetails>()};
253 generic && generic->derivedType()) {
254 const Symbol &dtSym{*generic->derivedType()};
255 if (dtSym.has<DerivedTypeDetails>()) {
256 if (dtSym.scope()) {
257 HarvestSymbolsNeededFromOtherModules(set, *dtSym.scope());
258 }
259 } else {
260 CHECK(dtSym.has<UseDetails>() || dtSym.has<UseErrorDetails>());
261 }
262 } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
263 HarvestArraySpec(object->shape());
264 HarvestArraySpec(object->coshape());
265 if (IsNamedConstant(symbol) || scope.IsDerivedType()) {
266 if (object->init()) {
267 for (SymbolRef ref : evaluate::CollectSymbols(*object->init())) {
268 set.emplace(*ref);
269 }
270 }
271 }
272 } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
273 if (proc->init() && *proc->init() && scope.IsDerivedType()) {
274 set.emplace(**proc->init());
275 }
276 } else if (const auto *subp{symbol.detailsIf<SubprogramDetails>()}) {
277 for (const Symbol *dummy : subp->dummyArgs()) {
278 if (dummy) {
279 HarvestSymbolsNeededFromOtherModules(set, *dummy, scope);
280 }
281 }
282 if (subp->isFunction()) {
283 HarvestSymbolsNeededFromOtherModules(set, subp->result(), scope);
284 }
285 }
286}
287
288static void HarvestSymbolsNeededFromOtherModules(
289 SourceOrderedSymbolSet &set, const Scope &scope) {
290 for (const auto &[_, symbol] : scope) {
291 HarvestSymbolsNeededFromOtherModules(set, *symbol, scope);
292 }
293}
294
295void ModFileWriter::PrepareRenamings(const Scope &scope) {
296 // Identify use-associated symbols already in scope under some name
297 std::map<const Symbol *, const Symbol *> useMap;
298 for (const auto &[name, symbolRef] : scope) {
299 const Symbol *symbol{&*symbolRef};
300 while (const auto *hostAssoc{symbol->detailsIf<HostAssocDetails>()}) {
301 symbol = &hostAssoc->symbol();
302 }
303 if (const auto *use{symbol->detailsIf<UseDetails>()}) {
304 useMap.emplace(&use->symbol(), symbol);
305 }
306 }
307 // Collect symbols needed from other modules
308 SourceOrderedSymbolSet symbolsNeeded;
309 HarvestSymbolsNeededFromOtherModules(symbolsNeeded, scope);
310 // Establish any necessary renamings of symbols in other modules
311 // to their names in this scope, creating those new names when needed.
312 auto &renamings{context_.moduleFileOutputRenamings()};
313 for (SymbolRef s : symbolsNeeded) {
314 if (s->owner().kind() != Scope::Kind::Module) {
315 // Not a USE'able name from a module's top scope;
316 // component, binding, dummy argument, &c.
317 continue;
318 }
319 const Scope *sMod{FindModuleContaining(s->owner())};
320 if (!sMod || sMod == &scope) {
321 continue;
322 }
323 if (auto iter{useMap.find(&*s)}; iter != useMap.end()) {
324 renamings.emplace(&*s, iter->second->name());
325 continue;
326 }
327 SourceName rename{s->name()};
328 if (const Symbol * found{scope.FindSymbol(s->name())}) {
329 if (found == &*s) {
330 continue; // available in scope
331 }
332 if (const auto *generic{found->detailsIf<GenericDetails>()}) {
333 if (generic->derivedType() == &*s || generic->specific() == &*s) {
334 continue;
335 }
336 } else if (found->has<UseDetails>()) {
337 if (&found->GetUltimate() == &*s) {
338 continue; // already use-associated with same name
339 }
340 }
341 if (&s->owner() != &found->owner()) { // Symbol needs renaming
342 rename = scope.context().SaveTempName(
343 DEREF(sMod->symbol()).name().ToString() + "$" +
344 s->name().ToString());
345 }
346 }
347 // Symbol is used in this scope but not visible under its name
348 if (sMod->parent().IsIntrinsicModules()) {
349 uses_ << "use,intrinsic::";
350 } else {
351 uses_ << "use ";
352 }
353 uses_ << DEREF(sMod->symbol()).name() << ",only:";
354 if (rename != s->name()) {
355 uses_ << rename << "=>";
356 renamings.emplace(&s->GetUltimate(), rename);
357 }
358 uses_ << s->name() << '\n';
359 useExtraAttrs_ << "private::" << rename << '\n';
360 }
361}
362
363// Put out the visible symbols from scope.
364void ModFileWriter::PutSymbols(
365 const Scope &scope, UnorderedSymbolSet *hermeticModules) {
366 SymbolVector sorted;
367 SymbolVector uses;
368 auto &renamings{context_.moduleFileOutputRenamings()};
369 auto previousRenamings{std::move(renamings)};
370 PrepareRenamings(scope);
371 SourceOrderedSymbolSet modules;
372 CollectSymbols(scope, sorted, uses, modules);
373 // Write module files for dependencies first so that their
374 // hashes are known.
375 for (auto ref : modules) {
376 if (hermeticModules) {
377 hermeticModules->insert(*ref);
378 } else {
379 Write(*ref);
380 needs_ << ModHeader::need
381 << CheckSumString(
382 ref->get<ModuleDetails>().moduleFileHash().value())
383 << (ref->owner().IsIntrinsicModules() ? " i " : " n ")
384 << ref->name().ToString() << '\n';
385 }
386 }
387 std::string buf; // stuff after CONTAINS in derived type
388 llvm::raw_string_ostream typeBindings{buf};
389 for (const Symbol &symbol : sorted) {
390 if (!symbol.test(Symbol::Flag::CompilerCreated)) {
391 PutSymbol(typeBindings, symbol);
392 }
393 }
394 for (const Symbol &symbol : uses) {
395 PutUse(symbol);
396 }
397 for (const auto &set : scope.equivalenceSets()) {
398 if (!set.empty() &&
399 !set.front().symbol.test(Symbol::Flag::CompilerCreated)) {
400 char punctuation{'('};
401 decls_ << "equivalence";
402 for (const auto &object : set) {
403 decls_ << punctuation << object.AsFortran();
404 punctuation = ',';
405 }
406 decls_ << ")\n";
407 }
408 }
409 CHECK(typeBindings.str().empty());
410 renamings = std::move(previousRenamings);
411}
412
413// Emit components in order
414bool ModFileWriter::PutComponents(const Symbol &typeSymbol) {
415 const auto &scope{DEREF(typeSymbol.scope())};
416 std::string buf; // stuff after CONTAINS in derived type
417 llvm::raw_string_ostream typeBindings{buf};
418 UnorderedSymbolSet emitted;
419 SymbolVector symbols{scope.GetSymbols()};
420 // Emit type parameter declarations first, in order
421 const auto &details{typeSymbol.get<DerivedTypeDetails>()};
422 for (const Symbol &symbol : details.paramDeclOrder()) {
423 CHECK(symbol.has<TypeParamDetails>());
424 PutSymbol(typeBindings, symbol);
425 emitted.emplace(symbol);
426 }
427 // Emit actual components in component order.
428 for (SourceName name : details.componentNames()) {
429 auto iter{scope.find(name)};
430 if (iter != scope.end()) {
431 const Symbol &component{*iter->second};
432 if (!component.test(Symbol::Flag::ParentComp)) {
433 PutSymbol(typeBindings, component);
434 }
435 emitted.emplace(component);
436 }
437 }
438 // Emit remaining symbols from the type's scope
439 for (const Symbol &symbol : symbols) {
440 if (emitted.find(symbol) == emitted.end()) {
441 PutSymbol(typeBindings, symbol);
442 }
443 }
444 if (auto str{typeBindings.str()}; !str.empty()) {
445 CHECK(scope.IsDerivedType());
446 decls_ << "contains\n" << str;
447 return true;
448 } else {
449 return false;
450 }
451}
452
453// Return the symbol's attributes that should be written
454// into the mod file.
455static Attrs getSymbolAttrsToWrite(const Symbol &symbol) {
456 // Is SAVE attribute is implicit, it should be omitted
457 // to not violate F202x C862 for a common block member.
458 return symbol.attrs() & ~(symbol.implicitAttrs() & Attrs{Attr::SAVE});
459}
460
461static llvm::raw_ostream &PutGenericName(
462 llvm::raw_ostream &os, const Symbol &symbol) {
463 if (IsGenericDefinedOp(symbol)) {
464 return os << "operator(" << symbol.name() << ')';
465 } else {
466 return os << symbol.name();
467 }
468}
469
470// Emit a symbol to decls_, except for bindings in a derived type (type-bound
471// procedures, type-bound generics, final procedures) which go to typeBindings.
472void ModFileWriter::PutSymbol(
473 llvm::raw_ostream &typeBindings, const Symbol &symbol) {
474 common::visit(
475 common::visitors{
476 [&](const ModuleDetails &) { /* should be current module */ },
477 [&](const DerivedTypeDetails &) { PutDerivedType(symbol); },
478 [&](const SubprogramDetails &) { PutSubprogram(symbol); },
479 [&](const GenericDetails &x) {
480 if (symbol.owner().IsDerivedType()) {
481 // generic binding
482 for (const Symbol &proc : x.specificProcs()) {
483 PutGenericName(typeBindings << "generic::", symbol)
484 << "=>" << proc.name() << '\n';
485 }
486 } else {
487 PutGeneric(symbol);
488 }
489 },
490 [&](const UseDetails &) { PutUse(symbol); },
491 [](const UseErrorDetails &) {},
492 [&](const ProcBindingDetails &x) {
493 bool deferred{symbol.attrs().test(Attr::DEFERRED)};
494 typeBindings << "procedure";
495 if (deferred) {
496 typeBindings << '(' << x.symbol().name() << ')';
497 }
498 PutPassName(typeBindings, x.passName());
499 auto attrs{symbol.attrs()};
500 if (x.passName()) {
501 attrs.reset(Attr::PASS);
502 }
503 PutAttrs(typeBindings, attrs);
504 typeBindings << "::" << symbol.name();
505 if (!deferred && x.symbol().name() != symbol.name()) {
506 typeBindings << "=>" << x.symbol().name();
507 }
508 typeBindings << '\n';
509 },
510 [&](const NamelistDetails &x) {
511 decls_ << "namelist/" << symbol.name();
512 char sep{'/'};
513 for (const Symbol &object : x.objects()) {
514 decls_ << sep << object.name();
515 sep = ',';
516 }
517 decls_ << '\n';
518 if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
519 decls_ << "private::" << symbol.name() << '\n';
520 }
521 },
522 [&](const CommonBlockDetails &x) {
523 decls_ << "common/" << symbol.name();
524 char sep = '/';
525 for (const auto &object : x.objects()) {
526 decls_ << sep << object->name();
527 sep = ',';
528 }
529 decls_ << '\n';
530 if (symbol.attrs().test(Attr::BIND_C)) {
531 PutAttrs(decls_, getSymbolAttrsToWrite(symbol), x.bindName(),
532 x.isExplicitBindName(), ""s);
533 decls_ << "::/" << symbol.name() << "/\n";
534 }
535 },
536 [](const HostAssocDetails &) {},
537 [](const MiscDetails &) {},
538 [&](const auto &) {
539 PutEntity(decls_, symbol);
540 PutDirective(decls_, symbol);
541 },
542 },
543 symbol.details());
544}
545
546void ModFileWriter::PutDerivedType(
547 const Symbol &typeSymbol, const Scope *scope) {
548 auto &details{typeSymbol.get<DerivedTypeDetails>()};
549 if (details.isDECStructure()) {
550 PutDECStructure(typeSymbol, scope);
551 return;
552 }
553 PutAttrs(decls_ << "type", typeSymbol.attrs());
554 if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
555 decls_ << ",extends(" << extends->name() << ')';
556 }
557 decls_ << "::" << typeSymbol.name();
558 if (!details.paramNameOrder().empty()) {
559 char sep{'('};
560 for (const SymbolRef &ref : details.paramNameOrder()) {
561 decls_ << sep << ref->name();
562 sep = ',';
563 }
564 decls_ << ')';
565 }
566 decls_ << '\n';
567 if (details.sequence()) {
568 decls_ << "sequence\n";
569 }
570 bool contains{PutComponents(typeSymbol)};
571 if (!details.finals().empty()) {
572 const char *sep{contains ? "final::" : "contains\nfinal::"};
573 for (const auto &pair : details.finals()) {
574 decls_ << sep << pair.second->name();
575 sep = ",";
576 }
577 if (*sep == ',') {
578 decls_ << '\n';
579 }
580 }
581 decls_ << "end type\n";
582}
583
584void ModFileWriter::PutDECStructure(
585 const Symbol &typeSymbol, const Scope *scope) {
586 if (emittedDECStructures_.find(typeSymbol) != emittedDECStructures_.end()) {
587 return;
588 }
589 if (!scope && context_.IsTempName(typeSymbol.name().ToString())) {
590 return; // defer until used
591 }
592 emittedDECStructures_.insert(typeSymbol);
593 decls_ << "structure ";
594 if (!context_.IsTempName(typeSymbol.name().ToString())) {
595 decls_ << typeSymbol.name();
596 }
597 if (scope && scope->kind() == Scope::Kind::DerivedType) {
598 // Nested STRUCTURE: emit entity declarations right now
599 // on the STRUCTURE statement.
600 bool any{false};
601 for (const auto &ref : scope->GetSymbols()) {
602 const auto *object{ref->detailsIf<ObjectEntityDetails>()};
603 if (object && object->type() &&
604 object->type()->category() == DeclTypeSpec::TypeDerived &&
605 &object->type()->derivedTypeSpec().typeSymbol() == &typeSymbol) {
606 if (any) {
607 decls_ << ',';
608 } else {
609 any = true;
610 }
611 decls_ << ref->name();
612 PutShape(decls_, object->shape(), '(', ')');
613 PutInit(decls_, *ref, object->init(), nullptr, context_);
614 emittedDECFields_.insert(*ref);
615 } else if (any) {
616 break; // any later use of this structure will use RECORD/str/
617 }
618 }
619 }
620 decls_ << '\n';
621 PutComponents(typeSymbol);
622 decls_ << "end structure\n";
623}
624
625// Attributes that may be in a subprogram prefix
626static const Attrs subprogramPrefixAttrs{Attr::ELEMENTAL, Attr::IMPURE,
627 Attr::MODULE, Attr::NON_RECURSIVE, Attr::PURE, Attr::RECURSIVE};
628
629static void PutOpenACCDeviceTypeRoutineInfo(
630 llvm::raw_ostream &os, const OpenACCRoutineDeviceTypeInfo &info) {
631 if (info.isSeq()) {
632 os << " seq";
633 }
634 if (info.isGang()) {
635 os << " gang";
636 if (info.gangDim() > 0) {
637 os << "(dim: " << info.gangDim() << ")";
638 }
639 }
640 if (info.isVector()) {
641 os << " vector";
642 }
643 if (info.isWorker()) {
644 os << " worker";
645 }
646 if (const std::variant<std::string, SymbolRef> *bindName{info.bindName()}) {
647 os << " bind(";
648 if (std::holds_alternative<std::string>(*bindName)) {
649 os << "\"" << std::get<std::string>(*bindName) << "\"";
650 } else {
651 os << std::get<SymbolRef>(*bindName)->name();
652 }
653 os << ")";
654 }
655}
656
657static void PutOpenACCRoutineInfo(
658 llvm::raw_ostream &os, const SubprogramDetails &details) {
659 for (auto info : details.openACCRoutineInfos()) {
660 os << "!$acc routine";
661
662 PutOpenACCDeviceTypeRoutineInfo(os, info);
663
664 if (info.isNohost()) {
665 os << " nohost";
666 }
667
668 for (auto dtype : info.deviceTypeInfos()) {
669 os << " device_type(";
670 if (dtype.dType() == common::OpenACCDeviceType::Star) {
671 os << "*";
672 } else {
673 os << parser::ToLowerCaseLetters(common::EnumToString(dtype.dType()));
674 }
675 os << ")";
676
677 PutOpenACCDeviceTypeRoutineInfo(os, dtype);
678 }
679
680 os << "\n";
681 }
682}
683
684void ModFileWriter::PutSubprogram(const Symbol &symbol) {
685 auto &details{symbol.get<SubprogramDetails>()};
686 if (const Symbol * interface{details.moduleInterface()}) {
687 const Scope *module{FindModuleContaining(interface->owner())};
688 if (module && module != &symbol.owner()) {
689 // Interface is in ancestor module
690 } else {
691 PutSubprogram(symbol: *interface);
692 }
693 }
694 auto attrs{symbol.attrs()};
695 Attrs bindAttrs{};
696 if (attrs.test(Attr::BIND_C)) {
697 // bind(c) is a suffix, not prefix
698 bindAttrs.set(Attr::BIND_C, true);
699 attrs.set(Attr::BIND_C, false);
700 }
701 bool isAbstract{attrs.test(Attr::ABSTRACT)};
702 if (isAbstract) {
703 attrs.set(Attr::ABSTRACT, false);
704 }
705 Attrs prefixAttrs{subprogramPrefixAttrs & attrs};
706 // emit any non-prefix attributes in an attribute statement
707 attrs &= ~subprogramPrefixAttrs;
708 std::string ssBuf;
709 llvm::raw_string_ostream ss{ssBuf};
710 PutAttrs(ss, attrs);
711 if (!ss.str().empty()) {
712 decls_ << ss.str().substr(pos: 1) << "::" << symbol.name() << '\n';
713 }
714 bool isInterface{details.isInterface()};
715 llvm::raw_ostream &os{isInterface ? decls_ : contains_};
716 if (isInterface) {
717 os << (isAbstract ? "abstract " : "") << "interface\n";
718 }
719 PutAttrs(os, prefixAttrs, nullptr, false, ""s, " "s);
720 if (auto attrs{details.cudaSubprogramAttrs()}) {
721 if (*attrs == common::CUDASubprogramAttrs::HostDevice) {
722 os << "attributes(host,device) ";
723 } else {
724 PutLower(os << "attributes(", common::EnumToString(*attrs)) << ") ";
725 }
726 if (!details.cudaLaunchBounds().empty()) {
727 os << "launch_bounds";
728 char sep{'('};
729 for (auto x : details.cudaLaunchBounds()) {
730 os << sep << x;
731 sep = ',';
732 }
733 os << ") ";
734 }
735 if (!details.cudaClusterDims().empty()) {
736 os << "cluster_dims";
737 char sep{'('};
738 for (auto x : details.cudaClusterDims()) {
739 os << sep << x;
740 sep = ',';
741 }
742 os << ") ";
743 }
744 }
745 os << (details.isFunction() ? "function " : "subroutine ");
746 os << symbol.name() << '(';
747 int n = 0;
748 for (const auto &dummy : details.dummyArgs()) {
749 if (n++ > 0) {
750 os << ',';
751 }
752 if (dummy) {
753 os << dummy->name();
754 } else {
755 os << "*";
756 }
757 }
758 os << ')';
759 PutAttrs(os, bindAttrs, details.bindName(), details.isExplicitBindName(),
760 " "s, ""s);
761 if (details.isFunction()) {
762 const Symbol &result{details.result()};
763 if (result.name() != symbol.name()) {
764 os << " result(" << result.name() << ')';
765 }
766 }
767 os << '\n';
768 // walk symbols, collect ones needed for interface
769 const Scope &scope{
770 details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};
771 SubprogramSymbolCollector collector{symbol, scope};
772 collector.Collect();
773 std::string typeBindingsBuf;
774 llvm::raw_string_ostream typeBindings{typeBindingsBuf};
775 ModFileWriter writer{context_};
776 for (const Symbol &need : collector.symbols()) {
777 writer.PutSymbol(typeBindings, need);
778 }
779 CHECK(typeBindings.str().empty());
780 os << writer.uses_.str();
781 for (const SourceName &import : collector.imports()) {
782 decls_ << "import::" << import << "\n";
783 }
784 os << writer.decls_.str();
785 PutOpenACCRoutineInfo(os, details);
786 os << "end\n";
787 if (isInterface) {
788 os << "end interface\n";
789 }
790}
791
792static bool IsIntrinsicOp(const Symbol &symbol) {
793 if (const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()}) {
794 return details->kind().IsIntrinsicOperator();
795 } else {
796 return false;
797 }
798}
799
800void ModFileWriter::PutGeneric(const Symbol &symbol) {
801 const auto &genericOwner{symbol.owner()};
802 auto &details{symbol.get<GenericDetails>()};
803 PutGenericName(os&: decls_ << "interface ", symbol) << '\n';
804 for (const Symbol &specific : details.specificProcs()) {
805 if (specific.owner() == genericOwner) {
806 decls_ << "procedure::" << specific.name() << '\n';
807 }
808 }
809 decls_ << "end interface\n";
810 if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
811 PutGenericName(os&: decls_ << "private::", symbol) << '\n';
812 }
813}
814
815void ModFileWriter::PutUse(const Symbol &symbol) {
816 auto &details{symbol.get<UseDetails>()};
817 auto &use{details.symbol()};
818 const Symbol &module{GetUsedModule(details)};
819 if (use.owner().parent().IsIntrinsicModules()) {
820 uses_ << "use,intrinsic::";
821 } else {
822 uses_ << "use ";
823 usedNonIntrinsicModules_.insert(module);
824 }
825 uses_ << module.name() << ",only:";
826 PutGenericName(os&: uses_, symbol);
827 // Can have intrinsic op with different local-name and use-name
828 // (e.g. `operator(<)` and `operator(.lt.)`) but rename is not allowed
829 if (!IsIntrinsicOp(symbol) && use.name() != symbol.name()) {
830 PutGenericName(uses_ << "=>", use);
831 }
832 uses_ << '\n';
833 PutUseExtraAttr(Attr::VOLATILE, symbol, use);
834 PutUseExtraAttr(Attr::ASYNCHRONOUS, symbol, use);
835 if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
836 PutGenericName(os&: useExtraAttrs_ << "private::", symbol) << '\n';
837 }
838}
839
840// We have "USE local => use" in this module. If attr was added locally
841// (i.e. on local but not on use), also write it out in the mod file.
842void ModFileWriter::PutUseExtraAttr(
843 Attr attr, const Symbol &local, const Symbol &use) {
844 if (local.attrs().test(attr) && !use.attrs().test(attr)) {
845 PutAttr(useExtraAttrs_, attr) << "::";
846 useExtraAttrs_ << local.name() << '\n';
847 }
848}
849
850// Collect the symbols of this scope sorted by their original order, not name.
851// Generics and namelists are exceptions: they are sorted after other symbols.
852void CollectSymbols(const Scope &scope, SymbolVector &sorted,
853 SymbolVector &uses, SourceOrderedSymbolSet &modules) {
854 SymbolVector namelist, generics;
855 auto symbols{scope.GetSymbols()};
856 std::size_t commonSize{scope.commonBlocks().size()};
857 sorted.reserve(symbols.size() + commonSize);
858 for (SymbolRef symbol : symbols) {
859 const auto *generic{symbol->detailsIf<GenericDetails>()};
860 if (generic) {
861 uses.insert(uses.end(), generic->uses().begin(), generic->uses().end());
862 for (auto ref : generic->uses()) {
863 modules.insert(GetUsedModule(ref->get<UseDetails>()));
864 }
865 } else if (const auto *use{symbol->detailsIf<UseDetails>()}) {
866 modules.insert(GetUsedModule(*use));
867 }
868 if (symbol->test(Symbol::Flag::ParentComp)) {
869 } else if (symbol->has<NamelistDetails>()) {
870 namelist.push_back(symbol);
871 } else if (generic) {
872 if (generic->specific() &&
873 &generic->specific()->owner() == &symbol->owner()) {
874 sorted.push_back(*generic->specific());
875 } else if (generic->derivedType() &&
876 &generic->derivedType()->owner() == &symbol->owner()) {
877 sorted.push_back(*generic->derivedType());
878 }
879 generics.push_back(symbol);
880 } else {
881 sorted.push_back(symbol);
882 }
883 }
884 std::sort(sorted.begin(), sorted.end(), SymbolSourcePositionCompare{});
885 std::sort(generics.begin(), generics.end(), SymbolSourcePositionCompare{});
886 sorted.insert(sorted.end(), generics.begin(), generics.end());
887 sorted.insert(sorted.end(), namelist.begin(), namelist.end());
888 for (const auto &pair : scope.commonBlocks()) {
889 sorted.push_back(*pair.second);
890 }
891 std::sort(
892 sorted.end() - commonSize, sorted.end(), SymbolSourcePositionCompare{});
893}
894
895void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol) {
896 common::visit(
897 common::visitors{
898 [&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },
899 [&](const ProcEntityDetails &) { PutProcEntity(os, symbol); },
900 [&](const TypeParamDetails &) { PutTypeParam(os, symbol); },
901 [&](const UserReductionDetails &) { PutUserReduction(os, symbol); },
902 [&](const auto &) {
903 common::die("PutEntity: unexpected details: %s",
904 DetailsToString(symbol.details()).c_str());
905 },
906 },
907 symbol.details());
908}
909
910void PutShapeSpec(llvm::raw_ostream &os, const ShapeSpec &x) {
911 if (x.lbound().isStar()) {
912 CHECK(x.ubound().isStar());
913 os << ".."; // assumed rank
914 } else {
915 if (!x.lbound().isColon()) {
916 PutBound(os, x.lbound());
917 }
918 os << ':';
919 if (!x.ubound().isColon()) {
920 PutBound(os, x.ubound());
921 }
922 }
923}
924void PutShape(
925 llvm::raw_ostream &os, const ArraySpec &shape, char open, char close) {
926 if (!shape.empty()) {
927 os << open;
928 bool first{true};
929 for (const auto &shapeSpec : shape) {
930 if (first) {
931 first = false;
932 } else {
933 os << ',';
934 }
935 PutShapeSpec(os, shapeSpec);
936 }
937 os << close;
938 }
939}
940
941void ModFileWriter::PutObjectEntity(
942 llvm::raw_ostream &os, const Symbol &symbol) {
943 auto &details{symbol.get<ObjectEntityDetails>()};
944 if (details.type() &&
945 details.type()->category() == DeclTypeSpec::TypeDerived) {
946 const Symbol &typeSymbol{details.type()->derivedTypeSpec().typeSymbol()};
947 if (typeSymbol.get<DerivedTypeDetails>().isDECStructure()) {
948 PutDerivedType(typeSymbol, scope: &symbol.owner());
949 if (emittedDECFields_.find(symbol) != emittedDECFields_.end()) {
950 return; // symbol was emitted on STRUCTURE statement
951 }
952 }
953 }
954 PutEntity(
955 os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },
956 getSymbolAttrsToWrite(symbol));
957 PutShape(os, details.shape(), '(', ')');
958 PutShape(os, details.coshape(), '[', ']');
959 PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit(),
960 context_);
961 os << '\n';
962 if (auto tkr{GetIgnoreTKR(symbol)}; !tkr.empty()) {
963 os << "!dir$ ignore_tkr(";
964 tkr.IterateOverMembers([&](common::IgnoreTKR tkr) {
965 switch (tkr) {
966 SWITCH_COVERS_ALL_CASES
967 case common::IgnoreTKR::Type:
968 os << 't';
969 break;
970 case common::IgnoreTKR::Kind:
971 os << 'k';
972 break;
973 case common::IgnoreTKR::Rank:
974 os << 'r';
975 break;
976 case common::IgnoreTKR::Device:
977 os << 'd';
978 break;
979 case common::IgnoreTKR::Managed:
980 os << 'm';
981 break;
982 case common::IgnoreTKR::Contiguous:
983 os << 'c';
984 break;
985 }
986 });
987 os << ") " << symbol.name() << '\n';
988 }
989 if (auto attr{details.cudaDataAttr()}) {
990 PutLower(os << "attributes(", common::EnumToString(*attr))
991 << ") " << symbol.name() << '\n';
992 }
993 if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointer)) {
994 for (const auto &[pointee, pointer] : symbol.owner().crayPointers()) {
995 if (pointer == symbol) {
996 os << "pointer(" << symbol.name() << "," << pointee << ")\n";
997 }
998 }
999 }
1000}
1001
1002void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
1003 if (symbol.attrs().test(Attr::INTRINSIC)) {
1004 os << "intrinsic::" << symbol.name() << '\n';
1005 if (!isSubmodule_ && symbol.attrs().test(Attr::PRIVATE)) {
1006 os << "private::" << symbol.name() << '\n';
1007 }
1008 return;
1009 }
1010 const auto &details{symbol.get<ProcEntityDetails>()};
1011 Attrs attrs{symbol.attrs()};
1012 if (details.passName()) {
1013 attrs.reset(Attr::PASS);
1014 }
1015 PutEntity(
1016 os, symbol,
1017 [&]() {
1018 os << "procedure(";
1019 if (details.rawProcInterface()) {
1020 os << details.rawProcInterface()->name();
1021 } else if (details.type()) {
1022 PutType(os, *details.type());
1023 }
1024 os << ')';
1025 PutPassName(os, details.passName());
1026 },
1027 attrs);
1028 os << '\n';
1029}
1030
1031void PutPassName(
1032 llvm::raw_ostream &os, const std::optional<SourceName> &passName) {
1033 if (passName) {
1034 os << ",pass(" << *passName << ')';
1035 }
1036}
1037
1038void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
1039 auto &details{symbol.get<TypeParamDetails>()};
1040 PutEntity(
1041 os, symbol,
1042 [&]() {
1043 PutType(os, DEREF(symbol.GetType()));
1044 PutLower(os << ',', common::EnumToString(details.attr().value()));
1045 },
1046 symbol.attrs());
1047 PutInit(os, details.init());
1048 os << '\n';
1049}
1050
1051void ModFileWriter::PutUserReduction(
1052 llvm::raw_ostream &os, const Symbol &symbol) {
1053 const auto &details{symbol.get<UserReductionDetails>()};
1054 // The module content for a OpenMP Declare Reduction is the OpenMP
1055 // declaration. There may be multiple declarations.
1056 // Decls are pointers, so do not use a reference.
1057 for (const auto decl : details.GetDeclList()) {
1058 common::visit( //
1059 common::visitors{//
1060 [&](const parser::OpenMPDeclareReductionConstruct *d) {
1061 Unparse(os, *d, context_.langOptions());
1062 },
1063 [&](const parser::OmpMetadirectiveDirective *m) {
1064 Unparse(os, *m, context_.langOptions());
1065 },
1066 [&](const auto &) {
1067 DIE("Unknown OpenMP DECLARE REDUCTION content");
1068 }},
1069 decl);
1070 }
1071}
1072
1073void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init,
1074 const parser::Expr *unanalyzed, SemanticsContext &context) {
1075 if (IsNamedConstant(symbol) || symbol.owner().IsDerivedType()) {
1076 const char *assign{symbol.attrs().test(Attr::POINTER) ? "=>" : "="};
1077 if (unanalyzed) {
1078 parser::Unparse(os << assign, *unanalyzed, context.langOptions());
1079 } else if (init) {
1080 init->AsFortran(os << assign);
1081 }
1082 }
1083}
1084
1085void PutInit(llvm::raw_ostream &os, const MaybeIntExpr &init) {
1086 if (init) {
1087 init->AsFortran(os << '=');
1088 }
1089}
1090
1091void PutBound(llvm::raw_ostream &os, const Bound &x) {
1092 if (x.isStar()) {
1093 os << '*';
1094 } else if (x.isColon()) {
1095 os << ':';
1096 } else {
1097 x.GetExplicit()->AsFortran(os);
1098 }
1099}
1100
1101// Write an entity (object or procedure) declaration.
1102// writeType is called to write out the type.
1103void ModFileWriter::PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
1104 std::function<void()> writeType, Attrs attrs) {
1105 writeType();
1106 PutAttrs(os, attrs, symbol.GetBindName(), symbol.GetIsExplicitBindName());
1107 if (symbol.owner().kind() == Scope::Kind::DerivedType &&
1108 context_.IsTempName(symbol.name().ToString())) {
1109 os << "::%FILL";
1110 } else {
1111 os << "::" << symbol.name();
1112 }
1113}
1114
1115// Put out each attribute to os, surrounded by `before` and `after` and
1116// mapped to lower case.
1117llvm::raw_ostream &ModFileWriter::PutAttrs(llvm::raw_ostream &os, Attrs attrs,
1118 const std::string *bindName, bool isExplicitBindName, std::string before,
1119 std::string after) const {
1120 attrs.set(Attr::PUBLIC, false); // no need to write PUBLIC
1121 attrs.set(Attr::EXTERNAL, false); // no need to write EXTERNAL
1122 if (isSubmodule_) {
1123 attrs.set(Attr::PRIVATE, false);
1124 }
1125 if (bindName || isExplicitBindName) {
1126 os << before << "bind(c";
1127 if (isExplicitBindName) {
1128 os << ",name=\"" << (bindName ? *bindName : ""s) << '"';
1129 }
1130 os << ')' << after;
1131 attrs.set(Attr::BIND_C, false);
1132 }
1133 for (std::size_t i{0}; i < Attr_enumSize; ++i) {
1134 Attr attr{static_cast<Attr>(i)};
1135 if (attrs.test(attr)) {
1136 PutAttr(os << before, attr) << after;
1137 }
1138 }
1139 return os;
1140}
1141
1142llvm::raw_ostream &PutAttr(llvm::raw_ostream &os, Attr attr) {
1143 return PutLower(os, AttrToString(attr));
1144}
1145
1146llvm::raw_ostream &PutType(llvm::raw_ostream &os, const DeclTypeSpec &type) {
1147 return PutLower(os, type.AsFortran());
1148}
1149
1150llvm::raw_ostream &PutLower(llvm::raw_ostream &os, std::string_view str) {
1151 for (char c : str) {
1152 os << parser::ToLowerCaseLetter(c);
1153 }
1154 return os;
1155}
1156
1157void PutOpenACCDirective(llvm::raw_ostream &os, const Symbol &symbol) {
1158 if (symbol.test(Symbol::Flag::AccDeclare)) {
1159 os << "!$acc declare ";
1160 if (symbol.test(Symbol::Flag::AccCopy)) {
1161 os << "copy";
1162 } else if (symbol.test(Symbol::Flag::AccCopyIn) ||
1163 symbol.test(Symbol::Flag::AccCopyInReadOnly)) {
1164 os << "copyin";
1165 } else if (symbol.test(Symbol::Flag::AccCopyOut)) {
1166 os << "copyout";
1167 } else if (symbol.test(Symbol::Flag::AccCreate)) {
1168 os << "create";
1169 } else if (symbol.test(Symbol::Flag::AccPresent)) {
1170 os << "present";
1171 } else if (symbol.test(Symbol::Flag::AccDevicePtr)) {
1172 os << "deviceptr";
1173 } else if (symbol.test(Symbol::Flag::AccDeviceResident)) {
1174 os << "device_resident";
1175 } else if (symbol.test(Symbol::Flag::AccLink)) {
1176 os << "link";
1177 }
1178 os << "(";
1179 if (symbol.test(Symbol::Flag::AccCopyInReadOnly)) {
1180 os << "readonly: ";
1181 }
1182 os << symbol.name() << ")\n";
1183 }
1184}
1185
1186void PutOpenMPDirective(llvm::raw_ostream &os, const Symbol &symbol) {
1187 if (symbol.test(Symbol::Flag::OmpThreadprivate)) {
1188 os << "!$omp threadprivate(" << symbol.name() << ")\n";
1189 }
1190}
1191
1192void ModFileWriter::PutDirective(llvm::raw_ostream &os, const Symbol &symbol) {
1193 PutOpenACCDirective(os, symbol);
1194 PutOpenMPDirective(os, symbol);
1195}
1196
1197struct Temp {
1198 Temp(int fd, std::string path) : fd{fd}, path{path} {}
1199 Temp(Temp &&t) : fd{std::exchange(obj&: t.fd, new_val: -1)}, path{std::move(t.path)} {}
1200 ~Temp() {
1201 if (fd >= 0) {
1202 llvm::sys::fs::file_t native{llvm::sys::fs::convertFDToNativeFile(FD: fd)};
1203 llvm::sys::fs::closeFile(F&: native);
1204 llvm::sys::fs::remove(path: path.c_str());
1205 }
1206 }
1207 int fd;
1208 std::string path;
1209};
1210
1211// Create a temp file in the same directory and with the same suffix as path.
1212// Return an open file descriptor and its path.
1213static llvm::ErrorOr<Temp> MkTemp(const std::string &path) {
1214 auto length{path.length()};
1215 auto dot{path.find_last_of(s: "./")};
1216 std::string suffix{
1217 dot < length && path[dot] == '.' ? path.substr(pos: dot + 1) : ""};
1218 CHECK(length > suffix.length() &&
1219 path.substr(pos: length - suffix.length()) == suffix);
1220 auto prefix{path.substr(pos: 0, n: length - suffix.length())};
1221 int fd;
1222 llvm::SmallString<16> tempPath;
1223 if (std::error_code err{llvm::sys::fs::createUniqueFile(
1224 Model: prefix + "%%%%%%" + suffix, ResultFD&: fd, ResultPath&: tempPath)}) {
1225 return err;
1226 }
1227 return Temp{fd, tempPath.c_str()};
1228}
1229
1230// Write the module file at path, prepending header. If an error occurs,
1231// return errno, otherwise 0.
1232static std::error_code WriteFile(const std::string &path,
1233 const std::string &contents, ModuleCheckSumType &checkSum, bool debug) {
1234 checkSum = ComputeCheckSum(contents);
1235 auto header{std::string{ModHeader::bom} + ModHeader::magic +
1236 CheckSumString(checkSum) + ModHeader::terminator};
1237 if (debug) {
1238 llvm::dbgs() << "Processing module " << path << ": ";
1239 }
1240 if (FileContentsMatch(path, header, contents)) {
1241 if (debug) {
1242 llvm::dbgs() << "module unchanged, not writing\n";
1243 }
1244 return {};
1245 }
1246 llvm::ErrorOr<Temp> temp{MkTemp(path)};
1247 if (!temp) {
1248 return temp.getError();
1249 }
1250 llvm::raw_fd_ostream writer(temp->fd, /*shouldClose=*/false);
1251 writer << header;
1252 writer << contents;
1253 writer.flush();
1254 if (writer.has_error()) {
1255 return writer.error();
1256 }
1257 if (debug) {
1258 llvm::dbgs() << "module written\n";
1259 }
1260 return llvm::sys::fs::rename(from: temp->path, to: path);
1261}
1262
1263// Return true if the stream matches what we would write for the mod file.
1264static bool FileContentsMatch(const std::string &path,
1265 const std::string &header, const std::string &contents) {
1266 std::size_t hsize{header.size()};
1267 std::size_t csize{contents.size()};
1268 auto buf_or{llvm::MemoryBuffer::getFile(Filename: path)};
1269 if (!buf_or) {
1270 return false;
1271 }
1272 auto buf = std::move(buf_or.get());
1273 if (buf->getBufferSize() != hsize + csize) {
1274 return false;
1275 }
1276 if (!std::equal(first1: header.begin(), last1: header.end(), first2: buf->getBufferStart(),
1277 last2: buf->getBufferStart() + hsize)) {
1278 return false;
1279 }
1280
1281 return std::equal(first1: contents.begin(), last1: contents.end(),
1282 first2: buf->getBufferStart() + hsize, last2: buf->getBufferEnd());
1283}
1284
1285// Compute a simple hash of the contents of a module file and
1286// return it as a string of hex digits.
1287// This uses the Fowler-Noll-Vo hash function.
1288static ModuleCheckSumType ComputeCheckSum(const std::string_view &contents) {
1289 ModuleCheckSumType hash{0xcbf29ce484222325ull};
1290 for (char c : contents) {
1291 hash ^= c & 0xff;
1292 hash *= 0x100000001b3;
1293 }
1294 return hash;
1295}
1296
1297static std::string CheckSumString(ModuleCheckSumType hash) {
1298 static const char *digits = "0123456789abcdef";
1299 std::string result(ModHeader::sumLen, '0');
1300 for (size_t i{ModHeader::sumLen}; hash != 0; hash >>= 4) {
1301 result[--i] = digits[hash & 0xf];
1302 }
1303 return result;
1304}
1305
1306std::optional<ModuleCheckSumType> ExtractCheckSum(const std::string_view &str) {
1307 if (str.size() == ModHeader::sumLen) {
1308 ModuleCheckSumType hash{0};
1309 for (size_t j{0}; j < ModHeader::sumLen; ++j) {
1310 hash <<= 4;
1311 char ch{str.at(pos: j)};
1312 if (ch >= '0' && ch <= '9') {
1313 hash += ch - '0';
1314 } else if (ch >= 'a' && ch <= 'f') {
1315 hash += ch - 'a' + 10;
1316 } else {
1317 return std::nullopt;
1318 }
1319 }
1320 return hash;
1321 }
1322 return std::nullopt;
1323}
1324
1325static std::optional<ModuleCheckSumType> VerifyHeader(
1326 llvm::ArrayRef<char> content) {
1327 std::string_view sv{content.data(), content.size()};
1328 if (sv.substr(pos: 0, n: ModHeader::magicLen) != ModHeader::magic) {
1329 return std::nullopt;
1330 }
1331 ModuleCheckSumType checkSum{ComputeCheckSum(sv.substr(ModHeader::len))};
1332 std::string_view expectSum{sv.substr(pos: ModHeader::magicLen, n: ModHeader::sumLen)};
1333 if (auto extracted{ExtractCheckSum(expectSum)};
1334 extracted && *extracted == checkSum) {
1335 return checkSum;
1336 } else {
1337 return std::nullopt;
1338 }
1339}
1340
1341static void GetModuleDependences(
1342 ModuleDependences &dependences, llvm::ArrayRef<char> content) {
1343 std::size_t limit{content.size()};
1344 std::string_view str{content.data(), limit};
1345 for (std::size_t j{ModHeader::len};
1346 str.substr(pos: j, n: ModHeader::needLen) == ModHeader::need; ++j) {
1347 j += 7;
1348 auto checkSum{ExtractCheckSum(str.substr(j, ModHeader::sumLen))};
1349 if (!checkSum) {
1350 break;
1351 }
1352 j += ModHeader::sumLen;
1353 bool intrinsic{false};
1354 if (str.substr(pos: j, n: 3) == " i ") {
1355 intrinsic = true;
1356 } else if (str.substr(pos: j, n: 3) != " n ") {
1357 break;
1358 }
1359 j += 3;
1360 std::size_t start{j};
1361 for (; j < limit && str.at(pos: j) != '\n'; ++j) {
1362 }
1363 if (j > start && j < limit && str.at(pos: j) == '\n') {
1364 std::string depModName{str.substr(pos: start, n: j - start)};
1365 dependences.AddDependence(std::move(depModName), intrinsic, *checkSum);
1366 } else {
1367 break;
1368 }
1369 }
1370}
1371
1372Scope *ModFileReader::Read(SourceName name, std::optional<bool> isIntrinsic,
1373 Scope *ancestor, bool silent) {
1374 std::string ancestorName; // empty for module
1375 const Symbol *notAModule{nullptr};
1376 bool fatalError{false};
1377 if (ancestor) {
1378 if (auto *scope{ancestor->FindSubmodule(name)}) {
1379 return scope;
1380 }
1381 ancestorName = ancestor->GetName().value().ToString();
1382 }
1383 auto requiredHash{context_.moduleDependences().GetRequiredHash(
1384 name.ToString(), isIntrinsic.value_or(u: false))};
1385 if (!isIntrinsic.value_or(u: false) && !ancestor) {
1386 // Already present in the symbol table as a usable non-intrinsic module?
1387 if (Scope * hermeticScope{context_.currentHermeticModuleFileScope()}) {
1388 auto it{hermeticScope->find(name)};
1389 if (it != hermeticScope->end()) {
1390 return it->second->scope();
1391 }
1392 }
1393 auto it{context_.globalScope().find(name)};
1394 if (it != context_.globalScope().end()) {
1395 Scope *scope{it->second->scope()};
1396 if (scope->kind() == Scope::Kind::Module) {
1397 for (const Symbol *found{scope->symbol()}; found;) {
1398 if (const auto *module{found->detailsIf<ModuleDetails>()}) {
1399 if (!requiredHash ||
1400 *requiredHash ==
1401 module->moduleFileHash().value_or(*requiredHash)) {
1402 return const_cast<Scope *>(found->scope());
1403 }
1404 found = module->previous(); // same name, distinct hash
1405 } else {
1406 notAModule = found;
1407 break;
1408 }
1409 }
1410 } else {
1411 notAModule = scope->symbol();
1412 }
1413 }
1414 }
1415 if (notAModule) {
1416 // USE, NON_INTRINSIC global name isn't a module?
1417 fatalError = isIntrinsic.has_value();
1418 }
1419 std::string path{
1420 ModFileName(name, ancestorName, context_.moduleFileSuffix())};
1421 parser::Parsing parsing{context_.allCookedSources()};
1422 parser::Options options;
1423 options.isModuleFile = true;
1424 options.features.Enable(common::LanguageFeature::BackslashEscapes);
1425 if (context_.languageFeatures().IsEnabled(common::LanguageFeature::OpenACC)) {
1426 options.features.Enable(common::LanguageFeature::OpenACC);
1427 }
1428 options.features.Enable(common::LanguageFeature::OpenMP);
1429 options.features.Enable(common::LanguageFeature::CUDA);
1430 if (!isIntrinsic.value_or(u: false) && !notAModule) {
1431 // The search for this module file will scan non-intrinsic module
1432 // directories. If a directory is in both the intrinsic and non-intrinsic
1433 // directory lists, the intrinsic module directory takes precedence.
1434 options.searchDirectories = context_.searchDirectories();
1435 for (const auto &dir : context_.intrinsicModuleDirectories()) {
1436 options.searchDirectories.erase(
1437 std::remove(options.searchDirectories.begin(),
1438 options.searchDirectories.end(), dir),
1439 options.searchDirectories.end());
1440 }
1441 options.searchDirectories.insert(options.searchDirectories.begin(), "."s);
1442 }
1443 bool foundNonIntrinsicModuleFile{false};
1444 if (!isIntrinsic) {
1445 std::list<std::string> searchDirs;
1446 for (const auto &d : options.searchDirectories) {
1447 searchDirs.push_back(d);
1448 }
1449 foundNonIntrinsicModuleFile =
1450 parser::LocateSourceFile(path, searchDirs).has_value();
1451 }
1452 if (isIntrinsic.value_or(u: !foundNonIntrinsicModuleFile)) {
1453 // Explicitly intrinsic, or not specified and not found in the search
1454 // path; see whether it's already in the symbol table as an intrinsic
1455 // module.
1456 auto it{context_.intrinsicModulesScope().find(name)};
1457 if (it != context_.intrinsicModulesScope().end()) {
1458 return it->second->scope();
1459 }
1460 }
1461 // We don't have this module in the symbol table yet.
1462 // Find its module file and parse it. Define or extend the search
1463 // path with intrinsic module directories, if appropriate.
1464 if (isIntrinsic.value_or(u: true)) {
1465 for (const auto &dir : context_.intrinsicModuleDirectories()) {
1466 options.searchDirectories.push_back(dir);
1467 }
1468 if (!requiredHash) {
1469 requiredHash =
1470 context_.moduleDependences().GetRequiredHash(name.ToString(), true);
1471 }
1472 }
1473
1474 // Look for the right module file if its hash is known
1475 if (requiredHash && !fatalError) {
1476 for (const std::string &maybe :
1477 parser::LocateSourceFileAll(path, options.searchDirectories)) {
1478 if (const auto *srcFile{context_.allCookedSources().allSources().OpenPath(
1479 maybe, llvm::errs())}) {
1480 if (auto checkSum{VerifyHeader(srcFile->content())};
1481 checkSum && *checkSum == *requiredHash) {
1482 path = maybe;
1483 break;
1484 }
1485 }
1486 }
1487 }
1488 const auto *sourceFile{fatalError ? nullptr : parsing.Prescan(path, options)};
1489 if (fatalError || parsing.messages().AnyFatalError()) {
1490 if (!silent) {
1491 if (notAModule) {
1492 // Module is not explicitly INTRINSIC, and there's already a global
1493 // symbol of the same name that is not a module.
1494 context_.SayWithDecl(
1495 *notAModule, name, "'%s' is not a module"_err_en_US, name);
1496 } else {
1497 for (auto &msg : parsing.messages().messages()) {
1498 std::string str{msg.ToString()};
1499 Say("parse", name, ancestorName,
1500 parser::MessageFixedText{str.c_str(), str.size(), msg.severity()},
1501 path);
1502 }
1503 }
1504 }
1505 return nullptr;
1506 }
1507 CHECK(sourceFile);
1508 std::optional<ModuleCheckSumType> checkSum{
1509 VerifyHeader(sourceFile->content())};
1510 if (!checkSum) {
1511 Say("use", name, ancestorName, "File has invalid checksum: %s"_err_en_US,
1512 sourceFile->path());
1513 return nullptr;
1514 } else if (requiredHash && *requiredHash != *checkSum) {
1515 Say("use", name, ancestorName,
1516 "File is not the right module file for %s"_err_en_US,
1517 "'"s + name.ToString() + "': "s + sourceFile->path());
1518 return nullptr;
1519 }
1520 llvm::raw_null_ostream NullStream;
1521 parsing.Parse(NullStream);
1522 std::optional<parser::Program> &parsedProgram{parsing.parseTree()};
1523 if (!parsing.messages().empty() || !parsing.consumedWholeFile() ||
1524 !parsedProgram) {
1525 Say("parse", name, ancestorName, "Module file is corrupt: %s"_err_en_US,
1526 sourceFile->path());
1527 return nullptr;
1528 }
1529 parser::Program &parseTree{context_.SaveParseTree(std::move(*parsedProgram))};
1530 Scope *parentScope; // the scope this module/submodule goes into
1531 if (!isIntrinsic.has_value()) {
1532 for (const auto &dir : context_.intrinsicModuleDirectories()) {
1533 if (sourceFile->path().size() > dir.size() &&
1534 sourceFile->path().find(dir) == 0) {
1535 isIntrinsic = true;
1536 break;
1537 }
1538 }
1539 }
1540 Scope &topScope{isIntrinsic.value_or(u: false) ? context_.intrinsicModulesScope()
1541 : context_.globalScope()};
1542 Symbol *moduleSymbol{nullptr};
1543 const Symbol *previousModuleSymbol{nullptr};
1544 if (!ancestor) { // module, not submodule
1545 parentScope = &topScope;
1546 auto pair{parentScope->try_emplace(name, UnknownDetails{})};
1547 if (!pair.second) {
1548 // There is already a global symbol or intrinsic module of the same name.
1549 previousModuleSymbol = &*pair.first->second;
1550 if (const auto *details{
1551 previousModuleSymbol->detailsIf<ModuleDetails>()}) {
1552 if (!details->moduleFileHash().has_value()) {
1553 return nullptr;
1554 }
1555 } else {
1556 return nullptr;
1557 }
1558 CHECK(parentScope->erase(name) != 0);
1559 pair = parentScope->try_emplace(name, UnknownDetails{});
1560 CHECK(pair.second);
1561 }
1562 moduleSymbol = &*pair.first->second;
1563 moduleSymbol->set(Symbol::Flag::ModFile);
1564 } else if (std::optional<SourceName> parent{GetSubmoduleParent(parseTree)}) {
1565 // submodule with submodule parent
1566 parentScope = Read(*parent, false /*not intrinsic*/, ancestor, silent);
1567 } else {
1568 // submodule with module parent
1569 parentScope = ancestor;
1570 }
1571 // Process declarations from the module file
1572 auto wasModuleFileName{context_.foldingContext().moduleFileName()};
1573 context_.foldingContext().set_moduleFileName(name);
1574 // Are there multiple modules in the module file due to it having been
1575 // created under -fhermetic-module-files? If so, process them first in
1576 // their own nested scope that will be visible only to USE statements
1577 // within the module file.
1578 Scope *previousHermetic{context_.currentHermeticModuleFileScope()};
1579 if (parseTree.v.size() > 1) {
1580 parser::Program hermeticModules{std::move(parseTree.v)};
1581 parseTree.v.emplace_back(std::move(hermeticModules.v.front()));
1582 hermeticModules.v.pop_front();
1583 Scope &hermeticScope{topScope.MakeScope(Scope::Kind::Global)};
1584 context_.set_currentHermeticModuleFileScope(&hermeticScope);
1585 ResolveNames(context_, hermeticModules, hermeticScope);
1586 for (auto &[_, ref] : hermeticScope) {
1587 CHECK(ref->has<ModuleDetails>());
1588 ref->set(Symbol::Flag::ModFile);
1589 }
1590 }
1591 GetModuleDependences(context_.moduleDependences(), sourceFile->content());
1592 ResolveNames(context_, parseTree, top&: topScope);
1593 context_.foldingContext().set_moduleFileName(wasModuleFileName);
1594 context_.set_currentHermeticModuleFileScope(previousHermetic);
1595 if (!moduleSymbol) {
1596 // Submodule symbols' storage are owned by their parents' scopes,
1597 // but their names are not in their parents' dictionaries -- we
1598 // don't want to report bogus errors about clashes between submodule
1599 // names and other objects in the parent scopes.
1600 if (Scope * submoduleScope{ancestor->FindSubmodule(name)}) {
1601 moduleSymbol = submoduleScope->symbol();
1602 if (moduleSymbol) {
1603 moduleSymbol->set(Symbol::Flag::ModFile);
1604 }
1605 }
1606 }
1607 if (moduleSymbol) {
1608 CHECK(moduleSymbol->test(Symbol::Flag::ModFile));
1609 auto &details{moduleSymbol->get<ModuleDetails>()};
1610 details.set_moduleFileHash(checkSum.value());
1611 details.set_previous(previousModuleSymbol);
1612 if (isIntrinsic.value_or(u: false)) {
1613 moduleSymbol->attrs().set(Attr::INTRINSIC);
1614 }
1615 return moduleSymbol->scope();
1616 } else {
1617 return nullptr;
1618 }
1619}
1620
1621parser::Message &ModFileReader::Say(const char *verb, SourceName name,
1622 const std::string &ancestor, parser::MessageFixedText &&msg,
1623 const std::string &arg) {
1624 return context_.Say(name, "Cannot %s module file for %s: %s"_err_en_US, verb,
1625 parser::MessageFormattedText{ancestor.empty()
1626 ? "module '%s'"_en_US
1627 : "submodule '%s' of module '%s'"_en_US,
1628 name, ancestor}
1629 .MoveString(),
1630 parser::MessageFormattedText{std::move(msg), arg}.MoveString());
1631}
1632
1633// program was read from a .mod file for a submodule; return the name of the
1634// submodule's parent submodule, nullptr if none.
1635static std::optional<SourceName> GetSubmoduleParent(
1636 const parser::Program &program) {
1637 CHECK(program.v.size() == 1);
1638 auto &unit{program.v.front()};
1639 auto &submod{std::get<common::Indirection<parser::Submodule>>(unit.u)};
1640 auto &stmt{
1641 std::get<parser::Statement<parser::SubmoduleStmt>>(submod.value().t)};
1642 auto &parentId{std::get<parser::ParentIdentifier>(stmt.statement.t)};
1643 if (auto &parent{std::get<std::optional<parser::Name>>(parentId.t)}) {
1644 return parent->source;
1645 } else {
1646 return std::nullopt;
1647 }
1648}
1649
1650void SubprogramSymbolCollector::Collect() {
1651 const auto &details{symbol_.get<SubprogramDetails>()};
1652 isInterface_ = details.isInterface();
1653 for (const Symbol *dummyArg : details.dummyArgs()) {
1654 if (dummyArg) {
1655 DoSymbol(*dummyArg);
1656 }
1657 }
1658 if (details.isFunction()) {
1659 DoSymbol(details.result());
1660 }
1661 for (const auto &pair : scope_) {
1662 const Symbol &symbol{*pair.second};
1663 if (const auto *useDetails{symbol.detailsIf<UseDetails>()}) {
1664 const Symbol &ultimate{useDetails->symbol().GetUltimate()};
1665 bool needed{useSet_.count(ultimate) > 0};
1666 if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
1667 // The generic may not be needed itself, but the specific procedure
1668 // &/or derived type that it shadows may be needed.
1669 const Symbol *spec{generic->specific()};
1670 const Symbol *dt{generic->derivedType()};
1671 needed = needed || (spec && useSet_.count(spec->GetUltimate()) > 0) ||
1672 (dt && useSet_.count(dt->GetUltimate()) > 0);
1673 } else if (const auto *subp{ultimate.detailsIf<SubprogramDetails>()}) {
1674 const Symbol *interface { subp->moduleInterface() };
1675 needed = needed || (interface && useSet_.count(*interface) > 0);
1676 }
1677 if (needed) {
1678 need_.push_back(symbol);
1679 }
1680 } else if (symbol.has<SubprogramDetails>()) {
1681 // An internal subprogram is needed if it is used as interface
1682 // for a dummy or return value procedure.
1683 bool needed{false};
1684 const auto hasInterface{[&symbol](const Symbol *s) -> bool {
1685 // Is 's' a procedure with interface 'symbol'?
1686 if (s) {
1687 if (const auto *sDetails{s->detailsIf<ProcEntityDetails>()}) {
1688 if (sDetails->procInterface() == &symbol) {
1689 return true;
1690 }
1691 }
1692 }
1693 return false;
1694 }};
1695 for (const Symbol *dummyArg : details.dummyArgs()) {
1696 needed = needed || hasInterface(dummyArg);
1697 }
1698 needed =
1699 needed || (details.isFunction() && hasInterface(&details.result()));
1700 if (needed && needSet_.insert(symbol).second) {
1701 need_.push_back(symbol);
1702 }
1703 }
1704 }
1705}
1706
1707void SubprogramSymbolCollector::DoSymbol(const Symbol &symbol) {
1708 DoSymbol(symbol.name(), symbol);
1709}
1710
1711// Do symbols this one depends on; then add to need_
1712void SubprogramSymbolCollector::DoSymbol(
1713 const SourceName &name, const Symbol &symbol) {
1714 const auto &scope{symbol.owner()};
1715 if (scope != scope_ && !scope.IsDerivedType()) {
1716 if (scope != scope_.parent()) {
1717 useSet_.insert(symbol);
1718 }
1719 if (NeedImport(name, symbol)) {
1720 imports_.insert(x: name);
1721 }
1722 return;
1723 }
1724 if (!needSet_.insert(symbol).second) {
1725 return; // already done
1726 }
1727 common::visit(common::visitors{
1728 [this](const ObjectEntityDetails &details) {
1729 for (const ShapeSpec &spec : details.shape()) {
1730 DoBound(spec.lbound());
1731 DoBound(spec.ubound());
1732 }
1733 for (const ShapeSpec &spec : details.coshape()) {
1734 DoBound(spec.lbound());
1735 DoBound(spec.ubound());
1736 }
1737 if (const Symbol * commonBlock{details.commonBlock()}) {
1738 DoSymbol(*commonBlock);
1739 }
1740 },
1741 [this](const CommonBlockDetails &details) {
1742 for (const auto &object : details.objects()) {
1743 DoSymbol(*object);
1744 }
1745 },
1746 [this](const ProcEntityDetails &details) {
1747 if (details.rawProcInterface()) {
1748 DoSymbol(*details.rawProcInterface());
1749 } else {
1750 DoType(details.type());
1751 }
1752 },
1753 [this](const ProcBindingDetails &details) {
1754 DoSymbol(details.symbol());
1755 },
1756 [](const auto &) {},
1757 },
1758 symbol.details());
1759 if (!symbol.has<UseDetails>()) {
1760 DoType(symbol.GetType());
1761 }
1762 if (!scope.IsDerivedType()) {
1763 need_.push_back(symbol);
1764 }
1765 if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointer)) {
1766 for (const auto &[pointee, pointer] : symbol.owner().crayPointers()) {
1767 if (&*pointer == &symbol) {
1768 auto iter{symbol.owner().find(pointee)};
1769 CHECK(iter != symbol.owner().end());
1770 DoSymbol(*iter->second);
1771 }
1772 }
1773 } else if (symbol.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
1774 DoSymbol(GetCrayPointer(symbol));
1775 }
1776}
1777
1778void SubprogramSymbolCollector::DoType(const DeclTypeSpec *type) {
1779 if (!type) {
1780 return;
1781 }
1782 switch (type->category()) {
1783 case DeclTypeSpec::Numeric:
1784 case DeclTypeSpec::Logical:
1785 break; // nothing to do
1786 case DeclTypeSpec::Character:
1787 DoParamValue(type->characterTypeSpec().length());
1788 break;
1789 default:
1790 if (const DerivedTypeSpec * derived{type->AsDerived()}) {
1791 const auto &typeSymbol{derived->typeSymbol()};
1792 for (const auto &pair : derived->parameters()) {
1793 DoParamValue(pair.second);
1794 }
1795 // The components of the type (including its parent component, if
1796 // any) matter to IMPORT symbol collection only for derived types
1797 // defined in the subprogram.
1798 if (typeSymbol.owner() == scope_) {
1799 if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
1800 DoSymbol(extends->name(), extends->typeSymbol());
1801 }
1802 for (const auto &pair : *typeSymbol.scope()) {
1803 DoSymbol(*pair.second);
1804 }
1805 }
1806 DoSymbol(derived->name(), typeSymbol);
1807 }
1808 }
1809}
1810
1811void SubprogramSymbolCollector::DoBound(const Bound &bound) {
1812 if (const MaybeSubscriptIntExpr & expr{bound.GetExplicit()}) {
1813 DoExpr(*expr);
1814 }
1815}
1816void SubprogramSymbolCollector::DoParamValue(const ParamValue &paramValue) {
1817 if (const auto &expr{paramValue.GetExplicit()}) {
1818 DoExpr(*expr);
1819 }
1820}
1821
1822// Do we need a IMPORT of this symbol into an interface block?
1823bool SubprogramSymbolCollector::NeedImport(
1824 const SourceName &name, const Symbol &symbol) {
1825 if (!isInterface_) {
1826 return false;
1827 } else if (IsSeparateModuleProcedureInterface(&symbol_)) {
1828 return false; // IMPORT needed only for external and dummy procedure
1829 // interfaces
1830 } else if (&symbol == scope_.symbol()) {
1831 return false;
1832 } else if (symbol.owner().Contains(scope_)) {
1833 return true;
1834 } else if (const Symbol *found{scope_.FindSymbol(name)}) {
1835 // detect import from ancestor of use-associated symbol
1836 return found->has<UseDetails>() && found->owner() != scope_;
1837 } else {
1838 // "found" can be null in the case of a use-associated derived type's
1839 // parent type, and also in the case of an object (like a dummy argument)
1840 // used to define a length or bound of a nested interface.
1841 return false;
1842 }
1843}
1844
1845} // namespace Fortran::semantics
1846

source code of flang/lib/Semantics/mod-file.cpp