[flang-commits] [flang] 21971af - [flang] Stricter scrutiny of deferred type parameters (C702)

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-10-29T17:31:34-07:00
New Revision: 21971af236355ae324de7982841e41d47fc7edc7

URL: https://github.com/llvm/llvm-project/commit/21971af236355ae324de7982841e41d47fc7edc7
DIFF: https://github.com/llvm/llvm-project/commit/21971af236355ae324de7982841e41d47fc7edc7.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/resolve69.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index c44037dd5a72..0df66b4086e9 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 6b68074b798d..f600ddc623bf 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 ee3e21a6a870..0edc91ab6cf1 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