bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
void CheckInitialDataTarget(const Symbol &, const SomeExpr &, SourceName);
- void CheckInitialProcTarget(const Symbol &, const parser::Name &);
+ void CheckInitialProcTarget(const Symbol &, const parser::Name &, SourceName);
void Initialization(const parser::Name &, const parser::Initialization &,
bool inComponentDecl);
bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
// Set the SAVE attribute on symbol unless it is implicitly saved anyway.
void DeclarationVisitor::SetSaveAttr(Symbol &symbol) {
- auto scopeKind{symbol.owner().kind()};
- if (scopeKind == Scope::Kind::MainProgram ||
- scopeKind == Scope::Kind::Module) {
- return;
+ if (!IsSaved(symbol)) {
+ symbol.attrs().set(Attr::SAVE);
}
- if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
- if (details->init()) {
- return;
- }
- }
- symbol.attrs().set(Attr::SAVE);
}
// Check types of common block objects, now that they are known.
pointer.name(), ultimate.name());
return;
}
- if (!ultimate.attrs().test(Attr::SAVE)) {
+ if (!IsSaved(ultimate)) {
Say(source,
"Pointer '%s' cannot be initialized with a reference to an object '%s' that lacks the SAVE attribute"_err_en_US,
pointer.name(), ultimate.name());
}
void DeclarationVisitor::CheckInitialProcTarget(
- const Symbol &pointer, const parser::Name &target) {
- // TODO pmk write
+ const Symbol &pointer, const parser::Name &target, SourceName source) {
+ // C1519 - must be nonelemental external or module procedure,
+ // or an unrestricted specific intrinsic function.
+ if (const Symbol * targetSym{target.symbol}) {
+ const Symbol &ultimate{targetSym->GetUltimate()};
+ if (ultimate.attrs().test(Attr::INTRINSIC)) {
+ } else if (!ultimate.attrs().test(Attr::EXTERNAL) &&
+ ultimate.owner().kind() != Scope::Kind::Module) {
+ Say(source,
+ "Procedure pointer '%s' initializer '%s' is neither "
+ "an external nor a module procedure"_err_en_US,
+ pointer.name(), ultimate.name());
+ } else if (ultimate.attrs().test(Attr::ELEMENTAL)) {
+ Say(source,
+ "Procedure pointer '%s' cannot be initialized with the "
+ "elemental procedure '%s"_err_en_US,
+ pointer.name(), ultimate.name());
+ } else {
+ // TODO: Check the "shalls" in the 15.4.3.6 paragraphs 7-10.
+ }
+ }
}
void DeclarationVisitor::Initialization(const parser::Name &name,
Symbol &ultimate{name.symbol->GetUltimate()};
if (IsProcedurePointer(ultimate)) {
auto &details{ultimate.get<ProcEntityDetails>()};
- if (details.init() == nullptr) {
+ if (!details.init().has_value()) {
Walk(target);
if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) {
- CheckInitialProcTarget(ultimate, *targetName);
+ CheckInitialProcTarget(ultimate, *targetName, name.source);
if (targetName->symbol != nullptr) {
details.set_init(*targetName->symbol);
}
+ } else {
+ details.set_init(nullptr); // NULL()
}
}
} else {
void set_interface(const ProcInterface &interface) { interface_ = interface; }
inline bool HasExplicitInterface() const;
- const Symbol *init() const { return init_; }
- Symbol *init() { return init_; }
- void set_init(Symbol &symbol) { init_ = &symbol; }
+ std::optional<const Symbol *> init() const { return init_; }
+ void set_init(const Symbol &symbol) { init_ = &symbol; }
+ void set_init(std::nullptr_t) { init_ = nullptr; }
private:
ProcInterface interface_;
- Symbol *init_{nullptr};
+ std::optional<const Symbol *> init_; // if present but null => NULL()
friend std::ostream &operator<<(std::ostream &, const ProcEntityDetails &);
};
return false;
}
+bool IsSaved(const Symbol &symbol) {
+ auto scopeKind{symbol.owner().kind()};
+ if (scopeKind == Scope::Kind::MainProgram ||
+ scopeKind == Scope::Kind::Module) {
+ return true;
+ } else if (scopeKind == Scope::Kind::DerivedType) {
+ return false; // this is a component
+ } else if (symbol.attrs().test(Attr::SAVE)) {
+ return true;
+ } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+ return object->init().has_value();
+ } else if (IsProcedurePointer(symbol)) {
+ return symbol.get<ProcEntityDetails>().init().has_value();
+ } else {
+ return false;
+ }
+}
+
+const Symbol *FindUltimateComponent(const DerivedTypeSpec &derivedTypeSpec,
+ std::function<bool(const Symbol &)> predicate) {
+ const auto *scope{derivedTypeSpec.typeSymbol().scope()};
+ CHECK(scope);
+ for (const auto &pair : *scope) {
+ const Symbol &component{*pair.second};
+ const DeclTypeSpec *type{component.GetType()};
+ if (!type) {
+ continue;
+ }
+ const DerivedTypeSpec *derived{type->AsDerived()};
+ bool isUltimate{IsAllocatableOrPointer(component) || !derived};
+ if (const Symbol *
+ result{!isUltimate ? FindUltimateComponent(*derived, predicate)
+ : predicate(component) ? &component : nullptr}) {
+ return result;
+ }
+ }
+ return nullptr;
+}
+
bool IsFinalizable(const Symbol &symbol) {
if (const DeclTypeSpec * type{symbol.GetType()}) {
if (const DerivedTypeSpec * derived{type->AsDerived()}) {