AcoSail/llvm-project
8
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[flang] Respect function vs subroutine distinction in generic matching

Browse Source 
When checking the specific procedures of a generic interface for a
match against a given set of actual arguments, be sure to not match
a function against a subroutine call or vice versa.  (We generally
catch and warn about attempts to declare mixed interfaces, but they
are usually conforming and can be inadvertently created when generics
are merged due to USE and host association.)

Differential Revision: https://reviews.llvm.org/D139059
This commit is contained in:
Peter Klausler 2022-11-06 11:37:12 -08:00
parent 4178671b2e
commit 2f999cce19
8 changed files with 83 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
flang/docs/Extensions.md
View File

@ -356,6 +356,15 @@ end
appears as part of a complex-literal-constant be a scalar, but
most compilers emit an error when an array appears.
f18 supports them with a portability warning.
* f18 does not enforce a blanket prohibition against generic
interfaces containing a mixture of functions and subroutines.
Apart from some contexts in which the standard requires all of
a particular generic interface to have only all functions or
all subroutines as its specific procedures, we allow both to
appear, unlike several other Fortran compilers.
This is especially desirable when two generics of the same
name are combined due to USE association and the mixture may
be inadvertent.
## Behavior in cases where the standard is ambiguous or indefinite

3
flang/include/flang/Semantics/expression.h
View File

@ -354,7 +354,8 @@ private:
std::pair<const Symbol *, bool /* failure due to NULL() actuals */>
ResolveGeneric(const Symbol &, const ActualArguments &, const AdjustActuals &,
bool isSubroutine, bool mightBeStructureConstructor = false);
void EmitGenericResolutionError(const Symbol &, bool dueToNullActuals);
void EmitGenericResolutionError(
const Symbol &, bool dueToNullActuals, bool isSubroutine);
const Symbol &AccessSpecific(
const Symbol &originalGeneric, const Symbol &specific);
std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,

40
flang/lib/Semantics/expression.cpp
View File

