[flang-commits] [flang] [flang] Allow defined assignment to CLASS(*) (PR #124817)
via flang-commits
flang-commits at lists.llvm.org
Tue Jan 28 10:47:41 PST 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
An unlimited polymorphic left-hand side variable is acceptable in the definition of a defined assignment subroutine.
Fixes https://github.com/llvm/llvm-project/issues/124621.
---
Full diff: https://github.com/llvm/llvm-project/pull/124817.diff
2 Files Affected:
- (modified) flang/lib/Semantics/tools.cpp (-6)
- (added) flang/test/Semantics/bug124621.f90 (+46)
``````````diff
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 013d006e614b4b..9ebfbbb5317b66 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -137,12 +137,6 @@ Tristate IsDefinedAssignment(
if (!lhsType || !rhsType) {
return Tristate::No; // error or rhs is untyped
}
- if (lhsType->IsUnlimitedPolymorphic()) {
- return Tristate::No;
- }
- if (rhsType->IsUnlimitedPolymorphic()) {
- return Tristate::Maybe;
- }
TypeCategory lhsCat{lhsType->category()};
TypeCategory rhsCat{rhsType->category()};
if (rhsRank > 0 && lhsRank != rhsRank) {
diff --git a/flang/test/Semantics/bug124621.f90 b/flang/test/Semantics/bug124621.f90
new file mode 100644
index 00000000000000..1106ed4a25c493
--- /dev/null
+++ b/flang/test/Semantics/bug124621.f90
@@ -0,0 +1,46 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+ type t1
+ contains
+ procedure, pass(from) :: defAsst1
+ generic :: assignment(=) => defAsst1
+ end type
+ type t2
+ end type
+ type t3
+ end type
+ interface assignment(=)
+ module procedure defAsst2
+ end interface
+ contains
+ subroutine defAsst1(to,from)
+ class(*), intent(out) :: to
+ class(t1), intent(in) :: from
+ end
+ subroutine defAsst2(to,from)
+ class(*), intent(out) :: to
+ class(t2), intent(in) :: from
+ end
+end
+
+program test
+ use m
+ type(t1) x1
+ type(t2) x2
+ type(t3) x3
+ j = x1
+ j = x2
+ !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types INTEGER(4) and TYPE(t3)
+ j = x3
+ x1 = x1
+ x1 = x2
+ !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t1) and TYPE(t3)
+ x1 = x3
+ x2 = x1
+ x2 = x2
+ !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t2) and TYPE(t3)
+ x2 = x3
+ x3 = x1
+ x3 = x2
+ x3 = x3
+end
``````````
</details>
https://github.com/llvm/llvm-project/pull/124817
More information about the flang-commits
mailing list