forked from OSchip/llvm-project
[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:
parent
f6ddfac401
commit
338f21a4bd
|
@ -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())};
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue