maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Add checks for valid defined assignment procedures 

Perform the checks from 15.4.3.4.3 to determine what procedures are
valid to implement defined assignment. This requires characterizing
procedures, so share the result of that with
`CheckSpecificsAreDistinguishable`.

Original-commit: flang-compiler/f18@9e0d79f173
Reviewed-on: https://github.com/flang-compiler/f18/pull/841
Tree-same-pre-rewrite: false
This commit is contained in:
Tim Keith 2019-11-22 14:40:53 -08:00
parent 67c548376d
commit b51673cab9
5 changed files with 240 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
flang/lib/semantics/check-declarations.cc
View File

@ -26,6 +26,10 @@
namespace Fortran::semantics {
using evaluate::characteristics::DummyArgument;
using evaluate::characteristics::DummyDataObject;
using evaluate::characteristics::Procedure;
class CheckHelper {
public:
explicit CheckHelper(SemanticsContext &c) : context_{c} {}
@ -58,7 +62,11 @@ private:
void CheckProcEntity(const Symbol &, const ProcEntityDetails &);
void CheckDerivedType(const Symbol &, const DerivedTypeDetails &);
void CheckGeneric(const Symbol &, const GenericDetails &);
void CheckSpecificsAreDistinguishable(const Symbol &, const GenericDetails &);
std::optional<std::vector<Procedure>> Characterize(const SymbolVector &);
bool CheckDefinedAssignment(const Symbol &, const Procedure &);
bool CheckDefinedAssignmentArg(const Symbol &, const DummyArgument &, int);
void CheckSpecificsAreDistinguishable(
const Symbol &, const GenericDetails &, const std::vector<Procedure> &);
void SayNotDistinguishable(
const SourceName &, GenericKind, const Symbol &, const Symbol &);
bool InPure() const {
@ -119,7 +127,7 @@ void CheckHelper::Check(const Symbol &symbol) {
}
const DeclTypeSpec *type{symbol.GetType()};
const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
auto save{messages_.SetLocation(symbol.name())};
auto restorer{messages_.SetLocation(symbol.name())};
context_.set_location(symbol.name());
bool isAssociated{symbol.has<UseDetails>() || symbol.has<HostAssocDetails>()};
if (symbol.attrs().test(Attr::VOLATILE)) {
@ -386,12 +394,28 @@ void CheckHelper::CheckDerivedType(
void CheckHelper::CheckGeneric(
const Symbol &symbol, const GenericDetails &details) {
CheckSpecificsAreDistinguishable(symbol, details);
const SymbolVector &specifics{details.specificProcs()};
const auto &bindingNames{details.bindingNames()};
std::optional<std::vector<Procedure>> procs{Characterize(specifics)};
if (!procs) {
return;
}
bool ok{true};
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);
}
}
// Check that the specifics of this generic are distinguishable from each other
void CheckHelper::CheckSpecificsAreDistinguishable(
const Symbol &generic, const GenericDetails &details) {
void CheckHelper::CheckSpecificsAreDistinguishable(const Symbol &generic,
const GenericDetails &details, const std::vector<Procedure> &procs) {
const SymbolVector &specifics{details.specificProcs()};
std::size_t count{specifics.size()};
if (count < 2) {
@ -401,18 +425,6 @@ void CheckHelper::CheckSpecificsAreDistinguishable(
auto distinguishable{kind.IsAssignment() || kind.IsOperator()
? evaluate::characteristics::DistinguishableOpOrAssign
: evaluate::characteristics::Distinguishable};
using evaluate::characteristics::Procedure;
std::vector<Procedure> procs;
for (const Symbol &symbol : specifics) {
if (context_.HasError(symbol)) {
return;
}
auto proc{Procedure::Characterize(symbol, context_.intrinsics())};
if (!proc) {
return;
}
procs.emplace_back(*proc);
}
for (std::size_t i1{0}; i1 < count - 1; ++i1) {
auto &proc1{procs[i1]};
for (std::size_t i2{i1 + 1}; i2 < count; ++i2) {
@ -438,6 +450,91 @@ void CheckHelper::SayNotDistinguishable(const SourceName &name,
evaluate::AttachDeclaration(msg, proc2);
}
static bool ConflictsWithIntrinsicAssignment(
const DummyDataObject &arg0, const DummyDataObject &arg1) {
auto cat0{arg0.type.type().category()};
auto cat1{arg1.type.type().category()};
int rank0{arg0.type.Rank()};
int rank1{arg1.type.Rank()};
if (cat0 == TypeCategory::Derived || (rank1 > 0 && rank0 != rank1)) {
return false;
} else {
return cat0 == cat1 ||
(IsNumericTypeCategory(cat0) && IsNumericTypeCategory(cat1));
}
}
// 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) {
std::optional<parser::MessageFixedText> msg;
if (!proc.IsSubroutine()) {
msg = "Defined assignment procedure '%s' must be a subroutine"_err_en_US;
} else if (proc.dummyArguments.size() != 2) {
msg = "Defined assignment subroutine '%s' must have"
" two dummy arguments"_err_en_US;
} else if (!CheckDefinedAssignmentArg(specific, proc.dummyArguments[0], 0) |
!CheckDefinedAssignmentArg(specific, proc.dummyArguments[1], 1)) {
return false; // error was reported
} else if (ConflictsWithIntrinsicAssignment(
std::get<DummyDataObject>(proc.dummyArguments[0].u),
std::get<DummyDataObject>(proc.dummyArguments[1].u))) {
msg = "Defined assignment subroutine '%s' conflicts with"
" intrinsic assignment"_err_en_US;
} else {
return true; // OK
}
SayWithDeclaration(specific, std::move(msg.value()), specific.name());
return false;
}
bool CheckHelper::CheckDefinedAssignmentArg(
const Symbol &symbol, const DummyArgument &arg, int pos) {
std::optional<parser::MessageFixedText> msg;
if (arg.IsOptional()) {
msg = "In defined assignment subroutine '%s', dummy argument '%s'"
" may not be OPTIONAL"_err_en_US;
} else if (const auto *dataObject{std::get_if<DummyDataObject>(&arg.u)}) {
if (pos == 0) {
if (dataObject->intent != common::Intent::Out &&
dataObject->intent != common::Intent::InOut) {
msg = "In defined assignment subroutine '%s', first dummy argument '%s'"
" must have INTENT(OUT) or INTENT(INOUT)"_err_en_US;
}
} else if (pos == 1) {
if (dataObject->intent != common::Intent::In &&
!dataObject->attrs.test(DummyDataObject::Attr::Value)) {
msg =
"In defined assignment subroutine '%s', second dummy"
" argument '%s' must have INTENT(IN) or VALUE attribute"_err_en_US;
}
} else {
DIE("pos must be 0 or 1");
}
} else {
msg = "In defined assignment subroutine '%s', dummy argument '%s'"
" must be a data object"_err_en_US;
}
if (msg) {
SayWithDeclaration(symbol, std::move(*msg), symbol.name(), arg.name);
return false;
}
return true;
}
std::optional<std::vector<Procedure>> CheckHelper::Characterize(
const SymbolVector &specifics) {
std::vector<Procedure> result;
for (const Symbol &specific : specifics) {
auto proc{Procedure::Characterize(specific, context_.intrinsics())};
if (!proc || context_.HasError(specific)) {
return std::nullopt;
}
result.emplace_back(*proc);
}
return result;
}
void CheckHelper::CheckVolatile(const Symbol &symbol, bool isAssociated,
const DerivedTypeSpec *derived) { // C866 - C868
if (IsIntentIn(symbol)) {

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

@ -101,6 +101,7 @@ set(ERROR_TESTS
resolve62.f90
resolve63.f90
resolve64.f90
resolve65.f90
stop01.f90
structconst01.f90
structconst02.f90

6
flang/test/semantics/resolve15.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.
@ -41,6 +41,8 @@ subroutine s
module procedure :: sub
end interface
contains
subroutine sub
subroutine sub(x, y)
real, intent(out) :: x
logical, intent(in) :: y
end
end

26
flang/test/semantics/resolve53.f90
View File

@ -445,32 +445,8 @@ contains
end
end
! C1512 - rules for assignment
! s1 and s2 are not distinguishable for a generic name but they are
! for assignment
module m19
interface assignment(=)
module procedure s1
module procedure s2
end interface
!ERROR: Generic 'g' may not have specific procedures 's1' and 's2' as their interfaces are not distinguishable
interface g
module procedure s1
module procedure s2
end interface
contains
subroutine s1(d, p)
real, intent(out) :: d
integer, intent(in) :: p
end subroutine
subroutine s2(p, d)
integer, intent(out) :: p
real, intent(in) :: d
end subroutine
end module
! C1511 - rules for operators
module m20
module m19
interface operator(.foo.)
module procedure f1
module procedure f2

120
flang/test/semantics/resolve65.f90 Normal file
View File

@ -0,0 +1,120 @@
! 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 assignment.
module m1
implicit none
type :: t
contains
!ERROR: Defined assignment procedure 'binding' must be a subroutine
generic :: assignment(=) => binding
procedure :: binding => assign_t1
procedure :: assign_t
procedure :: assign_t2
procedure :: assign_t3
!ERROR: Defined assignment subroutine 'assign_t2' must have two dummy arguments
!ERROR: In defined assignment subroutine 'assign_t3', second dummy argument 'y' must have INTENT(IN) or VALUE attribute
!ERROR: In defined assignment subroutine 'assign_t4', first dummy argument 'x' must have INTENT(OUT) or INTENT(INOUT)
generic :: assignment(=) => assign_t, assign_t2, assign_t3, assign_t4
procedure :: assign_t4
end type
contains
subroutine assign_t(x, y)
class(t), intent(out) :: x
type(t), intent(in) :: y
end
logical function assign_t1(x, y)
class(t), intent(out) :: x
type(t), intent(in) :: y
end
subroutine assign_t2(x)
class(t), intent(out) :: x
end
subroutine assign_t3(x, y)
class(t), intent(out) :: x
real :: y
end
subroutine assign_t4(x, y)
class(t) :: x
integer, intent(in) :: y
end
end
module m2
type :: t
end type
interface assignment(=)
!ERROR: In defined assignment subroutine 's1', dummy argument 'y' may not be OPTIONAL
subroutine s1(x, y)
import t
type(t), intent(out) :: x
real, optional, intent(in) :: y
end
!ERROR: In defined assignment subroutine 's2', dummy argument 'y' must be a data object
subroutine s2(x, y)
import t
type(t), intent(out) :: x
intent(in) :: y
interface
subroutine y()
end
end interface
end
end interface
end
! Detect defined assignment that conflicts with intrinsic assignment
module m5
type :: t
end type
interface assignment(=)
! OK - lhs is derived type
subroutine assign_tt(x, y)
import t
type(t), intent(out) :: x
type(t), intent(in) :: y
end
!OK - incompatible types
subroutine assign_il(x, y)
integer, intent(out) :: x
logical, intent(in) :: y
end
!OK - different ranks
subroutine assign_23(x, y)
integer, intent(out) :: x(:,:)
integer, intent(in) :: y(:,:,:)
end
!OK - scalar = array
subroutine assign_01(x, y)
integer, intent(out) :: x
integer, intent(in) :: y(:)
end
!ERROR: Defined assignment subroutine 'assign_10' conflicts with intrinsic assignment
subroutine assign_10(x, y)
integer, intent(out) :: x(:)
integer, intent(in) :: y
end
!ERROR: Defined assignment subroutine 'assign_ir' conflicts with intrinsic assignment
subroutine assign_ir(x, y)
integer, intent(out) :: x
real, intent(in) :: y
end
!ERROR: Defined assignment subroutine 'assign_ii' conflicts with intrinsic assignment
subroutine assign_ii(x, y)
integer(2), intent(out) :: x
integer(1), intent(in) :: y
end
end interface
end