[flang-commits] [flang] 2f999cc - [flang] Respect function vs subroutine distinction in generic matching
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sat Dec 3 07:53:12 PST 2022
Author: Peter Klausler
Date: 2022-12-03T07:53:04-08:00
New Revision: 2f999cce195946b66f968d50e38b06e6a1f60b8e
URL: https://github.com/llvm/llvm-project/commit/2f999cce195946b66f968d50e38b06e6a1f60b8e
DIFF: https://github.com/llvm/llvm-project/commit/2f999cce195946b66f968d50e38b06e6a1f60b8e.diff
LOG: [flang] Respect function vs subroutine distinction in generic matching
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
Added:
flang/test/Semantics/generic03.f90
Modified:
flang/docs/Extensions.md
flang/include/flang/Semantics/expression.h
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/resolve62.f90
flang/test/Semantics/resolve68.f90
flang/test/Semantics/resolve77.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 039b1f9e7f078..a512048293f20 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -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
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index bb6a14a9cf0e5..8474ec6ab613a 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -354,7 +354,8 @@ class ExpressionAnalyzer {
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 &,
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 7b9b367e9c13e..cd0c717c7cf1d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -174,8 +174,8 @@ class ArgumentAnalyzer {
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;
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 510f7cbc05a4b..980f1b188ce0b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -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
diff --git a/flang/test/Semantics/generic03.f90 b/flang/test/Semantics/generic03.f90
new file mode 100644
index 0000000000000..829780f52174f
--- /dev/null
+++ b/flang/test/Semantics/generic03.f90
@@ -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
diff --git a/flang/test/Semantics/resolve62.f90 b/flang/test/Semantics/resolve62.f90
index ee4049fd61f82..5d297f0356a9a 100644
--- a/flang/test/Semantics/resolve62.f90
+++ b/flang/test/Semantics/resolve62.f90
@@ -10,7 +10,7 @@ real function f2(x, y)
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
diff --git a/flang/test/Semantics/resolve68.f90 b/flang/test/Semantics/resolve68.f90
index 0221fbc41cfb4..28d90a68d1ff1 100644
--- a/flang/test/Semantics/resolve68.f90
+++ b/flang/test/Semantics/resolve68.f90
@@ -21,14 +21,14 @@ subroutine test1(x, y, z)
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
diff --git a/flang/test/Semantics/resolve77.f90 b/flang/test/Semantics/resolve77.f90
index d762781acdac4..1f5e4d4d80719 100644
--- a/flang/test/Semantics/resolve77.f90
+++ b/flang/test/Semantics/resolve77.f90
@@ -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)
More information about the flang-commits
mailing list