[flang] Generic name resolution in expression analysis

Implement the basics of resolving generic names in expressions.

`ExpressionAnalyzer::ResolveGeneric` maps the symbol for a generic
name to the specific procedure appropriate for the actual arguments.
Extract `CheckExplicitInterface` out of `CheckArguments` so that it
can be tried for each specific procedure of the generic as part of
the test to see which is compatible.

Note that it may be there is an elemental and non-elemental specific
procedure that is compatible with the actual arguments. In that case
the generic is resolved to the non-elemental one.

Test this by using generic functions in specification expressions
that must be written to module files. Verify how the generics were
resolved by looking at the generated `.mod` files.

There is more work to be done in this area: the passed-object dummy
argument is not considered and in some cases generated module files
are not correct.

Original-commit: flang-compiler/f18@50e458045a
Reviewed-on: https://github.com/flang-compiler/f18/pull/778
This commit is contained in:
Tim Keith 2019-10-09 16:08:13 -07:00
parent 9c8312208d
commit 6acae749c8
9 changed files with 430 additions and 45 deletions

View File

@ -72,7 +72,7 @@ static void CheckImplicitInterfaceArg(
}
}
static void CheckExplicitInterfaceArg(const ActualArgument &arg,
static bool CheckExplicitInterfaceArg(const ActualArgument &arg,
const characteristics::DummyArgument &dummy, FoldingContext &context) {
std::visit(
common::visitors{
@ -95,9 +95,10 @@ static void CheckExplicitInterfaceArg(const ActualArgument &arg,
},
},
dummy.u);
return true; // TODO: return false when error detected
}
static void RearrangeArguments(const characteristics::Procedure &proc,
static bool RearrangeArguments(const characteristics::Procedure &proc,
ActualArguments &actuals, parser::ContextualMessages &messages) {
CHECK(proc.HasExplicitInterface());
if (actuals.size() < proc.dummyArguments.size()) {
@ -106,6 +107,7 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
messages.Say(
"Too many actual arguments (%zd) passed to procedure that expects only %zd"_err_en_US,
actuals.size(), proc.dummyArguments.size());
return false;
}
std::map<std::string, ActualArgument> kwArgs;
for (auto &x : actuals) {
@ -117,6 +119,7 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
messages.Say(*x->keyword,
"Argument keyword '%s=' appears on more than one effective argument in this procedure reference"_err_en_US,
*x->keyword);
return false;
}
x.reset();
}
@ -133,6 +136,7 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
messages.Say(*x.keyword,
"Keyword argument '%s=' has already been specified positionally (#%d) in this procedure reference"_err_en_US,
*x.keyword, index + 1);
return false;
} else {
actuals[index] = std::move(x);
}
@ -146,8 +150,40 @@ static void RearrangeArguments(const characteristics::Procedure &proc,
messages.Say(*x.keyword,
"Argument keyword '%s=' is not recognized for this procedure reference"_err_en_US,
*x.keyword);
return false;
}
}
return true;
}
bool CheckExplicitInterface(const characteristics::Procedure &proc,
ActualArguments &actuals, FoldingContext &context) {
if (!RearrangeArguments(proc, actuals, context.messages())) {
return false;
}
int index{0};
for (auto &actual : actuals) {
const auto &dummy{proc.dummyArguments[index++]};
if (actual.has_value()) {
if (!CheckExplicitInterfaceArg(*actual, dummy, context)) {
return false;
}
} else if (!dummy.IsOptional()) {
if (dummy.name.empty()) {
context.messages().Say(
"Dummy argument #%d is not OPTIONAL and is not associated with an "
"effective argument in this procedure reference"_err_en_US,
index);
} else {
context.messages().Say(
"Dummy argument '%s' (#%d) is not OPTIONAL and is not associated "
"with an effective argument in this procedure reference"_err_en_US,
dummy.name, index);
}
return false;
}
}
return true;
}
void CheckArguments(const characteristics::Procedure &proc,
@ -155,33 +191,14 @@ void CheckArguments(const characteristics::Procedure &proc,
bool treatingExternalAsImplicit) {
parser::Messages buffer;
parser::ContextualMessages messages{context.messages().at(), &buffer};
FoldingContext localContext{context, messages};
if (proc.HasExplicitInterface()) {
RearrangeArguments(proc, actuals, messages);
int index{0};
for (auto &x : actuals) {
const auto &dummy{proc.dummyArguments[index++]};
if (x.has_value()) {
CheckExplicitInterfaceArg(*x, dummy, localContext);
} else if (!dummy.IsOptional()) {
if (dummy.name.empty()) {
messages.Say(
"Dummy argument #%d is not OPTIONAL and is not associated with an effective argument in this procedure reference"_err_en_US,
index);
} else {
messages.Say(
"Dummy argument '%s' (#%d) is not OPTIONAL and is not associated with an effective argument in this procedure reference"_err_en_US,
dummy.name, index);
}
}
if (treatingExternalAsImplicit) {
CheckImplicitInterfaceArg(*x, context.messages());
}
}
} else {
for (auto &x : actuals) {
if (x.has_value()) {
CheckImplicitInterfaceArg(*x, context.messages());
FoldingContext localContext{context, messages};
CheckExplicitInterface(proc, actuals, localContext);
}
if (!proc.HasExplicitInterface() || treatingExternalAsImplicit) {
for (auto &actual : actuals) {
if (actual.has_value()) {
CheckImplicitInterfaceArg(*actual, messages);
}
}
}

View File

@ -35,5 +35,11 @@ class FoldingContext;
// defined at the top level in the same source file.
void CheckArguments(const characteristics::Procedure &, ActualArguments &,
FoldingContext &, bool treatingExternalAsImplicit = false);
// Check actual arguments against a procedure with an explicit interface.
// Report an error and return false if not compatible.
bool CheckExplicitInterface(
const characteristics::Procedure &, ActualArguments &, FoldingContext &);
}
#endif

View File

@ -1514,17 +1514,92 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
return std::nullopt;
}
// Can actual be argument associated with dummy?
static bool CheckCompatibleArgument(bool isElemental,
const ActualArgument &actual, const characteristics::DummyArgument &dummy) {
return std::visit(
common::visitors{
[&](const characteristics::DummyDataObject &x) {
characteristics::TypeAndShape dummyTypeAndShape{x.type};
if (!isElemental && actual.Rank() != dummyTypeAndShape.Rank()) {
return false;
} else if (auto actualType{actual.GetType()}) {
return dummyTypeAndShape.type().IsTkCompatibleWith(*actualType);
} else {
return false;
}
},
[&](const characteristics::DummyProcedure &) {
const auto *expr{actual.UnwrapExpr()};
return expr && IsProcedurePointer(*expr);
},
[&](const characteristics::AlternateReturn &) {
return actual.isAlternateReturn;
},
},
dummy.u);
}
// Are the actual arguments compatible with the dummy arguments of procedure?
static bool CheckCompatibleArguments(
const characteristics::Procedure &procedure,
const ActualArguments &actuals) {
bool isElemental{procedure.IsElemental()};
const auto &dummies{procedure.dummyArguments};
CHECK(dummies.size() == actuals.size());
for (std::size_t i{0}; i < dummies.size(); ++i) {
const characteristics::DummyArgument &dummy{dummies[i]};
const std::optional<ActualArgument> &actual{actuals[i]};
if (actual && !CheckCompatibleArgument(isElemental, *actual, dummy)) {
return false;
}
}
return true;
}
const Symbol *ExpressionAnalyzer::ResolveGeneric(
const Symbol &symbol, ActualArguments &actuals) {
const Symbol *elemental{nullptr}; // matching elemental specific proc
const auto &details{symbol.get<semantics::GenericDetails>()};
for (const Symbol *specific : details.specificProcs()) {
if (std::optional<characteristics::Procedure> procedure{
characteristics::Procedure::Characterize(
ProcedureDesignator{*specific}, context_.intrinsics())}) {
parser::Messages buffer;
parser::ContextualMessages messages{
context_.foldingContext().messages().at(), &buffer};
FoldingContext localContext{context_.foldingContext(), messages};
ActualArguments localActuals{actuals};
if (CheckExplicitInterface(*procedure, localActuals, localContext) &&
CheckCompatibleArguments(*procedure, localActuals)) {
if (!procedure->IsElemental()) {
return specific; // takes priority over elemental match
}
elemental = specific;
}
}
}
if (elemental) {
return elemental;
} else {
Say("No specific procedure of generic '%s' matches the actual arguments"_err_en_US,
symbol.name());
return nullptr;
}
}
auto ExpressionAnalyzer::GetCalleeAndArguments(
const parser::ProcedureDesignator &pd, ActualArguments &&arguments,
bool isSubroutine) -> std::optional<CalleeAndArguments> {
return std::visit(
common::visitors{
[&](const parser::Name &n) -> std::optional<CalleeAndArguments> {
if (context_.HasError(n.symbol)) {
const Symbol *symbol{n.symbol};
if (context_.HasError(symbol)) {
return std::nullopt;
}
const Symbol &symbol{n.symbol->GetUltimate()};
if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
const Symbol &ultimate{symbol->GetUltimate()};
if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
if (std::optional<SpecificCall> specificCall{
context_.intrinsics().Probe(
CallCharacteristics{n.source, isSubroutine},
@ -1536,12 +1611,18 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(
return std::nullopt;
}
}
CheckForBadRecursion(n.source, symbol);
return CalleeAndArguments{
ProcedureDesignator{*n.symbol}, std::move(arguments)};
CheckForBadRecursion(n.source, ultimate);
if (ultimate.has<semantics::GenericDetails>()) {
symbol = ResolveGeneric(ultimate, arguments);
}
if (symbol) {
return CalleeAndArguments{
ProcedureDesignator{*symbol}, std::move(arguments)};
} else {
return std::nullopt;
}
},
[&](const parser::ProcComponentRef &pcr)
-> std::optional<CalleeAndArguments> {
[&](const parser::ProcComponentRef &pcr) {
return AnalyzeProcedureComponentRef(pcr, std::move(arguments));
},
},
@ -1699,10 +1780,9 @@ std::optional<ActualArguments> ExpressionAnalyzer::AnalyzeArguments(
static bool IsExternalCalledImplicitly(
parser::CharBlock callSite, const ProcedureDesignator &proc) {
if (const auto *symbol{proc.GetSymbol()}) {
return !callSite.empty() && symbol->has<semantics::SubprogramDetails>() &&
(symbol->owner().IsGlobal() ||
(symbol->owner().parent().IsGlobal() &&
!symbol->owner().sourceRange().Contains(callSite)));
return symbol->has<semantics::SubprogramDetails>() &&
symbol->owner().IsGlobal() &&
!symbol->scope()->sourceRange().Contains(callSite);
} else {
return false;
}

View File

@ -326,7 +326,7 @@ private:
const parser::Call &, bool isSubroutine);
std::optional<characteristics::Procedure> CheckCall(
parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
const Symbol *ResolveGeneric(const Symbol &, ActualArguments &);
std::optional<CalleeAndArguments> GetCalleeAndArguments(
const parser::ProcedureDesignator &, ActualArguments &&,
bool isSubroutine);

View File

@ -609,7 +609,7 @@ protected:
GenericDetails &GetGenericDetails();
// Add to generic the symbol for the subprogram with the same name
void CheckGenericProcedures(Symbol &);
void CheckSpecificsAreDistinguishable(const Symbol &, const SymbolVector &);
void CheckSpecificsAreDistinguishable(Symbol &, const SymbolVector &);
private:
// A new GenericInfo is pushed for each interface block and generic stmt
@ -2330,7 +2330,7 @@ static bool IsOperatorOrAssignment(const Symbol &generic) {
// Check that the specifics of this generic are distinguishable from each other
void InterfaceVisitor::CheckSpecificsAreDistinguishable(
const Symbol &generic, const SymbolVector &specifics) {
Symbol &generic, const SymbolVector &specifics) {
auto count{specifics.size()};
if (specifics.size() < 2) {
return;
@ -2356,6 +2356,7 @@ void InterfaceVisitor::CheckSpecificsAreDistinguishable(
auto &proc2{procs[i2]};
if (!distinguishable(proc1, proc2)) {
SayNotDistinguishable(generic, *specifics[i1], *specifics[i2]);
context().SetError(generic);
}
}
}

View File

@ -98,6 +98,7 @@ set(ERROR_TESTS
resolve59.f90
resolve60.f90
resolve61.f90
resolve62.f90
stop01.f90
structconst01.f90
structconst02.f90
@ -227,6 +228,7 @@ set(MODFILE_TESTS
modfile29.f90
modfile30.f90
modfile31.f90
modfile32.f90
)
set(LABEL_TESTS

View File

@ -0,0 +1,235 @@
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
! http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
! Resolution of generic names in expressions.
! Test by using generic function in a specification expression that needs
! to be written to a .mod file.
! Resolve based on number of arguments
module m1
interface f
pure integer(8) function f1(x)
real, intent(in) :: x
end
pure integer(8) function f2(x, y)
real, intent(in) :: x, y
end
pure integer(8) function f3(x, y, z, w)
real, intent(in) :: x, y, z, w
optional :: w
end
end interface
contains
subroutine s1(x, z)
real :: z(f(x)) ! resolves to f1
end
subroutine s2(x, y, z)
real :: z(f(x, y)) ! resolves to f2
end
subroutine s3(x, y, z, w)
real :: w(f(x, y, z)) ! resolves to f3
end
subroutine s4(x, y, z, w, u)
real :: u(f(x, y, z, w)) ! resolves to f3
end
end
!Expect: m1.mod
!module m1
! interface f
! procedure :: f1
! procedure :: f2
! procedure :: f3
! end interface
! interface
! pure function f1(x)
! real(4), intent(in) :: x
! integer(8) :: f1
! end
! end interface
! interface
! pure function f2(x, y)
! real(4), intent(in) :: x
! real(4), intent(in) :: y
! integer(8) :: f2
! end
! end interface
! interface
! pure function f3(x, y, z, w)
! real(4), intent(in) :: x
! real(4), intent(in) :: y
! real(4), intent(in) :: z
! real(4), intent(in), optional :: w
! integer(8) :: f3
! end
! end interface
!contains
! subroutine s1(x, z)
! real(4) :: x
! real(4) :: z(1_8:f1(x))
! end
! subroutine s2(x, y, z)
! real(4) :: x
! real(4) :: y
! real(4) :: z(1_8:f2(x, y))
! end
! subroutine s3(x, y, z, w)
! real(4) :: x
! real(4) :: y
! real(4) :: z
! real(4) :: w(1_8:f3(x, y, z))
! end
! subroutine s4(x, y, z, w, u)
! real(4) :: x
! real(4) :: y
! real(4) :: z
! real(4) :: w
! real(4) :: u(1_8:f3(x, y, z, w))
! end
!end
! Resolve based on type or kind
module m2
interface f
pure integer(8) function f_real4(x)
real(4), intent(in) :: x
end
pure integer(8) function f_real8(x)
real(8), intent(in) :: x
end
pure integer(8) function f_integer(x)
integer, intent(in) :: x
end
end interface
contains
subroutine s1(x, y)
real(4) :: x
real :: y(f(x)) ! resolves to f_real4
end
subroutine s2(x, y)
real(8) :: x
real :: y(f(x)) ! resolves to f_real8
end
subroutine s3(x, y)
integer :: x
real :: y(f(x)) ! resolves to f_integer
end
end
!Expect: m2.mod
!module m2
! interface f
! procedure :: f_real4
! procedure :: f_real8
! procedure :: f_integer
! end interface
! interface
! pure function f_real4(x)
! real(4), intent(in) :: x
! integer(8) :: f_real4
! end
! end interface
! interface
! pure function f_real8(x)
! real(8), intent(in) :: x
! integer(8) :: f_real8
! end
! end interface
! interface
! pure function f_integer(x)
! integer(4), intent(in) :: x
! integer(8) :: f_integer
! end
! end interface
!contains
! subroutine s1(x, y)
! real(4) :: x
! real(4) :: y(1_8:f_real4(x))
! end
! subroutine s2(x, y)
! real(8) :: x
! real(4) :: y(1_8:f_real8(x))
! end
! subroutine s3(x, y)
! integer(4) :: x
! real(4) :: y(1_8:f_integer(x))
! end
!end
! Resolve based on rank
module m3a
interface f
procedure :: f_elem
procedure :: f_vector
end interface
contains
pure integer(8) elemental function f_elem(x) result(result)
real, intent(in) :: x
result = 1_8
end
pure integer(8) function f_vector(x) result(result)
real, intent(in) :: x(:)
result = 2_8
end
end
!Expect: m3a.mod
!module m3a
! interface f
! procedure :: f_elem
! procedure :: f_vector
! end interface
!contains
! elemental pure function f_elem(x) result(result)
! real(4), intent(in) :: x
! integer(8) :: result
! end
! pure function f_vector(x) result(result)
! real(4), intent(in) :: x(:)
! integer(8) :: result
! end
!end
module m3b
use m3a
contains
subroutine s1(x, y)
real :: x
real :: y(f(x)) ! resolves to f_elem
end
subroutine s2(x, y)
real :: x(10)
real :: y(f(x)) ! resolves to f_vector (preferred over elemental one)
end
subroutine s3(x, y)
real :: x(10, 10)
real :: y(ubound(f(x), 1)) ! resolves to f_elem
end
end
!Expect: m3b.mod
!module m3b
! use m3a, only: f
! use m3a, only: f_elem
! use m3a, only: f_vector
!contains
! subroutine s1(x, y)
! real(4) :: x
! real(4) :: y(1_8:f_elem(x))
! end
! subroutine s2(x, y)
! real(4) :: x(1_8:10_8)
! real(4) :: y(1_8:f_vector(x))
! end
! subroutine s3(x, y)
! real(4) :: x(1_8:10_8, 1_8:10_8)
! real(4) :: y(1_8:ubound(f_elem(x), 1_4))
! end
!end

View File

@ -0,0 +1,44 @@
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
! http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
! Resolve generic based on number of arguments
subroutine s1
interface f
real function f1(x)
optional :: x
end
real function f2(x, y)
end
end interface
z = f(1.0)
z = f(1.0, 2.0)
!ERROR: No specific procedure of generic 'f' matches the actual arguments
z = f(1.0, 2.0, 3.0)
end
! Elemental and non-element function both match: non-elemental one should be used
subroutine s2
interface f
logical elemental function f1(x)
intent(in) :: x
end
real function f2(x)
real :: x(10)
end
end interface
real :: x, y(10), z
logical :: a
a = f(1.0)
a = f(y) !TODO: this should resolve to f2 -- should get error here
end

View File

@ -51,8 +51,8 @@ for src in "$@"; do
fi
# The first three bytes of the file are a UTF-8 BOM
sed '/^[^!]*!mod\$/d' $temp/$mod > $actual
sed '1,/^!Expect: '"$mod"'/d' $src | sed -e '/^$/,$d' -e 's/^! *//' > $expect
if ! diff -U999999 $expect $actual > $diffs; then
sed '1,/^!Expect: '"$mod"'/d' $src | sed -e '/^$/,$d' -e 's/^!//' > $expect
if ! diff -w -U999999 $expect $actual > $diffs; then
echo "Module file $mod differs from expected:"
sed '1,2d' $diffs
die FAIL $path