mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-18 19:06:44 +00:00
Code Issues Projects Releases Wiki Activity

[flang] Accept IGNORE_TKR in separate module procedure interface (#98374)

Browse Source 
We emit an incorrect error message when !DIR$ IGNORE_TKR appears in a
separate module procedure's interface declaration.

Fixes https://github.com/llvm/llvm-project/issues/98210.
This commit is contained in:
Peter Klausler 2024-07-11 13:30:16 -07:00 committed by GitHub
parent d5285fef00
commit d6f314ce87
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
flang/lib/Semantics/check-declarations.cpp
View File

@ -762,13 +762,10 @@ void CheckHelper::CheckObjectEntity(
}
if (auto ignoreTKR{GetIgnoreTKR(symbol)}; !ignoreTKR.empty()) {
const Symbol *ownerSymbol{symbol.owner().symbol()};
const auto *ownerSubp{ownerSymbol->detailsIf<SubprogramDetails>()};
bool inInterface{ownerSubp && ownerSubp->isInterface()};
bool inExplicitInterface{
inInterface && !IsSeparateModuleProcedureInterface(ownerSymbol)};
bool inModuleProc{
!inInterface && ownerSymbol && IsModuleProcedure(*ownerSymbol)};
if (!inExplicitInterface && !inModuleProc) {
bool inModuleProc{ownerSymbol && IsModuleProcedure(*ownerSymbol)};
bool inExplicitExternalInterface{
InInterface() && !IsSeparateModuleProcedureInterface(ownerSymbol)};
if (!InInterface() && !inModuleProc) {
messages_.Say(
"!DIR$ IGNORE_TKR may apply only in an interface or a module procedure"_err_en_US);
}
@ -779,7 +776,7 @@ void CheckHelper::CheckObjectEntity(
}
if (IsPassedViaDescriptor(symbol)) {
if (IsAllocatableOrObjectPointer(&symbol)) {
if (inExplicitInterface) {
if (inExplicitExternalInterface) {
if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) {
WarnIfNotInModuleFile(
"!DIR$ IGNORE_TKR should not apply to an allocatable or pointer"_warn_en_US);
@ -794,7 +791,7 @@ void CheckHelper::CheckObjectEntity(
WarnIfNotInModuleFile(
"!DIR$ IGNORE_TKR(R) is not meaningful for an assumed-rank array"_warn_en_US);
}
} else if (inExplicitInterface) {
} else if (inExplicitExternalInterface) {
if (context_.ShouldWarn(common::UsageWarning::IgnoreTKRUsage)) {
WarnIfNotInModuleFile(
"!DIR$ IGNORE_TKR(R) should not apply to a dummy argument passed via descriptor"_warn_en_US);

13
flang/test/Semantics/ignore_tkr01.f90
View File

@ -92,6 +92,11 @@ module m
real x(:)
end
module subroutine t24(x)
!dir$ ignore_tkr(t) x
real x(:)
end
end interface
contains
@ -158,6 +163,14 @@ subroutine bad1(x)
real, intent(in) :: x
end
submodule(m) subm
contains
module subroutine t24(x)
!dir$ ignore_tkr(t) x
real x(:)
end
end
program test
!ERROR: !DIR$ IGNORE_TKR directive must appear in a subroutine or function