[flang] Warn about inconsistent external procedure interfaces

When multiple scopes in a compilation define interfaces (explicit
or implicit) for an external procedure, warn when those interfaces
are inconsistent.

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

Author: klausler

flang/lib/Semantics/check-declarations.cpp

@@ -66,7 +66,7 @@ class CheckHelper {
   void CheckArraySpec(const Symbol &, const ArraySpec &);
   void CheckProcEntity(const Symbol &, const ProcEntityDetails &);
   void CheckSubprogram(const Symbol &, const SubprogramDetails &);
-  void CheckLocalVsGlobal(const Symbol &);
+  void CheckExternal(const Symbol &);
   void CheckAssumedTypeEntity(const Symbol &, const ObjectEntityDetails &);
   void CheckDerivedType(const Symbol &, const DerivedTypeDetails &);
   bool CheckFinal(
@@ -161,6 +161,8 @@ class CheckHelper {
   std::map<std::pair<SourceName, const Symbol *>, SymbolRef> moduleProcs_;
   // Collection of symbols with global names, BIND(C) or otherwise
   std::map<std::string, SymbolRef> globalNames_;
+  // Collection of external procedures without global definitions
+  std::map<std::string, SymbolRef> externalNames_;
 };
 
 class DistinguishabilityHelper {
@@ -957,7 +959,7 @@ void CheckHelper::CheckProcEntity(
         "Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US,
         symbol.name());
   }
-  CheckLocalVsGlobal(symbol);
+  CheckExternal(symbol);
 }
 
 // When a module subprogram has the MODULE prefix the following must match
@@ -1098,17 +1100,18 @@ void CheckHelper::CheckSubprogram(
           "A function interface may not declare an assumed-length CHARACTER(*) result"_err_en_US);
     }
   }
-  CheckLocalVsGlobal(symbol);
+  CheckExternal(symbol);
   CheckModuleProcedureDef(symbol);
 }
 
-void CheckHelper::CheckLocalVsGlobal(const Symbol &symbol) {
+void CheckHelper::CheckExternal(const Symbol &symbol) {
   if (IsExternal(symbol)) {
-    if (const Symbol *global{FindGlobal(symbol)}; global && global != &symbol) {
-      std::string interfaceName{symbol.name().ToString()};
-      if (const auto *bind{symbol.GetBindName()}) {
-        interfaceName = *bind;
-      }
+    std::string interfaceName{symbol.name().ToString()};
+    if (const auto *bind{symbol.GetBindName()}) {
+      interfaceName = *bind;
+    }
+    if (const Symbol * global{FindGlobal(symbol)};
+        global && global != &symbol) {
       std::string definitionName{global->name().ToString()};
       if (const auto *bind{global->GetBindName()}) {
         definitionName = *bind;
@@ -1146,6 +1149,24 @@ void CheckHelper::CheckLocalVsGlobal(const Symbol &symbol) {
           evaluate::AttachDeclaration(msg, symbol);
         }
       }
+    } else if (auto iter{externalNames_.find(interfaceName)};
+               iter != externalNames_.end()) {
+      const Symbol &previous{*iter->second};
+      if (auto chars{Characterize(symbol)}) {
+        if (auto previousChars{Characterize(previous)}) {
+          std::string whyNot;
+          if (!chars->IsCompatibleWith(*previousChars, &whyNot)) {
+            if (auto *msg{messages_.Say(
+                    "The external interface '%s' is not compatible with an earlier definition (%s)"_warn_en_US,
+                    symbol.name(), whyNot)}) {
+              evaluate::AttachDeclaration(msg, previous);
+              evaluate::AttachDeclaration(msg, symbol);
+            }
+          }
+        }
+      }
+    } else {
+      externalNames_.emplace(interfaceName, symbol);
     }
   }
 }

flang/test/Semantics/null-init.f90

@@ -37,6 +37,7 @@ module m6
 
 module m7
   interface
+    !WARNING: The external interface 'null' is not compatible with an earlier definition (incompatible procedure attributes: ImplicitInterface)
     function null() result(p)
       integer, pointer :: p
     end function

flang/test/Semantics/resolve24.f90

@@ -14,11 +14,11 @@ function f()
 subroutine test2
   !ERROR: Generic interface 'foo' has both a function and a subroutine
   interface foo
-    function f1(x)
+    function t2f1(x)
     end function
     subroutine s()
     end subroutine
-    function f2(x, y)
+    function t2f2(x, y)
     end function
   end interface
 end subroutine
@@ -48,13 +48,13 @@ subroutine s()
 
 subroutine test5
   interface foo
-    function f1()
+    function t5f1()
     end function
   end interface
   interface bar
-    subroutine s1()
+    subroutine t5s1()
     end subroutine
-    subroutine s2(x)
+    subroutine t5s2(x)
     end subroutine
   end interface
   !ERROR: Cannot call function 'foo' like a subroutine

flang/test/Semantics/resolve53.f90

@@ -25,22 +25,22 @@ subroutine s4(x)
 end
 
 module m2
-  !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm2s1' and 'm2s2' as their interfaces are not distinguishable
   interface g
-    subroutine s1(x)
+    subroutine m2s1(x)
     end subroutine
-    subroutine s2(x)
+    subroutine m2s2(x)
       real x
     end subroutine
   end interface
 end
 
 module m3
-  !ERROR: Generic 'g' may not have specific procedures 'f1' and 'f2' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm3f1' and 'm3f2' as their interfaces are not distinguishable
   interface g
-    integer function f1()
+    integer function m3f1()
     end function
-    real function f2()
+    real function m3f2()
     end function
   end interface
 end
@@ -51,11 +51,11 @@ module m4
   type, extends(t1) :: t2
   end type
   interface g
-    subroutine s1(x)
+    subroutine m4s1(x)
       import :: t1
       type(t1) :: x
     end
-    subroutine s2(x)
+    subroutine m4s2(x)
       import :: t2
       type(t2) :: x
     end
@@ -65,91 +65,91 @@ subroutine s2(x)
 ! These are all different ranks so they are distinguishable
 module m5
   interface g
-    subroutine s1(x)
+    subroutine m5s1(x)
       real x
     end subroutine
-    subroutine s2(x)
+    subroutine m5s2(x)
       real x(:)
     end subroutine
-    subroutine s3(x)
+    subroutine m5s3(x)
       real x(:,:)
     end subroutine
   end interface
 end
 
 module m6
   use m5
-  !ERROR: Generic 'g' may not have specific procedures 's1' and 's4' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm5s1' and 'm6s4' as their interfaces are not distinguishable
   interface g
-    subroutine s4(x)
+    subroutine m6s4(x)
     end subroutine
   end interface
 end
 
 module m7
   use m5
-  !ERROR: Generic 'g' may not have specific procedures 's1' and 's5' as their interfaces are not distinguishable
-  !ERROR: Generic 'g' may not have specific procedures 's2' and 's5' as their interfaces are not distinguishable
-  !ERROR: Generic 'g' may not have specific procedures 's3' and 's5' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm5s1' and 'm7s5' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm5s2' and 'm7s5' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm5s3' and 'm7s5' as their interfaces are not distinguishable
   interface g
-    subroutine s5(x)
+    subroutine m7s5(x)
       real x(..)
     end subroutine
   end interface
 end
 
 ! Two procedures that differ only by attributes are not distinguishable
 module m8
-  !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm8s1' and 'm8s2' as their interfaces are not distinguishable
   interface g
-    pure subroutine s1(x)
+    pure subroutine m8s1(x)
       real, intent(in) :: x
     end subroutine
-    subroutine s2(x)
+    subroutine m8s2(x)
       real, intent(in) :: x
     end subroutine
   end interface
 end
 
 module m9
-  !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm9s1' and 'm9s2' as their interfaces are not distinguishable
   interface g
-    subroutine s1(x)
+    subroutine m9s1(x)
       real :: x(10)
     end subroutine
-    subroutine s2(x)
+    subroutine m9s2(x)
       real :: x(100)
     end subroutine
   end interface
 end
 
 module m10
-  !ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
+  !ERROR: Generic 'g' may not have specific procedures 'm10s1' and 'm10s2' as their interfaces are not distinguishable
   interface g
-    subroutine s1(x)
+    subroutine m10s1(x)
       real :: x(10)
     end subroutine
-    subroutine s2(x)
+    subroutine m10s2(x)
       real :: x(..)
     end subroutine
   end interface
 end
 
 program m11
   interface g1
-    subroutine s1(x)
+    subroutine m11s1(x)
       real, pointer, intent(out) :: x
     end subroutine
-    subroutine s2(x)
+    subroutine m11s2(x)
       real, allocatable :: x
     end subroutine
   end interface
-  !ERROR: Generic 'g2' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
+  !ERROR: Generic 'g2' may not have specific procedures 'm11s3' and 'm11s4' as their interfaces are not distinguishable
   interface g2
-    subroutine s3(x)
+    subroutine m11s3(x)
       real, pointer, intent(in) :: x
     end subroutine
-    subroutine s4(x)
+    subroutine m11s4(x)
       real, allocatable :: x
     end subroutine
   end interface
@@ -458,24 +458,24 @@ integer function f3(i, j)
 
 module m20
   interface operator(.not.)
-    real function f(x)
+    real function m20f(x)
       character(*),intent(in) :: x
     end function
   end interface
   interface operator(+)
-    procedure f
+    procedure m20f
   end interface
 end module
 
 subroutine subr1()
   use m20
   interface operator(.not.)
-    !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
-    procedure f
+    !ERROR: Procedure 'm20f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
+    procedure m20f
   end interface
   interface operator(+)
-    !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(+)'
-    procedure f
+    !ERROR: Procedure 'm20f' from module 'm20' is already specified in generic 'OPERATOR(+)'
+    procedure m20f
   end interface
 end subroutine subr1
 

flang/test/Semantics/resolve62.f90

@@ -2,10 +2,10 @@
 ! Resolve generic based on number of arguments
 subroutine subr1
   interface f
-    real function f1(x)
+    real function s1f1(x)
       optional :: x
     end
-    real function f2(x, y)
+    real function s1f2(x, y)
     end
   end interface
   z = f(1.0)
@@ -17,10 +17,10 @@ real function f2(x, y)
 ! Elemental and non-element function both match: non-elemental one should be used
 subroutine subr2
   interface f
-    logical elemental function f1(x)
+    logical elemental function s2f1(x)
       intent(in) :: x
     end
-    real function f2(x)
+    real function s2f2(x)
       real :: x(10)
     end
   end interface

flang/test/Semantics/resolve67.f90

@@ -89,6 +89,7 @@ real function plus(x)
     end
   end interface
   interface operator(.not.)
+    !WARNING: The external interface 'not1' is not compatible with an earlier definition (distinct numbers of dummy arguments)
     real function not1(x)
       real, value :: x
     end