Changeset View
Changeset View
Standalone View
Standalone View
flang/lib/Semantics/check-call.cpp
| Show First 20 Lines • Show All 138 Lines • ▼ Show 20 Lines | static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, | ||||
| characteristics::TypeAndShape &actualType, bool isElemental, | characteristics::TypeAndShape &actualType, bool isElemental, | ||||
| bool actualIsArrayElement, evaluate::FoldingContext &context, | bool actualIsArrayElement, evaluate::FoldingContext &context, | ||||
| const Scope *scope) { | const Scope *scope) { | ||||
| // Basic type & rank checking | // Basic type & rank checking | ||||
| parser::ContextualMessages &messages{context.messages()}; | parser::ContextualMessages &messages{context.messages()}; | ||||
| PadShortCharacterActual(actual, dummy.type, actualType, messages); | PadShortCharacterActual(actual, dummy.type, actualType, messages); | ||||
| ConvertIntegerActual(actual, dummy.type, actualType, messages); | ConvertIntegerActual(actual, dummy.type, actualType, messages); | ||||
| bool typesCompatible{ | bool typesCompatible{dummy.type.type().IsTkCompatibleWith(actualType.type())}; | ||||
| dummy.type.type().IsTypeCompatibleWith(actualType.type())}; | |||||
| if (typesCompatible) { | if (typesCompatible) { | ||||
| if (isElemental) { | if (isElemental) { | ||||
| } else if (dummy.type.attrs().test( | } else if (dummy.type.attrs().test( | ||||
| characteristics::TypeAndShape::Attr::AssumedRank)) { | characteristics::TypeAndShape::Attr::AssumedRank)) { | ||||
| } else if (!dummy.type.attrs().test( | } else if (!dummy.type.attrs().test( | ||||
| characteristics::TypeAndShape::Attr::AssumedShape) && | characteristics::TypeAndShape::Attr::AssumedShape) && | ||||
| (actualType.Rank() > 0 || actualIsArrayElement)) { | (actualType.Rank() > 0 || actualIsArrayElement)) { | ||||
| // Sequence association (15.5.2.11) applies -- rank need not match | // Sequence association (15.5.2.11) applies -- rank need not match | ||||
| ▲ Show 20 Lines • Show All 53 Lines • ▼ Show 20 Lines | if (dummy.type.type().IsAssumedType()) { | ||||
| if (const Symbol * | if (const Symbol * | ||||
| tbp{FindImmediateComponent(*derived, [](const Symbol &symbol) { | tbp{FindImmediateComponent(*derived, [](const Symbol &symbol) { | ||||
| return symbol.has<ProcBindingDetails>(); | return symbol.has<ProcBindingDetails>(); | ||||
| })}) { // 15.5.2.4(2) | })}) { // 15.5.2.4(2) | ||||
| evaluate::SayWithDeclaration(messages, *tbp, | evaluate::SayWithDeclaration(messages, *tbp, | ||||
| "Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US, | "Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US, | ||||
| dummyName, tbp->name()); | dummyName, tbp->name()); | ||||
| } | } | ||||
| if (const Symbol * | const auto &finals{ | ||||
| finalizer{FindImmediateComponent(*derived, [](const Symbol &symbol) { | derived->typeSymbol().get<DerivedTypeDetails>().finals()}; | ||||
| return symbol.has<FinalProcDetails>(); | if (!finals.empty()) { // 15.5.2.4(2) | ||||
| })}) { // 15.5.2.4(2) | if (auto *msg{messages.Say( | ||||
| evaluate::SayWithDeclaration(messages, *finalizer, | "Actual argument associated with TYPE(*) %s may not have derived type '%s' with FINAL subroutine '%s'"_err_en_US, | ||||
| "Actual argument associated with TYPE(*) %s may not have FINAL subroutine '%s'"_err_en_US, | dummyName, derived->typeSymbol().name(), | ||||
| dummyName, finalizer->name()); | finals.begin()->first)}) { | ||||
| msg->Attach(finals.begin()->first, | |||||
| "FINAL subroutine '%s' in derived type '%s'"_en_US, | |||||
| finals.begin()->first, derived->typeSymbol().name()); | |||||
| } | |||||
| } | } | ||||
| } | } | ||||
| if (actualIsCoindexed) { | if (actualIsCoindexed) { | ||||
| if (dummy.intent != common::Intent::In && !dummyIsValue) { | if (dummy.intent != common::Intent::In && !dummyIsValue) { | ||||
| if (auto bad{ | if (auto bad{ | ||||
| FindAllocatableUltimateComponent(*derived)}) { // 15.5.2.4(6) | FindAllocatableUltimateComponent(*derived)}) { // 15.5.2.4(6) | ||||
| evaluate::SayWithDeclaration(messages, *bad, | 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, | "Coindexed actual argument with ALLOCATABLE ultimate component '%s' must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US, | ||||
| ▲ Show 20 Lines • Show All 193 Lines • ▼ Show 20 Lines | if (actualIsUnlimited != dummyIsUnlimited) { | ||||
| // extension: allow with warning, rule is only relevant for definables | // extension: allow with warning, rule is only relevant for definables | ||||
| messages.Say( | messages.Say( | ||||
| "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both should be so"_en_US); | "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both should be so"_en_US); | ||||
| } else { | } else { | ||||
| messages.Say( | messages.Say( | ||||
| "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so"_err_en_US); | "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so"_err_en_US); | ||||
| } | } | ||||
| } else if (!actualIsUnlimited && typesCompatible) { | } else if (!actualIsUnlimited && typesCompatible) { | ||||
| if (!actualType.type().IsTypeCompatibleWith(dummy.type.type())) { | if (!actualType.type().IsTkCompatibleWith(dummy.type.type())) { | ||||
| if (dummy.intent == common::Intent::In) { | if (dummy.intent == common::Intent::In) { | ||||
| // extension: allow with warning, rule is only relevant for definables | // extension: allow with warning, rule is only relevant for definables | ||||
| messages.Say( | messages.Say( | ||||
| "POINTER or ALLOCATABLE dummy and actual arguments should have the same declared type"_en_US); | "POINTER or ALLOCATABLE dummy and actual arguments should have the same declared type and kind"_en_US); | ||||
| } else { | } else { | ||||
| messages.Say( | messages.Say( | ||||
| "POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type"_err_en_US); | "POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind"_err_en_US); | ||||
| } | } | ||||
| } | } | ||||
| if (const auto *derived{ | if (const auto *derived{ | ||||
| evaluate::GetDerivedTypeSpec(actualType.type())}) { | evaluate::GetDerivedTypeSpec(actualType.type())}) { | ||||
| if (!DefersSameTypeParameters( | if (!DefersSameTypeParameters( | ||||
| *derived, *evaluate::GetDerivedTypeSpec(dummy.type.type()))) { | *derived, *evaluate::GetDerivedTypeSpec(dummy.type.type()))) { | ||||
| messages.Say( | messages.Say( | ||||
| "Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US); | "Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US); | ||||
| ▲ Show 20 Lines • Show All 308 Lines • Show Last 20 Lines | |||||