[flang-commits] [flang] 88a097d - [flang] Diagnose bad attributes of implicit interface externals

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-03-27T15:05:33-07:00
New Revision: 88a097d129bc02036317e8925089724705fb8fae

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

LOG: [flang] Diagnose bad attributes of implicit interface externals

Procedures with the EXTERNAL attribute (explicit or implied) are
not permitted to be ALLOCATABLE or be arrays if their interfaces
are implicit.

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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index d8d6bdc196ac..3a462d19ed83 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -426,6 +426,17 @@ void CheckHelper::Check(const Symbol &symbol) {
         " of a module"_err_en_US,
         symbol.name());
   }
+  if (IsProcedure(symbol) && !symbol.HasExplicitInterface()) {
+    if (IsAllocatable(symbol)) {
+      messages_.Say(
+          "Procedure '%s' may not be ALLOCATABLE without an explicit interface"_err_en_US,
+          symbol.name());
+    } else if (symbol.Rank() > 0) {
+      messages_.Say(
+          "Procedure '%s' may not be an array without an explicit interface"_err_en_US,
+          symbol.name());
+    }
+  }
 }
 
 void CheckHelper::CheckCommonBlock(const Symbol &symbol) {
@@ -916,7 +927,7 @@ void CheckHelper::CheckProcEntity(
     }
     CheckPassArg(symbol, details.procInterface(), details);
   }
-  if (symbol.attrs().test(Attr::POINTER)) {
+  if (IsPointer(symbol)) {
     CheckPointerInitialization(symbol);
     if (const Symbol * interface{details.procInterface()}) {
       const Symbol &ultimate{interface->GetUltimate()};
@@ -936,7 +947,7 @@ void CheckHelper::CheckProcEntity(
             symbol.name()); // C1517
       }
     }
-  } else if (symbol.attrs().test(Attr::SAVE)) {
+  } else if (IsSave(symbol)) {
     messages_.Say(
         "Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US,
         symbol.name());

diff  --git a/flang/test/Semantics/call05.f90 b/flang/test/Semantics/call05.f90
index 8256f5c25683..8ce70ee11b2a 100644
--- a/flang/test/Semantics/call05.f90
+++ b/flang/test/Semantics/call05.f90
@@ -121,7 +121,9 @@ subroutine test
 
 module m2
 
+  !ERROR: Procedure 't3' may not be ALLOCATABLE without an explicit interface
   character(len=10), allocatable :: t1, t2, t3, t4
+  !ERROR: Procedure 't6' may not be ALLOCATABLE without an explicit interface
   character(len=:), allocatable :: t5, t6, t7, t8(:)
 
   character(len=10), pointer :: p1

diff  --git a/flang/test/Semantics/resolve20.f90 b/flang/test/Semantics/resolve20.f90
index a3d240dbc598..a0870de7b82f 100644
--- a/flang/test/Semantics/resolve20.f90
+++ b/flang/test/Semantics/resolve20.f90
@@ -21,6 +21,7 @@ subroutine foo2
   procedure(h) :: i
   procedure(forward) :: j
   !ERROR: 'bad1' must be an abstract interface or a procedure with an explicit interface
+  !ERROR: Procedure 'k1' may not be an array without an explicit interface
   procedure(bad1) :: k1
   !ERROR: 'bad2' must be an abstract interface or a procedure with an explicit interface
   procedure(bad2) :: k2