}
CheckForDefinableVariable(*var, "Input");
if (auto expr{AnalyzeExpr(context_, *var)}) {
- CheckForBadIoComponent(*expr,
+ CheckForBadIoType(*expr,
flags_.test(Flag::FmtOrNml) ? GenericKind::DefinedIo::ReadFormatted
: GenericKind::DefinedIo::ReadUnformatted,
var->GetSource());
context_.Say(parser::FindSourceLocation(*x),
"Output item must not be a procedure pointer"_err_en_US); // C1233
}
- CheckForBadIoComponent(*expr,
+ CheckForBadIoType(*expr,
flags_.test(Flag::FmtOrNml)
? GenericKind::DefinedIo::WriteFormatted
: GenericKind::DefinedIo::WriteUnformatted,
Done();
}
-static void CheckForDoVariableInNamelist(const Symbol &namelist,
- SemanticsContext &context, parser::CharBlock namelistLocation) {
- const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
- for (const Symbol &object : details.objects()) {
- context.CheckIndexVarRedefine(namelistLocation, object);
- }
-}
-
-static void CheckForDoVariableInNamelistSpec(
- const parser::ReadStmt &readStmt, SemanticsContext &context) {
- const std::list<parser::IoControlSpec> &controls{readStmt.controls};
+static const parser::Name *FindNamelist(
+ const std::list<parser::IoControlSpec> &controls) {
for (const auto &control : controls) {
- if (const auto *namelist{std::get_if<parser::Name>(&control.u)}) {
- if (const Symbol * symbol{namelist->symbol}) {
- CheckForDoVariableInNamelist(*symbol, context, namelist->source);
+ if (const parser::Name * namelist{std::get_if<parser::Name>(&control.u)}) {
+ if (namelist->symbol &&
+ namelist->symbol->GetUltimate().has<NamelistDetails>()) {
+ return namelist;
}
}
}
+ return nullptr;
}
static void CheckForDoVariable(
const parser::ReadStmt &readStmt, SemanticsContext &context) {
- CheckForDoVariableInNamelistSpec(readStmt, context);
const std::list<parser::InputItem> &items{readStmt.items};
for (const auto &item : items) {
if (const parser::Variable *
if (!flags_.test(Flag::InternalUnit)) {
CheckForPureSubprogram();
}
+ if (const parser::Name * namelist{FindNamelist(readStmt.controls)}) {
+ if (namelist->symbol) {
+ CheckNamelist(*namelist->symbol, GenericKind::DefinedIo::ReadFormatted,
+ namelist->source);
+ }
+ }
CheckForDoVariable(readStmt, context_);
if (!flags_.test(Flag::IoControlList)) {
Done();
Done();
}
-void IoChecker::Leave(const parser::WriteStmt &) {
+void IoChecker::Leave(const parser::WriteStmt &writeStmt) {
if (!flags_.test(Flag::InternalUnit)) {
CheckForPureSubprogram();
}
+ if (const parser::Name * namelist{FindNamelist(writeStmt.controls)}) {
+ if (namelist->symbol) {
+ CheckNamelist(*namelist->symbol, GenericKind::DefinedIo::WriteFormatted,
+ namelist->source);
+ }
+ }
LeaveReadWrite();
CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213
CheckForProhibitedSpecifier(IoSpecKind::End); // C1213
}
}
-// Fortran 2018, 12.6.3 paragraph 7
-void IoChecker::CheckForBadIoComponent(const SomeExpr &expr,
+// Seeks out an allocatable or pointer ultimate component that is not
+// nested in a nonallocatable/nonpointer component with a specific
+// defined I/O procedure.
+static const Symbol *FindUnsafeIoDirectComponent(GenericKind::DefinedIo which,
+ const DerivedTypeSpec &derived, const Scope &scope) {
+ if (HasDefinedIo(which, derived, &scope)) {
+ return nullptr;
+ }
+ if (const Scope * dtScope{derived.scope()}) {
+ for (const auto &pair : *dtScope) {
+ const Symbol &symbol{*pair.second};
+ if (IsAllocatableOrPointer(symbol)) {
+ return &symbol;
+ }
+ if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
+ if (const DeclTypeSpec * type{details->type()}) {
+ if (type->category() == DeclTypeSpec::Category::TypeDerived) {
+ const DerivedTypeSpec &componentDerived{type->derivedTypeSpec()};
+ if (const Symbol *
+ bad{FindUnsafeIoDirectComponent(
+ which, componentDerived, scope)}) {
+ return bad;
+ }
+ }
+ }
+ }
+ }
+ }
+ return nullptr;
+}
+
+// For a type that does not have a defined I/O subroutine, finds a direct
+// component that is a witness to an accessibility violation outside the module
+// in which the type was defined.
+static const Symbol *FindInaccessibleComponent(GenericKind::DefinedIo which,
+ const DerivedTypeSpec &derived, const Scope &scope) {
+ if (const Scope * dtScope{derived.scope()}) {
+ if (const Scope * module{FindModuleContaining(*dtScope)}) {
+ for (const auto &pair : *dtScope) {
+ const Symbol &symbol{*pair.second};
+ if (IsAllocatableOrPointer(symbol)) {
+ continue; // already an error
+ }
+ if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
+ const DerivedTypeSpec *componentDerived{nullptr};
+ if (const DeclTypeSpec * type{details->type()}) {
+ if (type->category() == DeclTypeSpec::Category::TypeDerived) {
+ componentDerived = &type->derivedTypeSpec();
+ }
+ }
+ if (componentDerived &&
+ HasDefinedIo(which, *componentDerived, &scope)) {
+ continue; // this component and its descendents are fine
+ }
+ if (symbol.attrs().test(Attr::PRIVATE) &&
+ !symbol.test(Symbol::Flag::ParentComp)) {
+ if (!DoesScopeContain(module, scope)) {
+ return &symbol;
+ }
+ }
+ if (componentDerived) {
+ if (const Symbol *
+ bad{FindInaccessibleComponent(
+ which, *componentDerived, scope)}) {
+ return bad;
+ }
+ }
+ }
+ }
+ }
+ }
+ return nullptr;
+}
+
+// Fortran 2018, 12.6.3 paragraphs 5 & 7
+parser::Message *IoChecker::CheckForBadIoType(const evaluate::DynamicType &type,
GenericKind::DefinedIo which, parser::CharBlock where) const {
- if (auto type{expr.GetType()}) {
- if (type->category() == TypeCategory::Derived &&
- !type->IsUnlimitedPolymorphic()) {
+ if (type.IsUnlimitedPolymorphic()) {
+ return &context_.Say(
+ where, "I/O list item may not be unlimited polymorphic"_err_en_US);
+ } else if (type.category() == TypeCategory::Derived) {
+ const auto &derived{type.GetDerivedTypeSpec()};
+ const Scope &scope{context_.FindScope(where)};
+ if (const Symbol *
+ bad{FindUnsafeIoDirectComponent(which, derived, scope)}) {
+ return &context_.SayWithDecl(*bad, where,
+ "Derived type '%s' in I/O cannot have an allocatable or pointer direct component '%s' unless using defined I/O"_err_en_US,
+ derived.name(), bad->name());
+ }
+ if (!HasDefinedIo(which, derived, &scope)) {
+ if (type.IsPolymorphic()) {
+ return &context_.Say(where,
+ "Derived type '%s' in I/O may not be polymorphic unless using defined I/O"_err_en_US,
+ derived.name());
+ }
if (const Symbol *
- bad{FindUnsafeIoDirectComponent(
- which, type->GetDerivedTypeSpec(), &context_.FindScope(where))}) {
- context_.SayWithDecl(*bad, where,
- "Derived type in I/O cannot have an allocatable or pointer direct component unless using defined I/O"_err_en_US);
+ bad{FindInaccessibleComponent(which, derived, scope)}) {
+ return &context_.Say(where,
+ "I/O of the derived type '%s' may not be performed without defined I/O in a scope in which a direct component like '%s' is inaccessible"_err_en_US,
+ derived.name(), bad->name());
}
}
}
+ return nullptr;
+}
+
+void IoChecker::CheckForBadIoType(const SomeExpr &expr,
+ GenericKind::DefinedIo which, parser::CharBlock where) const {
+ if (auto type{expr.GetType()}) {
+ CheckForBadIoType(*type, which, where);
+ }
+}
+
+parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol,
+ GenericKind::DefinedIo which, parser::CharBlock where) const {
+ if (auto type{evaluate::DynamicType::From(symbol)}) {
+ if (auto *msg{CheckForBadIoType(*type, which, where)}) {
+ evaluate::AttachDeclaration(*msg, symbol);
+ return msg;
+ }
+ }
+ return nullptr;
+}
+
+void IoChecker::CheckNamelist(const Symbol &namelist,
+ GenericKind::DefinedIo which, parser::CharBlock namelistLocation) const {
+ const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
+ for (const Symbol &object : details.objects()) {
+ context_.CheckIndexVarRedefine(namelistLocation, object);
+ if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) {
+ evaluate::AttachDeclaration(*msg, namelist);
+ }
+ }
}
} // namespace Fortran::semantics
projects / platform / upstream / llvm.git / commitdiff