diff options
author | Peter Klausler <pklausler@nvidia.com> | 2022-05-03 23:57:14 +0300 |
---|---|---|
committer | Peter Klausler <pklausler@nvidia.com> | 2022-05-10 03:55:10 +0300 |
commit | eef76f9821b845b684c9f54d4f3b6d67c0dc2acc (patch) | |
tree | 6aa9d6e82402e39223118c827249b9cc1952031e /flang | |
parent | 5d5d2a0b197fa02abac5ccf295731ca826864ddd (diff) |
[flang] Reverse a reversed type compatibility check
The semantic test for an intrinsic assignment to a polymorphic
derived type entity from a type that is an extension of its base
type was reversed, so it would allow assignments that it shouldn't
and disallowed some that it should; and the test case for it
incorectly assumed that the invalid semantics were correct.
Fix the code and the test, and add a new test for the invalid
case (LHS type is an extension of the RHS type).
Differential Revision: https://reviews.llvm.org/D125135
Diffstat (limited to 'flang')
-rw-r--r-- | flang/lib/Semantics/tools.cpp | 2 | ||||
-rw-r--r-- | flang/test/Semantics/selecttype03.f90 | 9 |
2 files changed, 8 insertions, 3 deletions
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 0b345a66a478..87c842de8842 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -94,7 +94,7 @@ const Scope *FindPureProcedureContaining(const Scope &start) { static bool MightBeSameDerivedType( const std::optional<evaluate::DynamicType> &lhsType, const std::optional<evaluate::DynamicType> &rhsType) { - return lhsType && rhsType && rhsType->IsTkCompatibleWith(*lhsType); + return lhsType && rhsType && lhsType->IsTkCompatibleWith(*rhsType); } Tristate IsDefinedAssignment( diff --git a/flang/test/Semantics/selecttype03.f90 b/flang/test/Semantics/selecttype03.f90 index bfb1bd4535e5..f7070f7bb0d6 100644 --- a/flang/test/Semantics/selecttype03.f90 +++ b/flang/test/Semantics/selecttype03.f90 @@ -110,11 +110,16 @@ contains if (i>0) then foo = array1(2,U) else if (i<0) then - !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types CLASS(t1) and CLASS(t2) - foo = array2(2,U) + foo = array2(2,U) ! ok: t2 extends t1 end if end function + function foo2() + class(t2),DIMENSION(:),allocatable :: foo2 + !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types CLASS(t2) and CLASS(t1) + foo2 = array1(2,:) + end function + subroutine sub_with_in_and_inout_param(y, z) type(t2), INTENT(IN) :: y class(t2), INTENT(INOUT) :: z |