From bb6faec1818026a5b7ead29ff98511784ce2cfdd Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Fri, 17 Mar 2023 14:13:39 -0700 Subject: [PATCH] [flang] Tune handling of LEN type parameter discrepancies on ALLOCATE Presently, semantics doesn't check for discrepancies between known constant corresponding LEN type parameters between the declared type of an allocatable/pointer and either the type-spec or the SOURCE=/MOLD= on an ALLOCATE statement. This allows discrepancies between character lengths to go unchecked. Some compilers accept mismatched character lengths on SOURCE=/MOLD= and the allocate object, and that's useful and unambiguous feature that already works in f18 via truncation or padding. A portability warning should issue, however. But for mismatched character lengths between an allocate object and an explicit type-spec, and for any mismatch between derived type LEN type parameters, an error is appropriate. Differential Revision: https://reviews.llvm.org/D146583 --- flang/docs/Extensions.md | 3 ++ flang/lib/Semantics/check-allocate.cpp | 82 ++++++++++++++++++++++++---------- flang/test/Semantics/allocate07.f90 | 48 ++++++++++++-------- flang/test/Semantics/allocate09.f90 | 56 +++++++++++++---------- 4 files changed, 123 insertions(+), 66 deletions(-) diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index 7540283..d1b7591 100644 --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -269,6 +269,9 @@ end * A scalar logical dummy argument to a `BIND(C)` procedure does not have to have `KIND=C_BOOL` since it can be converted to/from `_Bool` without loss of information. +* The character length of the `SOURCE=` or `MOLD=` in `ALLOCATE` + may be distinct from the constant character length, if any, + of an allocated object. ### Extensions supported when enabled by options diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp index c397c9f..fa1951d 100644 --- a/flang/lib/Semantics/check-allocate.cpp +++ b/flang/lib/Semantics/check-allocate.cpp @@ -350,30 +350,24 @@ static std::optional GetTypeParameterInt64Value( if (const ParamValue * paramValue{derivedType.FindParameter(parameterSymbol.name())}) { return evaluate::ToInt64(paramValue->GetExplicit()); - } else { - return std::nullopt; } + return std::nullopt; } -// HaveCompatibleKindParameters functions assume type1 is type compatible with -// type2 (except for kind type parameters) -static bool HaveCompatibleKindParameters( +static bool HaveCompatibleTypeParameters( const DerivedTypeSpec &derivedType1, const DerivedTypeSpec &derivedType2) { for (const Symbol &symbol : OrderParameterDeclarations(derivedType1.typeSymbol())) { - if (symbol.get().attr() == common::TypeParamAttr::Kind) { - // At this point, it should have been ensured that these contain integer - // constants, so die if this is not the case. - if (GetTypeParameterInt64Value(symbol, derivedType1).value() != - GetTypeParameterInt64Value(symbol, derivedType2).value()) { - return false; - } + auto v1{GetTypeParameterInt64Value(symbol, derivedType1)}; + auto v2{GetTypeParameterInt64Value(symbol, derivedType2)}; + if (v1 && v2 && *v1 != *v2) { + return false; } } return true; } -static bool HaveCompatibleKindParameters( +static bool HaveCompatibleTypeParameters( const DeclTypeSpec &type1, const evaluate::DynamicType &type2) { if (type1.category() == DeclTypeSpec::Category::ClassStar) { return true; @@ -383,28 +377,56 @@ static bool HaveCompatibleKindParameters( } else if (type2.IsUnlimitedPolymorphic()) { return false; } else if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) { - return HaveCompatibleKindParameters( + return HaveCompatibleTypeParameters( *derivedType1, type2.GetDerivedTypeSpec()); } else { common::die("unexpected type1 category"); } } -static bool HaveCompatibleKindParameters( +static bool HaveCompatibleTypeParameters( const DeclTypeSpec &type1, const DeclTypeSpec &type2) { if (type1.category() == DeclTypeSpec::Category::ClassStar) { return true; - } - if (const IntrinsicTypeSpec * intrinsicType1{type1.AsIntrinsic()}) { - return intrinsicType1->kind() == DEREF(type2.AsIntrinsic()).kind(); + } else if (const IntrinsicTypeSpec * intrinsicType1{type1.AsIntrinsic()}) { + const IntrinsicTypeSpec *intrinsicType2{type2.AsIntrinsic()}; + return !intrinsicType2 || intrinsicType1->kind() == intrinsicType2->kind(); } else if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) { - return HaveCompatibleKindParameters( - *derivedType1, DEREF(type2.AsDerived())); + const DerivedTypeSpec *derivedType2{type2.AsDerived()}; + return !derivedType2 || + HaveCompatibleTypeParameters(*derivedType1, *derivedType2); } else { common::die("unexpected type1 category"); } } +static bool HaveCompatibleLengths( + const DeclTypeSpec &type1, const DeclTypeSpec &type2) { + if (type1.category() == DeclTypeSpec::Character && + type2.category() == DeclTypeSpec::Character) { + auto v1{ + evaluate::ToInt64(type1.characterTypeSpec().length().GetExplicit())}; + auto v2{ + evaluate::ToInt64(type2.characterTypeSpec().length().GetExplicit())}; + return !v1 || !v2 || *v1 == *v2; + } else { + return true; + } +} + +static bool HaveCompatibleLengths( + const DeclTypeSpec &type1, const evaluate::DynamicType &type2) { + if (type1.category() == DeclTypeSpec::Character && + type2.category() == TypeCategory::Character) { + auto v1{ + evaluate::ToInt64(type1.characterTypeSpec().length().GetExplicit())}; + auto v2{type2.knownLength()}; + return !v1 || !v2 || *v1 == *v2; + } else { + return true; + } +} + bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { if (!symbol_) { CHECK(context.AnyFatalError()); @@ -455,10 +477,15 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { "Allocatable object in ALLOCATE must be type compatible with type-spec"_err_en_US); return false; } - if (!HaveCompatibleKindParameters(*type_, *allocateInfo_.typeSpec)) { + if (!HaveCompatibleTypeParameters(*type_, *allocateInfo_.typeSpec)) { context.Say(name_.source, // C936 - "Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec"_err_en_US); + "Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec"_err_en_US); + return false; + } + if (!HaveCompatibleLengths(*type_, *allocateInfo_.typeSpec)) { // C934 + context.Say(name_.source, + "Character length of allocatable object in ALLOCATE must be the same as the type-spec"_err_en_US); return false; } if (!HaveSameAssumedTypeParameters(*type_, *allocateInfo_.typeSpec)) { @@ -474,11 +501,18 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) { "Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE"_err_en_US); return false; } - if (!HaveCompatibleKindParameters( + if (!HaveCompatibleTypeParameters( *type_, allocateInfo_.sourceExprType.value())) { // C946 context.Say(name_.source, - "Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression"_err_en_US); + "Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression"_err_en_US); + return false; + } + // Character length distinction is allowed, with a warning + if (!HaveCompatibleLengths( + *type_, allocateInfo_.sourceExprType.value())) { // C945 + context.Say(name_.source, + "Character length of allocatable object in ALLOCATE should be the same as the SOURCE or MOLD"_port_en_US); return false; } } diff --git a/flang/test/Semantics/allocate07.f90 b/flang/test/Semantics/allocate07.f90 index 8ebdbaa..94e17f3 100644 --- a/flang/test/Semantics/allocate07.f90 +++ b/flang/test/Semantics/allocate07.f90 @@ -37,6 +37,9 @@ subroutine C936(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred) class(*), pointer :: whatever + character(:), allocatable :: deferredChar + character(2), allocatable :: char2 + ! Nominal test cases allocate(real(kind=4):: x1, x2(10)) allocate(WithParam(4, 2):: param_ta_4_2, param_ca_4_2) @@ -52,42 +55,49 @@ subroutine C936(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred) allocate(WithParam(k1=1):: param_defaulted) allocate(WithParamExtent2(k1=1, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_defaulted) allocate(WithParamExtent2(k1=1, l1=2, k2=5, l2=6, k3=5, l3=8 ):: whatever) + allocate(character(len=1):: deferredChar) + allocate(character(len=2):: char2) - - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(real(kind=8):: x1) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(real(kind=8):: x2(10)) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam(8, 2):: param_ta_4_2) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam(8, 2):: param_ca_4_2) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParamExtent(8, 2, 8, 3):: param_ca_4_2) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam(8, *):: param_ta_4_assumed) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam(8, *):: param_ca_4_assumed) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParamExtent(8, *, 8, 3):: param_ca_4_assumed) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam(8, 2):: param_ta_4_deferred) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam(8, 2):: param_ca_4_deferred) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParamExtent(8, 2, 8, 3):: param_ca_4_deferred) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParamExtent2(k1=5, l1=5, k2=5, l2=6, l3=8 ):: extended2) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParamExtent2(k1=5, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_ca_4_2) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParamExtent2(k1=4, l1=5, k2=5, l2=6, k3=5, l3=8 ):: extended2) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam:: param_ca_4_2) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam(k1=2, l1=2):: param_defaulted) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParam(k1=2):: param_defaulted) - !ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec + !ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec allocate(WithParamExtent2(k1=5, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_defaulted) + + !ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object has a deferred type parameters + allocate(deferredChar) + !ERROR: Character length of allocatable object in ALLOCATE must be the same as the type-spec + allocate(character(len=1):: char2) + end subroutine diff --git a/flang/test/Semantics/allocate09.f90 b/flang/test/Semantics/allocate09.f90 index f235cab..2c7107c 100644 --- a/flang/test/Semantics/allocate09.f90 +++ b/flang/test/Semantics/allocate09.f90 @@ -57,6 +57,9 @@ subroutine C946(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred) class(*), pointer :: whatever + character(:), allocatable :: deferredChar + character(2), allocatable :: char2 + ! Nominal test cases allocate(x1, x2(10), source=srcx) allocate(x2(10), source=srcx_array) @@ -80,51 +83,58 @@ subroutine C946(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred) allocate(integer_default, source=[(i,i=0,9)]) + allocate(deferredChar, source="abcd") + allocate(deferredChar, mold=deferredChar) + !PORTABILITY: Character length of allocatable object in ALLOCATE should be the same as the SOURCE or MOLD + allocate(char2, source="a") + !PORTABILITY: Character length of allocatable object in ALLOCATE should be the same as the SOURCE or MOLD + allocate(char2, source="abc") + allocate(char2, mold=deferredChar) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(x1, source=cos(0._8)) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(x2(10), source=srcx8) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(x2(10), mold=srcx8_array) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived 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_2) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived 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 + !ERROR: Derived 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_def) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived 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 + !ERROR: Derived 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_def_8_3) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived 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_def) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived 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 + !ERROR: Derived 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_def) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived 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 + !ERROR: Derived 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 + !ERROR: Derived 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_def) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived 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 + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(extended2, source=src_c_5_5_5_6_8_8) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived 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_c_5_2_5_6_5_8) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(extended2, source=WithParamExtent2(k1=4, l1=5, k2=5, l2=6, k3=5, l3=8)(x=5)) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(param_ca_4_2, mold=param_defaulted) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(param_defaulted, source=param_ca_4_2) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(param_defaulted, mold=WithParam(k1=2)(x=5)) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(param_defaulted, source=src_c_5_2_5_6_5_8) - !ERROR: Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression + !ERROR: Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression allocate(integer_default, source=[(i, integer(8)::i=0,9)]) end subroutine -- 2.7.4