squiid/llvm
1
0
Fork 0
Code Issues Pull requests Activity

[flang] Check functions that implement defined operators (flang-compiler/f18#846)

Browse source 
Section 15.4.3.4.2 specifies restrictions on functions that may be used
to implement an "extended-intrinsic-op". These checkw are implemented in
`CheckHelper::CheckDefinedOperator`.

Move `IsIntrinsicRelational` et al. to `semantics/tools.h` so that
the same logic is used to check both dummy and actual arguments.

Fix up tests that had errors that are now detected.

Original-commit: flang-compiler/f18@b900762eed
Reviewed-on: https://github.com/flang-compiler/f18/pull/846
This commit is contained in:
Tim Keith 2019-12-02 08:55:44 -08:00 committed by GitHub
parent 201119217f
commit b0823c7b69
12 changed files with 357 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

142
flang/lib/semantics/check-declarations.cc
View file

@ -63,6 +63,12 @@ private:
void CheckDerivedType(const Symbol &, const DerivedTypeDetails &);
void CheckGeneric(const Symbol &, const GenericDetails &);
std::optional<std::vector<Procedure>> Characterize(const SymbolVector &);
bool CheckDefinedOperator(const SourceName &, const GenericKind &,
const Symbol &, const Procedure &);
std::optional<parser::MessageFixedText> CheckNumberOfArgs(
const GenericKind &, std::size_t);
bool CheckDefinedOperatorArg(
const SourceName &, const Symbol &, const Procedure &, std::size_t);
bool CheckDefinedAssignment(const Symbol &, const Procedure &);
bool CheckDefinedAssignmentArg(const Symbol &, const DummyArgument &, int);
void CheckSpecificsAreDistinguishable(
@ -401,13 +407,19 @@ void CheckHelper::CheckGeneric(
return;
}
bool ok{true};
if (details.kind().IsIntrinsicOperator()) {
for (std::size_t i{0}; i < specifics.size(); ++i) {
auto restorer{messages_.SetLocation(bindingNames[i])};
ok &= CheckDefinedOperator(
symbol.name(), details.kind(), specifics[i], (*procs)[i]);
}
}
if (details.kind().IsAssignment()) {
for (std::size_t i{0}; i < specifics.size(); ++i) {
auto restorer{messages_.SetLocation(bindingNames[i])};
ok &= CheckDefinedAssignment(specifics[i], (*procs)[i]);
}
}
// TODO: check defined operators too
if (ok) {
CheckSpecificsAreDistinguishable(symbol, details, *procs);
}
@ -457,6 +469,134 @@ static bool ConflictsWithIntrinsicAssignment(const Procedure &proc) {
IsDefinedAssignment(lhs.type(), lhs.Rank(), rhs.type(), rhs.Rank());
}
static bool ConflictsWithIntrinsicOperator(
const GenericKind &kind, const Procedure &proc) {
auto arg0{std::get<DummyDataObject>(proc.dummyArguments[0].u).type};
auto type0{arg0.type()};
if (proc.dummyArguments.size() == 1) { // unary
return std::visit(
common::visitors{
[&](common::NumericOperator) { return IsIntrinsicNumeric(type0); },
[&](common::LogicalOperator) { return IsIntrinsicLogical(type0); },
[](const auto &) -> bool { DIE("bad generic kind"); },
},
kind.u);
} else { // binary
int rank0{arg0.Rank()};
auto arg1{std::get<DummyDataObject>(proc.dummyArguments[1].u).type};
auto type1{arg1.type()};
int rank1{arg1.Rank()};
return std::visit(
common::visitors{
[&](common::NumericOperator) {
return IsIntrinsicNumeric(type0, rank0, type1, rank1);
},
[&](common::LogicalOperator) {
return IsIntrinsicLogical(type0, rank0, type1, rank1);
},
[&](common::RelationalOperator opr) {
return IsIntrinsicRelational(opr, type0, rank0, type1, rank1);
},
[&](GenericKind::OtherKind x) {
CHECK(x == GenericKind::OtherKind::Concat);
return IsIntrinsicConcat(type0, rank0, type1, rank1);
},
[](const auto &) -> bool { DIE("bad generic kind"); },
},
kind.u);
}
}
// Check if this procedure can be used for defined operators (see 15.4.3.4.2).
bool CheckHelper::CheckDefinedOperator(const SourceName &opName,
const GenericKind &kind, const Symbol &specific, const Procedure &proc) {
std::optional<parser::MessageFixedText> msg;
if (!proc.functionResult.has_value()) {
msg = "%s procedure '%s' must be a function"_err_en_US;
} else if (proc.functionResult->IsAssumedLengthCharacter()) {
msg = "%s function '%s' may not have assumed-length CHARACTER(*)"
" result"_err_en_US;
} else if (auto m{CheckNumberOfArgs(kind, proc.dummyArguments.size())}) {
msg = std::move(m);
} else if (!CheckDefinedOperatorArg(opName, specific, proc, 0) |
!CheckDefinedOperatorArg(opName, specific, proc, 1)) {
return false; // error was reported
} else if (ConflictsWithIntrinsicOperator(kind, proc)) {
msg = "%s function '%s' conflicts with intrinsic operator"_err_en_US;
} else {
return true; // OK
}
SayWithDeclaration(specific, std::move(msg.value()),
parser::ToUpperCaseLetters(opName.ToString()), specific.name());
return false;
}
// If the number of arguments is wrong for this intrinsic operator, return
// false and return the error message in msg.
std::optional<parser::MessageFixedText> CheckHelper::CheckNumberOfArgs(
const GenericKind &kind, std::size_t nargs) {
std::size_t min{2}, max{2}; // allowed number of args; default is binary
std::visit(
common::visitors{
[&](const common::NumericOperator &x) {
if (x == common::NumericOperator::Add ||
x == common::NumericOperator::Subtract) {
min = 1; // + and - are unary or binary
}
},
[&](const common::LogicalOperator &x) {
if (x == common::LogicalOperator::Not) {
min = 1; // .NOT. is unary
max = 1;
}
},
[](const common::RelationalOperator &) {
// all are binary
},
[](const GenericKind::OtherKind &x) {
CHECK(x == GenericKind::OtherKind::Concat);
},
[](const auto &) { DIE("expected intrinsic operator"); },
},
kind.u);
if (nargs >= min && nargs <= max) {
return std::nullopt;
} else if (max == 1) {
return "%s function '%s' must have one dummy argument"_err_en_US;
} else if (min == 2) {
return "%s function '%s' must have two dummy arguments"_err_en_US;
} else {
return "%s function '%s' must have one or two dummy arguments"_err_en_US;
}
}
bool CheckHelper::CheckDefinedOperatorArg(const SourceName &opName,
const Symbol &symbol, const Procedure &proc, std::size_t pos) {
if (pos >= proc.dummyArguments.size()) {
return true;
}
auto &arg{proc.dummyArguments.at(pos)};
std::optional<parser::MessageFixedText> msg;
if (arg.IsOptional()) {
msg = "In %s function '%s', dummy argument '%s' may not be"
" OPTIONAL"_err_en_US;
} else if (const auto *dataObject{std::get_if<DummyDataObject>(&arg.u)};
dataObject == nullptr) {
msg = "In %s function '%s', dummy argument '%s' must be a"
" data object"_err_en_US;
} else if (dataObject->intent != common::Intent::In &&
!dataObject->attrs.test(DummyDataObject::Attr::Value)) {
msg = "In %s function '%s', dummy argument '%s' must have INTENT(IN)"
" or VALUE attribute"_err_en_US;
}
if (msg) {
SayWithDeclaration(symbol, std::move(*msg),
parser::ToUpperCaseLetters(opName.ToString()), symbol.name(), arg.name);
return false;
}
return true;
}
// Check if this procedure can be used for defined assignment (see 15.4.3.4.3).
bool CheckHelper::CheckDefinedAssignment(
const Symbol &specific, const Procedure &proc) {

43
flang/lib/semantics/expression.cc
View file

@ -187,6 +187,7 @@ private:
bool AreConformable() const;
Symbol *FindDefinedOp(const char *) const;
std::optional<DynamicType> GetType(std::size_t) const;
int GetRank(std::size_t) const;
bool IsBOZLiteral(std::size_t i) const {
return std::holds_alternative<BOZLiteralConstant>(GetExpr(i).u);
}
@ -2465,18 +2466,9 @@ void ArgumentAnalyzer::Analyze(
}
bool ArgumentAnalyzer::IsIntrinsicRelational(RelationalOperator opr) const {
auto cat0{GetType(0)->category()};
auto cat1{GetType(1)->category()};
if (!AreConformable()) {
return false;
} else if (IsNumericTypeCategory(cat0) && IsNumericTypeCategory(cat1)) {
// numeric types: EQ/NE always ok, others ok for non-complex
return opr == RelationalOperator::EQ || opr == RelationalOperator::NE ||
(cat0 != TypeCategory::Complex && cat1 != TypeCategory::Complex);
} else {
// not both numeric: only Character is ok
return cat0 == TypeCategory::Character && cat1 == TypeCategory::Character;
}
CHECK(actuals_.size() == 2);
return semantics::IsIntrinsicRelational(
opr, *GetType(0), GetRank(0), *GetType(1), GetRank(1));
}
bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
@ -2485,7 +2477,7 @@ bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
if (IsBOZLiteral(0)) {
return opr == NumericOperator::Add;
} else {
return type0 && IsNumericTypeCategory(type0->category());
return type0 && semantics::IsIntrinsicNumeric(*type0);
}
} else {
std::optional<DynamicType> type1{GetType(1)};
@ -2496,25 +2488,25 @@ bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
auto cat0{type0->category()};
return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Real;
} else {
return AreConformable() && type0 && type1 &&
IsNumericTypeCategory(type0->category()) &&
IsNumericTypeCategory(type1->category());
return type0 && type1 &&
semantics::IsIntrinsicNumeric(*type0, GetRank(0), *type1, GetRank(1));
}
}
}
bool ArgumentAnalyzer::IsIntrinsicLogical() const {
return GetType(0)->category() == TypeCategory::Logical &&
(actuals_.size() == 1 ||
(AreConformable() &&
GetType(1)->category() == TypeCategory::Logical));
if (actuals_.size() == 1) {
return semantics::IsIntrinsicLogical(*GetType(0));
return GetType(0)->category() == TypeCategory::Logical;
} else {
return semantics::IsIntrinsicLogical(
*GetType(0), GetRank(0), *GetType(1), GetRank(1));
}
}
bool ArgumentAnalyzer::IsIntrinsicConcat() const {
return AreConformable() &&
GetType(0)->category() == TypeCategory::Character &&
GetType(1)->category() == TypeCategory::Character &&
GetType(0)->kind() == GetType(1)->kind();
return semantics::IsIntrinsicConcat(
*GetType(0), GetRank(0), *GetType(1), GetRank(1));
}
MaybeExpr ArgumentAnalyzer::TryDefinedOp(
@ -2614,6 +2606,9 @@ Symbol *ArgumentAnalyzer::FindDefinedOp(const char *opr) const {
std::optional<DynamicType> ArgumentAnalyzer::GetType(std::size_t i) const {
return i < actuals_.size() ? actuals_[i].value().GetType() : std::nullopt;
}
int ArgumentAnalyzer::GetRank(std::size_t i) const {
return i < actuals_.size() ? actuals_[i].value().Rank() : 0;
}
// Report error resolving opr when there is a user-defined one available
void ArgumentAnalyzer::SayNoMatch(const std::string &opr, bool isAssignment) {

11
flang/lib/semantics/expression.h
View file

@ -349,14 +349,13 @@ private:
friend class ArgumentAnalyzer;
};
inline bool AreConformable(int leftRank, int rightRank) {
return leftRank == 0 || rightRank == 0 || leftRank == rightRank;
}
template<typename L, typename R>
bool AreConformable(const L &left, const R &right) {
int leftRank{left.Rank()};
if (leftRank == 0) {
return true;
}
int rightRank{right.Rank()};
return rightRank == 0 || leftRank == rightRank;
return AreConformable(left.Rank(), right.Rank());
}
template<typename L, typename R>

48
flang/lib/semantics/tools.cc
View file

@ -103,6 +103,54 @@ Tristate IsDefinedAssignment(
}
}
bool IsIntrinsicRelational(common::RelationalOperator opr,
const evaluate::DynamicType &type0, int rank0,
const evaluate::DynamicType &type1, int rank1) {
if (!evaluate::AreConformable(rank0, rank1)) {
return false;
} else {
auto cat0{type0.category()};
auto cat1{type1.category()};
if (IsNumericTypeCategory(cat0) && IsNumericTypeCategory(cat1)) {
// numeric types: EQ/NE always ok, others ok for non-complex
return opr == common::RelationalOperator::EQ ||
opr == common::RelationalOperator::NE ||
(cat0 != TypeCategory::Complex && cat1 != TypeCategory::Complex);
} else {
// not both numeric: only Character is ok
return cat0 == TypeCategory::Character && cat1 == TypeCategory::Character;
}
}
}
bool IsIntrinsicNumeric(const evaluate::DynamicType &type0) {
return IsNumericTypeCategory(type0.category());
}
bool IsIntrinsicNumeric(const evaluate::DynamicType &type0, int rank0,
const evaluate::DynamicType &type1, int rank1) {
return evaluate::AreConformable(rank0, rank1) &&
IsNumericTypeCategory(type0.category()) &&
IsNumericTypeCategory(type1.category());
}
bool IsIntrinsicLogical(const evaluate::DynamicType &type0) {
return type0.category() == TypeCategory::Logical;
}
bool IsIntrinsicLogical(const evaluate::DynamicType &type0, int rank0,
const evaluate::DynamicType &type1, int rank1) {
return evaluate::AreConformable(rank0, rank1) &&
type0.category() == TypeCategory::Logical &&
type1.category() == TypeCategory::Logical;
}
bool IsIntrinsicConcat(const evaluate::DynamicType &type0, int rank0,
const evaluate::DynamicType &type1, int rank1) {
return evaluate::AreConformable(rank0, rank1) &&
type0.category() == TypeCategory::Character &&
type1.category() == TypeCategory::Character &&
type0.kind() == type1.kind();
}
bool IsGenericDefinedOp(const Symbol &symbol) {
const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()};
return details && details->kind().IsDefinedOperator();

12
flang/lib/semantics/tools.h
View file

@ -66,6 +66,18 @@ inline Tristate ToTristate(bool x) { return x ? Tristate::Yes : Tristate::No; }
Tristate IsDefinedAssignment(
const std::optional<evaluate::DynamicType> &lhsType, int lhsRank,
const std::optional<evaluate::DynamicType> &rhsType, int rhsRank);
// Test for intrinsic unary and binary operators based on types and ranks
bool IsIntrinsicRelational(common::RelationalOperator,
const evaluate::DynamicType &, int, const evaluate::DynamicType &, int);
bool IsIntrinsicNumeric(const evaluate::DynamicType &);
bool IsIntrinsicNumeric(
const evaluate::DynamicType &, int, const evaluate::DynamicType &, int);
bool IsIntrinsicLogical(const evaluate::DynamicType &);
bool IsIntrinsicLogical(
const evaluate::DynamicType &, int, const evaluate::DynamicType &, int);
bool IsIntrinsicConcat(
const evaluate::DynamicType &, int, const evaluate::DynamicType &, int);
bool IsGenericDefinedOp(const Symbol &);
bool IsCommonBlockContaining(const Symbol &block, const Symbol &object);
bool DoesScopeContain(const Scope *maybeAncestor, const Scope &maybeDescendent);

1
flang/test/semantics/CMakeLists.txt
View file

@ -103,6 +103,7 @@ set(ERROR_TESTS
resolve64.f90
resolve65.f90
resolve66.f90
resolve67.f90
stop01.f90
structconst01.f90
structconst02.f90

6
flang/test/semantics/resolve11.f90
View file

@ -36,7 +36,7 @@ module m2
private :: operator(+) , ifoo
contains
integer function ifoo(x, y)
integer, intent(in) :: x, y
logical, intent(in) :: x, y
end
end module
@ -47,7 +47,7 @@ module m3
interface operator(<)
logical function lt(x, y)
import t
type(t) :: x, y
type(t), intent(in) :: x, y
end function
end interface
!ERROR: The accessibility of 'operator(<)' has already been specified as PRIVATE
@ -55,7 +55,7 @@ module m3
interface operator(.gt.)
logical function gt(x, y)
import t
type(t) :: x, y
type(t), intent(in) :: x, y
end function
end interface
public :: operator(>)

4
flang/test/semantics/resolve13.f90
View file

@ -1,4 +1,4 @@
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
! Copyright (c) 2018-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.
@ -30,7 +30,7 @@ module m1
private :: operator(.priv.), operator(*)
contains
integer function ifoo(x, y)
integer, intent(in) :: x, y
logical, intent(in) :: x, y
end
end

2
flang/test/semantics/resolve25.f90
View file

@ -46,7 +46,7 @@ end module
module m2
interface
integer function f(x, y)
integer, intent(in) :: x, y
logical, intent(in) :: x, y
end function
end interface
generic :: operator(+)=> f

9
flang/test/semantics/resolve53.f90
View file

@ -239,13 +239,16 @@ module m14
end interface
contains
real function f1(x, y)
real :: x, y
real, intent(in) :: x
logical, intent(in) :: y
end
integer function f2(x, y)
integer :: x, y
integer, intent(in) :: x
logical, intent(in) :: y
end
real function f3(x, y)
real :: x, y
real, value :: x
logical, value :: y
end
end module

4
flang/test/semantics/resolve63.f90
View file

@ -141,8 +141,8 @@ end
module m3
interface operator(+)
logical function add(x, y)
logical :: x
integer :: y
logical, intent(in) :: x
integer, value :: y
end
end interface
contains

117
flang/test/semantics/resolve67.f90 Normal file
View file

@ -0,0 +1,117 @@
! 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.
! Test restrictions on what subprograms can be used for defined operators.
! See: 15.4.3.4.2
module m1
interface operator(+)
!ERROR: OPERATOR(+) procedure 'add1' must be a function
subroutine add1(x, y, z)
real, intent(out) :: x
real, intent(in) :: y, z
end
end interface
end
module m2
interface operator(-)
real function sub1(x)
logical, intent(in) :: x
end
real function sub2(x, y)
logical, intent(in) :: x, y
end
!ERROR: OPERATOR(-) function 'sub3' must have one or two dummy arguments
real function sub3(x, y, z)
real, intent(in) :: x, y, z
end
end interface
interface operator(.not.)
!ERROR: OPERATOR(.NOT.) function 'not1' must have one dummy argument
real function not1(x, y)
real, intent(in) :: x, y
end
end interface
end
module m3
interface operator(/)
!ERROR: OPERATOR(/) function 'divide' may not have assumed-length CHARACTER(*) result
character(*) function divide(x, y)
character(*), intent(in) :: x, y
end
end interface
interface operator(<)
!ERROR: In OPERATOR(<) function 'lt1', dummy argument 'x' must have INTENT(IN) or VALUE attribute
!ERROR: In OPERATOR(<) function 'lt1', dummy argument 'y' may not be OPTIONAL
logical function lt1(x, y)
logical :: x
real, value, optional :: y
end
!ERROR: In OPERATOR(<) function 'lt2', dummy argument 'y' must be a data object
logical function lt2(x, y)
logical, intent(in) :: x
intent(in) :: y
interface
subroutine y()
end
end interface
end
end interface
end
module m4
interface operator(+)
!ERROR: OPERATOR(+) function 'add' conflicts with intrinsic operator
complex function add(x, y)
real, intent(in) :: x
integer, value :: y
end
!ERROR: OPERATOR(+) function 'plus' conflicts with intrinsic operator
real function plus(x)
complex, intent(in) :: x
end
end interface
interface operator(.not.)
real function not1(x)
real, value :: x
end
!ERROR: OPERATOR(.NOT.) function 'not2' conflicts with intrinsic operator
logical(8) function not2(x)
logical(8), value :: x
end
end interface
interface operator(.and.)
!ERROR: OPERATOR(.AND.) function 'and' conflicts with intrinsic operator
real function and(x, y)
logical(1), value :: x
logical(8), value :: y
end
end interface
interface operator(//)
real function concat1(x, y)
real, value :: x, y
end
real function concat2(x, y)
character(kind=1, len=4), intent(in) :: x
character(kind=4, len=4), intent(in) :: y
end
!ERROR: OPERATOR(//) function 'concat3' conflicts with intrinsic operator
real function concat3(x, y)
character(kind=4, len=4), intent(in) :: x
character(kind=4, len=4), intent(in) :: y
end
end interface
end