[flang-commits] [flang] 982614f - [flang] Warn about inconsistent external procedure interfaces
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Mar 27 15:23:49 PDT 2023
Author: Peter Klausler
Date: 2023-03-27T15:15:46-07:00
New Revision: 982614fa47e87ba6760907588f5021e1b6d5911c
URL: https://github.com/llvm/llvm-project/commit/982614fa47e87ba6760907588f5021e1b6d5911c
DIFF: https://github.com/llvm/llvm-project/commit/982614fa47e87ba6760907588f5021e1b6d5911c.diff
LOG: [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
Added:
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/test/Semantics/null-init.f90
flang/test/Semantics/resolve24.f90
flang/test/Semantics/resolve53.f90
flang/test/Semantics/resolve62.f90
flang/test/Semantics/resolve67.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 0be05e699091..45a626640036 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/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);
}
}
}
diff --git a/flang/test/Semantics/null-init.f90 b/flang/test/Semantics/null-init.f90
index 234dd4bdcbe4..ad3f91679a42 100644
--- a/flang/test/Semantics/null-init.f90
+++ b/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
diff --git a/flang/test/Semantics/resolve24.f90 b/flang/test/Semantics/resolve24.f90
index 0b61a50065de..4af6f202cf4f 100644
--- a/flang/test/Semantics/resolve24.f90
+++ b/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
diff --git a/flang/test/Semantics/resolve53.f90 b/flang/test/Semantics/resolve53.f90
index 23babfe5b5b1..22af2305fc33 100644
--- a/flang/test/Semantics/resolve53.f90
+++ b/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,13 +65,13 @@ subroutine s2(x)
! These are all
diff erent 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
@@ -79,20 +79,20 @@ subroutine s3(x)
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
@@ -100,36 +100,36 @@ subroutine s5(x)
! Two procedures that
diff er 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
@@ -137,19 +137,19 @@ subroutine s2(x)
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
diff --git a/flang/test/Semantics/resolve62.f90 b/flang/test/Semantics/resolve62.f90
index 5d297f0356a9..1594447f8dd4 100644
--- a/flang/test/Semantics/resolve62.f90
+++ b/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
diff --git a/flang/test/Semantics/resolve67.f90 b/flang/test/Semantics/resolve67.f90
index 189092f69b1d..4d5fea8054a9 100644
--- a/flang/test/Semantics/resolve67.f90
+++ b/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
More information about the flang-commits
mailing list