[flang] Stricter scrutiny of deferred type parameters (C702)

[klausler]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Semantics/check-declarations.cpp

if (!IsDummy(symbol)) {
             symbol.name());
       }
     }
   }
 }
 
 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());
   if (details.shape().Rank() > common::maxRank) {
     messages_.Say(
         "'%s' has rank %d, which is greater than the maximum supported rank %d"_err_en_US,
         symbol.name(), details.shape().Rank(), common::maxRank);
   } else if (details.shape().Rank() + details.coshape().Rank() >

flang/lib/Semantics/resolve-names.cpp

void DeclarationVisitor::CheckAccessibility(
   if (symbol.attrs().test(Attr::PRIVATE) != isPrivate) {
     Say2(name,
         "'%s' does not have the same accessibility as its previous declaration"_err_en_US,
         symbol, "Previous declaration of '%s'"_en_US);
   }
 }
 
 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) {
   DeclareObjectEntity(std::get<parser::Name>(x.t));
 }
 void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {
   DeclareObjectEntity(std::get<parser::Name>(x.t));

flang/test/Semantics/resolve69.f90

subroutine s1()
   !   Section 10.1.11 defines specification expressions
   !
   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
+!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
 
 !ERROR: Must have INTEGER type, but is REAL(4)
   character(3.5) :: badParamValue
 
   type derived(typeKind, typeLen)
     integer, kind :: typeKind
     integer, len :: typeLen
     character(typeKind) :: kindValue
     character(typeLen) :: lenValue
   end type derived
 
   type (derived(constVal, 3)) :: constDerivedKind
 !ERROR: Value of kind type parameter 'typekind' (nonconstval) must be 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
+!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
     Character(maxlen) :: value
   End Type
   Type(string(80)) line
   line%value = 'ok'
   Print *,Trim(line%value)