[flang] Enforce specification function rules on callee, not call

A function can't be a specification function if it has a dummy procedure
argument, even if it's optional and unused.  So don't check the reference
for actual procedure arguments, but rather the characteristics of the
function.

Differential Revision: https://reviews.llvm.org/D109935
This commit is contained in:
peter klausler 2021-09-15 17:25:15 -07:00
parent f6ddfac401
commit 338f21a4bd
2 changed files with 17 additions and 5 deletions

View File

@ -460,9 +460,6 @@ public:
: Base{*this}, scope_{s}, context_{context} {}
using Base::operator();
Result operator()(const ProcedureDesignator &) const {
return "dummy procedure argument";
}
Result operator()(const CoarrayRef &) const { return "coindexed reference"; }
Result operator()(const semantics::Symbol &symbol) const {
@ -541,6 +538,20 @@ public:
"' not allowed for derived type components or type parameter"
" values";
}
if (auto procChars{
characteristics::Procedure::Characterize(x.proc(), context_)}) {
const auto iter{std::find_if(procChars->dummyArguments.begin(),
procChars->dummyArguments.end(),
[](const characteristics::DummyArgument &dummy) {
return std::holds_alternative<characteristics::DummyProcedure>(
dummy.u);
})};
if (iter != procChars->dummyArguments.end()) {
return "reference to function '"s + ultimate.name().ToString() +
"' with dummy procedure argument '" + iter->name + '\'';
}
}
// References to internal functions are caught in expression semantics.
// TODO: other checks for standard module procedures
} else {
const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};

View File

@ -15,6 +15,7 @@ module m
pure integer function hasProcArg(p)
import realfunc
procedure(realfunc) :: p
optional :: p
end function
end interface
integer :: coarray[*]
@ -37,8 +38,8 @@ module m
integer, intent(in), optional :: optional
!ERROR: Invalid specification expression: reference to OPTIONAL dummy argument 'optional'
type(t(optional)) :: x5
!ERROR: Invalid specification expression: dummy procedure argument
type(t(hasProcArg(realfunc))) :: x6
!ERROR: Invalid specification expression: reference to function 'hasprocarg' with dummy procedure argument 'p'
type(t(hasProcArg())) :: x6
!ERROR: Invalid specification expression: coindexed reference
type(t(coarray[1])) :: x7
type(t(kind(foo()))) :: x101 ! ok