From ae3b96456f211c848e5a9f61e4cb9fe909617d71 Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Tue, 11 Sep 2018 17:33:42 -0700 Subject: [PATCH] [flang] Simplify representation of intrinsic types Intrinsic types are now just a TypeCategory and a int kind. If no kind is specified the default is used so that every type has an explicit kind. This caused changes in the expected results of some of the tests. Add support for "double precision" and "double complex". Intrinsic types are now stored as values in DeclTypeSpec so none of the KindedTypeHelper machinery is needed any more. Eliminate DerivedTypeDef, DataComponentDef, ProcComponentDef, TypeBoundProc. The components and bindings of a derived type are now represented by the corresponding Scope. Original-commit: flang-compiler/f18@4ad8ffb18708e073da9a0f37c3bb09a271ca1c02 Reviewed-on: https://github.com/flang-compiler/f18/pull/182 Tree-same-pre-rewrite: false --- flang/lib/semantics/resolve-names.cc | 35 +-- flang/lib/semantics/type.cc | 241 +++----------- flang/lib/semantics/type.h | 453 ++++----------------------- flang/test/semantics/modfile01.f90 | 8 +- flang/test/semantics/modfile02.f90 | 4 +- flang/test/semantics/modfile03.f90 | 6 +- flang/test/semantics/modfile04.f90 | 10 +- flang/test/semantics/modfile05.f90 | 6 +- flang/test/semantics/modfile06.f90 | 8 +- flang/test/semantics/modfile07.f90 | 8 +- flang/test/semantics/modfile08.f90 | 10 +- flang/test/semantics/modfile09-a.f90 | 2 +- flang/test/semantics/modfile09-b.f90 | 2 +- flang/test/semantics/modfile09-c.f90 | 2 +- flang/test/semantics/modfile09-d.f90 | 2 +- flang/test/semantics/modfile10.f90 | 16 +- flang/test/semantics/modfile11.f90 | 6 +- flang/test/semantics/symbol01.f90 | 6 +- flang/test/semantics/symbol03.f90 | 4 +- flang/test/semantics/symbol04.f90 | 2 +- flang/test/semantics/symbol05.f90 | 26 +- flang/test/semantics/test_modfile.sh | 2 +- flang/tools/f18/dump.cc | 3 +- 23 files changed, 191 insertions(+), 671 deletions(-) diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 5c388fc648e2..86f53ef29c60 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -176,10 +176,9 @@ private: DerivedTypeSpec *derivedTypeSpec_{nullptr}; std::unique_ptr typeParamValue_; - void MakeIntrinsic(const IntrinsicTypeSpec &intrinsicTypeSpec); + void MakeIntrinsic(TypeCategory, int); void SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec); - static KindParamValue GetKindParamValue( - const std::optional &kind); + static int GetKindParamValue(const std::optional &kind); }; // Track statement source locations and save messages. @@ -731,9 +730,9 @@ std::optional ImplicitRules::GetType(char ch) const { } else if (inheritFromParent_) { return parent_->GetType(ch); } else if (ch >= 'i' && ch <= 'n') { - return DeclTypeSpec{IntegerTypeSpec::Make()}; + return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Integer}}; } else if (ch >= 'a' && ch <= 'z') { - return DeclTypeSpec{RealTypeSpec::Make()}; + return DeclTypeSpec{IntrinsicTypeSpec{TypeCategory::Real}}; } else { return std::nullopt; } @@ -889,37 +888,38 @@ void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) { } bool DeclTypeSpecVisitor::Pre(const parser::IntegerTypeSpec &x) { - MakeIntrinsic(IntegerTypeSpec::Make(GetKindParamValue(x.v))); + MakeIntrinsic(TypeCategory::Integer, GetKindParamValue(x.v)); return false; } void DeclTypeSpecVisitor::Post(const parser::IntrinsicTypeSpec::Character &x) { CHECK(!"TODO: character"); } bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Logical &x) { - MakeIntrinsic(LogicalTypeSpec::Make(GetKindParamValue(x.kind))); + MakeIntrinsic(TypeCategory::Logical, GetKindParamValue(x.kind)); return false; } bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Real &x) { - MakeIntrinsic(RealTypeSpec::Make(GetKindParamValue(x.kind))); + MakeIntrinsic(TypeCategory::Real, GetKindParamValue(x.kind)); return false; } bool DeclTypeSpecVisitor::Pre(const parser::IntrinsicTypeSpec::Complex &x) { - MakeIntrinsic(ComplexTypeSpec::Make(GetKindParamValue(x.kind))); + MakeIntrinsic(TypeCategory::Complex, GetKindParamValue(x.kind)); return false; } bool DeclTypeSpecVisitor::Pre( const parser::IntrinsicTypeSpec::DoublePrecision &) { - CHECK(!"TODO: double precision"); + MakeIntrinsic(TypeCategory::Real, + 2 * IntrinsicTypeSpec::GetDefaultKind(TypeCategory::Real)); return false; } bool DeclTypeSpecVisitor::Pre( const parser::IntrinsicTypeSpec::DoubleComplex &) { - CHECK(!"TODO: double complex"); + MakeIntrinsic(TypeCategory::Complex, + 2 * IntrinsicTypeSpec::GetDefaultKind(TypeCategory::Complex)); return false; } -void DeclTypeSpecVisitor::MakeIntrinsic( - const IntrinsicTypeSpec &intrinsicTypeSpec) { - SetDeclTypeSpec(DeclTypeSpec{intrinsicTypeSpec}); +void DeclTypeSpecVisitor::MakeIntrinsic(TypeCategory category, int kind) { + SetDeclTypeSpec(DeclTypeSpec{IntrinsicTypeSpec{category, kind}}); } // Set declTypeSpec_ based on derivedTypeSpec_ @@ -941,15 +941,14 @@ void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) { declTypeSpec_ = std::make_unique(declTypeSpec); } -KindParamValue DeclTypeSpecVisitor::GetKindParamValue( +int DeclTypeSpecVisitor::GetKindParamValue( const std::optional &kind) { if (kind) { if (auto *intExpr{std::get_if(&kind->u)}) { const parser::Expr &expr{*intExpr->thing.thing.thing}; if (auto *lit{std::get_if(&expr.u)}) { if (auto *intLit{std::get_if(&lit->u)}) { - return KindParamValue{ - IntConst::Make(std::get(intLit->t))}; + return std::get(intLit->t); } } CHECK(!"TODO: constant evaluation"); @@ -957,7 +956,7 @@ KindParamValue DeclTypeSpecVisitor::GetKindParamValue( CHECK(!"TODO: translate star-size to kind"); } } - return KindParamValue{}; + return 0; } // MessageHandler implementation diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc index afe5733373d5..0ffc623b7ce0 100644 --- a/flang/lib/semantics/type.cc +++ b/flang/lib/semantics/type.cc @@ -13,12 +13,10 @@ // limitations under the License. #include "type.h" -#include "attr.h" #include "scope.h" #include "symbol.h" -#include "../common/idioms.h" -#include -#include +#include "../evaluate/type.h" +#include "../parser/characters.h" namespace Fortran::semantics { @@ -33,10 +31,6 @@ std::ostream &operator<<(std::ostream &o, const IntConst &x) { std::unordered_map IntConst::cache; -std::ostream &operator<<(std::ostream &o, const KindParamValue &x) { - return o << x.value_; -} - const IntConst &IntConst::Make(std::uint64_t value) { auto it{cache.find(value)}; if (it == cache.end()) { @@ -45,118 +39,6 @@ const IntConst &IntConst::Make(std::uint64_t value) { return it->second; } -std::ostream &operator<<(std::ostream &o, const TypeSpec &x) { - return x.Output(o); -} - -const LogicalTypeSpec &LogicalTypeSpec::Make() { return helper.Make(); } -const LogicalTypeSpec &LogicalTypeSpec::Make(KindParamValue kind) { - return helper.Make(kind); -} -KindedTypeHelper LogicalTypeSpec::helper{"LOGICAL", 0}; -std::ostream &operator<<(std::ostream &o, const LogicalTypeSpec &x) { - return LogicalTypeSpec::helper.Output(o, x); -} - -const IntegerTypeSpec &IntegerTypeSpec::Make() { return helper.Make(); } -const IntegerTypeSpec &IntegerTypeSpec::Make(KindParamValue kind) { - return helper.Make(kind); -} -KindedTypeHelper IntegerTypeSpec::helper{"INTEGER", 0}; -std::ostream &operator<<(std::ostream &o, const IntegerTypeSpec &x) { - return IntegerTypeSpec::helper.Output(o, x); -} - -const RealTypeSpec &RealTypeSpec::Make() { return helper.Make(); } -const RealTypeSpec &RealTypeSpec::Make(KindParamValue kind) { - return helper.Make(kind); -} -KindedTypeHelper RealTypeSpec::helper{"REAL", 0}; -std::ostream &operator<<(std::ostream &o, const RealTypeSpec &x) { - return RealTypeSpec::helper.Output(o, x); -} - -const ComplexTypeSpec &ComplexTypeSpec::Make() { return helper.Make(); } -const ComplexTypeSpec &ComplexTypeSpec::Make(KindParamValue kind) { - return helper.Make(kind); -} -KindedTypeHelper ComplexTypeSpec::helper{"COMPLEX", 0}; -std::ostream &operator<<(std::ostream &o, const ComplexTypeSpec &x) { - return ComplexTypeSpec::helper.Output(o, x); -} - -std::ostream &operator<<(std::ostream &o, const CharacterTypeSpec &x) { - o << "CHARACTER(" << x.len_; - if (x.kind_ != CharacterTypeSpec::DefaultKind) { - o << ", " << x.kind_; - } - return o << ')'; -} - -std::ostream &operator<<(std::ostream &o, const DerivedTypeDef &x) { - o << "TYPE"; - if (!x.data_.attrs.empty()) { - o << ", " << x.data_.attrs; - } - o << " :: " << x.data_.name->ToString(); - if (x.data_.lenParams.size() > 0 || x.data_.kindParams.size() > 0) { - o << '('; - int n = 0; - for (const auto ¶m : x.data_.lenParams) { - if (n++) { - o << ", "; - } - o << param.name(); - } - for (auto param : x.data_.kindParams) { - if (n++) { - o << ", "; - } - o << param.name(); - } - o << ')'; - } - o << '\n'; - for (const auto ¶m : x.data_.lenParams) { - o << " " << param.type() << ", LEN :: " << param.name() << "\n"; - } - for (const auto ¶m : x.data_.kindParams) { - o << " " << param.type() << ", KIND :: " << param.name() << "\n"; - } - if (x.data_.Private) { - o << " PRIVATE\n"; - } - if (x.data_.sequence) { - o << " SEQUENCE\n"; - } - for (const auto &comp : x.data_.dataComps) { - o << " " << comp << "\n"; - } - for (const auto &comp : x.data_.procComps) { - o << " " << comp << "\n"; - } - if (x.data_.hasTbpPart()) { - o << "CONTAINS\n"; - if (x.data_.bindingPrivate) { - o << " PRIVATE\n"; - } - for (const auto &tbp : x.data_.typeBoundProcs) { - o << " " << tbp << "\n"; - } - for (const auto &tbg : x.data_.typeBoundGenerics) { - o << " " << tbg << "\n"; - } - for (const auto &name : x.data_.finalProcs) { - o << " FINAL :: " << name.ToString() << '\n'; - } - } - return o << "END TYPE"; -} - -// DerivedTypeSpec is a base class for classes with virtual functions, -// so clang wants it to have a virtual destructor. -DerivedTypeSpec::~DerivedTypeSpec() {} - void DerivedTypeSpec::set_scope(const Scope &scope) { CHECK(!scope_); CHECK(scope.kind() == Scope::Kind::DerivedType); @@ -197,57 +79,43 @@ std::ostream &operator<<(std::ostream &o, const ShapeSpec &x) { return o; } -std::ostream &operator<<(std::ostream &o, const DataComponentDef &x) { - o << x.type_; - if (!x.attrs_.empty()) { - o << ", " << x.attrs_; - } - o << " :: " << x.name_.ToString(); - if (!x.arraySpec_.empty()) { - o << '('; - int n = 0; - for (ShapeSpec shape : x.arraySpec_) { - if (n++) { - o << ", "; - } - o << shape; - } - o << ')'; - } - return o; +IntrinsicTypeSpec::IntrinsicTypeSpec(TypeCategory category, int kind) + : category_{category}, kind_{kind ? kind : GetDefaultKind(category)} { + CHECK(category != TypeCategory::Derived); } -DataComponentDef::DataComponentDef(const DeclTypeSpec &type, - const SourceName &name, const Attrs &attrs, const ArraySpec &arraySpec) - : type_{type}, name_{name}, attrs_{attrs}, arraySpec_{arraySpec} { - attrs.CheckValid({Attr::PUBLIC, Attr::PRIVATE, Attr::ALLOCATABLE, - Attr::POINTER, Attr::CONTIGUOUS}); - if (attrs.HasAny({Attr::ALLOCATABLE, Attr::POINTER})) { - for (const auto &shapeSpec : arraySpec) { - CHECK(shapeSpec.isDeferred()); - } - } else { - for (const auto &shapeSpec : arraySpec) { - CHECK(shapeSpec.isExplicit()); - } +int IntrinsicTypeSpec::GetDefaultKind(TypeCategory category) { + switch (category) { + case TypeCategory::Character: return evaluate::DefaultCharacter::kind; + //case TypeCategory::Complex: return evaluate::DefaultComplex::kind; + case TypeCategory::Complex: return 4; // TEMP to work around bug + case TypeCategory::Integer: return evaluate::DefaultInteger::kind; + case TypeCategory::Logical: return evaluate::DefaultLogical::kind; + case TypeCategory::Real: return evaluate::DefaultReal::kind; + default: CRASH_NO_CASE; } } +std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x) { + os << parser::ToUpperCaseLetters(common::EnumToString(x.category())); + if (x.kind() != 0) { + os << '(' << x.kind() << ')'; + } + return os; +} + DeclTypeSpec::DeclTypeSpec(const IntrinsicTypeSpec &intrinsic) - : category_{Intrinsic} { - typeSpec_.intrinsic = &intrinsic; -} + : category_{Intrinsic}, typeSpec_{intrinsic} {} DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &derived) - : category_{category} { + : category_{category}, typeSpec_{&derived} { CHECK(category == TypeDerived || category == ClassDerived); - typeSpec_.derived = &derived; } DeclTypeSpec::DeclTypeSpec(Category category) : category_{category} { CHECK(category == TypeStar || category == ClassStar); } const IntrinsicTypeSpec &DeclTypeSpec::intrinsicTypeSpec() const { CHECK(category_ == Intrinsic); - return *typeSpec_.intrinsic; + return typeSpec_.intrinsic; } DerivedTypeSpec &DeclTypeSpec::derivedTypeSpec() { CHECK(category_ == TypeDerived || category_ == ClassDerived); @@ -257,10 +125,21 @@ const DerivedTypeSpec &DeclTypeSpec::derivedTypeSpec() const { CHECK(category_ == TypeDerived || category_ == ClassDerived); return *typeSpec_.derived; } +bool DeclTypeSpec::operator==(const DeclTypeSpec &that) const { + if (category_ != that.category_) { + return false; + } + switch (category_) { + case Intrinsic: return typeSpec_.intrinsic == that.typeSpec_.intrinsic; + case TypeDerived: + case ClassDerived: return typeSpec_.derived == that.typeSpec_.derived; + default: return true; + } +} std::ostream &operator<<(std::ostream &o, const DeclTypeSpec &x) { switch (x.category()) { - case DeclTypeSpec::Intrinsic: return x.intrinsicTypeSpec().Output(o); + case DeclTypeSpec::Intrinsic: return o << x.intrinsicTypeSpec(); case DeclTypeSpec::TypeDerived: return o << "TYPE(" << x.derivedTypeSpec().name().ToString() << ')'; case DeclTypeSpec::ClassDerived: @@ -280,28 +159,6 @@ void ProcInterface::set_type(const DeclTypeSpec &type) { type_ = type; } -std::ostream &operator<<(std::ostream &o, const ProcDecl &x) { - return o << x.name_.ToString(); -} - -ProcComponentDef::ProcComponentDef( - const ProcDecl &decl, Attrs attrs, const ProcInterface &interface) - : decl_{decl}, attrs_{attrs}, interface_{interface} { - CHECK(attrs_.test(Attr::POINTER)); - attrs_.CheckValid( - {Attr::PUBLIC, Attr::PRIVATE, Attr::NOPASS, Attr::POINTER, Attr::PASS}); -} -std::ostream &operator<<(std::ostream &o, const ProcComponentDef &x) { - o << "PROCEDURE("; - if (auto *symbol{x.interface_.symbol()}) { - o << symbol->name().ToString(); - } else if (auto *type{x.interface_.type()}) { - o << *type; - } - o << "), " << x.attrs_ << " :: " << x.decl_; - return o; -} - std::ostream &operator<<(std::ostream &o, const GenericSpec &x) { switch (x.kind()) { case GenericSpec::GENERIC_NAME: return o << x.genericName().ToString(); @@ -334,28 +191,4 @@ std::ostream &operator<<(std::ostream &o, const GenericSpec &x) { } } -std::ostream &operator<<(std::ostream &o, const TypeBoundProc &x) { - o << "PROCEDURE("; - if (x.interface_) { - o << x.interface_->ToString(); - } - o << ")"; - if (!x.attrs_.empty()) { - o << ", " << x.attrs_; - } - o << " :: " << x.binding_.ToString(); - if (x.procedure_ != x.binding_) { - o << " => " << x.procedure_.ToString(); - } - return o; -} -std::ostream &operator<<(std::ostream &o, const TypeBoundGeneric &x) { - o << "GENERIC "; - if (!x.attrs_.empty()) { - o << ", " << x.attrs_; - } - o << " :: " << x.genericSpec_ << " => " << x.name_.ToString(); - return o; -} - } // namespace Fortran::semantics diff --git a/flang/lib/semantics/type.h b/flang/lib/semantics/type.h index 69d94a3568d0..690e58291b4e 100644 --- a/flang/lib/semantics/type.h +++ b/flang/lib/semantics/type.h @@ -16,47 +16,27 @@ #define FORTRAN_SEMANTICS_TYPE_H_ #include "attr.h" +#include "../common/fortran.h" #include "../common/idioms.h" #include "../parser/char-block.h" #include -#include #include #include #include -#include #include #include -/* - -Type specs are represented by a class hierarchy rooted at TypeSpec. Only the -leaves are concrete types: - TypeSpec - IntrinsicTypeSpec - CharacterTypeSpec - LogicalTypeSpec - NumericTypeSpec - IntegerTypeSpec - RealTypeSpec - ComplexTypeSpec - DerivedTypeSpec - -TypeSpec classes are immutable. For intrinsic types (except character) there -is a limited number of instances -- one for each kind. - -A DerivedTypeSpec is based on a DerivedTypeDef (from a derived type statement) -with kind and len parameter values provided. - -*/ - namespace Fortran::semantics { -using Name = std::string; +class Scope; +class Symbol; /// A SourceName is a name in the cooked character stream, /// i.e. a range of lower-case characters with provenance. using SourceName = parser::CharBlock; +using TypeCategory = common::TypeCategory; + // TODO class IntExpr { public: @@ -85,21 +65,6 @@ private: friend std::ostream &operator<<(std::ostream &, const IntConst &); }; -// The value of a kind type parameter -class KindParamValue { -public: - KindParamValue(int value = 0) : KindParamValue(IntConst::Make(value)) {} - KindParamValue(const IntConst &value) : value_{value} {} - bool operator==(const KindParamValue &x) const { return value_ == x.value_; } - bool operator!=(const KindParamValue &x) const { return !operator==(x); } - bool operator<(const KindParamValue &x) const { return value_ < x.value_; } - const IntConst &value() const { return value_; } - -private: - const IntConst &value_; - friend std::ostream &operator<<(std::ostream &, const KindParamValue &); -}; - // An array spec bound: an explicit integer expression or ASSUMED or DEFERRED class Bound { public: @@ -122,186 +87,24 @@ private: friend std::ostream &operator<<(std::ostream &, const Bound &); }; -// The value of a len type parameter -using LenParamValue = Bound; - -class IntrinsicTypeSpec; -class DerivedTypeSpec; - -class DeclTypeSpec { +class IntrinsicTypeSpec { public: - enum Category { Intrinsic, TypeDerived, ClassDerived, TypeStar, ClassStar }; - - // intrinsic-type-spec or TYPE(intrinsic-type-spec) - DeclTypeSpec(const IntrinsicTypeSpec &); - // TYPE(derived-type-spec) or CLASS(derived-type-spec) - DeclTypeSpec(Category, DerivedTypeSpec &); - // TYPE(*) or CLASS(*) - DeclTypeSpec(Category); - DeclTypeSpec() = delete; - - bool operator==(const DeclTypeSpec &that) const { - if (category_ != that.category_) { - return false; - } - switch (category_) { - case Intrinsic: return typeSpec_.intrinsic == that.typeSpec_.intrinsic; - case TypeDerived: - case ClassDerived: return typeSpec_.derived == that.typeSpec_.derived; - default: return true; - } + IntrinsicTypeSpec(TypeCategory, int kind = 0); + const TypeCategory category() const { return category_; } + const int kind() const { return kind_; } + bool operator==(const IntrinsicTypeSpec &x) const { + return category_ == x.category_ && kind_ == x.kind_; } - bool operator!=(const DeclTypeSpec &that) const { return !operator==(that); } + bool operator!=(const IntrinsicTypeSpec &x) const { return !operator==(x); } - Category category() const { return category_; } - const IntrinsicTypeSpec &intrinsicTypeSpec() const; - DerivedTypeSpec &derivedTypeSpec(); - const DerivedTypeSpec &derivedTypeSpec() const; + static int GetDefaultKind(TypeCategory category); private: - Category category_; - union { - const IntrinsicTypeSpec *intrinsic; - DerivedTypeSpec *derived; - } typeSpec_; + TypeCategory category_; + int kind_; + friend std::ostream &operator<<(std::ostream &os, const IntrinsicTypeSpec &x); + // TODO: Character and len }; -std::ostream &operator<<(std::ostream &, const DeclTypeSpec &); - -// Root of the *TypeSpec hierarchy -class TypeSpec { -public: - virtual std::ostream &Output(std::ostream &o) const = 0; -}; - -class IntrinsicTypeSpec : public TypeSpec { -public: - const KindParamValue &kind() const { return kind_; } - -protected: - IntrinsicTypeSpec(KindParamValue kind) : kind_{kind} {} - const KindParamValue kind_; -}; - -class NumericTypeSpec : public IntrinsicTypeSpec { -protected: - NumericTypeSpec(KindParamValue kind) : IntrinsicTypeSpec(kind) {} -}; - -namespace { - -// Helper to cache mapping of kind to TypeSpec -template class KindedTypeHelper { -public: - std::map cache; - KindedTypeHelper(Name name, KindParamValue defaultValue) - : name_{name}, defaultValue_{defaultValue} {} - const T &Make() { return Make(defaultValue_); } - const T &Make(KindParamValue kind) { - auto it{cache.find(kind)}; - if (it == cache.end()) { - it = cache.insert(std::make_pair(kind, T{kind})).first; - } - return it->second; - } - std::ostream &Output(std::ostream &o, const T &x) { - o << name_; - if (x.kind_ != defaultValue_) o << '(' << x.kind_ << ')'; - return o; - } - -private: - const Name name_; - const KindParamValue defaultValue_; -}; - -} // namespace - -// One unique instance of LogicalTypeSpec for each kind. -class LogicalTypeSpec : public IntrinsicTypeSpec { -public: - static const LogicalTypeSpec &Make(); - static const LogicalTypeSpec &Make(KindParamValue kind); - std::ostream &Output(std::ostream &o) const override { return o << *this; } - -private: - friend class KindedTypeHelper; - static KindedTypeHelper helper; - LogicalTypeSpec(KindParamValue kind) : IntrinsicTypeSpec(kind) {} - friend std::ostream &operator<<(std::ostream &o, const LogicalTypeSpec &x); -}; - -// One unique instance of IntegerTypeSpec for each kind. -class IntegerTypeSpec : public NumericTypeSpec { -public: - static const IntegerTypeSpec &Make(); - static const IntegerTypeSpec &Make(KindParamValue kind); - std::ostream &Output(std::ostream &o) const override { return o << *this; } - -private: - friend class KindedTypeHelper; - static KindedTypeHelper helper; - IntegerTypeSpec(KindParamValue kind) : NumericTypeSpec(kind) {} - friend std::ostream &operator<<(std::ostream &o, const IntegerTypeSpec &x); -}; - -// One unique instance of RealTypeSpec for each kind. -class RealTypeSpec : public NumericTypeSpec { -public: - static const RealTypeSpec &Make(); - static const RealTypeSpec &Make(KindParamValue kind); - std::ostream &Output(std::ostream &o) const override { return o << *this; } - -private: - friend class KindedTypeHelper; - static KindedTypeHelper helper; - RealTypeSpec(KindParamValue kind) : NumericTypeSpec(kind) {} - friend std::ostream &operator<<(std::ostream &o, const RealTypeSpec &x); -}; - -// One unique instance of ComplexTypeSpec for each kind. -class ComplexTypeSpec : public NumericTypeSpec { -public: - static const ComplexTypeSpec &Make(); - static const ComplexTypeSpec &Make(KindParamValue kind); - std::ostream &Output(std::ostream &o) const override { return o << *this; } - -private: - friend class KindedTypeHelper; - static KindedTypeHelper helper; - ComplexTypeSpec(KindParamValue kind) : NumericTypeSpec(kind) {} - friend std::ostream &operator<<(std::ostream &o, const ComplexTypeSpec &x); -}; - -class CharacterTypeSpec : public IntrinsicTypeSpec { -public: - static const int DefaultKind = 0; - CharacterTypeSpec(LenParamValue len, KindParamValue kind = DefaultKind) - : IntrinsicTypeSpec{kind}, len_{len} {} - const LenParamValue &len() const { return len_; } - std::ostream &Output(std::ostream &o) const override { return o << *this; } - -private: - const LenParamValue len_; - friend std::ostream &operator<<(std::ostream &, const CharacterTypeSpec &); -}; - -// Definition of a type parameter -class TypeParamDef { -public: - TypeParamDef(const Name &name, const IntegerTypeSpec &type, - const std::optional &defaultValue = {}) - : name_{name}, type_{type}, defaultValue_{defaultValue} {}; - const Name &name() const { return name_; } - const IntegerTypeSpec &type() const { return type_; } - const std::optional &defaultValue() const { return defaultValue_; } - -private: - const Name name_; - const IntegerTypeSpec type_; - const std::optional defaultValue_; -}; - -using TypeParamDefs = std::list; class ShapeSpec { public: @@ -345,78 +148,6 @@ private: using ArraySpec = std::list; -class DataComponentDef { -public: - // TODO: character-length - should be in DeclTypeSpec (overrides what is - // there) - // TODO: coarray-spec - // TODO: component-initialization - DataComponentDef( - const DeclTypeSpec &type, const SourceName &name, const Attrs &attrs) - : DataComponentDef(type, name, attrs, ArraySpec{}) {} - DataComponentDef(const DeclTypeSpec &type, const SourceName &name, - const Attrs &attrs, const ArraySpec &arraySpec); - - const DeclTypeSpec &type() const { return type_; } - const SourceName &name() const { return name_; } - const Attrs &attrs() const { return attrs_; } - const ArraySpec &shape() const { return arraySpec_; } - -private: - const DeclTypeSpec type_; - const SourceName name_; - const Attrs attrs_; - const ArraySpec arraySpec_; - friend std::ostream &operator<<(std::ostream &, const DataComponentDef &); -}; - -class Scope; -class Symbol; - -// This represents a proc-interface in the declaration of a procedure or -// procedure component. It comprises a symbol (representing the specific -// interface), a decl-type-spec (representing the function return type), -// or neither. -class ProcInterface { -public: - const Symbol *symbol() const { return symbol_; } - const DeclTypeSpec *type() const { return type_ ? &*type_ : nullptr; } - void set_symbol(const Symbol &symbol); - void set_type(const DeclTypeSpec &type); - -private: - const Symbol *symbol_{nullptr}; - std::optional type_; -}; - -class ProcDecl { -public: - ProcDecl(const ProcDecl &decl) = default; - ProcDecl(const SourceName &name) : name_{name} {} - // TODO: proc-pointer-init - const SourceName &name() const { return name_; } - -private: - const SourceName name_; - friend std::ostream &operator<<(std::ostream &, const ProcDecl &); -}; - -class ProcComponentDef { -public: - ProcComponentDef( - const ProcDecl &decl, Attrs attrs, const ProcInterface &interface); - - const ProcDecl &decl() const { return decl_; } - const Attrs &attrs() const { return attrs_; } - const ProcInterface &interface() const { return interface_; } - -private: - const ProcDecl decl_; - const Attrs attrs_; - const ProcInterface interface_; - friend std::ostream &operator<<(std::ostream &, const ProcComponentDef &); -}; - class GenericSpec { public: enum Kind { @@ -473,111 +204,15 @@ private: friend std::ostream &operator<<(std::ostream &, const GenericSpec &); }; -class TypeBoundGeneric { -public: - TypeBoundGeneric(const SourceName &name, const Attrs &attrs, - const GenericSpec &genericSpec) - : name_{name}, attrs_{attrs}, genericSpec_{genericSpec} { - attrs_.CheckValid({Attr::PUBLIC, Attr::PRIVATE}); - } - -private: - const SourceName name_; - const Attrs attrs_; - const GenericSpec genericSpec_; - friend std::ostream &operator<<(std::ostream &, const TypeBoundGeneric &); -}; - -class TypeBoundProc { -public: - TypeBoundProc(const SourceName &interface, const Attrs &attrs, - const SourceName &binding) - : TypeBoundProc(interface, attrs, binding, binding) { - if (!attrs_.test(Attr::DEFERRED)) { - common::die( - "DEFERRED attribute is required if interface name is specified"); - } - } - TypeBoundProc(const Attrs &attrs, const SourceName &binding, - const std::optional &procedure) - : TypeBoundProc({}, attrs, binding, procedure ? *procedure : binding) { - if (attrs_.test(Attr::DEFERRED)) { - common::die("DEFERRED attribute is only allowed with interface name"); - } - } - -private: - TypeBoundProc(const std::optional &interface, const Attrs &attrs, - const SourceName &binding, const SourceName &procedure) - : interface_{interface}, attrs_{attrs}, binding_{binding}, procedure_{ - procedure} { - attrs_.CheckValid({Attr::PUBLIC, Attr::PRIVATE, Attr::NOPASS, Attr::PASS, - Attr::DEFERRED, Attr::NON_OVERRIDABLE}); - } - const std::optional interface_; - const Attrs attrs_; - const SourceName binding_; - const SourceName procedure_; - friend std::ostream &operator<<(std::ostream &, const TypeBoundProc &); -}; - -// Definition of a derived type -class DerivedTypeDef { -public: - const SourceName &name() const { return *data_.name; } - const SourceName *extends() const { return data_.extends; } - const Attrs &attrs() const { return data_.attrs; } - const TypeParamDefs &lenParams() const { return data_.lenParams; } - const TypeParamDefs &kindParams() const { return data_.kindParams; } - const std::list &dataComponents() const { - return data_.dataComps; - } - const std::list &procComponents() const { - return data_.procComps; - } - const std::list &typeBoundProcs() const { - return data_.typeBoundProcs; - } - const std::list &typeBoundGenerics() const { - return data_.typeBoundGenerics; - } - const std::list finalProcs() const { return data_.finalProcs; } - - struct Data { - const SourceName *name{nullptr}; - const SourceName *extends{nullptr}; - Attrs attrs; - bool Private{false}; - bool sequence{false}; - TypeParamDefs lenParams; - TypeParamDefs kindParams; - std::list dataComps; - std::list procComps; - bool bindingPrivate{false}; - std::list typeBoundProcs; - std::list typeBoundGenerics; - std::list finalProcs; - bool hasTbpPart() const { - return !finalProcs.empty() || !typeBoundProcs.empty() || - !typeBoundGenerics.empty(); - } - }; - explicit DerivedTypeDef(const Data &x); - -private: - const Data data_; - // TODO: type-bound procedures - friend std::ostream &operator<<(std::ostream &, const DerivedTypeDef &); -}; +// The value of a len type parameter +using LenParamValue = Bound; using ParamValue = LenParamValue; -class DerivedTypeSpec : public TypeSpec { +class DerivedTypeSpec { public: - std::ostream &Output(std::ostream &o) const override { return o << *this; } explicit DerivedTypeSpec(const SourceName &name) : name_{&name} {} DerivedTypeSpec() = delete; - virtual ~DerivedTypeSpec(); const SourceName &name() const { return *name_; } const Scope *scope() const { return scope_; } void set_scope(const Scope &); @@ -589,6 +224,54 @@ private: friend std::ostream &operator<<(std::ostream &, const DerivedTypeSpec &); }; +class DeclTypeSpec { +public: + enum Category { Intrinsic, TypeDerived, ClassDerived, TypeStar, ClassStar }; + + // intrinsic-type-spec or TYPE(intrinsic-type-spec) + DeclTypeSpec(const IntrinsicTypeSpec &); + // TYPE(derived-type-spec) or CLASS(derived-type-spec) + DeclTypeSpec(Category, DerivedTypeSpec &); + // TYPE(*) or CLASS(*) + DeclTypeSpec(Category); + DeclTypeSpec() = delete; + + bool operator==(const DeclTypeSpec &) const; + bool operator!=(const DeclTypeSpec &that) const { return !operator==(that); } + + Category category() const { return category_; } + const IntrinsicTypeSpec &intrinsicTypeSpec() const; + DerivedTypeSpec &derivedTypeSpec(); + const DerivedTypeSpec &derivedTypeSpec() const; + +private: + Category category_; + union TypeSpec { + TypeSpec() : derived{nullptr} {} + TypeSpec(IntrinsicTypeSpec intrinsic) : intrinsic{intrinsic} {} + TypeSpec(DerivedTypeSpec *derived) : derived{derived} {} + IntrinsicTypeSpec intrinsic; + DerivedTypeSpec *derived; + } typeSpec_; +}; +std::ostream &operator<<(std::ostream &, const DeclTypeSpec &); + +// This represents a proc-interface in the declaration of a procedure or +// procedure component. It comprises a symbol (representing the specific +// interface), a decl-type-spec (representing the function return type), +// or neither. +class ProcInterface { +public: + const Symbol *symbol() const { return symbol_; } + const DeclTypeSpec *type() const { return type_ ? &*type_ : nullptr; } + void set_symbol(const Symbol &symbol); + void set_type(const DeclTypeSpec &type); + +private: + const Symbol *symbol_{nullptr}; + std::optional type_; +}; + } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_TYPE_H_ diff --git a/flang/test/semantics/modfile01.f90 b/flang/test/semantics/modfile01.f90 index 73f33254e70b..56b8f80ab644 100644 --- a/flang/test/semantics/modfile01.f90 +++ b/flang/test/semantics/modfile01.f90 @@ -27,11 +27,11 @@ end !Expect: m.mod !module m -!integer::i -!integer,private::j +!integer(4)::i +!integer(4),private::j !type::t -!integer::i -!integer,private::j +!integer(4)::i +!integer(4),private::j !end type !type,private::u !end type diff --git a/flang/test/semantics/modfile02.f90 b/flang/test/semantics/modfile02.f90 index e852221035e7..7e83ead6439c 100644 --- a/flang/test/semantics/modfile02.f90 +++ b/flang/test/semantics/modfile02.f90 @@ -28,10 +28,10 @@ end !Expect: m.mod !module m !type,private::t1 -!integer::i +!integer(4)::i !end type !type,private::t2 -!integer::i +!integer(4)::i !end type !type(t1)::x1 !type(t2),private::x2 diff --git a/flang/test/semantics/modfile03.f90 b/flang/test/semantics/modfile03.f90 index 91f0009d183f..bb785aa26624 100644 --- a/flang/test/semantics/modfile03.f90 +++ b/flang/test/semantics/modfile03.f90 @@ -35,14 +35,14 @@ end !Expect: m1.mod !module m1 -!integer::x1 -!integer,private::x2 +!integer(4)::x1 +!integer(4),private::x2 !end !Expect: m2.mod !module m2 !use m1,only:x1 -!integer::y1 +!integer(4)::y1 !end !Expect: m3.mod diff --git a/flang/test/semantics/modfile04.f90 b/flang/test/semantics/modfile04.f90 index 96c77f71e1a3..539c598bcd3a 100644 --- a/flang/test/semantics/modfile04.f90 +++ b/flang/test/semantics/modfile04.f90 @@ -38,14 +38,14 @@ end !module m !contains !pure subroutine s(x,y) bind(c) -!logical,intent(in)::x -!real,intent(inout)::y +!logical(4),intent(in)::x +!real(4),intent(inout)::y !end !function f1() result(x) -!real::x +!real(4)::x !end !function f2(y) -!real::f2 -!complex::y +!real(4)::f2 +!complex(4)::y !end !end diff --git a/flang/test/semantics/modfile05.f90 b/flang/test/semantics/modfile05.f90 index 2b6328814fcb..f81d4bf8d3a4 100644 --- a/flang/test/semantics/modfile05.f90 +++ b/flang/test/semantics/modfile05.f90 @@ -29,9 +29,9 @@ end !Expect: m1.mod !module m1 -!real::x -!integer::y -!real,volatile::z +!real(4)::x +!integer(4)::y +!real(4),volatile::z !end !Expect: m2.mod diff --git a/flang/test/semantics/modfile06.f90 b/flang/test/semantics/modfile06.f90 index 50e52fa4755e..99b20e9c391e 100644 --- a/flang/test/semantics/modfile06.f90 +++ b/flang/test/semantics/modfile06.f90 @@ -28,14 +28,14 @@ end !module m ! interface ! function f(x) -! integer::f -! real::x +! integer(4)::f +! real(4)::x ! end ! end interface ! interface ! subroutine s(y,z) -! logical::y -! complex::z +! logical(4)::y +! complex(4)::z ! end ! end interface !end diff --git a/flang/test/semantics/modfile07.f90 b/flang/test/semantics/modfile07.f90 index 84c98952923a..ec6843eeec3b 100644 --- a/flang/test/semantics/modfile07.f90 +++ b/flang/test/semantics/modfile07.f90 @@ -42,20 +42,20 @@ end ! generic::foo=>s1,s2 ! interface ! subroutine s1(x) -! real::x +! real(4)::x ! end ! end interface ! interface ! subroutine s2(x) -! complex::x +! complex(4)::x ! end ! end interface ! generic::bar=>s1,s2,s3,s4 !contains ! subroutine s3(x) -! logical::x +! logical(4)::x ! end ! subroutine s4(x) -! integer::x +! integer(4)::x ! end !end diff --git a/flang/test/semantics/modfile08.f90 b/flang/test/semantics/modfile08.f90 index 3f4997965653..a52270361c71 100644 --- a/flang/test/semantics/modfile08.f90 +++ b/flang/test/semantics/modfile08.f90 @@ -35,16 +35,16 @@ end !Expect: m.mod !module m -! procedure(real)::a -! procedure(logical)::b -! procedure(complex)::c +! procedure(real(4))::a +! procedure(logical(4))::b +! procedure(complex(4))::c ! procedure()::d ! procedure()::e -! procedure(real)::f +! procedure(real(4))::f ! procedure(s)::g ! type::t ! procedure(),nopass,pointer::e -! procedure(real),nopass,pointer::f +! procedure(real(4)),nopass,pointer::f ! procedure(s),pointer,private::g ! end type !contains diff --git a/flang/test/semantics/modfile09-a.f90 b/flang/test/semantics/modfile09-a.f90 index 1baceec6d49d..1e614ea3cf32 100644 --- a/flang/test/semantics/modfile09-a.f90 +++ b/flang/test/semantics/modfile09-a.f90 @@ -8,7 +8,7 @@ end !Expect: m.mod !module m -!integer::m1_x +!integer(4)::m1_x !interface !module subroutine s() !end diff --git a/flang/test/semantics/modfile09-b.f90 b/flang/test/semantics/modfile09-b.f90 index 6fc67035ce5e..69c88064f667 100644 --- a/flang/test/semantics/modfile09-b.f90 +++ b/flang/test/semantics/modfile09-b.f90 @@ -4,5 +4,5 @@ end !Expect: m-s1.mod !submodule(m) s1 -!integer::s1_x +!integer(4)::s1_x !end diff --git a/flang/test/semantics/modfile09-c.f90 b/flang/test/semantics/modfile09-c.f90 index d6670e46d651..3edb997f5679 100644 --- a/flang/test/semantics/modfile09-c.f90 +++ b/flang/test/semantics/modfile09-c.f90 @@ -4,5 +4,5 @@ end !Expect: m-s2.mod !submodule(m:s1) s2 -!integer::s2_x +!integer(4)::s2_x !end diff --git a/flang/test/semantics/modfile09-d.f90 b/flang/test/semantics/modfile09-d.f90 index 00550b5fbf40..6e8b7caac4c0 100644 --- a/flang/test/semantics/modfile09-d.f90 +++ b/flang/test/semantics/modfile09-d.f90 @@ -4,5 +4,5 @@ end !Expect: m-s3.mod !submodule(m:s2) s3 -!integer::s3_x +!integer(4)::s3_x !end diff --git a/flang/test/semantics/modfile10.f90 b/flang/test/semantics/modfile10.f90 index 001eb7f6d7cc..917ab0858e36 100644 --- a/flang/test/semantics/modfile10.f90 +++ b/flang/test/semantics/modfile10.f90 @@ -38,6 +38,8 @@ module m sequence integer i real x + double precision y + double complex z end type contains subroutine b() @@ -58,19 +60,19 @@ end module !module m ! interface ! subroutine a(i,j) -! integer::i -! integer::j +! integer(4)::i +! integer(4)::j ! end ! end interface ! type,abstract::t -! integer::i +! integer(4)::i ! contains ! procedure(a),deferred,nopass::q ! procedure(b),deferred,nopass::p ! procedure(b),deferred,nopass::r ! end type ! type::t2 -! integer::x +! integer(4)::x ! contains ! final::c ! procedure,non_overridable,private::d @@ -78,8 +80,10 @@ end module ! end type ! type::t3 ! sequence -! integer::i -! real::x +! integer(4)::i +! real(4)::x +! real(8)::y +! complex(8)::z ! end type !contains ! subroutine b() diff --git a/flang/test/semantics/modfile11.f90 b/flang/test/semantics/modfile11.f90 index 469a083d7293..de9364ad435a 100644 --- a/flang/test/semantics/modfile11.f90 +++ b/flang/test/semantics/modfile11.f90 @@ -28,13 +28,13 @@ end !Expect: m.mod !module m ! type::t1(a,b,c) -! integer,kind::a +! integer(4),kind::a ! integer(8),len::b ! integer(8),len::c -! integer::d +! integer(4)::d ! end type ! type,extends(t1)::t2(e) -! integer,len::e +! integer(4),len::e ! end type ! type,bind(c),extends(t2)::t3 ! end type diff --git a/flang/test/semantics/symbol01.f90 b/flang/test/semantics/symbol01.f90 index a6ea4907f35c..bcc6fc667d4f 100644 --- a/flang/test/semantics/symbol01.f90 +++ b/flang/test/semantics/symbol01.f90 @@ -20,8 +20,8 @@ module m private :: f contains !DEF: /m/s BIND(C), PUBLIC, PURE Subprogram - !DEF: /m/s/x INTENT(IN) (implicit) ObjectEntity REAL - !DEF: /m/s/y INTENT(INOUT) (implicit) ObjectEntity REAL + !DEF: /m/s/x INTENT(IN) (implicit) ObjectEntity REAL(4) + !DEF: /m/s/y INTENT(INOUT) (implicit) ObjectEntity REAL(4) pure subroutine s (x, y) bind(c) intent(in) :: x intent(inout) :: y @@ -31,7 +31,7 @@ contains end subroutine end subroutine !DEF: /m/f PRIVATE, PURE, RECURSIVE Subprogram - !DEF: /m/f/x ALLOCATABLE ObjectEntity REAL + !DEF: /m/f/x ALLOCATABLE ObjectEntity REAL(4) recursive pure function f() result(x) real, allocatable :: x !REF: /m/f/x diff --git a/flang/test/semantics/symbol03.f90 b/flang/test/semantics/symbol03.f90 index 01a18e0ac825..7d004c2c0bf5 100644 --- a/flang/test/semantics/symbol03.f90 +++ b/flang/test/semantics/symbol03.f90 @@ -16,14 +16,14 @@ !DEF: /main MainProgram program main - !DEF: /main/x ObjectEntity INTEGER + !DEF: /main/x ObjectEntity INTEGER(4) integer x !REF: /main/s call s contains !DEF: /main/s Subprogram subroutine s - !DEF: /main/s/y (implicit) ObjectEntity REAL + !DEF: /main/s/y (implicit) ObjectEntity REAL(4) !REF: /main/x y = x end subroutine diff --git a/flang/test/semantics/symbol04.f90 b/flang/test/semantics/symbol04.f90 index 8d56cf7004af..5b36b1df6e62 100644 --- a/flang/test/semantics/symbol04.f90 +++ b/flang/test/semantics/symbol04.f90 @@ -21,7 +21,7 @@ module m end type !DEF: /m/t2 PUBLIC DerivedType type :: t2 - !DEF: /m/t2/t1 ObjectEntity INTEGER + !DEF: /m/t2/t1 ObjectEntity INTEGER(4) integer :: t1 !DEF: /m/t2/x ObjectEntity TYPE(t1) !REF: /m/t1 diff --git a/flang/test/semantics/symbol05.f90 b/flang/test/semantics/symbol05.f90 index 0f06957f977c..18c0e224c984 100644 --- a/flang/test/semantics/symbol05.f90 +++ b/flang/test/semantics/symbol05.f90 @@ -16,10 +16,10 @@ !DEF: /s1 Subprogram subroutine s1 - !DEF: /s1/x ObjectEntity INTEGER + !DEF: /s1/x ObjectEntity INTEGER(4) integer x block - !DEF: /s1/Block1/y ObjectEntity INTEGER + !DEF: /s1/Block1/y ObjectEntity INTEGER(4) integer y !REF: /s1/x x = 1 @@ -27,7 +27,7 @@ subroutine s1 y = 2.0 end block block - !DEF: /s1/Block2/y ObjectEntity REAL + !DEF: /s1/Block2/y ObjectEntity REAL(4) real y !REF: /s1/Block2/y y = 3.0 @@ -38,9 +38,9 @@ end subroutine subroutine s2 implicit integer(w-x) block - !DEF: /s2/x (implicit) ObjectEntity INTEGER + !DEF: /s2/x (implicit) ObjectEntity INTEGER(4) x = 1 - !DEF: /s2/y (implicit) ObjectEntity REAL + !DEF: /s2/y (implicit) ObjectEntity REAL(4) y = 2 end block contains @@ -48,7 +48,7 @@ contains subroutine s !REF: /s2/x x = 1 - !DEF: /s2/s/w (implicit) ObjectEntity INTEGER + !DEF: /s2/s/w (implicit) ObjectEntity INTEGER(4) w = 1 end subroutine end subroutine @@ -58,8 +58,8 @@ subroutine s3 block !DEF: /s3/Block1/t DerivedType type :: t - !DEF: /s3/i (implicit) ObjectEntity INTEGER - !DEF: /s3/Block1/t/x ObjectEntity REAL + !DEF: /s3/i (implicit) ObjectEntity INTEGER(4) + !DEF: /s3/Block1/t/x ObjectEntity REAL(4) real :: x(10) = [(i, i=1,10)] end type end block @@ -70,8 +70,8 @@ subroutine s4 implicit integer(x) interface !DEF: /s4/s EXTERNAL Subprogram - !DEF: /s4/s/x (implicit) ObjectEntity REAL - !DEF: /s4/s/y (implicit) ObjectEntity INTEGER + !DEF: /s4/s/x (implicit) ObjectEntity REAL(4) + !DEF: /s4/s/y (implicit) ObjectEntity INTEGER(4) subroutine s (x, y) implicit integer(y) end subroutine @@ -81,13 +81,13 @@ end subroutine !DEF: /s5 Subprogram subroutine s5 block - !DEF: /s5/Block1/x (implicit) ObjectEntity REAL + !DEF: /s5/Block1/x (implicit) ObjectEntity REAL(4) dimension :: x(2) block - !DEF: /s5/Block1/Block1/x (implicit) ObjectEntity REAL + !DEF: /s5/Block1/Block1/x (implicit) ObjectEntity REAL(4) dimension :: x(3) end block end block - !DEF: /s5/x (implicit) ObjectEntity REAL + !DEF: /s5/x (implicit) ObjectEntity REAL(4) x = 1.0 end subroutine diff --git a/flang/test/semantics/test_modfile.sh b/flang/test/semantics/test_modfile.sh index 954cf2f3492a..69ed0f40284f 100755 --- a/flang/test/semantics/test_modfile.sh +++ b/flang/test/semantics/test_modfile.sh @@ -61,7 +61,7 @@ for src in "$@"; do fi sed '/^!mod\$/d' $temp/$mod > $actual sed '1,/^!Expect: '"$mod"'/d' $src | sed -e '/^$/,$d' -e 's/^! *//' > $expect - if ! diff -U999999 $actual $expect > $diffs; then + if ! diff -U999999 $expect $actual > $diffs; then echo "Module file $mod differs from expected:" sed '1,2d' $diffs echo FAIL diff --git a/flang/tools/f18/dump.cc b/flang/tools/f18/dump.cc index 6cd60422bb97..4b941bcee947 100644 --- a/flang/tools/f18/dump.cc +++ b/flang/tools/f18/dump.cc @@ -40,7 +40,8 @@ DEFINE_DUMP(parser, Name) DEFINE_DUMP(parser, CharBlock) DEFINE_DUMP(semantics, Symbol) DEFINE_DUMP(semantics, Scope) -DEFINE_DUMP(semantics, TypeSpec) +DEFINE_DUMP(semantics, IntrinsicTypeSpec) +DEFINE_DUMP(semantics, DerivedTypeSpec) DEFINE_DUMP(semantics, DeclTypeSpec) } // namespace Fortran