Skip to content

Commit bb6faec

Browse files
klauslerklausler
committed
[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
1 parent 36c8a9a commit bb6faec

File tree

4 files changed

+123
-66
lines changed

4 files changed

+123
-66
lines changed

‎flang/docs/Extensions.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -269,6 +269,9 @@ end
269269
* A scalar logical dummy argument to a `BIND(C)` procedure does
270270
not have to have `KIND=C_BOOL` since it can be converted to/from
271271
`_Bool` without loss of information.
272+
* The character length of the `SOURCE=` or `MOLD=` in `ALLOCATE`
273+
may be distinct from the constant character length, if any,
274+
of an allocated object.
272275

273276
### Extensions supported when enabled by options
274277

‎flang/lib/Semantics/check-allocate.cpp

Lines changed: 58 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -350,30 +350,24 @@ static std::optional<std::int64_t> GetTypeParameterInt64Value(
350350
if (const ParamValue *
351351
paramValue{derivedType.FindParameter(parameterSymbol.name())}) {
352352
return evaluate::ToInt64(paramValue->GetExplicit());
353-
} else {
354-
return std::nullopt;
355353
}
354+
return std::nullopt;
356355
}
357356

358-
// HaveCompatibleKindParameters functions assume type1 is type compatible with
359-
// type2 (except for kind type parameters)
360-
static bool HaveCompatibleKindParameters(
357+
static bool HaveCompatibleTypeParameters(
361358
const DerivedTypeSpec &derivedType1, const DerivedTypeSpec &derivedType2) {
362359
for (const Symbol &symbol :
363360
OrderParameterDeclarations(derivedType1.typeSymbol())) {
364-
if (symbol.get<TypeParamDetails>().attr() == common::TypeParamAttr::Kind) {
365-
// At this point, it should have been ensured that these contain integer
366-
// constants, so die if this is not the case.
367-
if (GetTypeParameterInt64Value(symbol, derivedType1).value() !=
368-
GetTypeParameterInt64Value(symbol, derivedType2).value()) {
369-
return false;
370-
}
361+
auto v1{GetTypeParameterInt64Value(symbol, derivedType1)};
362+
auto v2{GetTypeParameterInt64Value(symbol, derivedType2)};
363+
if (v1 && v2 && *v1 != *v2) {
364+
return false;
371365
}
372366
}
373367
return true;
374368
}
375369

376-
static bool HaveCompatibleKindParameters(
370+
static bool HaveCompatibleTypeParameters(
377371
const DeclTypeSpec &type1, const evaluate::DynamicType &type2) {
378372
if (type1.category() == DeclTypeSpec::Category::ClassStar) {
379373
return true;
@@ -383,28 +377,56 @@ static bool HaveCompatibleKindParameters(
383377
} else if (type2.IsUnlimitedPolymorphic()) {
384378
return false;
385379
} else if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) {
386-
return HaveCompatibleKindParameters(
380+
return HaveCompatibleTypeParameters(
387381
*derivedType1, type2.GetDerivedTypeSpec());
388382
} else {
389383
common::die("unexpected type1 category");
390384
}
391385
}
392386

393-
static bool HaveCompatibleKindParameters(
387+
static bool HaveCompatibleTypeParameters(
394388
const DeclTypeSpec &type1, const DeclTypeSpec &type2) {
395389
if (type1.category() == DeclTypeSpec::Category::ClassStar) {
396390
return true;
397-
}
398-
if (const IntrinsicTypeSpec * intrinsicType1{type1.AsIntrinsic()}) {
399-
return intrinsicType1->kind() == DEREF(type2.AsIntrinsic()).kind();
391+
} else if (const IntrinsicTypeSpec * intrinsicType1{type1.AsIntrinsic()}) {
392+
const IntrinsicTypeSpec *intrinsicType2{type2.AsIntrinsic()};
393+
return !intrinsicType2 || intrinsicType1->kind() == intrinsicType2->kind();
400394
} else if (const DerivedTypeSpec * derivedType1{type1.AsDerived()}) {
401-
return HaveCompatibleKindParameters(
402-
*derivedType1, DEREF(type2.AsDerived()));
395+
const DerivedTypeSpec *derivedType2{type2.AsDerived()};
396+
return !derivedType2 ||
397+
HaveCompatibleTypeParameters(*derivedType1, *derivedType2);
403398
} else {
404399
common::die("unexpected type1 category");
405400
}
406401
}
407402

403+
static bool HaveCompatibleLengths(
404+
const DeclTypeSpec &type1, const DeclTypeSpec &type2) {
405+
if (type1.category() == DeclTypeSpec::Character &&
406+
type2.category() == DeclTypeSpec::Character) {
407+
auto v1{
408+
evaluate::ToInt64(type1.characterTypeSpec().length().GetExplicit())};
409+
auto v2{
410+
evaluate::ToInt64(type2.characterTypeSpec().length().GetExplicit())};
411+
return !v1 || !v2 || *v1 == *v2;
412+
} else {
413+
return true;
414+
}
415+
}
416+
417+
static bool HaveCompatibleLengths(
418+
const DeclTypeSpec &type1, const evaluate::DynamicType &type2) {
419+
if (type1.category() == DeclTypeSpec::Character &&
420+
type2.category() == TypeCategory::Character) {
421+
auto v1{
422+
evaluate::ToInt64(type1.characterTypeSpec().length().GetExplicit())};
423+
auto v2{type2.knownLength()};
424+
return !v1 || !v2 || *v1 == *v2;
425+
} else {
426+
return true;
427+
}
428+
}
429+
408430
bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
409431
if (!symbol_) {
410432
CHECK(context.AnyFatalError());
@@ -455,10 +477,15 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
455477
"Allocatable object in ALLOCATE must be type compatible with type-spec"_err_en_US);
456478
return false;
457479
}
458-
if (!HaveCompatibleKindParameters(*type_, *allocateInfo_.typeSpec)) {
480+
if (!HaveCompatibleTypeParameters(*type_, *allocateInfo_.typeSpec)) {
459481
context.Say(name_.source,
460482
// C936
461-
"Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec"_err_en_US);
483+
"Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec"_err_en_US);
484+
return false;
485+
}
486+
if (!HaveCompatibleLengths(*type_, *allocateInfo_.typeSpec)) { // C934
487+
context.Say(name_.source,
488+
"Character length of allocatable object in ALLOCATE must be the same as the type-spec"_err_en_US);
462489
return false;
463490
}
464491
if (!HaveSameAssumedTypeParameters(*type_, *allocateInfo_.typeSpec)) {
@@ -474,11 +501,18 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
474501
"Allocatable object in ALLOCATE must be type compatible with source expression from MOLD or SOURCE"_err_en_US);
475502
return false;
476503
}
477-
if (!HaveCompatibleKindParameters(
504+
if (!HaveCompatibleTypeParameters(
478505
*type_, allocateInfo_.sourceExprType.value())) {
479506
// C946
480507
context.Say(name_.source,
481-
"Kind type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression"_err_en_US);
508+
"Derived type parameters of allocatable object must be the same as the corresponding ones of SOURCE or MOLD expression"_err_en_US);
509+
return false;
510+
}
511+
// Character length distinction is allowed, with a warning
512+
if (!HaveCompatibleLengths(
513+
*type_, allocateInfo_.sourceExprType.value())) { // C945
514+
context.Say(name_.source,
515+
"Character length of allocatable object in ALLOCATE should be the same as the SOURCE or MOLD"_port_en_US);
482516
return false;
483517
}
484518
}

‎flang/test/Semantics/allocate07.f90

Lines changed: 29 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,9 @@ subroutine C936(param_ca_4_assumed, param_ta_4_assumed, param_ca_4_deferred)
3737

3838
class(*), pointer :: whatever
3939

40+
character(:), allocatable :: deferredChar
41+
character(2), allocatable :: char2
42+
4043
! Nominal test cases
4144
allocate(real(kind=4):: x1, x2(10))
4245
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)
5255
allocate(WithParam(k1=1):: param_defaulted)
5356
allocate(WithParamExtent2(k1=1, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_defaulted)
5457
allocate(WithParamExtent2(k1=1, l1=2, k2=5, l2=6, k3=5, l3=8 ):: whatever)
58+
allocate(character(len=1):: deferredChar)
59+
allocate(character(len=2):: char2)
5560

56-
57-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
61+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
5862
allocate(real(kind=8):: x1)
59-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
63+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
6064
allocate(real(kind=8):: x2(10))
61-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
65+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
6266
allocate(WithParam(8, 2):: param_ta_4_2)
63-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
67+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
6468
allocate(WithParam(8, 2):: param_ca_4_2)
65-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
69+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
6670
allocate(WithParamExtent(8, 2, 8, 3):: param_ca_4_2)
67-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
71+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
6872
allocate(WithParam(8, *):: param_ta_4_assumed)
69-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
73+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
7074
allocate(WithParam(8, *):: param_ca_4_assumed)
71-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
75+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
7276
allocate(WithParamExtent(8, *, 8, 3):: param_ca_4_assumed)
73-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
77+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
7478
allocate(WithParam(8, 2):: param_ta_4_deferred)
75-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
79+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
7680
allocate(WithParam(8, 2):: param_ca_4_deferred)
77-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
81+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
7882
allocate(WithParamExtent(8, 2, 8, 3):: param_ca_4_deferred)
79-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
83+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
8084
allocate(WithParamExtent2(k1=5, l1=5, k2=5, l2=6, l3=8 ):: extended2)
81-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
85+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
8286
allocate(WithParamExtent2(k1=5, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_ca_4_2)
83-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
87+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
8488
allocate(WithParamExtent2(k1=4, l1=5, k2=5, l2=6, k3=5, l3=8 ):: extended2)
85-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
89+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
8690
allocate(WithParam:: param_ca_4_2)
87-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
91+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
8892
allocate(WithParam(k1=2, l1=2):: param_defaulted)
89-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
93+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
9094
allocate(WithParam(k1=2):: param_defaulted)
91-
!ERROR: Kind type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
95+
!ERROR: Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec
9296
allocate(WithParamExtent2(k1=5, l1=2, k2=5, l2=6, k3=5, l3=8 ):: param_defaulted)
97+
98+
!ERROR: Either type-spec or source-expr must appear in ALLOCATE when allocatable object has a deferred type parameters
99+
allocate(deferredChar)
100+
!ERROR: Character length of allocatable object in ALLOCATE must be the same as the type-spec
101+
allocate(character(len=1):: char2)
102+
93103
end subroutine

0 commit comments

Comments
 (0)