From: Peter Klausler <pklausler@nvidia.com>
Date: Wed, 12 Oct 2022 22:15:33 +0000 (-0700)
Subject: [flang] Stricter scrutiny of deferred type parameters (C702)
X-Git-Tag: upstream/17.0.6~29078
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=21971af236355ae324de7982841e41d47fc7edc7;p=platform%2Fupstream%2Fllvm.git

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

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