forked from OSchip/llvm-project
[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:
parent
9c8312208d
commit
6acae749c8
|
@ -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);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue