From: Tim Keith Date: Mon, 16 Dec 2019 22:28:23 +0000 (-0800) Subject: [flang] Add evaluate::GetDerivedTypeSpec(DynamicType) X-Git-Tag: llvmorg-12-init~9537^2~299 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=ea00274e6d016115f795084e6d60902c8ab4197b;p=platform%2Fupstream%2Fllvm.git [flang] Add evaluate::GetDerivedTypeSpec(DynamicType) It gets the semantics::DerivedTypeSpec of a DynamicType if it has one. Make use of it where it simplifies the code. Original-commit: flang-compiler/f18@9ad12e7c131459a8beab2b9ffa204966a85f405a Reviewed-on: https://github.com/flang-compiler/f18/pull/872 --- diff --git a/flang/lib/evaluate/characteristics.cc b/flang/lib/evaluate/characteristics.cc index 85b8caa..e2c4076 100644 --- a/flang/lib/evaluate/characteristics.cc +++ b/flang/lib/evaluate/characteristics.cc @@ -293,12 +293,11 @@ bool DummyDataObject::CanBePassedViaImplicitInterface() const { return false; // 15.4.2.2(3)(b-d) } else if (type.type().IsPolymorphic()) { return false; // 15.4.2.2(3)(f) - } else if (type.type().category() == TypeCategory::Derived) { - if (!type.type().GetDerivedTypeSpec().parameters().empty()) { - return false; // 15.4.2.2(3)(e) - } + } else if (const auto *derived{GetDerivedTypeSpec(type.type())}) { + return derived->parameters().empty(); // 15.4.2.2(3)(e) + } else { + return true; } - return true; } std::ostream &DummyDataObject::Dump(std::ostream &o) const { diff --git a/flang/lib/evaluate/type.cc b/flang/lib/evaluate/type.cc index 86acfa5..621d8c1 100644 --- a/flang/lib/evaluate/type.cc +++ b/flang/lib/evaluate/type.cc @@ -100,6 +100,20 @@ bool DynamicType::IsTypelessIntrinsicArgument() const { return category_ == TypeCategory::Integer && kind_ == TypelessKind; } +const semantics::DerivedTypeSpec *GetDerivedTypeSpec( + const std::optional &type) { + return type ? GetDerivedTypeSpec(*type) : nullptr; +} + +const semantics::DerivedTypeSpec *GetDerivedTypeSpec(const DynamicType &type) { + if (type.category() == TypeCategory::Derived && + !type.IsUnlimitedPolymorphic()) { + return &type.GetDerivedTypeSpec(); + } else { + return nullptr; + } +} + static const semantics::Symbol *FindParentComponent( const semantics::DerivedTypeSpec &derived) { const semantics::Symbol &typeSymbol{derived.typeSymbol()}; diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h index 0bc5e09..021d4ab 100644 --- a/flang/lib/evaluate/type.h +++ b/flang/lib/evaluate/type.h @@ -212,6 +212,11 @@ private: const semantics::DerivedTypeSpec *derived_{nullptr}; // TYPE(T), CLASS(T) }; +// Return the DerivedTypeSpec of a DynamicType if it has one. +const semantics::DerivedTypeSpec *GetDerivedTypeSpec(const DynamicType &); +const semantics::DerivedTypeSpec *GetDerivedTypeSpec( + const std::optional &); + std::string DerivedTypeSpecAsFortran(const semantics::DerivedTypeSpec &); template struct TypeBase { diff --git a/flang/lib/semantics/assignment.cc b/flang/lib/semantics/assignment.cc index 577b007..57e55a6 100644 --- a/flang/lib/semantics/assignment.cc +++ b/flang/lib/semantics/assignment.cc @@ -593,14 +593,12 @@ void CheckDefinabilityInPureScope(parser::ContextualMessages &messages, static std::optional GetPointerComponentDesignatorName( const SomeExpr &expr) { - if (auto type{evaluate::DynamicType::From(expr)}) { - if (type->category() == TypeCategory::Derived && - !type->IsUnlimitedPolymorphic()) { - UltimateComponentIterator ultimates{type->GetDerivedTypeSpec()}; - if (auto pointer{ - std::find_if(ultimates.begin(), ultimates.end(), IsPointer)}) { - return pointer.BuildResultDesignatorName(); - } + if (const auto *derived{ + evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(expr))}) { + UltimateComponentIterator ultimates{*derived}; + if (auto pointer{ + std::find_if(ultimates.begin(), ultimates.end(), IsPointer)}) { + return pointer.BuildResultDesignatorName(); } } return std::nullopt; @@ -648,11 +646,9 @@ void AssignmentContext::CheckForPureContext(const SomeExpr &lhs, Say(at_, "Deallocation of polymorphic object is not permitted in a PURE subprogram"_err_en_US); } - if (type->category() == TypeCategory::Derived && - !type->IsUnlimitedPolymorphic()) { - const DerivedTypeSpec &derived{type->GetDerivedTypeSpec()}; + if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(type)}) { if (auto bad{FindPolymorphicAllocatableNonCoarrayUltimateComponent( - derived)}) { + *derived)}) { evaluate::SayWithDeclaration(messages, *bad, "Deallocation of polymorphic non-coarray component '%s' is not permitted in a PURE subprogram"_err_en_US, bad.BuildResultDesignatorName()); diff --git a/flang/lib/semantics/check-allocate.cc b/flang/lib/semantics/check-allocate.cc index eed83d1..5f9d638 100644 --- a/flang/lib/semantics/check-allocate.cc +++ b/flang/lib/semantics/check-allocate.cc @@ -203,12 +203,10 @@ static std::optional CheckAllocateOptions( } info.sourceExprRank = expr->Rank(); info.sourceExprLoc = parserSourceExpr->source; - if (info.sourceExprType.value().category() == TypeCategory::Derived && - !info.sourceExprType.value().IsUnlimitedPolymorphic()) { - const DerivedTypeSpec &derived{ - info.sourceExprType.value().GetDerivedTypeSpec()}; + if (const DerivedTypeSpec * + derived{evaluate::GetDerivedTypeSpec(info.sourceExprType)}) { // C949 - if (auto it{FindCoarrayUltimateComponent(derived)}) { + if (auto it{FindCoarrayUltimateComponent(*derived)}) { context .Say(at, "SOURCE or MOLD expression must not have a type with a coarray ultimate component"_err_en_US) @@ -219,10 +217,10 @@ static std::optional CheckAllocateOptions( } if (info.gotSource) { // C948 - if (IsEventTypeOrLockType(&derived)) { + if (IsEventTypeOrLockType(derived)) { context.Say(at, "SOURCE expression type must not be EVENT_TYPE or LOCK_TYPE from ISO_FORTRAN_ENV"_err_en_US); - } else if (auto it{FindEventOrLockPotentialComponent(derived)}) { + } else if (auto it{FindEventOrLockPotentialComponent(*derived)}) { context .Say(at, "SOURCE expression type must not have potential subobject " @@ -571,16 +569,14 @@ bool AllocationCheckerHelper::RunCoarrayRelatedChecks( // C948 const evaluate::DynamicType &sourceType{ allocateInfo_.sourceExprType.value()}; - if (sourceType.category() == TypeCategory::Derived && - !sourceType.IsUnlimitedPolymorphic()) { - const DerivedTypeSpec derived{sourceType.GetDerivedTypeSpec()}; - if (IsTeamType(&derived)) { + if (const auto *derived{evaluate::GetDerivedTypeSpec(sourceType)}) { + if (IsTeamType(derived)) { context .Say(allocateInfo_.sourceExprLoc.value(), "SOURCE or MOLD expression type must not be TEAM_TYPE from ISO_FORTRAN_ENV when an allocatable object is a coarray"_err_en_US) .Attach(name_.source, "'%s' is a coarray"_en_US, name_.source); return false; - } else if (IsIsoCType(&derived)) { + } else if (IsIsoCType(derived)) { context .Say(allocateInfo_.sourceExprLoc.value(), "SOURCE or MOLD expression type must not be C_PTR or C_FUNPTR from ISO_C_BINDING when an allocatable object is a coarray"_err_en_US) diff --git a/flang/lib/semantics/check-call.cc b/flang/lib/semantics/check-call.cc index 788b815..5b323f2 100644 --- a/flang/lib/semantics/check-call.cc +++ b/flang/lib/semantics/check-call.cc @@ -44,9 +44,8 @@ static void CheckImplicitInterfaceArg( } else if (type->IsPolymorphic()) { messages.Say( "Polymorphic argument requires an explicit interface"_err_en_US); - } else if (type->category() == TypeCategory::Derived) { - auto &derived{type->GetDerivedTypeSpec()}; - if (!derived.parameters().empty()) { + } else if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(type)}) { + if (!derived->parameters().empty()) { messages.Say( "Parameterized derived type argument requires an explicit interface"_err_en_US); } @@ -157,17 +156,15 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::ASYNCHRONOUS)}; bool actualIsVolatile{ actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::VOLATILE)}; - if (!actualType.type().IsUnlimitedPolymorphic() && - actualType.type().category() == TypeCategory::Derived) { - const auto &derived{actualType.type().GetDerivedTypeSpec()}; + if (const auto *derived{evaluate::GetDerivedTypeSpec(actualType.type())}) { if (dummy.type.type().IsAssumedType()) { - if (!derived.parameters().empty()) { // 15.5.2.4(2) + if (!derived->parameters().empty()) { // 15.5.2.4(2) messages.Say( "Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US, dummyName); } if (const Symbol * - tbp{FindImmediateComponent(derived, [](const Symbol &symbol) { + tbp{FindImmediateComponent(*derived, [](const Symbol &symbol) { return symbol.has(); })}) { // 15.5.2.4(2) evaluate::SayWithDeclaration(messages, *tbp, @@ -175,7 +172,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, dummyName, tbp->name()); } if (const Symbol * - finalizer{FindImmediateComponent(derived, [](const Symbol &symbol) { + finalizer{FindImmediateComponent(*derived, [](const Symbol &symbol) { return symbol.has(); })}) { // 15.5.2.4(2) evaluate::SayWithDeclaration(messages, *finalizer, @@ -186,7 +183,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, if (actualIsCoindexed) { if (dummy.intent != common::Intent::In && !dummyIsValue) { if (auto bad{ - FindAllocatableUltimateComponent(derived)}) { // 15.5.2.4(6) + FindAllocatableUltimateComponent(*derived)}) { // 15.5.2.4(6) evaluate::SayWithDeclaration(messages, *bad, "Coindexed actual argument with ALLOCATABLE ultimate component '%s' must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US, bad.BuildResultDesignatorName(), dummyName); @@ -206,7 +203,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, } } if (actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22) - if (auto bad{semantics::FindCoarrayUltimateComponent(derived)}) { + if (auto bad{semantics::FindCoarrayUltimateComponent(*derived)}) { evaluate::SayWithDeclaration(messages, *bad, "VOLATILE attribute must match for %s when actual argument has a coarray ultimate component '%s'"_err_en_US, dummyName, bad.BuildResultDesignatorName()); @@ -400,11 +397,13 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, "POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type"_err_en_US); } } - if (actualType.type().category() == TypeCategory::Derived && - !DefersSameTypeParameters(actualType.type().GetDerivedTypeSpec(), - dummy.type.type().GetDerivedTypeSpec())) { - messages.Say( - "Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US); + if (const auto *derived{ + evaluate::GetDerivedTypeSpec(actualType.type())}) { + if (!DefersSameTypeParameters( + *derived, *evaluate::GetDerivedTypeSpec(dummy.type.type()))) { + messages.Say( + "Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US); + } } } } diff --git a/flang/lib/semantics/check-coarray.cc b/flang/lib/semantics/check-coarray.cc index 088afaa..2b8ac22 100644 --- a/flang/lib/semantics/check-coarray.cc +++ b/flang/lib/semantics/check-coarray.cc @@ -26,13 +26,9 @@ namespace Fortran::semantics { template static void CheckTeamType(SemanticsContext &context, const T &x) { if (const auto *expr{GetExpr(x)}) { - if (auto type{expr->GetType()}) { - if (type->category() != TypeCategory::Derived || - type->IsUnlimitedPolymorphic() || - !IsTeamType(&type->GetDerivedTypeSpec())) { - context.Say(parser::FindSourceLocation(x), // C1114 - "Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US); - } + if (!IsTeamType(evaluate::GetDerivedTypeSpec(expr->GetType()))) { + context.Say(parser::FindSourceLocation(x), // C1114 + "Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US); } } } diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 0bebe4b..9b54b42 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -913,16 +913,6 @@ static std::optional CreateComponent( return std::nullopt; } -static const semantics::DerivedTypeSpec *GetDerivedTypeSpec( - const std::optional &type) { - if (type && type->category() == TypeCategory::Derived) { - if (!type->IsUnlimitedPolymorphic()) { - return &type->GetDerivedTypeSpec(); - } - } - return nullptr; -} - // Derived type component references and type parameter inquiries MaybeExpr ExpressionAnalyzer::Analyze(const parser::StructureComponent &sc) { MaybeExpr base{Analyze(sc.base)}; diff --git a/flang/lib/semantics/tools.cc b/flang/lib/semantics/tools.cc index 25c7e11..90878d6 100644 --- a/flang/lib/semantics/tools.cc +++ b/flang/lib/semantics/tools.cc @@ -95,11 +95,14 @@ Tristate IsDefinedAssignment( } else if (lhsCat != TypeCategory::Derived) { return ToTristate(lhsCat != rhsCat && (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat))); - } else if (rhsCat == TypeCategory::Derived && - lhsType->GetDerivedTypeSpec() == rhsType->GetDerivedTypeSpec()) { - return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or intrinsic } else { - return Tristate::Yes; + const auto *lhsDerived{evaluate::GetDerivedTypeSpec(lhsType)}; + const auto *rhsDerived{evaluate::GetDerivedTypeSpec(rhsType)}; + if (lhsDerived && rhsDerived && *lhsDerived == *rhsDerived) { + return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or intrinsic + } else { + return Tristate::Yes; + } } }