forked from OSchip/llvm-project
[flang] checkpoint, tests pass
Original-commit: flang-compiler/f18@d90d5d9244 Reviewed-on: https://github.com/flang-compiler/f18/pull/287 Tree-same-pre-rewrite: false
This commit is contained in:
parent
a412dce037
commit
4d1a8a3ac8
|
@ -35,7 +35,7 @@ private:
|
|||
A original_;
|
||||
};
|
||||
|
||||
template<typename A> Restorer<A> ScopedSet(A &to, A &&from) {
|
||||
template<typename A, typename B> Restorer<A> ScopedSet(A &to, B &&from) {
|
||||
Restorer<A> result{to};
|
||||
to = std::move(from);
|
||||
return result;
|
||||
|
|
|
@ -24,6 +24,7 @@
|
|||
#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"
|
||||
|
@ -712,6 +713,7 @@ protected:
|
|||
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();
|
||||
|
||||
|
@ -959,7 +961,6 @@ private:
|
|||
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 &);
|
||||
|
@ -1538,8 +1539,13 @@ Symbol &ScopeHandler::Resolve(const parser::Name &name, Symbol &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;
|
||||
}
|
||||
|
@ -2384,6 +2390,37 @@ void DeclarationVisitor::CheckAccessibility(
|
|||
}
|
||||
}
|
||||
|
||||
// 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};
|
||||
|
@ -2829,6 +2866,11 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) {
|
|||
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));
|
||||
|
@ -3071,64 +3113,84 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
|
|||
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)) {
|
||||
|
@ -3138,27 +3200,30 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
|
|||
}
|
||||
}
|
||||
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);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -4030,8 +4095,8 @@ const parser::Name *ResolveNamesVisitor::FindComponent(
|
|||
}
|
||||
} 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 {
|
||||
|
@ -4051,30 +4116,6 @@ const parser::Name *ResolveNamesVisitor::FindComponent(
|
|||
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)};
|
||||
|
|
|
@ -49,7 +49,7 @@ Symbol *Scope::FindSymbol(const SourceName &name) const {
|
|||
if (kind() == Kind::DerivedType) {
|
||||
return parent_.FindSymbol(name);
|
||||
}
|
||||
const auto it{find(name)};
|
||||
auto it{find(name)};
|
||||
if (it != end()) {
|
||||
return it->second;
|
||||
} else if (CanImport(name)) {
|
||||
|
|
|
@ -640,12 +640,10 @@ SymbolList DerivedTypeDetails::OrderComponents(const Scope &scope) const {
|
|||
const Symbol &symbol{*iter->second};
|
||||
if (symbol.test(Symbol::Flag::ParentComp)) {
|
||||
CHECK(result.empty());
|
||||
const Symbol &typeSymbol{symbol.get<ObjectEntityDetails>()
|
||||
.type()
|
||||
->AsDerived()
|
||||
->typeSymbol()};
|
||||
result = typeSymbol.get<DerivedTypeDetails>().OrderComponents(
|
||||
*typeSymbol.scope());
|
||||
const DerivedTypeSpec &spec{
|
||||
*symbol.get<ObjectEntityDetails>().type()->AsDerived()};
|
||||
result = spec.typeSymbol().get<DerivedTypeDetails>().OrderComponents(
|
||||
*spec.scope());
|
||||
}
|
||||
result.push_back(&symbol);
|
||||
}
|
||||
|
|
|
@ -68,6 +68,7 @@ set(ERROR_TESTS
|
|||
resolve40.f90
|
||||
resolve41.f90
|
||||
resolve42.f90
|
||||
resolve43.f90
|
||||
)
|
||||
|
||||
# These test files have expected symbols in the source
|
||||
|
|
|
@ -11,6 +11,7 @@
|
|||
! 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.
|
||||
|
||||
module m
|
||||
implicit none
|
||||
real, parameter :: a = 8.0
|
||||
|
|
|
@ -0,0 +1,86 @@
|
|||
! 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
|
Loading…
Reference in New Issue