static void PutEntity(std::ostream &, const Symbol &);
static void PutObjectEntity(std::ostream &, const Symbol &);
static void PutProcEntity(std::ostream &, const Symbol &);
+static void PutTypeParam(std::ostream &, const Symbol &);
static void PutEntity(std::ostream &, const Symbol &, std::function<void()>);
static std::ostream &PutAttrs(
std::ostream &, Attrs, std::string before = ","s, std::string after = ""s);
void ModFileWriter::PutDerivedType(const Symbol &typeSymbol) {
PutAttrs(decls_ << "type", typeSymbol.attrs(), ","s, ""s);
- PutLower(decls_ << "::", typeSymbol) << '\n';
- PutSymbols(*typeSymbol.scope());
+ PutLower(decls_ << "::", typeSymbol);
+ auto &typeScope{*typeSymbol.scope()};
+ if (typeSymbol.get<DerivedTypeDetails>().hasTypeParams()) {
+ bool first{true};
+ decls_ << '(';
+ for (const auto *symbol : SortSymbols(CollectSymbols(typeScope))) {
+ if (symbol->has<TypeParamDetails>()) {
+ PutLower(first ? decls_ : decls_ << ',', *symbol);
+ first = false;
+ }
+ }
+ decls_ << ')';
+ }
+ decls_ << '\n';
+ PutSymbols(typeScope);
decls_ << "end type\n";
}
[&](const EntityDetails &) { PutObjectEntity(os, symbol); },
[&](const ObjectEntityDetails &) { PutObjectEntity(os, symbol); },
[&](const ProcEntityDetails &) { PutProcEntity(os, symbol); },
+ [&](const TypeParamDetails &) { PutTypeParam(os, symbol); },
[&](const auto &) {
common::die("PutEntity: unexpected details: %s",
DetailsToString(symbol.details()).c_str());
});
}
+void PutTypeParam(std::ostream &os, const Symbol &symbol) {
+ PutEntity(os, symbol, [&]() {
+ auto *type{symbol.GetType()};
+ CHECK(type);
+ PutLower(os, *type);
+ PutLower(os << ',',
+ common::EnumToString(symbol.get<TypeParamDetails>().kindOrLen()));
+ });
+}
+
// Write an entity (object or procedure) declaration.
// writeType is called to write out the type.
void PutEntity(
void Post(const parser::DerivedTypeDef &x);
bool Pre(const parser::DerivedTypeStmt &x);
void Post(const parser::DerivedTypeStmt &x);
- bool Pre(const parser::EndTypeStmt &);
+ bool Pre(const parser::TypeParamDefStmt &x) { return BeginDecl(); }
+ void Post(const parser::TypeParamDefStmt &);
bool Pre(const parser::TypeAttrSpec::Extends &x);
bool Pre(const parser::PrivateStmt &x);
bool Pre(const parser::SequenceStmt &x);
const Symbol *ResolveDerivedType(const SourceName &);
bool CanBeTypeBoundProc(const Symbol &);
Symbol *FindExplicitInterface(const SourceName &);
- void MakeTypeSymbol(const SourceName &, const Details &);
+ Symbol &MakeTypeSymbol(const SourceName &, const Details &);
// Declare an object or procedure entity.
// T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
bool Pre(const parser::CommonBlockObject &);
void Post(const parser::CommonBlockObject &);
- bool Pre(const parser::TypeParamDefStmt &);
- void Post(const parser::TypeParamDefStmt &);
bool Pre(const parser::PrefixSpec &);
void Post(const parser::SpecificationPart &);
bool Pre(const parser::MainProgram &);
}
void DeclarationVisitor::Post(const parser::DerivedTypeDef &x) {
derivedTypeData_.reset();
+ std::set<SourceName> paramNames;
+ auto &scope{currScope()};
+ auto &stmt{std::get<parser::Statement<parser::DerivedTypeStmt>>(x.t)};
+ for (auto &name : std::get<std::list<parser::Name>>(stmt.statement.t)) {
+ auto ¶mName{name.source};
+ if (auto it{scope.find(paramName)}; it == scope.end()) {
+ Say(paramName,
+ "No definition found for type parameter '%s'"_err_en_US); // C742
+ } else {
+ auto *symbol{it->second};
+ if (!symbol->has<TypeParamDetails>()) {
+ Say2(paramName, "'%s' is not defined as a type parameter"_err_en_US,
+ symbol->name(),
+ "Definition of '%s'"_en_US); // C741
+ } else {
+ symbol->add_occurrence(paramName);
+ }
+ }
+ if (!paramNames.insert(paramName).second) {
+ Say(paramName,
+ "Duplicate type parameter name: '%s'"_err_en_US); // C731
+ }
+ }
+ scope.symbol()->get<DerivedTypeDetails>().set_hasTypeParams(
+ !paramNames.empty());
+ for (const auto &pair : currScope()) {
+ const auto *symbol{pair.second};
+ if (symbol->has<TypeParamDetails>() && !paramNames.count(symbol->name())) {
+ Say2(symbol->name(),
+ "'%s' is not a type parameter of this derived type"_err_en_US,
+ stmt.source, "Derived type statement"_en_US); // C742
+ }
+ }
+ PopScope();
}
bool DeclarationVisitor::Pre(const parser::DerivedTypeStmt &x) {
return BeginAttrs();
PushScope(Scope::Kind::DerivedType, &symbol);
EndAttrs();
}
-bool DeclarationVisitor::Pre(const parser::EndTypeStmt &) {
- PopScope();
- return false;
+void DeclarationVisitor::Post(const parser::TypeParamDefStmt &x) {
+ auto &type{GetDeclTypeSpec()};
+ auto kindOrLen{std::get<common::TypeParamKindOrLen>(x.t)};
+ for (auto &decl : std::get<std::list<parser::TypeParamDecl>>(x.t)) {
+ auto &name{std::get<parser::Name>(decl.t).source};
+ // TODO: initialization
+ // auto &init{
+ // std::get<std::optional<parser::ScalarIntConstantExpr>>(decl.t)};
+ auto &symbol{MakeTypeSymbol(name, TypeParamDetails{kindOrLen})};
+ SetType(name, symbol, *type);
+ }
+ EndDecl();
}
bool DeclarationVisitor::Pre(const parser::TypeAttrSpec::Extends &x) {
auto &name{x.v.source};
// Create a symbol for a type parameter, component, or procedure binding in
// the current derived type scope.
-void DeclarationVisitor::MakeTypeSymbol(
+Symbol &DeclarationVisitor::MakeTypeSymbol(
const SourceName &name, const Details &details) {
Scope &derivedType{currScope()};
CHECK(derivedType.kind() == Scope::Kind::DerivedType);
"Type parameter, component, or procedure binding '%s'"
" already defined in this type"_err_en_US,
it->second->name(), "Previous definition of '%s'"_en_US);
+ return *it->second;
} else {
- MakeSymbol(name, GetAttrs(), details);
+ return MakeSymbol(name, GetAttrs(), details);
}
}
// ResolveNamesVisitor implementation
-bool ResolveNamesVisitor::Pre(const parser::TypeParamDefStmt &x) {
- BeginDeclTypeSpec();
- return true;
-}
-void ResolveNamesVisitor::Post(const parser::TypeParamDefStmt &x) {
- EndDeclTypeSpec();
- // TODO: TypeParamDefStmt
-}
-
bool ResolveNamesVisitor::Pre(const parser::CommonBlockObject &x) {
BeginArraySpec();
return true;
[](const ProcBindingDetails &) { return "ProcBinding"; },
[](const GenericBindingDetails &) { return "GenericBinding"; },
[](const FinalProcDetails &) { return "FinalProc"; },
+ [](const TypeParamDetails &) { return "TypeParam"; },
[](const auto &) { return "unknown"; },
},
details);
return x.type().has_value() ? &x.type().value() : nullptr;
},
[](const ProcEntityDetails &x) { return x.interface().type(); },
+ [](const TypeParamDetails &x) {
+ return x.type().has_value() ? &x.type().value() : nullptr;
+ },
[](const auto &) {
return static_cast<const DeclTypeSpec *>(nullptr);
},
[&](EntityDetails &x) { x.set_type(type); },
[&](ObjectEntityDetails &x) { x.set_type(type); },
[&](ProcEntityDetails &x) { x.interface().set_type(type); },
+ [&](TypeParamDetails &x) { x.set_type(type); },
[](auto &) {},
},
details_);
},
[&](const GenericBindingDetails &) { /* TODO */ },
[&](const FinalProcDetails &) {},
+ [&](const TypeParamDetails &x) {
+ if (x.type()) {
+ os << ' ' << *x.type();
+ }
+ os << ' ' << common::EnumToString(x.kindOrLen());
+ },
},
details);
return os;
#include "type.h"
#include "../common/enum-set.h"
+#include "../common/fortran.h"
#include <functional>
#include <memory>
friend std::ostream &operator<<(std::ostream &, const ProcEntityDetails &);
};
-// A derived type
-class DerivedTypeDetails {};
+class DerivedTypeDetails {
+public:
+ bool hasTypeParams() const { return hasTypeParams_; }
+ void set_hasTypeParams(bool x = true) { hasTypeParams_ = x; }
+
+private:
+ bool hasTypeParams_{false};
+};
class ProcBindingDetails {
public:
class FinalProcDetails {};
+class TypeParamDetails {
+public:
+ TypeParamDetails(common::TypeParamKindOrLen kindOrLen)
+ : kindOrLen_{kindOrLen} {}
+ common::TypeParamKindOrLen kindOrLen() const { return kindOrLen_; }
+ const std::optional<DeclTypeSpec> &type() const { return type_; }
+ void set_type(const DeclTypeSpec &type) {
+ CHECK(!type_);
+ type_ = type;
+ }
+
+private:
+ common::TypeParamKindOrLen kindOrLen_;
+ std::optional<DeclTypeSpec> type_;
+};
+
// Record the USE of a symbol: location is where (USE statement or renaming);
// symbol is the USEd module.
class UseDetails {
SubprogramDetails, SubprogramNameDetails, EntityDetails,
ObjectEntityDetails, ProcEntityDetails, DerivedTypeDetails, UseDetails,
UseErrorDetails, GenericDetails, ProcBindingDetails, GenericBindingDetails,
- FinalProcDetails>;
+ FinalProcDetails, TypeParamDetails>;
std::ostream &operator<<(std::ostream &, const Details &);
std::string DetailsToString(const Details &);
resolve30.f90
resolve31.f90
resolve32.f90
+ resolve33.f90
)
# These test files have expected symbols in the source
modfile08.f90
modfile09-*.f90
modfile10.f90
+ modfile11.f90
)
foreach(test ${ERROR_TESTS})
--- /dev/null
+! Copyright (c) 2018, 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.
+
+module m
+ type t(a, b, c)
+ integer, kind :: a
+ integer(8), len :: b, c
+ integer :: d
+ end type
+end
+
+!Expect: m.mod
+!module m
+! type::t(a,b,c)
+! integer,kind::a
+! integer(8),len::b
+! integer(8),len::c
+! integer::d
+! end type
+!end
--- /dev/null
+! Copyright (c) 2018, 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.
+
+! Derived type parameters
+
+module m
+ !ERROR: Duplicate type parameter name: 'a'
+ type t1(a, b, a)
+ integer, kind :: a
+ integer(8), len :: b
+ end type
+ !ERROR: No definition found for type parameter 'b'
+ type t2(a, b, c)
+ integer, kind :: a
+ integer, len :: c
+ end type
+ !ERROR: 'b' is not defined as a type parameter
+ type t3(a, b)
+ integer, kind :: a
+ integer :: b
+ end type
+ type t4(a)
+ integer, kind :: a
+ !ERROR: 'd' is not a type parameter of this derived type
+ integer(8), len :: d
+ end type
+end module
projects / platform / upstream / llvm.git / commitdiff