@ -174,8 +174,8 @@ private:
std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &);
bool AreConformable() const;
const Symbol *FindBoundOp(
parser::CharBlock, int passIndex, const Symbol *&definedOp);
const Symbol *FindBoundOp(parser::CharBlock, int passIndex,
const Symbol *&definedOp, bool isSubroutine);
void AddAssignmentConversion(
const DynamicType &lhsType, const DynamicType &rhsType);
bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs);
@ -2078,7 +2078,8 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
// re-resolve the name to the specific binding
sc.component.symbol = const_cast<Symbol *>(sym);
} else {
EmitGenericResolutionError(*sc.component.symbol, pair.second);
EmitGenericResolutionError(
*sc.component.symbol, pair.second, isSubroutine);
return std::nullopt;
}
}
@ -2223,6 +2224,9 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
return IsBareNullPointer(iter->UnwrapExpr());
}) != actuals.end()};
for (const Symbol &specific : details->specificProcs()) {
if (isSubroutine != !IsFunction(specific)) {
continue;
}
if (!ResolveForward(specific)) {
continue;
}
@ -2327,12 +2331,14 @@ const Symbol &ExpressionAnalyzer::AccessSpecific(
}
void ExpressionAnalyzer::EmitGenericResolutionError(
const Symbol &symbol, bool dueToNullActuals) {
const Symbol &symbol, bool dueToNullActuals, bool isSubroutine) {
Say(dueToNullActuals
? "One or more NULL() actual arguments to the generic procedure '%s' requires a MOLD= for disambiguation"_err_en_US
: semantics::IsGenericDefinedOp(symbol)
? "No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US
: "No specific procedure of generic '%s' matches the actual arguments"_err_en_US,
: isSubroutine
? "No specific subroutine of generic '%s' matches the actual arguments"_err_en_US
: "No specific function of generic '%s' matches the actual arguments"_err_en_US,
symbol.name());
}
@ -2395,7 +2401,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
std::move(specificCall->arguments)};
} else {
if (isGenericInterface) {
EmitGenericResolutionError(*symbol, dueToNullActual);
EmitGenericResolutionError(*symbol, dueToNullActual, isSubroutine);
}
return std::nullopt;
}
@ -3654,8 +3660,8 @@ MaybeExpr ArgumentAnalyzer::TryDefinedOp(const char *opr,
}
}
for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) {
if (const Symbol *symbol{
FindBoundOp(oprName, passIndex, *definedOpSymbolPtr)}) {
if (const Symbol *
symbol{FindBoundOp(oprName, passIndex, *definedOpSymbolPtr, false)}) {
if (MaybeExpr result{TryBoundOp(*symbol, passIndex)}) {
return result;
}
@ -3773,15 +3779,16 @@ std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
if (pair.first) {
proc = pair.first;
} else {
context_.EmitGenericResolutionError(*symbol, pair.second);
context_.EmitGenericResolutionError(*symbol, pair.second, true);
}
}
int passedObjectIndex{-1};
const Symbol *definedOpSymbol{nullptr};
for (std::size_t i{0}; i < actuals_.size(); ++i) {
if (const Symbol *specific{FindBoundOp(oprName, i, definedOpSymbol)}) {
if (const Symbol *resolution{
GetBindingResolution(GetType(i), *specific)}) {
if (const Symbol *
specific{FindBoundOp(oprName, i, definedOpSymbol, true)}) {
if (const Symbol *
resolution{GetBindingResolution(GetType(i), *specific)}) {
proc = resolution;
} else {
proc = specific;
@ -3863,8 +3870,8 @@ bool ArgumentAnalyzer::AreConformable() const {
}
// Look for a type-bound operator in the type of arg number passIndex.
const Symbol *ArgumentAnalyzer::FindBoundOp(
parser::CharBlock oprName, int passIndex, const Symbol *&definedOp) {
const Symbol *ArgumentAnalyzer::FindBoundOp(parser::CharBlock oprName,
int passIndex, const Symbol *&definedOp, bool isSubroutine) {
const auto *type{GetDerivedTypeSpec(GetType(passIndex))};
if (!type || !type->scope()) {
return nullptr;
@ -3878,9 +3885,10 @@ const Symbol *ArgumentAnalyzer::FindBoundOp(
[&](const Symbol &proc, ActualArguments &) {
return passIndex == GetPassIndex(proc);
}};
auto pair{context_.ResolveGeneric(*symbol, actuals_, adjustment, false)};
auto pair{
context_.ResolveGeneric(*symbol, actuals_, adjustment, isSubroutine)};
if (!pair.first) {
context_.EmitGenericResolutionError(*symbol, pair.second);
context_.EmitGenericResolutionError(*symbol, pair.second, isSubroutine);
}
return pair.first;
}

15
flang/lib/Semantics/resolve-names.cpp
View File

@ -3246,9 +3246,8 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
specificProcs_.erase(range.first, range.second);
}
// Check that the specific procedures are all functions or all subroutines.
// If there is a derived type with the same name they must be functions.
// Set the corresponding flag on generic.
// Mixed interfaces are allowed by the standard.
// If there is a derived type with the same name, they must all be functions.
void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
ResolveSpecificsInGeneric(generic);
auto &details{generic.get<GenericDetails>()};
@ -3271,10 +3270,11 @@ void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
}
const Symbol &firstSpecific{specifics.front()};
bool isFunction{firstSpecific.test(Symbol::Flag::Function)};
bool isBoth{false};
for (const Symbol &specific : specifics) {
if (isFunction != specific.test(Symbol::Flag::Function)) { // C1514
auto &msg{Say(generic.name(),
"Generic interface '%s' has both a function and a subroutine"_err_en_US)};
"Generic interface '%s' has both a function and a subroutine"_warn_en_US)};
if (isFunction) {
msg.Attach(firstSpecific.name(), "Function declaration"_en_US);
msg.Attach(specific.name(), "Subroutine declaration"_en_US);
@ -3282,6 +3282,9 @@ void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
msg.Attach(firstSpecific.name(), "Subroutine declaration"_en_US);
msg.Attach(specific.name(), "Function declaration"_en_US);
}
isFunction = false;
isBoth = true;
break;
}
}
if (!isFunction && details.derivedType()) {
@ -3290,7 +3293,9 @@ void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
" with same name"_err_en_US,
*details.derivedType()->GetUltimate().scope());
}
generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
if (!isBoth) {
generic.set(isFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
}
}
// SubprogramVisitor implementation

34
flang/test/Semantics/generic03.f90 Normal file
View File

@ -0,0 +1,34 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
! Exercise function vs subroutine distinction in generics
module m1
type t1
integer n
end type
interface g1
integer function f1(x, j)
import t1
class(t1), intent(in out) :: x
integer, intent(in) :: j
end
end interface
end module
program test
use m1
!WARNING: Generic interface 'g1' has both a function and a subroutine
interface g1
subroutine s1(x, a)
import t1
class(t1), intent(in out) :: x
real, intent(in) :: a
end subroutine
end interface
type(t1) :: x
print *, g1(x,1) ! ok
!ERROR: No specific function of generic 'g1' matches the actual arguments
print *, g1(x,1.)
!ERROR: No specific subroutine of generic 'g1' matches the actual arguments
call g1(x,1)
call g1(x, 1.) ! ok
contains
end

2
flang/test/Semantics/resolve62.f90
View File

@ -10,7 +10,7 @@ subroutine subr1
end interface
z = f(1.0)
z = f(1.0, 2.0)
!ERROR: No specific procedure of generic 'f' matches the actual arguments
!ERROR: No specific function of generic 'f' matches the actual arguments
z = f(1.0, 2.0, 3.0)
end

4
flang/test/Semantics/resolve68.f90
View File

@ -21,14 +21,14 @@ contains
type(t) :: x
integer :: y
integer :: z
!ERROR: No specific procedure of generic 'g' matches the actual arguments
!ERROR: No specific function of generic 'g' matches the actual arguments
z = x%g(y)
end
subroutine test2(x, y, z)
type(t) :: x
real :: y
integer :: z
!ERROR: No specific procedure of generic 'g' matches the actual arguments
!ERROR: No specific function of generic 'g' matches the actual arguments
z = x%g(x, y)
end
end

2
flang/test/Semantics/resolve77.f90
View File

@ -10,7 +10,7 @@ module m
end interface
!ERROR: Automatic data object 'a' may not appear in the specification part of a module
real :: a(if1(1))
!ERROR: No specific procedure of generic 'ifn2' matches the actual arguments
!ERROR: No specific function of generic 'ifn2' matches the actual arguments
real :: b(ifn2(1))
contains
subroutine t1(n)