maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Implement forward references to derived types (fix flang-compiler/f18#573) 

Restructuring PDT instantiation in preparation for forward references

Complete tests, pass them

Address review comments

Original-commit: flang-compiler/f18@b66ba55a73
Reviewed-on: https://github.com/flang-compiler/f18/pull/847
This commit is contained in:
peter klausler 2019-11-22 08:15:02 -08:00
parent e373ddf6cd
commit 780c2aea65
13 changed files with 715 additions and 350 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
flang/lib/semantics/check-declarations.cc
View File

@ -370,7 +370,10 @@ void CheckHelper::CheckProcEntity(
void CheckHelper::CheckDerivedType(
const Symbol &symbol, const DerivedTypeDetails &details) {
CHECK(symbol.scope());
if (!symbol.scope()) {
CHECK(details.isForwardReferenced());
return;
}
CHECK(symbol.scope()->symbol() == &symbol);
CHECK(symbol.scope()->IsDerivedType());
if (symbol.attrs().test(Attr::ABSTRACT) &&

196
flang/lib/semantics/resolve-names.cc
View File

@ -89,7 +89,7 @@ private:
// map_ contains the mapping between letters and types that were defined
// by the IMPLICIT statements of the related scope. It does not contain
// the default Fortran mappings nor the mapping defined in parents.
std::map<char, const DeclTypeSpec *> map_;
std::map<char, common::Reference<const DeclTypeSpec>> map_;
friend std::ostream &operator<<(std::ostream &, const ImplicitRules &);
friend void ShowImplicitRule(std::ostream &, const ImplicitRules &, char);
@ -173,11 +173,18 @@ public:
if (!maybeExpr) {
return std::nullopt;
}
auto exprType{maybeExpr->GetType()};
auto converted{evaluate::ConvertToType(symbol, std::move(*maybeExpr))};
if (!converted) {
Say(source,
"Initialization expression could not be converted to declared type of '%s'"_err_en_US,
symbol.name());
if (exprType) {
Say(source,
"Initialization expression could not be converted to declared type of '%s' from %s"_err_en_US,
symbol.name(), exprType->AsFortran());
} else {
Say(source,
"Initialization expression could not be converted to declared type of '%s'"_err_en_US,
symbol.name());
}
return std::nullopt;
}
return FoldExpr(std::move(*converted));
@ -308,11 +315,21 @@ protected:
DerivedTypeSpec *type{nullptr};
DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived};
} derived;
bool allowForwardReferenceToDerivedType{false};
};
bool allowForwardReferenceToDerivedType() const {
return state_.allowForwardReferenceToDerivedType;
}
void set_allowForwardReferenceToDerivedType(bool yes) {
state_.allowForwardReferenceToDerivedType = yes;
}
// Walk the parse tree of a type spec and return the DeclTypeSpec for it.
template<typename T> const DeclTypeSpec *ProcessTypeSpec(const T &x) {
template<typename T>
const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) {
auto save{common::ScopedSet(state_, State{})};
set_allowForwardReferenceToDerivedType(allowForward);
BeginDeclTypeSpec();
Walk(x);
const auto *type{GetDeclTypeSpec()};
@ -418,7 +435,7 @@ public:
using ImplicitRulesVisitor::Post;
using ImplicitRulesVisitor::Pre;
Scope &currScope() { return *currScope_; }
Scope &currScope() { return DEREF(currScope_); }
// The enclosing scope, skipping blocks and derived types.
Scope &InclusiveScope();
// The global scope, containing program units.
@ -739,6 +756,7 @@ public:
void Post(const parser::ComponentDecl &);
bool Pre(const parser::ProcedureDeclarationStmt &);
void Post(const parser::ProcedureDeclarationStmt &);
bool Pre(const parser::DataComponentDefStmt &); // returns false
bool Pre(const parser::ProcComponentDefStmt &);
void Post(const parser::ProcComponentDefStmt &);
bool Pre(const parser::ProcPointerInit &);
@ -1406,7 +1424,7 @@ const DeclTypeSpec *ImplicitRules::GetType(char ch) const {
if (isImplicitNoneType_) {
return nullptr;
} else if (auto it{map_.find(ch)}; it != map_.end()) {
return it->second;
return &*it->second;
} else if (inheritFromParent_) {
return parent_->GetType(ch);
} else if (ch >= 'i' && ch <= 'n') {
@ -1421,7 +1439,7 @@ const DeclTypeSpec *ImplicitRules::GetType(char ch) const {
void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,
parser::Location fromLetter, parser::Location toLetter) {
for (char ch = *fromLetter; ch; ch = ImplicitRules::Incr(ch)) {
auto res{map_.emplace(ch, &type)};
auto res{map_.emplace(ch, type)};
if (!res.second) {
context_.Say(parser::CharBlock{fromLetter},
"More than one implicit type specified for '%c'"_err_en_US, ch);
@ -1696,6 +1714,7 @@ bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {
bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {
BeginDeclTypeSpec();
set_allowForwardReferenceToDerivedType(true);
return true;
}
@ -1939,8 +1958,7 @@ void ScopeHandler::PopScope() {
// assumed to be objects.
// TODO: Statement functions
for (auto &pair : currScope()) {
Symbol &symbol{*pair.second};
ConvertToObjectEntity(symbol);
ConvertToObjectEntity(*pair.second);
}
SetScope(currScope_->parent());
}
@ -2047,7 +2065,15 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
}
}
const DeclTypeSpec *ScopeHandler::GetImplicitType(Symbol &symbol) {
return implicitRules().GetType(symbol.name().begin()[0]);
const DeclTypeSpec *type{implicitRules().GetType(symbol.name().begin()[0])};
if (type) {
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
// Resolve any forward-referenced derived type; a quick no-op else.
auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
instantiatable.Instantiate(currScope(), context());
}
}
return type;
}
// Convert symbol to be a ObjectEntity or return false if it can't be.
@ -2609,7 +2635,7 @@ void SubprogramVisitor::Post(const parser::ImplicitPart &) {
// If the function has a type in the prefix, process it now
if (funcInfo_.parsedType) {
messageHandler().set_currStmtSource(funcInfo_.source);
if (const auto *type{ProcessTypeSpec(*funcInfo_.parsedType)}) {
if (const auto *type{ProcessTypeSpec(*funcInfo_.parsedType, true)}) {
funcInfo_.resultSymbol->SetType(*type);
}
}
@ -3344,93 +3370,48 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
if (!spec) {
return;
}
const Symbol *typeSymbol{&spec->typeSymbol()};
// This DerivedTypeSpec is created initially as a search key.
// If it turns out to have the same name and actual parameter
// value expressions as some other DerivedTypeSpec in the current
// scope, then we'll use that extant spec; otherwise, when this
// spec is distinct from all derived types previously instantiated
// in the current scope, this spec will be moved to that collection.
// The expressions in a derived type specifier whose values define
// non-defaulted type parameters are evaluated in the enclosing scope.
// Default initialization expressions for the derived type's parameters
// may reference other parameters so long as the declaration precedes the
// use in the expression (10.1.12). This is not necessarily the same
// order as "type parameter order" (7.5.3.2).
// Parameters of the most deeply nested "base class" come first when the
// derived type is an extension.
auto parameterNames{OrderParameterNames(*typeSymbol)};
auto parameterDecls{OrderParameterDeclarations(*typeSymbol)};
auto nextNameIter{parameterNames.begin()};
bool seenAnyName{false};
for (const auto &typeParamSpec :
std::get<std::list<parser::TypeParamSpec>>(x.t)) {
const auto &optKeyword{
std::get<std::optional<parser::Keyword>>(typeParamSpec.t)};
SourceName name;
common::TypeParamAttr attr{common::TypeParamAttr::Kind};
std::optional<SourceName> name;
if (optKeyword) {
seenAnyName = true;
name = optKeyword->v.source;
auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
[&](const Symbol &symbol) { return symbol.name() == name; })};
if (it == parameterDecls.end()) {
Say(name,
"'%s' is not the name of a parameter for this type"_err_en_US);
} else {
attr = it->get().get<TypeParamDetails>().attr();
Resolve(optKeyword->v, const_cast<Symbol *>(&it->get()));
}
} else if (seenAnyName) {
Say(typeName.source, "Type parameter value must have a name"_err_en_US);
continue;
} else if (nextNameIter != parameterNames.end()) {
name = *nextNameIter++;
auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
[&](const Symbol &symbol) { return symbol.name() == name; })};
if (it != parameterDecls.end()) {
attr = it->get().get<TypeParamDetails>().attr();
}
} else {
Say(typeName.source,
"Too many type parameters given for derived type '%s'"_err_en_US);
break;
}
if (spec->FindParameter(name)) {
Say(typeName.source,
"Multiple values given for type parameter '%s'"_err_en_US, name);
} else {
const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)};
ParamValue param{GetParamValue(value, attr)}; // folded
if (!param.isExplicit() || param.GetExplicit()) {
spec->AddParamValue(name, std::move(param));
}
}
}
// Ensure that any type parameter without an explicit value has a
// default initialization in the derived type's definition.
const Scope *typeScope{typeSymbol->scope()};
CHECK(typeScope);
for (const SourceName &name : parameterNames) {
if (!spec->FindParameter(name)) {
auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
[&](const Symbol &symbol) { return symbol.name() == name; })};
if (it != parameterDecls.end()) {
const auto *details{it->get().detailsIf<TypeParamDetails>()};
if (!details || !details->init()) {
Say(typeName.source,
"Type parameter '%s' lacks a value and has no default"_err_en_US,
name);
}
}
const auto &value{std::get<parser::TypeParamValue>(typeParamSpec.t)};
// The expressions in a derived type specifier whose values define
// non-defaulted type parameters are evaluated (folded) in the enclosing
// scope. The KIND/LEN distinction is resolved later in
// DerivedTypeSpec::CookParameters().
ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)};
if (!param.isExplicit() || param.GetExplicit()) {
spec->AddRawParamValue(optKeyword, std::move(param));
}
}
// The DerivedTypeSpec *spec is used initially as a search key.
// If it turns out to have the same name and actual parameter
// value expressions as another DerivedTypeSpec in the current
// scope does, then we'll use that extant spec; otherwise, when this
// spec is distinct from all derived types previously instantiated
// in the current scope, this spec will be moved into that collection.
const auto &dtDetails{spec->typeSymbol().get<DerivedTypeDetails>()};
auto category{GetDeclTypeSpecCategory()};
ProcessParameterExpressions(*spec, context().foldingContext());
if (dtDetails.isForwardReferenced()) {
DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
SetDeclTypeSpec(type);
return;
}
// Normalize parameters to produce a better search key.
spec->CookParameters(GetFoldingContext());
if (!spec->MightBeParameterized()) {
spec->EvaluateParameters(GetFoldingContext());
}
if (const DeclTypeSpec *
extant{currScope().FindInstantiatedDerivedType(*spec, category)}) {
// This derived type and parameter expressions (if any) are already present
@ -3438,19 +3419,15 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
SetDeclTypeSpec(*extant);
} else {
DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
if (parameterNames.empty() || currScope().IsParameterizedDerivedType()) {
// The derived type being instantiated is not a parameterized derived
// type, or the instantiation is within the definition of a parameterized
// derived type; don't instantiate a new scope.
type.derivedTypeSpec().set_scope(*typeScope);
DerivedTypeSpec &derived{type.derivedTypeSpec()};
if (derived.MightBeParameterized() &&
currScope().IsParameterizedDerivedType()) {
// Defer instantiation; use the derived type's definition's scope.
derived.set_scope(DEREF(spec->typeSymbol().scope()));
} else {
// This is a parameterized derived type and this spec is not in the
// context of a parameterized derived type definition, so we need to
// clone its contents, specialize them with the actual type parameter
// values, and check constraints.
auto save{
auto restorer{
GetFoldingContext().messages().SetLocation(currStmtSource().value())};
InstantiateDerivedType(type.derivedTypeSpec(), currScope(), context());
derived.Instantiate(currScope(), context());
}
SetDeclTypeSpec(type);
}
@ -3630,6 +3607,17 @@ void DeclarationVisitor::Post(const parser::ProcedureDeclarationStmt &) {
interfaceName_ = nullptr;
EndDecl();
}
bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
// Overrides parse tree traversal so as to handle attributes first,
// so POINTER & ALLOCATABLE enable forward references to derived types.
Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));
set_allowForwardReferenceToDerivedType(
GetAttrs().test(Attr::POINTER) || GetAttrs().test(Attr::ALLOCATABLE));
Walk(std::get<parser::DeclarationTypeSpec>(x.t));
set_allowForwardReferenceToDerivedType(false);
Walk(std::get<std::list<parser::ComponentDecl>>(x.t));
return false;
}
bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
CHECK(!interfaceName_);
return true;
@ -4443,8 +4431,17 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
const parser::Name &name) {
const Symbol *symbol{FindSymbol(name)};
if (!symbol) {
Say(name, "Derived type '%s' not found"_err_en_US);
return std::nullopt;
if (allowForwardReferenceToDerivedType()) {
Symbol &forward{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
DerivedTypeDetails details;
details.set_isForwardReferenced();
forward.set_details(std::move(details));
Resolve(name, forward);
symbol = &forward;
} else {
Say(name, "Derived type '%s' not found"_err_en_US);
return std::nullopt;
}
}
if (CheckUseError(name)) {
return std::nullopt;
@ -4455,11 +4452,12 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
symbol = details->derivedType();
}
}
if (!symbol->has<DerivedTypeDetails>()) {
if (symbol->has<DerivedTypeDetails>()) {
return DerivedTypeSpec{name.source, *symbol};
} else {
Say(name, "'%s' is not a derived type"_err_en_US);
return std::nullopt;
}
return DerivedTypeSpec{name.source, *symbol};
}
std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveExtendsType(
@ -5687,6 +5685,8 @@ void ResolveNamesVisitor::FinishSpecificationPart() {
symbol.set(Symbol::Flag::Subroutine);
}
}
currScope().InstantiateDerivedTypes(context());
// TODO: what about instantiations in BLOCK?
CheckSaveStmts();
CheckCommonBlocks();
CheckEquivalenceSets();

9
flang/lib/semantics/scope.cc
View File

@ -327,4 +327,13 @@ const Scope *Scope::GetDerivedTypeParent() const {
}
return nullptr;
}
void Scope::InstantiateDerivedTypes(SemanticsContext &context) {
for (DeclTypeSpec &type : declTypeSpecs_) {
if (type.category() == DeclTypeSpec::TypeDerived ||
type.category() == DeclTypeSpec::ClassDerived) {
type.derivedTypeSpec().Instantiate(*this, context);
}
}
}
}

