[flang-commits] [flang] bcd0bf9 - [flang] Enforce 15.4.2.2(4)(c) - explicit interface required

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-12-15T18:26:16-08:00
New Revision: bcd0bf9284db0d5d4697611ff9bf3243504aab07

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

LOG: [flang] Enforce 15.4.2.2(4)(c) - explicit interface required

When a function has an implicit interface its result type may
not have a deferred type parameter.

Differential Revision: https://reviews.llvm.org/D140132

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 2913b7a51d887..0aca16d33bd4f 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2378,11 +2378,13 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
 }
 
 void CheckHelper::CheckSymbolType(const Symbol &symbol) {
-  if (!IsAllocatableOrPointer(symbol)) { // C702
+  if (!IsAllocatable(symbol) &&
+      (!IsPointer(symbol) ||
+          (IsProcedure(symbol) && !symbol.HasExplicitInterface()))) { // 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,
+            "'%s' has a type %s with a deferred type parameter but is neither an allocatable nor an object pointer"_err_en_US,
             symbol.name(), dyType->AsFortran());
       }
     }

diff  --git a/flang/test/Semantics/resolve69.f90 b/flang/test/Semantics/resolve69.f90
index 4db277dfe5c7f..e5bdac5205e2e 100644
--- a/flang/test/Semantics/resolve69.f90
+++ b/flang/test/Semantics/resolve69.f90
@@ -3,36 +3,40 @@ 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 
+  ! 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.
   !
-  ! C704 (R703) In a declaration-type-spec, every type-param-value that is 
+  ! C704 (R703) In a declaration-type-spec, every type-param-value that is
   ! not a colon or an asterisk shall be a specification expression.
   !   Section 10.1.11 defines specification expressions
   !
+  ! 15.4.2.2(4)(c) A procedure must have an explicit interface if it has a
+  ! result that has a nonassumed type parameter value that is not a constant
+  ! expression.
+  !
   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: 'constkindstring2' has a type CHARACTER(KIND=2,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer
+!ERROR: 'constkindstring2' has a type CHARACTER(KIND=2,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
   character(len=:, kind=constVal + 1) :: constKindString2
 !ERROR: Must be a constant value
   character(len=20, kind=nonConstVal) :: nonConstKindString
-!ERROR: 'deferredstring' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer
+!ERROR: 'deferredstring' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
   character(len=:) :: deferredString
-!ERROR: 'colonstring2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer
+!ERROR: 'colonstring2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
   character(:) :: colonString2
   !OK because of the allocatable attribute
   character(:), allocatable :: colonString3
-!ERROR: 'foo1' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer
+!ERROR: 'foo1' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
   character(:), external :: foo1
-!ERROR: 'foo2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer
+!ERROR: 'foo2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
   procedure(character(:)) :: foo2
   interface
     function foo3()
-!ERROR: 'foo3' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable or a pointer
+!ERROR: 'foo3' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
       character(:) foo3
     end function
   end interface
@@ -57,30 +61,30 @@ function foo3()
 
 !ERROR: Invalid specification expression: reference to local entity 'nonconstval'
   type (derived(3, nonConstVal)) :: nonConstDerivedLen
-!ERROR: 'colonderivedlen' has a type derived(typekind=3_4,typelen=:) with a deferred type parameter but is neither an allocatable or a pointer
+!ERROR: 'colonderivedlen' has a type derived(typekind=3_4,typelen=:) with a deferred type parameter but is neither an allocatable nor an object pointer
   type (derived(3, :)) :: colonDerivedLen
-!ERROR: 'colonderivedlen1' has a type derived(typekind=:,typelen=:) with a deferred type parameter but is neither an allocatable or a pointer
+!ERROR: 'colonderivedlen1' has a type derived(typekind=:,typelen=:) with a deferred type parameter but is neither an allocatable nor an object 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
+!ERROR: 'f1' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object 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
+!ERROR: 'f2' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object 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
+!ERROR: 'res' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object 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
+!ERROR: 'f4' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
 function f4
   implicit character(:)(f)
 end function
@@ -107,3 +111,14 @@ function inner2()
     real inner2(n)
   end function inner2
 end subroutine outer
+
+subroutine s2(dp,dpp)
+  !ERROR: 'dp' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
+  procedure(character(:)) :: dp
+  !ERROR: 'dpp' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
+  procedure(character(:)), pointer :: dpp
+  !ERROR: 'pp' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
+  procedure(character(:)), pointer :: pp
+  !ERROR: 'xp' has a type CHARACTER(KIND=1,LEN=:) with a deferred type parameter but is neither an allocatable nor an object pointer
+  procedure(character(:)) :: xp
+end subroutine