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

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