[flang] Semantic checks for C702

C702 (R701) A colon shall not be used as a type-param-value except in the
declaration of an entity that has the POINTER or ALLOCATABLE attribute.

I added code to the visitor for a TypeDeclarationStmt to check for the
'LEN' type parameter for strings and to loop over the type parameters
for derived types.

I also ran into a few situations where previous tests had erroneously
used a colon for type parameters without either the POINTER or
ALLOCATABLE attribute and fixed them up.

Original-commit: flang-compiler/f18@a1a95bfcd1
Reviewed-on: https://github.com/flang-compiler/f18/pull/973
This commit is contained in:
Pete Steinfeld 2020-02-06 12:26:51 -08:00
parent f90404e59c
commit 05f44aff45
8 changed files with 84 additions and 13 deletions

View file

@ -720,7 +720,7 @@ public:
void Post(const parser::DimensionStmt::Declaration &);
void Post(const parser::CodimensionDecl &);
bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
void Post(const parser::TypeDeclarationStmt &) { EndDecl(); }
void Post(const parser::TypeDeclarationStmt &);
void Post(const parser::IntegerTypeSpec &);
void Post(const parser::IntrinsicTypeSpec::Real &);
void Post(const parser::IntrinsicTypeSpec::Complex &);
@ -2889,6 +2889,29 @@ bool DeclarationVisitor::CheckAccessibleComponent(
return false;
}
void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) {
if (!GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { // C702
if (const auto *typeSpec{GetDeclTypeSpec()}) {
if (typeSpec->category() == DeclTypeSpec::Character) {
if (typeSpec->characterTypeSpec().length().isDeferred()) {
Say("The type parameter LEN cannot be deferred without"
" the POINTER or ALLOCATABLE attribute"_err_en_US);
}
} else if (const DerivedTypeSpec * derivedSpec{typeSpec->AsDerived()}) {
for (const auto &pair : derivedSpec->parameters()) {
if (pair.second.isDeferred()) {
Say(currStmtSource().value(),
"The value of type parameter '%s' cannot be deferred"
" without the POINTER or ALLOCATABLE attribute"_err_en_US,
pair.first);
}
}
}
}
}
EndDecl();
}
void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
const auto &name{std::get<parser::Name>(x.t)};
DeclareObjectEntity(name, Attrs{});
@ -3522,7 +3545,7 @@ bool DeclarationVisitor::Pre(const parser::DataComponentDefStmt &x) {
// so POINTER & ALLOCATABLE enable forward references to derived types.
Walk(std::get<std::list<parser::ComponentAttrSpec>>(x.t));
set_allowForwardReferenceToDerivedType(
GetAttrs().test(Attr::POINTER) || GetAttrs().test(Attr::ALLOCATABLE));
GetAttrs().HasAny({Attr::POINTER, Attr::ALLOCATABLE}));
Walk(std::get<parser::DeclarationTypeSpec>(x.t));
set_allowForwardReferenceToDerivedType(false);
Walk(std::get<std::list<parser::ComponentDecl>>(x.t));

Binary file not shown.

View file

@ -99,6 +99,7 @@ set(ERROR_TESTS
resolve66.f90
resolve67.f90
resolve68.f90
resolve69.f90
stop01.f90
structconst01.f90
structconst02.f90

View file

@ -34,7 +34,7 @@ subroutine C933_a(b1, ca3, ca4, cp3, cp3mold, cp4, cp7, cp8, bsrc)
type(SomeType(1, l1=3)), pointer :: cp9, cp10(:)
type(B(*)) b1
type(B(:)) b2
type(B(:)), allocatable :: b2
type(B(5)) b3
type(SomeType(4, *, 8)) bsrc

View file

@ -26,12 +26,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_def
class(WithParam(8, :)) src_a_8_def
class(WithParam(4, :)), allocatable :: src_a_4_def
class(WithParam(8, :)), allocatable :: src_a_8_def
type(WithParamExtent(4, 2, 8, 3)) src_b_4_2_8_3
class(WithParamExtent(4, :, 8, 3)) src_b_4_def_8_3
class(WithParamExtent(4, :, 8, 3)), allocatable :: 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_def_8_3
class(WithParamExtent(8, :, 8, 3)), allocatable :: 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

View file

@ -3,20 +3,20 @@
! Note: Module files are encoded in UTF-8.
module m
character(kind=4,len=:), parameter :: c4 = 4_"Hi! 你好!"
character(kind=4,len=*), parameter :: c4 = 4_"Hi! 你好!"
! In CHARACTER(1) literals, codepoints > 0xff are serialized into UTF-8;
! each of those bytes then gets encoded into UTF-8 for the module file.
character(kind=1,len=:), parameter :: c1 = 1_"Hi! 你好!"
character(kind=4,len=:), parameter :: c4a(*) = [4_"一", 4_"二", 4_"三", 4_"四", 4_"五"]
character(kind=1,len=*), parameter :: c1 = 1_"Hi! 你好!"
character(kind=4,len=*), parameter :: c4a(*) = [4_"一", 4_"二", 4_"三", 4_"四", 4_"五"]
integer, parameter :: lc4 = len(c4)
integer, parameter :: lc1 = len(c1)
end module m
!Expect: m.mod
!module m
!character(:,4),parameter::c4=4_"Hi! \344\275\240\345\245\275!"
!character(:,1),parameter::c1=1_"Hi! \344\275\240\345\245\275!"
!character(:,4),parameter::c4a(1_8:*)=[CHARACTER(KIND=4,LEN=1)::4_"\344\270\200",4_"\344\272\214",4_"\344\270\211",4_"\345\233\233",4_"\344\272\224"]
!character(*,4),parameter::c4=4_"Hi! \344\275\240\345\245\275!"
!character(*,1),parameter::c1=1_"Hi! \344\275\240\345\245\275!"
!character(*,4),parameter::c4a(1_8:*)=[CHARACTER(KIND=4,LEN=1)::4_"\344\270\200",4_"\344\272\214",4_"\344\270\211",4_"\345\233\233",4_"\344\272\224"]
!integer(4),parameter::lc4=7_4
!intrinsic::len
!integer(4),parameter::lc1=11_4

View file

@ -1,3 +1,5 @@
! C701 The type-param-value for a kind type parameter shall be a constant
! expression. This constraint looks like a mistake in the standard.
integer, parameter :: k = 8
real, parameter :: l = 8.0
integer :: n = 2

View file

@ -0,0 +1,45 @@
subroutine s1()
! C701 (R701) The type-param-value for a kind type parameter shall be a
! constant expression.
! C702 (R701) A colon shall not be used as a type-param-value except in the
! declaration of an entity that has the POINTER or ALLOCATABLE attribute.
integer, parameter :: constVal = 1
integer :: nonConstVal = 1
!ERROR: Invalid specification expression: reference to local entity 'nonconstval'
character(nonConstVal) :: colonString1
character(len=20, kind=constVal + 1) :: constKindString
character(len=:, kind=constVal + 1), pointer :: constKindString1
!ERROR: The type parameter LEN cannot be deferred without the POINTER or ALLOCATABLE attribute
character(len=:, kind=constVal + 1) :: constKindString2
!ERROR: Must be a constant value
character(len=20, kind=nonConstVal) :: nonConstKindString
!ERROR: The type parameter LEN cannot be deferred without the POINTER or ALLOCATABLE attribute
character(len=:) :: deferredString
!ERROR: The type parameter LEN cannot be deferred without the POINTER or ALLOCATABLE attribute
character(:) :: colonString2
!OK because of the allocatable attribute
character(:), allocatable :: colonString3
type derived(typeKind, typeLen)
integer, kind :: typeKind
integer, len :: typeLen
end type derived
type (derived(constVal, 3)) :: constDerivedKind
!ERROR: Value of kind type parameter 'typekind' (nonconstval) is not a scalar INTEGER constant
!ERROR: Invalid specification expression: reference to local entity 'nonconstval'
type (derived(nonConstVal, 3)) :: nonConstDerivedKind
!OK because all type-params are constants
type (derived(3, constVal)) :: constDerivedLen
!ERROR: Invalid specification expression: reference to local entity 'nonconstval'
type (derived(3, nonConstVal)) :: nonConstDerivedLen
!ERROR: The value of type parameter 'typelen' cannot be deferred without the POINTER or ALLOCATABLE attribute
type (derived(3, :)) :: colonDerivedLen
!ERROR: The value of type parameter 'typekind' cannot be deferred without the POINTER or ALLOCATABLE attribute
!ERROR: The value of type parameter 'typelen' cannot be deferred without the POINTER or ALLOCATABLE attribute
type (derived( :, :)) :: colonDerivedLen1
type (derived( :, :)), pointer :: colonDerivedLen2
type (derived(4, :)), pointer :: colonDerivedLen3
end subroutine s1