4
flang/lib/semantics/scope.h
View File

@ -34,6 +34,8 @@ using namespace parser::literals;
using common::ConstantSubscript;
class SemanticsContext;
// An equivalence object is represented by a symbol for the variable name,
// the indices for an array element, and the lower bound for a substring.
struct EquivalenceObject {
@ -215,6 +217,8 @@ public:
symbol_->test(Symbol::Flag::ModFile);
}
void InstantiateDerivedTypes(SemanticsContext &);
private:
Scope &parent_; // this is enclosing scope, not extended derived type base
const Kind kind_;

119
flang/lib/semantics/symbol.cc
View File

@ -14,6 +14,8 @@
#include "symbol.h"
#include "scope.h"
#include "semantics.h"
#include "tools.h"
#include "../common/idioms.h"
#include <ostream>
#include <string>
@ -245,11 +247,15 @@ bool Symbol::CanReplaceDetails(const Details &details) const {
return std::visit(
common::visitors{
[](const UseErrorDetails &) { return true; },
[=](const ObjectEntityDetails &) { return has<EntityDetails>(); },
[=](const ProcEntityDetails &) { return has<EntityDetails>(); },
[=](const SubprogramDetails &) {
[&](const ObjectEntityDetails &) { return has<EntityDetails>(); },
[&](const ProcEntityDetails &) { return has<EntityDetails>(); },
[&](const SubprogramDetails &) {
return has<SubprogramNameDetails>() || has<EntityDetails>();
},
[&](const DerivedTypeDetails &) {
auto *derived{detailsIf<DerivedTypeDetails>()};
return derived && derived->isForwardReferenced();
},
[](const auto &) { return false; },
},
details);
@ -553,7 +559,6 @@ const DerivedTypeSpec *Symbol::GetParentTypeSpec(const Scope *scope) const {
const Symbol *Symbol::GetParentComponent(const Scope *scope) const {
if (const auto *dtDetails{detailsIf<DerivedTypeDetails>()}) {
if (!scope) {
CHECK(scope_);
scope = scope_;
}
return dtDetails->GetParentComponent(DEREF(scope));
@ -562,6 +567,112 @@ const Symbol *Symbol::GetParentComponent(const Scope *scope) const {
}
}
// Utility routine for InstantiateComponent(): applies type
// parameter values to an intrinsic type spec.
static const DeclTypeSpec &InstantiateIntrinsicType(Scope &scope,
const DeclTypeSpec &spec, SemanticsContext &semanticsContext) {
const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())};
if (evaluate::ToInt64(intrinsic.kind())) {
return spec; // KIND is already a known constant
}
// The expression was not originally constant, but now it must be so
// in the context of a parameterized derived type instantiation.
KindExpr copy{intrinsic.kind()};
evaluate::FoldingContext &foldingContext{semanticsContext.foldingContext()};
copy = evaluate::Fold(foldingContext, std::move(copy));
int kind{semanticsContext.GetDefaultKind(intrinsic.category())};
if (auto value{evaluate::ToInt64(copy)}) {
if (evaluate::IsValidKindOfIntrinsicType(intrinsic.category(), *value)) {
kind = *value;
} else {
foldingContext.messages().Say(
"KIND parameter value (%jd) of intrinsic type %s "
"did not resolve to a supported value"_err_en_US,
static_cast<std::intmax_t>(*value),
parser::ToUpperCaseLetters(
common::EnumToString(intrinsic.category())));
}
}
switch (spec.category()) {
case DeclTypeSpec::Numeric:
return scope.MakeNumericType(intrinsic.category(), KindExpr{kind});
case DeclTypeSpec::Logical: //
return scope.MakeLogicalType(KindExpr{kind});
case DeclTypeSpec::Character:
return scope.MakeCharacterType(
ParamValue{spec.characterTypeSpec().length()}, KindExpr{kind});
default: CRASH_NO_CASE;
}
}
Symbol &Symbol::InstantiateComponent(
Scope &scope, SemanticsContext &context) const {
auto &foldingContext{context.foldingContext()};
auto pair{scope.try_emplace(name(), attrs())};
Symbol &result{*pair.first->second};
if (!pair.second) {
// Symbol was already present in the scope, which can only happen
// in the case of type parameters.
CHECK(has<TypeParamDetails>());
return result;
}
result.attrs() = attrs();
result.flags() = flags();
result.set_details(common::Clone(details()));
if (auto *details{result.detailsIf<ObjectEntityDetails>()}) {
if (DeclTypeSpec * origType{result.GetType()}) {
if (const DerivedTypeSpec * derived{origType->AsDerived()}) {
DerivedTypeSpec newSpec{*derived};
newSpec.CookParameters(foldingContext); // enables AddParamValue()
if (test(Symbol::Flag::ParentComp)) {
// Forward any explicit type parameter values from the
// derived type spec under instantiation that define type parameters
// of the parent component to the derived type spec of the
// parent component.
const DerivedTypeSpec &instanceSpec{
DEREF(foldingContext.pdtInstance())};
for (const auto &[name, value] : instanceSpec.parameters()) {
if (scope.find(name) == scope.end()) {
newSpec.AddParamValue(name, ParamValue{value});
}
}
}
details->ReplaceType(FindOrInstantiateDerivedType(
scope, std::move(newSpec), context, origType->category()));
} else if (origType->AsIntrinsic()) {
details->ReplaceType(
InstantiateIntrinsicType(scope, *origType, context));
} else if (origType->category() != DeclTypeSpec::ClassStar) {
DIE("instantiated component has type that is "
"neither intrinsic, derived, nor CLASS(*)");
}
}
details->set_init(
evaluate::Fold(foldingContext, std::move(details->init())));
for (ShapeSpec &dim : details->shape()) {
if (dim.lbound().isExplicit()) {
dim.lbound().SetExplicit(
Fold(foldingContext, std::move(dim.lbound().GetExplicit())));
}
if (dim.ubound().isExplicit()) {
dim.ubound().SetExplicit(
Fold(foldingContext, std::move(dim.ubound().GetExplicit())));
}
}
for (ShapeSpec &dim : details->coshape()) {
if (dim.lbound().isExplicit()) {
dim.lbound().SetExplicit(
Fold(foldingContext, std::move(dim.lbound().GetExplicit())));
}
if (dim.ubound().isExplicit()) {
dim.ubound().SetExplicit(
Fold(foldingContext, std::move(dim.ubound().GetExplicit())));
}
}
}
return result;
}
void DerivedTypeDetails::add_component(const Symbol &symbol) {
if (symbol.test(Symbol::Flag::ParentComp)) {
CHECK(componentNames_.empty());

6
flang/lib/semantics/symbol.h
View File

@ -228,10 +228,12 @@ public:
const std::list<SourceName> &paramNames() const { return paramNames_; }
const SymbolVector &paramDecls() const { return paramDecls_; }
bool sequence() const { return sequence_; }
bool isForwardReferenced() const { return isForwardReferenced_; }
void add_paramName(const SourceName &name) { paramNames_.push_back(name); }
void add_paramDecl(const Symbol &symbol) { paramDecls_.push_back(symbol); }
void add_component(const Symbol &);
void set_sequence(bool x = true) { sequence_ = x; }
void set_isForwardReferenced() { isForwardReferenced_ = true; }
const std::list<SourceName> &componentNames() const {
return componentNames_;
}
@ -258,6 +260,7 @@ private:
// order. A parent component, if any, appears first in this list.
std::list<SourceName> componentNames_;
bool sequence_{false};
bool isForwardReferenced_{false};
friend std::ostream &operator<<(std::ostream &, const DerivedTypeDetails &);
};
@ -642,6 +645,9 @@ public:
// for a parameterized derived type instantiation with the instance's scope.
const DerivedTypeSpec *GetParentTypeSpec(const Scope * = nullptr) const;
// Clones the Symbol into a parameterized derived type instance.
Symbol &InstantiateComponent(Scope &, SemanticsContext &) const;
private:
const Scope *owner_;
SourceName name_;

241
flang/lib/semantics/tools.cc
View File

@ -885,57 +885,6 @@ bool IsPolymorphicAllocatable(const Symbol &symbol) {
return IsAllocatable(symbol) && IsPolymorphic(symbol);
}
static const DeclTypeSpec &InstantiateIntrinsicType(Scope &scope,
const DeclTypeSpec &spec, SemanticsContext &semanticsContext) {
const IntrinsicTypeSpec *intrinsic{spec.AsIntrinsic()};
CHECK(intrinsic);
if (evaluate::ToInt64(intrinsic->kind())) {
return spec; // KIND is already a known constant
}
// The expression was not originally constant, but now it must be so
// in the context of a parameterized derived type instantiation.
KindExpr copy{intrinsic->kind()};
evaluate::FoldingContext &foldingContext{semanticsContext.foldingContext()};
copy = evaluate::Fold(foldingContext, std::move(copy));
int kind{semanticsContext.GetDefaultKind(intrinsic->category())};
if (auto value{evaluate::ToInt64(copy)}) {
if (evaluate::IsValidKindOfIntrinsicType(intrinsic->category(), *value)) {
kind = *value;
} else {
foldingContext.messages().Say(
"KIND parameter value (%jd) of intrinsic type %s "
"did not resolve to a supported value"_err_en_US,
static_cast<std::intmax_t>(*value),
parser::ToUpperCaseLetters(
common::EnumToString(intrinsic->category())));
}
}
switch (spec.category()) {
case DeclTypeSpec::Numeric:
return scope.MakeNumericType(intrinsic->category(), KindExpr{kind});
case DeclTypeSpec::Logical: //
return scope.MakeLogicalType(KindExpr{kind});
case DeclTypeSpec::Character:
return scope.MakeCharacterType(
ParamValue{spec.characterTypeSpec().length()}, KindExpr{kind});
default: CRASH_NO_CASE;
}
}
static const DeclTypeSpec *FindInstantiatedDerivedType(const Scope &scope,
const DerivedTypeSpec &spec, DeclTypeSpec::Category category) {
DeclTypeSpec type{category, spec};
if (const auto *found{scope.FindType(type)}) {
return found;
} else if (scope.IsGlobal()) {
return nullptr;
} else {
return FindInstantiatedDerivedType(scope.parent(), spec, category);
}
}
static Symbol &InstantiateSymbol(const Symbol &, Scope &, SemanticsContext &);
std::list<SourceName> OrderParameterNames(const Symbol &typeSymbol) {
std::list<SourceName> result;
if (const DerivedTypeSpec * spec{typeSymbol.GetParentTypeSpec()}) {
@ -956,204 +905,22 @@ SymbolVector OrderParameterDeclarations(const Symbol &typeSymbol) {
return result;
}
void InstantiateDerivedType(DerivedTypeSpec &spec, Scope &containingScope,
SemanticsContext &semanticsContext) {
Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)};
newScope.set_derivedTypeSpec(spec);
spec.ReplaceScope(newScope);
const Symbol &typeSymbol{spec.typeSymbol()};
const Scope *typeScope{typeSymbol.scope()};
CHECK(typeScope);
for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol)) {
const SourceName &name{symbol.name()};
if (typeScope->find(symbol.name()) != typeScope->end()) {
// This type parameter belongs to the derived type itself, not to
// one of its parents. Put the type parameter expression value
// into the new scope as the initialization value for the parameter.
if (ParamValue * paramValue{spec.FindParameter(name)}) {
const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
paramValue->set_attr(details.attr());
if (MaybeIntExpr expr{paramValue->GetExplicit()}) {
// Ensure that any kind type parameters with values are
// constant by now.
if (details.attr() == common::TypeParamAttr::Kind) {
// Any errors in rank and type will have already elicited
// messages, so don't pile on by complaining further here.
if (auto maybeDynamicType{expr->GetType()}) {
if (expr->Rank() == 0 &&
maybeDynamicType->category() == TypeCategory::Integer) {
if (!evaluate::ToInt64(*expr)) {
std::stringstream fortran;
fortran << *expr;
if (auto *msg{
semanticsContext.foldingContext().messages().Say(
"Value of kind type parameter '%s' (%s) is not "
"a scalar INTEGER constant"_err_en_US,
name, fortran.str())}) {
msg->Attach(name, "declared here"_en_US);
}
}
}
}
}
TypeParamDetails instanceDetails{details.attr()};
if (const DeclTypeSpec * type{details.type()}) {
instanceDetails.set_type(*type);
}
instanceDetails.set_init(std::move(*expr));
newScope.try_emplace(name, std::move(instanceDetails));
}
}
}
}
// Instantiate every non-parameter symbol from the original derived
// type's scope into the new instance.
auto restorer{semanticsContext.foldingContext().WithPDTInstance(spec)};
newScope.AddSourceRange(typeScope->sourceRange());
for (const auto &pair : *typeScope) {
const Symbol &symbol{*pair.second};
InstantiateSymbol(symbol, newScope, semanticsContext);
}
}
void ProcessParameterExpressions(
DerivedTypeSpec &spec, evaluate::FoldingContext &foldingContext) {
auto paramDecls{OrderParameterDeclarations(spec.typeSymbol())};
// Fold the explicit type parameter value expressions first. Do not
// fold them within the scope of the derived type being instantiated;
// these expressions cannot use its type parameters. Convert the values
// of the expressions to the declared types of the type parameters.
for (const Symbol &symbol : paramDecls) {
const SourceName &name{symbol.name()};
if (ParamValue * paramValue{spec.FindParameter(name)}) {
if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) {
if (auto converted{evaluate::ConvertToType(symbol, SomeExpr{*expr})}) {
SomeExpr folded{
evaluate::Fold(foldingContext, std::move(*converted))};
if (auto *intExpr{std::get_if<SomeIntExpr>(&folded.u)}) {
paramValue->SetExplicit(std::move(*intExpr));
continue;
}
}
std::stringstream fortran;
fortran << *expr;
if (auto *msg{foldingContext.messages().Say(
"Value of type parameter '%s' (%s) is not "
"convertible to its type"_err_en_US,
name, fortran.str())}) {
msg->Attach(name, "declared here"_en_US);
}
}
}
}
// Type parameter default value expressions are folded in declaration order
// within the scope of the derived type so that the values of earlier type
// parameters are available for use in the default initialization
// expressions of later parameters.
auto restorer{foldingContext.WithPDTInstance(spec)};
for (const Symbol &symbol : paramDecls) {
const SourceName &name{symbol.name()};
const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
MaybeIntExpr expr;
ParamValue *paramValue{spec.FindParameter(name)};
if (!paramValue) {
expr = evaluate::Fold(foldingContext, common::Clone(details.init()));
} else if (paramValue->isExplicit()) {
expr = paramValue->GetExplicit();
}
if (expr) {
if (paramValue) {
paramValue->SetExplicit(std::move(*expr));
} else {
spec.AddParamValue(
symbol.name(), ParamValue{std::move(*expr), details.attr()});
}
}
}
}
const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope,
DerivedTypeSpec &&spec, SemanticsContext &semanticsContext,
DeclTypeSpec::Category category) {
ProcessParameterExpressions(spec, semanticsContext.foldingContext());
spec.CookParameters(semanticsContext.foldingContext());
spec.EvaluateParameters(semanticsContext.foldingContext());
if (const DeclTypeSpec *
type{FindInstantiatedDerivedType(scope, spec, category)}) {
type{scope.FindInstantiatedDerivedType(spec, category)}) {
return *type;
}
// Create a new instantiation of this parameterized derived type
// for this particular distinct set of actual parameter values.
DeclTypeSpec &type{scope.MakeDerivedType(category, std::move(spec))};
InstantiateDerivedType(type.derivedTypeSpec(), scope, semanticsContext);
type.derivedTypeSpec().Instantiate(scope, semanticsContext);
return type;
}
// Clone a Symbol in the context of a parameterized derived type instance
static Symbol &InstantiateSymbol(
const Symbol &symbol, Scope &scope, SemanticsContext &semanticsContext) {
evaluate::FoldingContext foldingContext{semanticsContext.foldingContext()};
const DerivedTypeSpec &instanceSpec{DEREF(foldingContext.pdtInstance())};
auto pair{scope.try_emplace(symbol.name(), symbol.attrs())};
Symbol &result{*pair.first->second};
if (!pair.second) {
// Symbol was already present in the scope, which can only happen
// in the case of type parameters.
CHECK(symbol.has<TypeParamDetails>());
return result;
}
result.attrs() = symbol.attrs();
result.flags() = symbol.flags();
result.set_details(common::Clone(symbol.details()));
if (auto *details{result.detailsIf<ObjectEntityDetails>()}) {
if (DeclTypeSpec * origType{result.GetType()}) {
if (const DerivedTypeSpec * derived{origType->AsDerived()}) {
DerivedTypeSpec newSpec{*derived};
if (symbol.test(Symbol::Flag::ParentComp)) {
// Forward any explicit type parameter values from the
// derived type spec under instantiation to its parent
// component derived type spec that define type parameters
// of the parent component.
for (const auto &pair : instanceSpec.parameters()) {
if (scope.find(pair.first) == scope.end()) {
newSpec.AddParamValue(pair.first, ParamValue{pair.second});
}
}
}
details->ReplaceType(FindOrInstantiateDerivedType(
scope, std::move(newSpec), semanticsContext, origType->category()));
} else if (origType->AsIntrinsic()) {
details->ReplaceType(
InstantiateIntrinsicType(scope, *origType, semanticsContext));
} else if (origType->category() != DeclTypeSpec::ClassStar) {
DIE("instantiated component has type that is "
"neither intrinsic, derived, nor CLASS(*)");
}
}
details->set_init(
evaluate::Fold(foldingContext, std::move(details->init())));
for (ShapeSpec &dim : details->shape()) {
if (dim.lbound().isExplicit()) {
dim.lbound().SetExplicit(
Fold(foldingContext, std::move(dim.lbound().GetExplicit())));
}
if (dim.ubound().isExplicit()) {
dim.ubound().SetExplicit(
Fold(foldingContext, std::move(dim.ubound().GetExplicit())));
}
}
for (ShapeSpec &dim : details->coshape()) {
if (dim.lbound().isExplicit()) {
dim.lbound().SetExplicit(
Fold(foldingContext, std::move(dim.lbound().GetExplicit())));
}
if (dim.ubound().isExplicit()) {
dim.ubound().SetExplicit(
Fold(foldingContext, std::move(dim.ubound().GetExplicit())));
}
}
}
return result;
}
// ComponentIterator implementation
template<ComponentKind componentKind>

4
flang/lib/semantics/tools.h
View File

@ -188,13 +188,9 @@ SymbolVector OrderParameterDeclarations(const Symbol &);
// order defined by 7.5.3.2.
std::list<SourceName> OrderParameterNames(const Symbol &);
// Create a new instantiation of this parameterized derived type
// for this particular distinct set of actual parameter values.
void InstantiateDerivedType(DerivedTypeSpec &, Scope &, SemanticsContext &);
// Return an existing or new derived type instance
const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &, DerivedTypeSpec &&,
SemanticsContext &, DeclTypeSpec::Category = DeclTypeSpec::TypeDerived);
void ProcessParameterExpressions(DerivedTypeSpec &, evaluate::FoldingContext &);
// Determines whether an object might be visible outside a
// PURE function (C1594); returns a non-null Symbol pointer for

239
flang/lib/semantics/type.cc
View File

@ -15,6 +15,7 @@
#include "type.h"
#include "scope.h"
#include "symbol.h"
#include "tools.h"
#include "../evaluate/fold.h"
#include "../parser/characters.h"
#include <ostream>
@ -38,11 +39,142 @@ void DerivedTypeSpec::ReplaceScope(const Scope &scope) {
scope_ = &scope;
}
ParamValue &DerivedTypeSpec::AddParamValue(
SourceName name, ParamValue &&value) {
void DerivedTypeSpec::AddRawParamValue(
const std::optional<parser::Keyword> &keyword, ParamValue &&value) {
CHECK(parameters_.empty());
rawParameters_.emplace_back(keyword ? &*keyword : nullptr, std::move(value));
}
void DerivedTypeSpec::CookParameters(evaluate::FoldingContext &foldingContext) {
if (cooked_) {
return;
}
cooked_ = true;
auto &messages{foldingContext.messages()};
if (IsForwardReferenced()) {
messages.Say(typeSymbol_.name(),
"Derived type '%s' was used but never defined"_err_en_US,
typeSymbol_.name());
return;
}
// Parameters of the most deeply nested "base class" come first when the
// derived type is an extension.
auto parameterNames{OrderParameterNames(typeSymbol_)};
auto parameterDecls{OrderParameterDeclarations(typeSymbol_)};
auto nextNameIter{parameterNames.begin()};
RawParameters raw{std::move(rawParameters_)};
for (auto &[maybeKeyword, value] : raw) {
SourceName name;
common::TypeParamAttr attr{common::TypeParamAttr::Kind};
if (maybeKeyword) {
name = maybeKeyword->v.source;
auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
[&](const Symbol &symbol) { return symbol.name() == name; })};
if (it == parameterDecls.end()) {
messages.Say(name,
"'%s' is not the name of a parameter for derived type '%s'"_err_en_US,
name, typeSymbol_.name());
} else {
// Resolve the keyword's symbol
maybeKeyword->v.symbol = const_cast<Symbol *>(&it->get());
attr = it->get().get<TypeParamDetails>().attr();
}
} else if (nextNameIter != parameterNames.end()) {
name = *nextNameIter++;
auto it{std::find_if(parameterDecls.begin(), parameterDecls.end(),
[&](const Symbol &symbol) { return symbol.name() == name; })};
CHECK(it != parameterDecls.end());
attr = it->get().get<TypeParamDetails>().attr();
} else {
messages.Say(name_,
"Too many type parameters given for derived type '%s'"_err_en_US,
typeSymbol_.name());
break;
}
if (FindParameter(name)) {
messages.Say(name_,
"Multiple values given for type parameter '%s'"_err_en_US, name);
} else {
value.set_attr(attr);
AddParamValue(name, std::move(value));
}
}
}
void DerivedTypeSpec::EvaluateParameters(
evaluate::FoldingContext &foldingContext) {
CookParameters(foldingContext);
if (evaluated_) {
return;
}
evaluated_ = true;
auto &messages{foldingContext.messages()};
// Fold the explicit type parameter value expressions first. Do not
// fold them within the scope of the derived type being instantiated;
// these expressions cannot use its type parameters. Convert the values
// of the expressions to the declared types of the type parameters.
auto parameterDecls{OrderParameterDeclarations(typeSymbol_)};
for (const Symbol &symbol : parameterDecls) {
const SourceName &name{symbol.name()};
if (ParamValue * paramValue{FindParameter(name)}) {
if (const MaybeIntExpr & expr{paramValue->GetExplicit()}) {
if (auto converted{evaluate::ConvertToType(symbol, SomeExpr{*expr})}) {
SomeExpr folded{
evaluate::Fold(foldingContext, std::move(*converted))};
if (auto *intExpr{std::get_if<SomeIntExpr>(&folded.u)}) {
paramValue->SetExplicit(std::move(*intExpr));
continue;
}
}
std::stringstream fortran;
expr->AsFortran(fortran);
evaluate::SayWithDeclaration(messages, symbol,
"Value of type parameter '%s' (%s) is not convertible to its type"_err_en_US,
name, fortran.str());
}
}
}
// Default initialization expressions for the derived type's parameters
// may reference other parameters so long as the declaration precedes the
// use in the expression (10.1.12). This is not necessarily the same
// order as "type parameter order" (7.5.3.2).
// Type parameter default value expressions are folded in declaration order
// within the scope of the derived type so that the values of earlier type
// parameters are available for use in the default initialization
// expressions of later parameters.
auto restorer{foldingContext.WithPDTInstance(*this)};
for (const Symbol &symbol : parameterDecls) {
const SourceName &name{symbol.name()};
if (!FindParameter(name)) {
const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
if (details.init()) {
auto expr{
evaluate::Fold(foldingContext, common::Clone(details.init()))};
AddParamValue(name, ParamValue{std::move(*expr), details.attr()});
} else {
messages.Say(name_,
"Type parameter '%s' lacks a value and has no default"_err_en_US,
name);
}
}
}
}
void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) {
CHECK(cooked_);
auto pair{parameters_.insert(std::make_pair(name, std::move(value)))};
CHECK(pair.second); // name was not already present
return pair.first->second;
}
bool DerivedTypeSpec::MightBeParameterized() const {
return !cooked_ || !parameters_.empty();
}
bool DerivedTypeSpec::IsForwardReferenced() const {
return typeSymbol_.get<DerivedTypeDetails>().isForwardReferenced();
}
ParamValue *DerivedTypeSpec::FindParameter(SourceName target) {
@ -50,10 +182,109 @@ ParamValue *DerivedTypeSpec::FindParameter(SourceName target) {
const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
}
void DerivedTypeSpec::Instantiate(
Scope &containingScope, SemanticsContext &context) {
if (instantiated_) {
return;
}
instantiated_ = true;
auto &foldingContext{context.foldingContext()};
if (IsForwardReferenced()) {
foldingContext.messages().Say(typeSymbol_.name(),
"The derived type '%s' was forward-referenced but not defined"_err_en_US,
typeSymbol_.name());
return;
}
CookParameters(foldingContext);
EvaluateParameters(foldingContext);
const Scope &typeScope{DEREF(typeSymbol_.scope())};
if (!MightBeParameterized()) {
scope_ = &typeScope;
for (const auto &pair : typeScope) {
const Symbol &symbol{*pair.second};
if (const DeclTypeSpec * type{symbol.GetType()}) {
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
instantiatable.Instantiate(containingScope, context);
}
}
}
return;
}
Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)};
newScope.set_derivedTypeSpec(*this);
ReplaceScope(newScope);
for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) {
const SourceName &name{symbol.name()};
if (typeScope.find(symbol.name()) != typeScope.end()) {
// This type parameter belongs to the derived type itself, not to
// one of its ancestors. Put the type parameter expression value
// into the new scope as the initialization value for the parameter.
if (ParamValue * paramValue{FindParameter(name)}) {
const TypeParamDetails &details{symbol.get<TypeParamDetails>()};
paramValue->set_attr(details.attr());
if (MaybeIntExpr expr{paramValue->GetExplicit()}) {
// Ensure that any kind type parameters with values are
// constant by now.
if (details.attr() == common::TypeParamAttr::Kind) {
// Any errors in rank and type will have already elicited
// messages, so don't pile on by complaining further here.
if (auto maybeDynamicType{expr->GetType()}) {
if (expr->Rank() == 0 &&
maybeDynamicType->category() == TypeCategory::Integer) {
if (!evaluate::ToInt64(*expr)) {
std::stringstream fortran;
fortran << *expr;
if (auto *msg{foldingContext.messages().Say(
"Value of kind type parameter '%s' (%s) is not "
"a scalar INTEGER constant"_err_en_US,
name, fortran.str())}) {
msg->Attach(name, "declared here"_en_US);
}
}
}
}
}
TypeParamDetails instanceDetails{details.attr()};
if (const DeclTypeSpec * type{details.type()}) {
instanceDetails.set_type(*type);
}
instanceDetails.set_init(std::move(*expr));
newScope.try_emplace(name, std::move(instanceDetails));
}
}
}
}
// Instantiate every non-parameter symbol from the original derived
// type's scope into the new instance.
auto restorer{foldingContext.WithPDTInstance(*this)};
newScope.AddSourceRange(typeScope.sourceRange());
for (const auto &pair : typeScope) {
const Symbol &symbol{*pair.second};
symbol.InstantiateComponent(newScope, context);
}
}
std::string DerivedTypeSpec::AsFortran() const {
std::stringstream ss;
ss << name_;
if (!parameters_.empty()) {
if (!rawParameters_.empty()) {
CHECK(parameters_.empty());
ss << '(';
bool first = true;
for (const auto &[maybeKeyword, value] : rawParameters_) {
if (first) {
first = false;
} else {
ss << ',';
}
if (maybeKeyword) {
ss << maybeKeyword->v.source.ToString() << '=';
}
ss << value.AsFortran();
}
ss << ')';
} else if (!parameters_.empty()) {
ss << '(';
bool first = true;
for (const auto &[name, value] : parameters_) {

35
flang/lib/semantics/type.h
View File

@ -27,9 +27,14 @@
#include <variant>
#include <vector>
namespace Fortran::parser {
struct Keyword;
}
namespace Fortran::semantics {
class Scope;
class SemanticsContext;
class Symbol;
/// A SourceName is a name in the cooked character stream,
@ -231,6 +236,8 @@ std::ostream &operator<<(std::ostream &, const ArraySpec &);
// The name may not match the symbol's name in case of a USE rename.
class DerivedTypeSpec {
public:
using RawParameter = std::pair<const parser::Keyword *, ParamValue>;
using RawParameters = std::vector<RawParameter>;
using ParameterMapType = std::map<SourceName, ParamValue>;
explicit DerivedTypeSpec(SourceName, const Symbol &);
DerivedTypeSpec(const DerivedTypeSpec &);
@ -241,9 +248,27 @@ public:
const Scope *scope() const { return scope_; }
void set_scope(const Scope &);
void ReplaceScope(const Scope &);
RawParameters &rawParameters() { return rawParameters_; }
const ParameterMapType &parameters() const { return parameters_; }
ParamValue &AddParamValue(SourceName, ParamValue &&);
bool MightBeParameterized() const;
bool IsForwardReferenced() const;
// The "raw" type parameter list is a simple transcription from the
// parameter list in the parse tree, built by calling AddRawParamValue().
// It can be used with forward-referenced derived types.
void AddRawParamValue(const std::optional<parser::Keyword> &, ParamValue &&);
// Checks the raw parameter list against the definition of a derived type.
// Converts the raw parameter list to a map, naming each actual parameter.
void CookParameters(evaluate::FoldingContext &);
// Evaluates type parameter expressions.
void EvaluateParameters(evaluate::FoldingContext &);
void AddParamValue(SourceName, ParamValue &&);
// Creates a Scope for the type and populates it with component
// instantiations that have been specialized with actual type parameter
// values, which are cooked &/or evaluated if necessary.
void Instantiate(Scope &, SemanticsContext &);
ParamValue *FindParameter(SourceName);
const ParamValue *FindParameter(SourceName target) const {
auto iter{parameters_.find(target)};
@ -254,7 +279,9 @@ public:
}
}
bool operator==(const DerivedTypeSpec &that) const {
return &typeSymbol_ == &that.typeSymbol_ && parameters_ == that.parameters_;
return &typeSymbol_ == &that.typeSymbol_ && cooked_ == that.cooked_ &&
parameters_ == that.parameters_ &&
rawParameters_ == that.rawParameters_;
}
std::string AsFortran() const;
@ -262,6 +289,10 @@ private:
SourceName name_;
const Symbol &typeSymbol_;
const Scope *scope_{nullptr}; // same as typeSymbol_.scope() unless PDT
bool cooked_{false};
bool evaluated_{false};
bool instantiated_{false};
RawParameters rawParameters_;
ParameterMapType parameters_;
friend std::ostream &operator<<(std::ostream &, const DerivedTypeSpec &);
};

2
flang/test/semantics/CMakeLists.txt
View File

@ -195,6 +195,7 @@ set(ERROR_TESTS
misc-declarations.f90
separate-module-procs.f90
bindings01.f90
bad-forward-type.f90
)
# These test files have expected symbols in the source
@ -214,6 +215,7 @@ set(SYMBOL_TESTS
symbol14.f90
symbol15.f90
symbol16.f90
symbol17.f90
omp-symbol01.f90
omp-symbol02.f90
omp-symbol03.f90

83
flang/test/semantics/bad-forward-type.f90 Normal file
View File

@ -0,0 +1,83 @@
! 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.
! Forward references to derived types (error cases)
!ERROR: The derived type 'undef' was forward-referenced but not defined
type(undef) function f1()
call sub(f1)
end function
!ERROR: The derived type 'undef' was forward-referenced but not defined
type(undef) function f2() result(r)
call sub(r)
end function
!ERROR: The derived type 'undefpdt' was forward-referenced but not defined
type(undefpdt(1)) function f3()
call sub(f3)
end function
!ERROR: The derived type 'undefpdt' was forward-referenced but not defined
type(undefpdt(1)) function f4() result(r)
call sub(f4)
end function
!ERROR: 'bad' is not the name of a parameter for derived type 'pdt'
type(pdt(bad=1)) function f5()
type :: pdt(good)
integer, kind :: good = kind(0)
integer(kind=good) :: n
end type
end function
subroutine s1(q1)
!ERROR: The derived type 'undef' was forward-referenced but not defined
implicit type(undef)(q)
end subroutine
subroutine s2(q1)
!ERROR: The derived type 'undefpdt' was forward-referenced but not defined
implicit type(undefpdt(1))(q)
end subroutine
subroutine s3
type :: t1
!ERROR: Derived type 'undef' not found
type(undef) :: x
end type
end subroutine
subroutine s4
type :: t1
!ERROR: Derived type 'undefpdt' not found
type(undefpdt(1)) :: x
end type
end subroutine
subroutine s5(x)
!ERROR: Derived type 'undef' not found
type(undef) :: x
end subroutine
subroutine s6(x)
!ERROR: Derived type 'undefpdt' not found
type(undefpdt(1)) :: x
end subroutine
subroutine s7(x)
!ERROR: Derived type 'undef' not found
type, extends(undef) :: t
end type
end subroutine

122
flang/test/semantics/symbol17.f90 Normal file
View File

@ -0,0 +1,122 @@
! 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.
! Forward references to derived types (non-error cases)
!DEF: /main MainProgram
program main
!DEF: /main/t1 DerivedType
type :: t1
!DEF: /main/t2 DerivedType
!DEF: /main/t1/t1a ALLOCATABLE ObjectEntity TYPE(t2)
type(t2), allocatable :: t1a
!REF: /main/t2
!DEF: /main/t1/t1p POINTER ObjectEntity TYPE(t2)
type(t2), pointer :: t1p
end type
!REF: /main/t2
type :: t2
!REF: /main/t2
!DEF: /main/t2/t2a ALLOCATABLE ObjectEntity TYPE(t2)
type(t2), allocatable :: t2a
!REF: /main/t2
!DEF: /main/t2/t2p POINTER ObjectEntity TYPE(t2)
type(t2), pointer :: t2p
end type
!REF: /main/t1
!DEF: /main/t1x ObjectEntity TYPE(t1)
type(t1) :: t1x
!REF: /main/t1x
!REF: /main/t1/t1a
allocate(t1x%t1a)
!REF: /main/t1x
!REF: /main/t1/t1p
!REF: /main/t1/t1a
t1x%t1p => t1x%t1a
!REF: /main/t1x
!REF: /main/t1/t1a
!REF: /main/t2/t2a
allocate(t1x%t1a%t2a)
!REF: /main/t1x
!REF: /main/t1/t1a
!REF: /main/t2/t2p
!REF: /main/t2/t2a
t1x%t1a%t2p => t1x%t1a%t2a
end program
!DEF: /f1/fwd DerivedType
!DEF: /f1 (Function) Subprogram TYPE(fwd)
!DEF: /f1/n (Implicit) ObjectEntity INTEGER(4)
type(fwd) function f1(n)
!REF: /f1/fwd
type :: fwd
!DEF: /f1/fwd/n ObjectEntity INTEGER(4)
integer :: n
end type
!DEF: /f1/f1 ObjectEntity TYPE(fwd)
!REF: /f1/fwd/n
!REF: /f1/n
f1%n = n
end function
!DEF: /s1 (Subroutine) Subprogram
!DEF: /s1/q1 (Implicit) ObjectEntity TYPE(fwd)
subroutine s1 (q1)
!DEF: /s1/fwd DerivedType
implicit type(fwd)(q)
!REF: /s1/fwd
type :: fwd
!DEF: /s1/fwd/n ObjectEntity INTEGER(4)
integer :: n
end type
!REF: /s1/q1
!REF: /s1/fwd/n
q1%n = 1
end subroutine
!DEF: /f2/fwdpdt DerivedType
!DEF: /f2/kind INTRINSIC (Function) ProcEntity
!DEF: /f2 (Function) Subprogram TYPE(fwdpdt(k=4_4))
!DEF: /f2/n (Implicit) ObjectEntity INTEGER(4)
type(fwdpdt(kind(0))) function f2(n)
!REF: /f2/fwdpdt
!DEF: /f2/fwdpdt/k TypeParam INTEGER(4)
type :: fwdpdt(k)
!REF: /f2/fwdpdt/k
integer, kind :: k
!REF: /f2/fwdpdt/k
!DEF: /f2/fwdpdt/n ObjectEntity INTEGER(int(k,kind=8))
integer(kind=k) :: n
end type
!DEF: /f2/f2 ObjectEntity TYPE(fwdpdt(k=4_4))
!DEF: /f2/DerivedType2/n ObjectEntity INTEGER(4)
!REF: /f2/n
f2%n = n
end function
!DEF: /s2 (Subroutine) Subprogram
!DEF: /s2/q1 (Implicit) ObjectEntity TYPE(fwdpdt(k=4_4))
subroutine s2 (q1)
!DEF: /s2/fwdpdt DerivedType
!DEF: /s2/kind INTRINSIC (Function) ProcEntity
implicit type(fwdpdt(kind(0)))(q)
!REF: /s2/fwdpdt
!DEF: /s2/fwdpdt/k TypeParam INTEGER(4)
type :: fwdpdt(k)
!REF: /s2/fwdpdt/k
integer, kind :: k
!REF: /s2/fwdpdt/k
!DEF: /s2/fwdpdt/n ObjectEntity INTEGER(int(k,kind=8))
integer(kind=k) :: n
end type
!REF: /s2/q1
!DEF: /s2/DerivedType2/n ObjectEntity INTEGER(4)
q1%n = 1
end subroutine