forked from OSchip/llvm-project
[flang] Restored changes from pmk-call05
Original-commit: flang-compiler/f18@bb9c12eec3 Reviewed-on: https://github.com/flang-compiler/f18/pull/792 Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler
parent
bf102b76e4
commit
5f270940ff
|
|
@ -340,7 +340,7 @@ std::optional<DummyArgument> DummyArgument::FromActual(
|
|||
DummyDataObject{
|
||||
TypeAndShape{DynamicType::TypelessIntrinsicArgument()}});
|
||||
},
|
||||
[&](const NullPointer &) { return std::optional<DummyArgument>{}; },
|
||||
[](const NullPointer &) { return std::optional<DummyArgument>{}; },
|
||||
[&](const ProcedureDesignator &designator) {
|
||||
if (auto proc{Procedure::Characterize(
|
||||
designator, context.intrinsics())}) {
|
||||
|
|
|
|||
|
|
@ -366,7 +366,7 @@ auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
|
|||
return Result{shape};
|
||||
}
|
||||
},
|
||||
[&](const semantics::EntityDetails &) {
|
||||
[](const semantics::EntityDetails &) {
|
||||
return Scalar(); // no dimensions seen
|
||||
},
|
||||
[&](const semantics::ProcEntityDetails &proc) {
|
||||
|
|
@ -395,7 +395,7 @@ auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result {
|
|||
[&](const semantics::HostAssocDetails &assoc) {
|
||||
return (*this)(assoc.symbol());
|
||||
},
|
||||
[&](const auto &) { return Result{}; },
|
||||
[](const auto &) { return Result{}; },
|
||||
},
|
||||
symbol.details());
|
||||
}
|
||||
|
|
|
|||
|
|
@ -100,6 +100,18 @@ static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
|
|||
}
|
||||
}
|
||||
|
||||
static bool DefersSameTypeParameters(
|
||||
const DerivedTypeSpec &actual, const DerivedTypeSpec &dummy) {
|
||||
for (const auto &pair : actual.parameters()) {
|
||||
const ParamValue &actualValue{pair.second};
|
||||
const ParamValue *dummyValue{dummy.FindParameter(pair.first)};
|
||||
if (!dummyValue || (actualValue.isDeferred() != dummyValue->isDeferred())) {
|
||||
return false;
|
||||
}
|
||||
}
|
||||
return true;
|
||||
}
|
||||
|
||||
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
||||
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
|
||||
const characteristics::TypeAndShape &actualType, bool isElemental,
|
||||
|
|
@ -108,6 +120,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
// Basic type & rank checking
|
||||
parser::ContextualMessages &messages{context.messages()};
|
||||
PadShortCharacterActual(actual, dummy.type, actualType, messages);
|
||||
bool typesCompatible{dummy.type.IsCompatibleWith(
|
||||
messages, actualType, "dummy argument", "actual argument", isElemental)};
|
||||
bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
|
||||
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
|
||||
bool actualIsCoindexed{ExtractCoarrayRef(actual).has_value()};
|
||||
|
|
@ -135,7 +149,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
dummyName);
|
||||
}
|
||||
|
||||
// derived type actual argument checks
|
||||
// Derived type actual argument checks
|
||||
const Symbol *actualFirstSymbol{evaluate::GetFirstSymbol(actual)};
|
||||
bool actualIsAsynchronous{
|
||||
actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::ASYNCHRONOUS)};
|
||||
|
|
@ -152,9 +166,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
}
|
||||
if (const Symbol *
|
||||
tbp{FindImmediateComponent(derived,
|
||||
std::function<bool(const Symbol &)>{[](const Symbol &symbol) {
|
||||
[](const Symbol &symbol) {
|
||||
return symbol.has<ProcBindingDetails>();
|
||||
}})}) { // 15.5.2.4(2)
|
||||
})}) { // 15.5.2.4(2)
|
||||
if (auto *msg{messages.Say(
|
||||
"Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
|
||||
dummyName, tbp->name())}) {
|
||||
|
|
@ -163,9 +177,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
}
|
||||
if (const Symbol *
|
||||
finalizer{FindImmediateComponent(derived,
|
||||
std::function<bool(const Symbol &)>{[](const Symbol &symbol) {
|
||||
[](const Symbol &symbol) {
|
||||
return symbol.has<FinalProcDetails>();
|
||||
}})}) { // 15.5.2.4(2)
|
||||
})}) { // 15.5.2.4(2)
|
||||
if (auto *msg{messages.Say(
|
||||
"Actual argument associated with TYPE(*) %s may not have FINAL subroutine '%s'"_err_en_US,
|
||||
dummyName, finalizer->name())}) {
|
||||
|
|
@ -179,7 +193,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
!dummyIsValue) {
|
||||
if (auto iter{std::find_if(
|
||||
ultimates.begin(), ultimates.end(), [](const Symbol *component) {
|
||||
return DEREF(component).attrs().test(Attr::ALLOCATABLE);
|
||||
return IsAllocatable(DEREF(component));
|
||||
})}) { // 15.5.2.4(6)
|
||||
if (auto *msg{messages.Say(
|
||||
"Coindexed actual argument with ALLOCATABLE ultimate component '%s' must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
|
||||
|
|
@ -206,12 +220,16 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
}
|
||||
}
|
||||
|
||||
// rank and shape
|
||||
// Rank and shape checks
|
||||
const auto *actualLastSymbol{evaluate::GetLastSymbol(actual)};
|
||||
if (actualLastSymbol != nullptr) {
|
||||
actualLastSymbol = GetAssociationRoot(*actualLastSymbol);
|
||||
}
|
||||
const ObjectEntityDetails *actualLastObject{actualLastSymbol
|
||||
? actualLastSymbol->GetUltimate().detailsIf<ObjectEntityDetails>()
|
||||
: nullptr};
|
||||
int actualRank{evaluate::GetRank(actualType.shape())};
|
||||
bool actualIsPointer{actualLastSymbol && IsPointer(*actualLastSymbol)};
|
||||
if (dummy.type.attrs().test(
|
||||
characteristics::TypeAndShape::Attr::AssumedShape)) {
|
||||
// 15.5.2.4(16)
|
||||
|
|
@ -246,7 +264,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
"Polymorphic scalar may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
}
|
||||
if (actualLastSymbol && actualLastSymbol->attrs().test(Attr::POINTER)) {
|
||||
if (actualIsPointer) {
|
||||
messages.Say(
|
||||
"Scalar POINTER target may not be associated with a %s array"_err_en_US,
|
||||
dummyName);
|
||||
|
|
@ -265,7 +283,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
actualLastSymbol->name(), dummyName);
|
||||
}
|
||||
|
||||
// definability
|
||||
// Definability
|
||||
const char *reason{nullptr};
|
||||
if (dummy.intent == common::Intent::Out) {
|
||||
reason = "INTENT(OUT)";
|
||||
|
|
@ -290,6 +308,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
}
|
||||
|
||||
// Cases when temporaries might be needed but must not be permitted.
|
||||
bool dummyIsPointer{
|
||||
dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
|
||||
if ((actualIsAsynchronous || actualIsVolatile) &&
|
||||
(dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) {
|
||||
if (actualIsCoindexed) { // C1538
|
||||
|
|
@ -304,10 +324,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
characteristics::TypeAndShape::Attr::AssumedRank)};
|
||||
bool dummyIsAssumedShape{dummy.type.attrs().test(
|
||||
characteristics::TypeAndShape::Attr::AssumedShape)};
|
||||
bool actualIsPointer{actualLastSymbol &&
|
||||
actualLastSymbol->GetUltimate().attrs().test(Attr::POINTER)};
|
||||
bool dummyIsPointer{
|
||||
dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
|
||||
if (dummyIsContiguous ||
|
||||
!(dummyIsAssumedShape || dummyIsAssumedRank ||
|
||||
(actualIsPointer && dummyIsPointer))) { // C1539 & C1540
|
||||
|
|
@ -317,6 +333,38 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
|||
}
|
||||
}
|
||||
}
|
||||
|
||||
// 15.5.2.5 -- actual & dummy are both POINTER or both ALLOCATABLE
|
||||
bool actualIsAllocatable{
|
||||
actualLastSymbol && IsAllocatable(*actualLastSymbol)};
|
||||
bool dummyIsAllocatable{
|
||||
dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable)};
|
||||
if ((actualIsPointer && dummyIsPointer) ||
|
||||
(actualIsAllocatable && dummyIsAllocatable)) {
|
||||
if (dummyIsPolymorphic != actualIsPolymorphic) {
|
||||
messages.Say(
|
||||
"If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so"_err_en_US);
|
||||
}
|
||||
bool actualIsUnlimited{actualType.type().IsUnlimitedPolymorphic()};
|
||||
bool dummyIsUnlimited{dummy.type.type().IsUnlimitedPolymorphic()};
|
||||
if (!actualIsUnlimited) {
|
||||
if (dummyIsUnlimited) {
|
||||
messages.Say(
|
||||
"If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so"_err_en_US);
|
||||
} else if (typesCompatible) {
|
||||
if (!actualType.type().IsTypeCompatibleWith(dummy.type.type())) {
|
||||
messages.Say(
|
||||
"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);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
|
||||
|
|
|
|||
|
|
@ -30,36 +30,16 @@ public:
|
|||
explicit CheckHelper(SemanticsContext &c) : context_{c} {}
|
||||
|
||||
void Check() { Check(context_.globalScope()); }
|
||||
void Check(const ParamValue &value) { CheckSpecExpr(value.GetExplicit()); }
|
||||
void Check(const ParamValue &, bool canBeAssumed);
|
||||
void Check(Bound &bound) { CheckSpecExpr(bound.GetExplicit()); }
|
||||
void Check(ShapeSpec &spec) {
|
||||
Check(spec.lbound());
|
||||
Check(spec.ubound());
|
||||
}
|
||||
void Check(ArraySpec &shape) {
|
||||
for (auto &spec : shape) {
|
||||
Check(spec);
|
||||
}
|
||||
}
|
||||
void Check(DeclTypeSpec &type) {
|
||||
if (type.category() == DeclTypeSpec::Character) {
|
||||
Check(type.characterTypeSpec().length());
|
||||
} else if (const DerivedTypeSpec * spec{type.AsDerived()}) {
|
||||
for (auto &parm : spec->parameters()) {
|
||||
Check(parm.second);
|
||||
}
|
||||
}
|
||||
}
|
||||
void Check(ArraySpec &);
|
||||
void Check(DeclTypeSpec &, bool canHaveAssumedTypeParameters);
|
||||
void Check(Symbol &);
|
||||
void Check(Scope &scope) {
|
||||
scope_ = &scope;
|
||||
for (auto &pair : scope) {
|
||||
Check(*pair.second);
|
||||
}
|
||||
for (Scope &child : scope.children()) {
|
||||
Check(child);
|
||||
}
|
||||
}
|
||||
void Check(Scope &);
|
||||
|
||||
private:
|
||||
template<typename A> void CheckSpecExpr(A &x) {
|
||||
|
|
@ -76,6 +56,33 @@ private:
|
|||
const Scope *scope_{nullptr};
|
||||
};
|
||||
|
||||
void CheckHelper::Check(const ParamValue &value, bool canBeAssumed) {
|
||||
if (value.isAssumed()) {
|
||||
if (!canBeAssumed) { // C795
|
||||
messages_.Say(
|
||||
"An assumed (*) type parameter may be used only for a dummy argument, associate name, or named constant"_err_en_US);
|
||||
}
|
||||
} else {
|
||||
CheckSpecExpr(value.GetExplicit());
|
||||
}
|
||||
}
|
||||
|
||||
void CheckHelper::Check(ArraySpec &shape) {
|
||||
for (auto &spec : shape) {
|
||||
Check(spec);
|
||||
}
|
||||
}
|
||||
|
||||
void CheckHelper::Check(DeclTypeSpec &type, bool canHaveAssumedTypeParameters) {
|
||||
if (type.category() == DeclTypeSpec::Character) {
|
||||
Check(type.characterTypeSpec().length(), canHaveAssumedTypeParameters);
|
||||
} else if (const DerivedTypeSpec * spec{type.AsDerived()}) {
|
||||
for (auto &parm : spec->parameters()) {
|
||||
Check(parm.second, canHaveAssumedTypeParameters);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void CheckHelper::Check(Symbol &symbol) {
|
||||
if (context_.HasError(symbol) || symbol.has<UseDetails>() ||
|
||||
symbol.has<HostAssocDetails>()) {
|
||||
|
|
@ -84,7 +91,18 @@ void CheckHelper::Check(Symbol &symbol) {
|
|||
auto save{messages_.SetLocation(symbol.name())};
|
||||
context_.set_location(symbol.name());
|
||||
if (DeclTypeSpec * type{symbol.GetType()}) {
|
||||
Check(*type);
|
||||
bool canHaveAssumedParameter{IsNamedConstant(symbol) ||
|
||||
IsAssumedLengthCharacterFunction(symbol) ||
|
||||
symbol.test(Symbol::Flag::ParentComp)};
|
||||
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
|
||||
canHaveAssumedParameter |= object->isDummy() ||
|
||||
(object->isFuncResult() &&
|
||||
type->category() == DeclTypeSpec::Character);
|
||||
} else {
|
||||
canHaveAssumedParameter |=
|
||||
symbol.has<AssocEntityDetails>() || symbol.has<DerivedTypeDetails>();
|
||||
}
|
||||
Check(*type, canHaveAssumedParameter);
|
||||
}
|
||||
if (IsAssumedLengthCharacterFunction(symbol)) { // C723
|
||||
if (symbol.attrs().test(Attr::RECURSIVE)) {
|
||||
|
|
@ -115,9 +133,9 @@ void CheckHelper::Check(Symbol &symbol) {
|
|||
Check(object->coshape());
|
||||
if (object->isDummy() && symbol.attrs().test(Attr::INTENT_OUT)) {
|
||||
if (FindUltimateComponent(symbol,
|
||||
std::function<bool(const Symbol &)>{[](const Symbol &symbol) {
|
||||
[](const Symbol &symbol) {
|
||||
return IsCoarray(symbol) && IsAllocatable(symbol);
|
||||
}})) { // C846
|
||||
})) { // C846
|
||||
messages_.Say(
|
||||
"An INTENT(OUT) dummy argument may not be, or contain, an ALLOCATABLE coarray"_err_en_US);
|
||||
}
|
||||
|
|
@ -129,6 +147,16 @@ void CheckHelper::Check(Symbol &symbol) {
|
|||
}
|
||||
}
|
||||
|
||||
void CheckHelper::Check(Scope &scope) {
|
||||
scope_ = &scope;
|
||||
for (auto &pair : scope) {
|
||||
Check(*pair.second);
|
||||
}
|
||||
for (Scope &child : scope.children()) {
|
||||
Check(child);
|
||||
}
|
||||
}
|
||||
|
||||
void CheckDeclarations(SemanticsContext &context) {
|
||||
CheckHelper{context}.Check();
|
||||
}
|
||||
|
|
|
|||
|
|
@ -883,8 +883,7 @@ const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope,
|
|||
static Symbol &InstantiateSymbol(
|
||||
const Symbol &symbol, Scope &scope, SemanticsContext &semanticsContext) {
|
||||
evaluate::FoldingContext foldingContext{semanticsContext.foldingContext()};
|
||||
CHECK(foldingContext.pdtInstance() != nullptr);
|
||||
const DerivedTypeSpec &instanceSpec{*foldingContext.pdtInstance()};
|
||||
const DerivedTypeSpec &instanceSpec{DEREF(foldingContext.pdtInstance())};
|
||||
auto pair{scope.try_emplace(symbol.name(), symbol.attrs())};
|
||||
Symbol &result{*pair.first->second};
|
||||
if (!pair.second) {
|
||||
|
|
|
|||
|
|
@ -88,6 +88,8 @@ const Symbol *FindUltimateComponent(
|
|||
const Symbol &symbol, const std::function<bool(const Symbol &)> &predicate);
|
||||
|
||||
// Returns an immediate component of type that matches predicate, or nullptr.
|
||||
// An immediate component of a type is one declared for that type or is an
|
||||
// immediate component of the type that it extends.
|
||||
const Symbol *FindImmediateComponent(
|
||||
const DerivedTypeSpec &, const std::function<bool(const Symbol &)> &);
|
||||
|
||||
|
|
|
|||
|
|
@ -172,6 +172,7 @@ set(ERROR_TESTS
|
|||
call02.f90
|
||||
call03.f90
|
||||
call04.f90
|
||||
call05.f90
|
||||
call13.f90
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
! Check for semantic errors in ALLOCATE statements
|
||||
|
||||
subroutine C933_a(ca3, ca4, cp3, cp3mold, cp4, cp7, cp8, bsrc)
|
||||
subroutine C933_a(b1, ca3, ca4, cp3, cp3mold, cp4, cp7, cp8, bsrc)
|
||||
! If any allocate-object has a deferred type parameter, is unlimited polymorphic,
|
||||
! or is of abstract type, either type-spec or source-expr shall appear.
|
||||
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
! Check for semantic errors in ALLOCATE statements
|
||||
|
||||
|
||||
subroutine C935(l, ac1, ac2, ac3, dc1, dc2, ec1, ec2, aa, ab, ea, eb, da, db, whatever, something)
|
||||
subroutine C935(l, ac1, ac2, ac3, dc1, dc2, ec1, ec2, aa, ab, ab2, ea, eb, da, db, whatever, something, something_else)
|
||||
! A type-param-value in a type-spec shall be an asterisk if and only if each
|
||||
! allocate-object is a dummy argument for which the corresponding type parameter
|
||||
! is assumed.
|
||||
|
|
|
|||
|
|
@ -40,12 +40,12 @@ subroutine C946(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred)
|
|||
real(kind=8) srcx8, srcx8_array(10)
|
||||
class(WithParam(4, 2)) src_a_4_2
|
||||
type(WithParam(8, 2)) src_a_8_2
|
||||
class(WithParam(4, *)) src_a_4_star
|
||||
class(WithParam(8, *)) src_a_8_star
|
||||
class(WithParam(4, :)) src_a_4_def
|
||||
class(WithParam(8, :)) src_a_8_def
|
||||
type(WithParamExtent(4, 2, 8, 3)) src_b_4_2_8_3
|
||||
class(WithParamExtent(4, *, 8, 3)) src_b_4_star_8_3
|
||||
class(WithParamExtent(4, :, 8, 3)) src_b_4_def_8_3
|
||||
type(WithParamExtent(8, 2, 8, 3)) src_b_8_2_8_3
|
||||
class(WithParamExtent(8, *, 8, 3)) src_b_8_star_8_3
|
||||
class(WithParamExtent(8, :, 8, 3)) src_b_8_def_8_3
|
||||
type(WithParamExtent2(k1=4, l1=5, k2=5, l2=6, l3=8 )) src_c_4_5_5_6_8_8
|
||||
class(WithParamExtent2(k1=4, l1=2, k2=5, l2=6, k3=5, l3=8)) src_c_4_2_5_6_5_8
|
||||
class(WithParamExtent2(k2=5, l2=6, k3=5, l3=8)) src_c_1_2_5_6_5_8
|
||||
|
|
@ -73,14 +73,14 @@ subroutine C946(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred)
|
|||
allocate(x2(10), source=srcx_array)
|
||||
allocate(param_ta_4_2, param_ca_4_2, mold=src_a_4_2)
|
||||
allocate(param_ca_4_2, source=src_b_4_2_8_3)
|
||||
allocate(param_ta_4_2, param_ca_4_2, mold=src_a_4_star) ! no C935 equivalent for source-expr
|
||||
allocate(param_ca_4_2, source=src_b_4_star_8_3) ! no C935 equivalent for source-expr
|
||||
allocate(param_ta_4_assumed, param_ca_4_assumed, source=src_a_4_star)
|
||||
allocate(param_ca_4_assumed, mold=src_b_4_star_8_3)
|
||||
allocate(param_ta_4_2, param_ca_4_2, mold=src_a_4_def) ! no C935 equivalent for source-expr
|
||||
allocate(param_ca_4_2, source=src_b_4_def_8_3) ! no C935 equivalent for source-expr
|
||||
allocate(param_ta_4_assumed, param_ca_4_assumed, source=src_a_4_def)
|
||||
allocate(param_ca_4_assumed, mold=src_b_4_def_8_3)
|
||||
allocate(param_ta_4_assumed, param_ca_4_assumed, source=src_a_4_2) ! no C935 equivalent for source-expr
|
||||
allocate(param_ca_4_assumed, mold=src_b_4_2_8_3) ! no C935 equivalent for source-expr
|
||||
allocate(param_ta_4_deferred, param_ca_4_deferred, source =src_a_4_2)
|
||||
allocate(param_ca_4_deferred, mold=src_b_4_star_8_3)
|
||||
allocate(param_ca_4_deferred, mold=src_b_4_def_8_3)
|
||||
|
||||
allocate(extended2, source=src_c_4_5_5_6_8_8)
|
||||
allocate(param_ca_4_2, mold= src_c_4_2_5_6_5_8)
|
||||
|
|
@ -103,23 +103,23 @@ subroutine C946(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred)
|
|||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ca_4_2, mold=src_a_8_2)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ta_4_2, source=src_a_8_star)
|
||||
allocate(param_ta_4_2, source=src_a_8_def)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ca_4_2, source=src_b_8_2_8_3)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ca_4_2, mold=src_b_8_star_8_3)
|
||||
allocate(param_ca_4_2, mold=src_b_8_def_8_3)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ta_4_assumed, source=src_a_8_star)
|
||||
allocate(param_ta_4_assumed, source=src_a_8_def)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ta_4_assumed, mold=src_a_8_2)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ca_4_assumed, mold=src_a_8_star)
|
||||
allocate(param_ca_4_assumed, mold=src_a_8_def)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ca_4_assumed, source=src_b_8_2_8_3)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ta_4_deferred, mold=src_a_8_2)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ca_4_deferred, source=src_a_8_star)
|
||||
allocate(param_ca_4_deferred, source=src_a_8_def)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
allocate(param_ca_4_deferred, mold=src_b_8_2_8_3)
|
||||
!ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression
|
||||
|
|
|
|||
|
|
@ -33,8 +33,12 @@ module m
|
|||
class(t2), allocatable :: pa2(:)
|
||||
class(*), pointer :: up(:)
|
||||
class(*), allocatable :: ua(:)
|
||||
type(pdt(*)), pointer :: dmp(:)
|
||||
type(pdt(*)), allocatable :: dma(:)
|
||||
!ERROR: An assumed (*) type parameter may be used only for a dummy argument, associate name, or named constant
|
||||
type(pdt(*)), pointer :: amp(:)
|
||||
!ERROR: An assumed (*) type parameter may be used only for a dummy argument, associate name, or named constant
|
||||
type(pdt(*)), allocatable :: ama(:)
|
||||
type(pdt(:)), pointer :: dmp(:)
|
||||
type(pdt(:)), allocatable :: dma(:)
|
||||
type(pdt(1)), pointer :: nmp(:)
|
||||
type(pdt(1)), allocatable :: nma(:)
|
||||
|
||||
|
|
@ -58,17 +62,23 @@ module m
|
|||
subroutine sua(x)
|
||||
class(*), allocatable :: x(:)
|
||||
end subroutine
|
||||
subroutine sdmp(x)
|
||||
subroutine samp(x)
|
||||
type(pdt(*)), pointer :: x(:)
|
||||
end subroutine
|
||||
subroutine sama(x)
|
||||
type(pdt(*)), allocatable :: x(:)
|
||||
end subroutine
|
||||
subroutine sdmp(x)
|
||||
type(pdt(:)), pointer :: x(:)
|
||||
end subroutine
|
||||
subroutine sdma(x)
|
||||
type(pdt(*)), pointer :: x(:)
|
||||
type(pdt(:)), allocatable :: x(:)
|
||||
end subroutine
|
||||
subroutine snmp(x)
|
||||
type(pdt(1)), pointer :: x(:)
|
||||
end subroutine
|
||||
subroutine snma(x)
|
||||
type(pdt(1)), pointer :: x(:)
|
||||
type(pdt(1)), allocatable :: x(:)
|
||||
end subroutine
|
||||
|
||||
subroutine test
|
||||
|
|
@ -76,42 +86,48 @@ module m
|
|||
call sma(ma) ! ok
|
||||
call spp(pp) ! ok
|
||||
call spa(pa) ! ok
|
||||
!ERROR: If a dummy or effective argument is polymorphic, both must be so
|
||||
!ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
|
||||
call smp(pp)
|
||||
!ERROR: If a dummy or effective argument is polymorphic, both must be so
|
||||
call sma(pp)
|
||||
!ERROR: If a dummy or effective argument is polymorphic, both must be so
|
||||
!ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
|
||||
call sma(pa)
|
||||
!ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
|
||||
call spp(mp)
|
||||
!ERROR: If a dummy or effective argument is polymorphic, both must be so
|
||||
call spa(mp)
|
||||
!ERROR: If a dummy or effective argument is unlimited polymorphic, both must be so
|
||||
!ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
|
||||
call spa(ma)
|
||||
!ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
|
||||
call sup(pp)
|
||||
!ERROR: If a dummy or effective argument is unlimited polymorphic, both must be so
|
||||
!ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
|
||||
call sua(pa)
|
||||
!ERROR: If a dummy or effective argument is unlimited polymorphic, both must be so
|
||||
!ERROR: actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
|
||||
call spp(up)
|
||||
!ERROR: If a dummy or effective argument is unlimited polymorphic, both must be so
|
||||
!ERROR: actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
|
||||
call spa(ua)
|
||||
!ERROR: Dummy and effective arguments must have the same declared type
|
||||
!ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type
|
||||
call spp(pp2)
|
||||
!ERROR: Dummy and effective arguments must have the same declared type
|
||||
!ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type
|
||||
call spa(pa2)
|
||||
!ERROR: Dummy argument has rank 1, but effective argument has rank 2
|
||||
!ERROR: Rank of dummy argument is 1, but actual argument has rank 2
|
||||
call smp(mpmat)
|
||||
!ERROR: Dummy argument has rank 1, but effective argument has rank 2
|
||||
!ERROR: Rank of dummy argument is 1, but actual argument has rank 2
|
||||
call sma(mamat)
|
||||
call sdmp(dmp) ! ok
|
||||
call sdma(dma) ! ok
|
||||
call snmp(nmp) ! ok
|
||||
call snma(nma) ! ok
|
||||
!ERROR: Dummy and effective arguments must defer the same type parameters
|
||||
call samp(nmp) ! ok
|
||||
call sama(nma) ! ok
|
||||
!ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
|
||||
call sdmp(nmp)
|
||||
!ERROR: Dummy and effective arguments must defer the same type parameters
|
||||
!ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
|
||||
call sdma(nma)
|
||||
!ERROR: Dummy and effective arguments must defer the same type parameters
|
||||
!ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
|
||||
call snmp(dmp)
|
||||
!ERROR: Dummy and effective arguments must defer the same type parameters
|
||||
!ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
|
||||
call snma(dma)
|
||||
!ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
|
||||
call samp(dmp)
|
||||
!ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
|
||||
call sama(dma)
|
||||
end subroutine
|
||||
|
||||
end module
|
||||
|
|
|
|||
Loading…
Reference in New Issue