[flang-commits] [flang] [FLANG] Solved an issue with usage of unlimited polymorphic in where construct (PR #147001)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-fir-hlfir

Author: Ebin-McW (EbinJose2002)

<details>
<summary>Changes</summary>

Fixes #<!-- -->133669

---
Full diff: https://github.com/llvm/llvm-project/pull/147001.diff


2 Files Affected:

- (modified) flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp (+7) 
- (added) flang/test/Lower/polymorphic-array.f90 (+27) 


``````````diff
diff --git a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
index 33f687db08f9a..2196f6a9dde0c 100644
--- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
@@ -141,6 +141,13 @@ class AssignOpConversion : public mlir::OpRewritePattern<hlfir::AssignOp> {
         fir::runtime::genAssignTemporary(builder, loc, toMutableBox, from);
       else
         fir::runtime::genAssign(builder, loc, toMutableBox, from);
+    } else if (lhs.isPolymorphic() && rhs.isPolymorphic()) {
+      if (fir::isNoneOrSeqNone(fir::getElementTypeOf(lhsExv)) &&
+          fir::isNoneOrSeqNone(fir::getElementTypeOf(rhsExv))) {
+        mlir::Value to = fir::getBase(builder.createBox(loc, lhsExv));
+        mlir::Value from = fir::getBase(builder.createBox(loc, rhsExv));
+        fir::runtime::genAssignPolymorphic(builder, loc, to, from);
+      }
     } else {
       // TODO: use the type specification to see if IsFinalizable is set,
       // or propagate IsFinalizable attribute from lowering.
diff --git a/flang/test/Lower/polymorphic-array.f90 b/flang/test/Lower/polymorphic-array.f90
new file mode 100644
index 0000000000000..6e6d9ae7187e5
--- /dev/null
+++ b/flang/test/Lower/polymorphic-array.f90
@@ -0,0 +1,27 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Checks that no fir store is present with fir.class<none> as the first operand.
+! Regression test for bug: FIR lowering failure on polymorphic assignment.
+
+! CHECK-NOT: fir.store{{.*}}!fir.class<none>
+module m1
+  type x
+  end type x
+  logical,parameter::t=.true.,f=.false.
+  logical::mask(3)=[t,f,t]
+end module m1
+
+subroutine s1
+  use m1
+  class(*),allocatable::v(:),u(:)
+  allocate(x::v(3))
+  allocate(x::u(3))
+  where(mask)
+     u=v
+  end where
+end subroutine s1
+
+program main
+  call s1
+  print *,'pass'
+end program main

``````````

</details>


https://github.com/llvm/llvm-project/pull/147001