[flang] Ignore errors on declarations in interfaces that "have no effect"

Fortran strangely allows declarations to appear in procedure interface
definitions when those declarations do not contribute anything to the
characteristics of the procedure; in particular, one may declare local
variables that are neither dummy variables nor function results.
Such declarations "have no effect" on the semantics of the program,
and that should include semantic error checking for things like
special restrictions on PURE procedures.

Differential Revision: https://reviews.llvm.org/D135209
This commit is contained in:
Peter Klausler 2022-10-04 10:37:36 -07:00
parent 4ea1a647ff
commit e2eabb7ed5
2 changed files with 54 additions and 21 deletions

View File

@ -96,6 +96,12 @@ private:
bool InFunction() const {
return innermostSymbol_ && IsFunction(*innermostSymbol_);
}
bool InInterface() const {
const SubprogramDetails *subp{innermostSymbol_
? innermostSymbol_->detailsIf<SubprogramDetails>()
: nullptr};
return subp && subp->isInterface();
}
template <typename... A>
void SayWithDeclaration(const Symbol &symbol, A &&...x) {
if (parser::Message * msg{messages_.Say(std::forward<A>(x)...)}) {
@ -247,16 +253,37 @@ void CheckHelper::Check(const Symbol &symbol) {
CheckPointer(symbol);
}
if (InPure()) {
if (IsSaved(symbol)) {
if (IsInitialized(symbol)) {
messages_.Say(
"A pure subprogram may not initialize a variable"_err_en_US);
} else {
messages_.Say(
"A pure subprogram may not have a variable with the SAVE attribute"_err_en_US);
if (InInterface()) {
// Declarations in interface definitions "have no effect" if they
// are not pertinent to the characteristics of the procedure.
// Restrictions on entities in pure procedure interfaces don't need
// enforcement.
} else {
if (IsSaved(symbol)) {
if (IsInitialized(symbol)) {
messages_.Say(
"A pure subprogram may not initialize a variable"_err_en_US);
} else {
messages_.Say(
"A pure subprogram may not have a variable with the SAVE attribute"_err_en_US);
}
}
if (!IsDummy(symbol) && !IsFunctionResult(symbol)) {
if (IsPolymorphicAllocatable(symbol)) {
SayWithDeclaration(symbol,
"Deallocation of polymorphic object '%s' is not permitted in a pure subprogram"_err_en_US,
symbol.name());
} else if (derived) {
if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
SayWithDeclaration(*bad,
"Deallocation of polymorphic object '%s%s' is not permitted in a pure subprogram"_err_en_US,
symbol.name(), bad.BuildResultDesignatorName());
}
}
}
}
if (symbol.attrs().test(Attr::VOLATILE)) {
if (symbol.attrs().test(Attr::VOLATILE) &&
(IsDummy(symbol) || !InInterface())) {
messages_.Say(
"A pure subprogram may not have a variable with the VOLATILE attribute"_err_en_US);
}
@ -264,19 +291,6 @@ void CheckHelper::Check(const Symbol &symbol) {
messages_.Say(
"A dummy procedure of a pure subprogram must be pure"_err_en_US);
}
if (!IsDummy(symbol) && !IsFunctionResult(symbol)) {
if (IsPolymorphicAllocatable(symbol)) {
SayWithDeclaration(symbol,
"Deallocation of polymorphic object '%s' is not permitted in a pure subprogram"_err_en_US,
symbol.name());
} else if (derived) {
if (auto bad{FindPolymorphicAllocatableUltimateComponent(*derived)}) {
SayWithDeclaration(*bad,
"Deallocation of polymorphic object '%s%s' is not permitted in a pure subprogram"_err_en_US,
symbol.name(), bad.BuildResultDesignatorName());
}
}
}
}
if (type) { // Section 7.2, paragraph 7
bool canHaveAssumedParameter{IsNamedConstant(symbol) ||

View File

@ -17,6 +17,25 @@ module m
real, volatile, target :: volatile
interface
! Ensure no errors for "ignored" declarations in a pure interface.
! These declarations do not contribute to the characteristics of
! the procedure and must not elicit spurious errors about being used
! in a pure procedure.
pure subroutine s05a
import polyAlloc
real, save :: v1
real :: v2 = 0.
real :: v3
data v3/0./
real :: v4
common /blk/ v4
save /blk/
type(polyAlloc) :: v5
real, volatile :: v6
end subroutine
end interface
contains
subroutine impure(x)