[flang] Accept defined assignment with CLASS(*) RHS

A utility predicate in semantics was incorrectly determining that
an INTERFACE ASSIGNMENT(=) (or other form of generic) could not have
a specific procedure with an unlimited polymorphic second argument.
This led to a crash later in expression analysis.  Fix, and
extend tests.

Differential Revision: https://reviews.llvm.org/D126151

diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 7e6d1d0..807c015 100644 (file)
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -103,9 +103,12 @@ Tristate IsDefinedAssignment(
   if (!lhsType || !rhsType) {
     return Tristate::No; // error or rhs is untyped
   }
-  if (lhsType->IsUnlimitedPolymorphic() || rhsType->IsUnlimitedPolymorphic()) {
+  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/defined-ops.f90 b/flang/test/Semantics/defined-ops.f90
index e46caeb..18ed403 100644 (file)
--- a/flang/test/Semantics/defined-ops.f90
+++ b/flang/test/Semantics/defined-ops.f90
@@ -69,6 +69,10 @@ module m3
       class(t), intent(out) :: x
       integer, intent(in) :: y
     end
+    subroutine s2(x, y)
+      real, intent(out) :: x
+      class(*), intent(in) :: y
+    end
   end interface
   interface operator(+)
     integer function f(x, y)
@@ -77,12 +81,15 @@ module m3
     end
   end interface
 contains
-  subroutine test(x, y)
+  subroutine test(x, y, z)
     class(t) :: x, y
+    class(*), intent(in) :: z
+    real :: a
     !CHECK: CALL s1(x,2_4)
     x = 2
     !CHECK: i=f(x,y)
     i = x + y
+    !CHECK: CALL s2(a,z)
+    a = z
   end
 end
-