From 21971af236355ae324de7982841e41d47fc7edc7 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Wed, 12 Oct 2022 15:15:33 -0700 Subject: [PATCH] [flang] Stricter scrutiny of deferred type parameters (C702) Semantics checks C702, which disallows deferred type parameters for any entity that is neither an allocatable nor a pointer, only during name resolution of type declaration statements. This check needs to be broader, since Fortran entities can have their types specified in other ways. Rewrite the check and move it to the general declaration checking pass. Differential Revision: https://reviews.llvm.org/D136970 --- flang/lib/Semantics/check-declarations.cpp | 9 +++++++++ flang/lib/Semantics/resolve-names.cpp | 19 ------------------ flang/test/Semantics/resolve69.f90 | 32 ++++++++++++++++++++++++------ 3 files changed, 35 insertions(+), 25 deletions(-) diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index c44037d..0df66b4 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -493,6 +493,15 @@ void CheckHelper::CheckAssumedTypeEntity( // C709 void CheckHelper::CheckObjectEntity( const Symbol &symbol, const ObjectEntityDetails &details) { + if (!IsAllocatableOrPointer(symbol)) { // C702 + if (auto dyType{evaluate::DynamicType::From(symbol)}) { + if (dyType->HasDeferredTypeParameter()) { + messages_.Say( + "'%s' has a type %s with a deferred type parameter but is neither an allocatable or a pointer"_err_en_US, + symbol.name(), dyType->AsFortran()); + } + } + } CheckArraySpec(symbol, details.shape()); Check(details.shape()); Check(details.coshape()); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 6b68074..f600ddc 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3975,25 +3975,6 @@ void DeclarationVisitor::CheckAccessibility( } 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(); } diff --git a/flang/test/Semantics/resolve69.f90 b/flang/test/Semantics/resolve69.f90 index ee3e21a..0edc91a 100644 --- a/flang/test/Semantics/resolve69.f90 +++ b/flang/test/Semantics/resolve69.f90 @@ -16,13 +16,13 @@ subroutine s1() 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 +!ERROR: 'constkindstring2' has a type CHARACTER(KIND=2,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer 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 +!ERROR: 'deferredstring' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer character(len=:) :: deferredString -!ERROR: The type parameter LEN cannot be deferred without the POINTER or ALLOCATABLE attribute +!ERROR: 'colonstring2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer character(:) :: colonString2 !OK because of the allocatable attribute character(:), allocatable :: colonString3 @@ -47,14 +47,34 @@ subroutine s1() !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 +!ERROR: 'colonderivedlen' has a type derived(typekind=3_4,typelen=:) with a deferred type parameter but is neither an allocatable or a pointer 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 +!ERROR: 'colonderivedlen1' has a type derived(typekind=:,typelen=:) with a deferred type parameter but is neither an allocatable or a pointer type (derived( :, :)) :: colonDerivedLen1 type (derived( :, :)), pointer :: colonDerivedLen2 type (derived(4, :)), pointer :: colonDerivedLen3 end subroutine s1 + +!C702 +!ERROR: 'f1' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer +character(:) function f1 +end function + +function f2 +!ERROR: 'f2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer + character(:) f2 +end function + +function f3() result(res) +!ERROR: 'res' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer + character(:) res +end function + +!ERROR: 'f4' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer +function f4 + implicit character(:)(f) +end function + Program d5 Type string(maxlen) Integer,Kind :: maxlen -- 2.7.4