#include "../common/default-kinds.h"
#include "../common/fortran.h"
#include "../common/indirection.h"
+#include "../common/restorer.h"
#include "../evaluate/common.h"
#include "../evaluate/fold.h"
#include "../evaluate/tools.h"
const parser::Name &, const std::optional<parser::IntegerTypeSpec> &);
bool CheckUseError(const parser::Name &);
void CheckAccessibility(const parser::Name &, bool, const Symbol &);
+ bool CheckAccessibleComponent(const SourceName &, const Symbol &);
void CheckScalarIntegerType(const parser::Name &);
void CheckCommonBlocks();
const parser::Name *ResolveName(const parser::Name &);
const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
- bool CheckAccessibleComponent(const parser::Name &);
void CheckImports();
void CheckImport(const SourceName &, const SourceName &);
bool SetProcFlag(const parser::Name &, Symbol &);
return *Resolve(name, &symbol);
}
Symbol *ScopeHandler::Resolve(const parser::Name &name, Symbol *symbol) {
- if (symbol && !name.symbol) {
- name.symbol = symbol;
+ if (symbol) {
+ // TODO: Should name.symbol be unconditionally updated?
+ // Or should it be an internal error if name.symbol is
+ // set to a distinct symbol?
+ if (name.symbol == nullptr) {
+ name.symbol = symbol;
+ }
}
return symbol;
}
}
}
+// Check that component is accessible from current scope.
+bool DeclarationVisitor::CheckAccessibleComponent(
+ const SourceName &name, const Symbol &symbol) {
+ if (!symbol.attrs().test(Attr::PRIVATE)) {
+ return true;
+ }
+ // component must be in a module/submodule because of PRIVATE:
+ const Scope *moduleScope{&symbol.owner()};
+ CHECK(moduleScope->kind() == Scope::Kind::DerivedType);
+ while (moduleScope->kind() != Scope::Kind::Module &&
+ moduleScope->kind() != Scope::Kind::Global) {
+ moduleScope = &moduleScope->parent();
+ }
+ if (moduleScope->kind() == Scope::Kind::Module) {
+ for (auto *scope{&currScope()}; scope->kind() != Scope::Kind::Global;
+ scope = &scope->parent()) {
+ if (scope == moduleScope) {
+ return true;
+ }
+ }
+ Say(name,
+ "PRIVATE component '%s' is only accessible within module '%s'"_err_en_US,
+ name.ToString(), moduleScope->name());
+ } else {
+ Say(name,
+ "PRIVATE component '%s' is only accessible within its module"_err_en_US,
+ name.ToString());
+ }
+ return false;
+}
+
void DeclarationVisitor::CheckScalarIntegerType(const parser::Name &name) {
if (name.symbol != nullptr) {
const Symbol &symbol{*name.symbol};
if (auto *extendsName{derivedTypeInfo_.extends}) {
if (const Symbol * extends{ResolveDerivedType(*extendsName)}) {
// Declare the "parent component"; private if the type is
+ // Any symbol stored in the EXTENDS() clause is temporarily
+ // hidden so that a new symbol can be created for the parent
+ // component without producing spurious errors about already
+ // existing.
+ auto restorer{common::ScopedSet(extendsName->symbol, nullptr)};
if (OkToAddComponent(*extendsName, extends)) {
auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})};
comp.attrs().set(Attr::PRIVATE, extends->attrs().test(Attr::PRIVATE));
EndDeclTypeSpec();
SetDeclTypeSpecState(savedState);
- bool ok{typeSymbol != nullptr && typeScope != nullptr};
+ // This list holds all of the components in the derived type and its
+ // parents. The symbols for whole parent components appear after their
+ // own components and before the components of the types that extend them.
+ // E.g., TYPE :: A; REAL X; END TYPE
+ // TYPE, EXTENDS(A) :: B; REAL Y; END TYPE
+ // produces the component list X, A, Y.
+ // The order is important below because a structure constructor can
+ // initialize X or A by name, but not both.
SymbolList components;
+ bool ok{typeSymbol != nullptr && typeScope != nullptr};
if (ok) {
- // This list holds all of the components in the derived type and its
- // parents. The symbols for whole parent components appear after their
- // own components and before the components of the types that extend them.
- // E.g., TYPE :: A; REAL X; END TYPE
- // TYPE, EXTENDS(A) :: B; REAL Y; END TYPE
- // produces the component list X, A, Y.
- // The order is important below because a structure constructor can
- // initialize X or A by name, but not both.
components =
typeSymbol->get<DerivedTypeDetails>().OrderComponents(*typeScope);
+ if (typeSymbol->attrs().test(Attr::ABSTRACT)) { // C796
+ SayWithDecl(typeName, *typeSymbol,
+ "ABSTRACT type cannot be used in a structure constructor"_err_en_US);
+ }
}
+ // N.B C7102 is implicitly enforced by having inaccessible types not
+ // being found in resolution.
+
std::set<SourceName> unavailable;
auto nextAnonymous{components.begin()};
bool anyKeyword{false};
for (const auto &component :
std::get<std::list<parser::ComponentSpec>>(x.t)) {
- Walk(component);
+ // Visit the component spec expression, but not the keyword, since
+ // we need to resolve its symbol in the scope of the derived type.
const parser::Expr &value{
*std::get<parser::ComponentDataSource>(component.t).v};
+ Walk(value);
const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)};
const Symbol *symbol{nullptr};
+ SourceName source{value.source};
+ auto componentIter{components.end()};
if (kw.has_value()) {
- symbol = kw->v.symbol;
+ source = kw->v.source;
+ componentIter = std::find_if(components.begin(), components.end(),
+ [&](const Symbol *s) { return s->name() == source; });
+ if (componentIter != components.end()) {
+ if ((*componentIter)->has<TypeParamDetails>()) {
+ Say(source,
+ "Type parameter '%s' cannot appear in a structure constructor"_err_en_US);
+ } else {
+ symbol = *componentIter;
+ }
+ } else { // C7101
+ Say(source,
+ "Keyword '%s' is not a component of this derived type"_err_en_US);
+ }
anyKeyword = true;
- } else if (anyKeyword) {
- Say(value.source,
- "Component value lacks a required component name"_err_en_US);
+ ok &= symbol != nullptr;
+ } else if (anyKeyword) { // C7100
+ Say(source,
+ "Value in structure constructor lacks a required component name"_err_en_US);
}
if (symbol != nullptr) {
+ CHECK(componentIter != components.end());
if (unavailable.find(symbol->name()) != unavailable.cend()) {
- Say(kw->v.source,
- "Component '%s' conflicts with another component earlier in the constructor"_err_en_US);
+ // C797, C798
+ Say(source,
+ "Component '%s' conflicts with another component earlier in the structure constructor"_err_en_US);
+ } else if (symbol->test(Symbol::Flag::ParentComp)) {
+ // Make earlier components unavailable once a whole parent appears.
+ for (auto it{components.begin()}; it != componentIter; ++it) {
+ unavailable.insert((*it)->name());
+ }
} else {
- auto iter{std::find(components.begin(), components.end(), symbol)};
- if (iter == components.end()) {
- Say(kw->v.source,
- "Component '%s' is not a component of this derived type"_err_en_US);
- symbol = nullptr;
- } else if (symbol->test(Symbol::Flag::ParentComp)) {
- // Make earlier components unavailable once a whole parent appears.
- for (auto it{components.begin()}; it != iter; ++it) {
+ // Make whole parent components unavailable after any of their
+ // constituents appear.
+ for (auto it{componentIter}; it != components.end(); ++it) {
+ if ((*it)->test(Symbol::Flag::ParentComp)) {
unavailable.insert((*it)->name());
}
- } else {
- // Make whole parent components unavailable after any of their
- // constituents appear.
- for (auto it{iter}; it != components.end(); ++it) {
- if ((*it)->test(Symbol::Flag::ParentComp)) {
- unavailable.insert((*it)->name());
- }
- }
}
}
- } else {
+ } else if (ok) {
while (nextAnonymous != components.end()) {
symbol = *nextAnonymous++;
if (symbol->test(Symbol::Flag::ParentComp)) {
}
}
if (symbol == nullptr) {
- Say(value.source,
- "Unexpected value does not correspond to any component"_err_en_US);
+ Say(source, "Unexpected value in structure constructor"_err_en_US);
break;
}
}
- // Save the resolved component's symbol (if any) in the parse tree.
if (symbol != nullptr) {
+ // Save the resolved component's symbol (if any) in the parse tree.
component.symbol = symbol;
unavailable.insert(symbol->name());
+ CheckAccessibleComponent(source, *symbol); // C7102
+ // TODO pmk: C7104, C7105 check that pointer components are
+ // being initialized with data/procedure designators appropriately
}
}
// Ensure that unmentioned component objects have default initializers.
- for (const Symbol *symbol : components) {
- if (!symbol->test(Symbol::Flag::ParentComp) &&
- unavailable.find(symbol->name()) == unavailable.cend() &&
- !symbol->attrs().test(Attr::POINTER) &&
- !symbol->attrs().test(Attr::ALLOCATABLE)) {
- if (const auto *details{symbol->detailsIf<ObjectEntityDetails>()}) {
- if (!details->init().has_value()) {
- Say2(typeName, "Structure constructor lacks a value"_err_en_US,
- *symbol, "Absent component"_en_US);
+ if (ok) {
+ for (const Symbol *symbol : components) {
+ if (!symbol->test(Symbol::Flag::ParentComp) &&
+ unavailable.find(symbol->name()) == unavailable.cend() &&
+ !symbol->attrs().test(Attr::ALLOCATABLE)) {
+ if (const auto *details{symbol->detailsIf<ObjectEntityDetails>()}) {
+ if (!details->init().has_value()) { // C799
+ Say2(typeName, "Structure constructor lacks a value"_err_en_US,
+ *symbol, "Absent component"_en_US);
+ }
}
}
}
}
} else if (const DerivedTypeSpec * derived{type->AsDerived()}) {
if (const Scope * scope{derived->scope()}) {
- if (FindInTypeOrParents(*scope, component)) {
- if (CheckAccessibleComponent(component)) {
+ if (Resolve(component, FindInTypeOrParents(*scope, component.source))) {
+ if (CheckAccessibleComponent(component.source, *component.symbol)) {
return &component;
}
} else {
return nullptr;
}
-// Check that component is accessible from current scope.
-bool ResolveNamesVisitor::CheckAccessibleComponent(
- const parser::Name &component) {
- CHECK(component.symbol);
- auto &symbol{*component.symbol};
- if (!symbol.attrs().test(Attr::PRIVATE)) {
- return true;
- }
- CHECK(symbol.owner().kind() == Scope::Kind::DerivedType);
- // component must be in a module/submodule because of PRIVATE:
- const Scope &moduleScope{symbol.owner().parent()};
- CHECK(moduleScope.kind() == Scope::Kind::Module);
- for (auto *scope{&currScope()}; scope->kind() != Scope::Kind::Global;
- scope = &scope->parent()) {
- if (scope == &moduleScope) {
- return true;
- }
- }
- Say(component,
- "PRIVATE component '%s' is only accessible within module '%s'"_err_en_US,
- component.ToString(), moduleScope.name());
- return false;
-}
-
void ResolveNamesVisitor::Post(const parser::ProcedureDesignator &x) {
if (const auto *name{std::get_if<parser::Name>(&x.u)}) {
auto *symbol{FindSymbol(*name)};
--- /dev/null
+! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+! http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+! Error tests for structure constructors.
+! Type parameters are also used to make the parses unambiguous.
+
+module module1
+ type :: type1(j)
+ integer, kind :: j
+ integer :: n = 1
+ end type type1
+ type, extends(type1) :: type2(k)
+ integer, kind :: k
+ integer :: m
+ end type type2
+ type, abstract :: abstract(j)
+ integer, kind :: j
+ integer :: n
+ end type abstract
+ type :: privaten(j)
+ integer, kind :: j
+ integer, private :: n
+ end type privaten
+ contains
+ subroutine type1arg(x)
+ type(type1(0)), intent(in) :: x
+ end subroutine type1arg
+ subroutine type2arg(x)
+ type(type2(0,0)), intent(in) :: x
+ end subroutine type2arg
+ subroutine abstractarg(x)
+ type(abstract(0)), intent(in) :: x
+ end subroutine abstractarg
+ subroutine errors
+ call type1arg(type1(0)())
+ call type1arg(type1(0)(1))
+ call type1arg(type1(0)(n=1))
+ !ERROR: Keyword 'bad' is not a component of this derived type
+ call type1arg(type1(0)(bad=1))
+ !ERROR: Keyword 'j' is not a component of this derived type
+ call type1arg(type1(0)(j=1))
+ !ERROR: Unexpected value in structure constructor
+ call type1arg(type1(0)(1,2))
+ !ERROR: Component 'n' conflicts with another component earlier in the structure constructor
+ call type1arg(type1(0)(1,n=2))
+ !ERROR: Value in structure constructor lacks a required component name
+ call type1arg(type1(0)(n=1,2))
+ !ERROR: Component 'n' conflicts with another component earlier in the structure constructor
+ call type1arg(type1(0)(n=1,n=2))
+ call type2arg(type2(0,0)(n=1,m=2))
+ call type2arg(type2(0,0)(m=2))
+ !ERROR: Structure constructor lacks a value
+ call type2arg(type2(0,0)())
+ call type2arg(type2(0,0)(type1=type1(0)(n=1),m=2))
+ call type2arg(type2(0,0)(type1=type1(0)(),m=2))
+ !ERROR: Component 'type1' conflicts with another component earlier in the structure constructor
+ call type2arg(type2(0,0)(n=1,type1=type1(0)(n=2),m=3))
+ !ERROR: Component 'n' conflicts with another component earlier in the structure constructor
+ call type2arg(type2(0,0)(type1=type1(0)(n=1),n=2,m=3))
+ !ERROR: Component 'n' conflicts with another component earlier in the structure constructor
+ call type2arg(type2(0,0)(type1=type1(0)(1),n=2,m=3))
+ !ERROR: Keyword 'j' is not a component of this derived type
+ call type2arg(type2(0,0)(j=1, &
+ !ERROR: Keyword 'k' is not a component of this derived type
+ k=2,m=3))
+ !ERROR: ABSTRACT type cannot be used in a structure constructor
+ call abstractarg(abstract(0)(n=1))
+ end subroutine errors
+end module module1
+
+subroutine yotdau
+ use module1
+ !ERROR: PRIVATE component 'n' is only accessible within its module
+ type(privaten(0)) :: x = privaten(0)(n=1)
+end subroutine yotdau
projects / platform / upstream / llvm.git / commitdiff