[flang-commits] [flang] To fix polymorphic pointer assignment in FORALL when LHS is unlimited polymorphic and RHS is intrinsic type target (PR #164999)
Daniel Chen via flang-commits
flang-commits at lists.llvm.org
Wed Oct 29 10:37:15 PDT 2025
https://github.com/DanielCChen updated https://github.com/llvm/llvm-project/pull/164999
>From cd8927e25f755382a228bc51ab80210895369136 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Fri, 24 Oct 2025 11:18:30 -0400
Subject: [PATCH 1/3] To fix polymorphic pointer assignment in FORALL when LHS
is unlimited polymorphic and RHS is intrinsic type target.
---
flang/lib/Lower/Bridge.cpp | 4 +++
flang/test/Lower/forall-polymorphic.f90 | 41 +++++++++++++++++++++++++
2 files changed, 45 insertions(+)
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index a516a44204cac..67d280cb3e128 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -4778,6 +4778,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
mlir::Value shape = builder->genShape(loc, lbounds, extents);
rhsBox = fir::ReboxOp::create(*builder, loc, lhsBoxType, rhsBox, shape,
/*slice=*/mlir::Value{});
+ } else if (fir::isClassStarType(lhsBoxType) &&
+ !fir::ConvertOp::canBeConverted(rhsBoxType, lhsBoxType)) {
+ rhsBox = fir::ReboxOp::create(*builder, loc, lhsBoxType, rhsBox,
+ mlir::Value{}, mlir::Value{});
}
return rhsBox;
}
diff --git a/flang/test/Lower/forall-polymorphic.f90 b/flang/test/Lower/forall-polymorphic.f90
index 2b7a51f9b549a..656b6ecf00628 100644
--- a/flang/test/Lower/forall-polymorphic.f90
+++ b/flang/test/Lower/forall-polymorphic.f90
@@ -1,6 +1,7 @@
! Test lower of FORALL polymorphic pointer assignment
! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
!! Test when LHS is polymorphic and RHS is not polymorphic
! CHECK-LABEL: c.func @_QPforallpolymorphic
subroutine forallPolymorphic()
@@ -46,6 +47,7 @@ subroutine forallPolymorphic()
end subroutine forallPolymorphic
+
!! Test when LHS is not polymorphic but RHS is polymorphic
! CHECK-LABEL: c.func @_QPforallpolymorphic2(
! CHECK-SAME: %arg0: !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QFforallpolymorphic2Tdt{ptr:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphic2Tdt>>>>}>>>>> {fir.bindc_name = "tar1", fir.target}) {
@@ -87,3 +89,42 @@ subroutine forallPolymorphic2(Tar1)
end subroutine forallPolymorphic2
+
+!! Test when LHS is unlimited polymorphic and RHS non-polymorphic intrinsic
+!! type target.
+! CHECK-LABEL: c.func @_QPforallpolymorphic3
+subroutine forallPolymorphic3()
+ TYPE :: DT
+ CLASS(*), POINTER :: Ptr => NULL()
+ END TYPE
+
+ TYPE(DT) :: D1(10)
+ CHARACTER*1, TARGET :: TAR1(10)
+ INTEGER :: I
+
+ FORALL (I=1:10)
+ D1(I)%Ptr => Tar1(I)
+ END FORALL
+
+! CHECK: %[[V_7:[0-9]+]] = fir.alloca !fir.array<10x!fir.type<_QFforallpolymorphic3Tdt{ptr:!fir.class<!fir.ptr<none>>}>> {bindc_name = "d1", uniq_name = "_QFforallpolymorphic3Ed1"}
+! CHECK: %[[V_8:[0-9]+]] = fir.shape %c10 : (index) -> !fir.shape<1>
+! CHECK: %[[V_9:[0-9]+]] = fir.declare %[[V_7]](%[[V_8]]) {uniq_name = "_QFforallpolymorphic3Ed1"} : (!fir.ref<!fir.array<10x!fir.type<_QFforallpolymorphic3Tdt{ptr:!fir.class<!fir.ptr<none>>}>>>, !fir.shape<1>) -> !fir.ref<!fir.array<10x!fir.type<_QFforallpolymorphic3Tdt{ptr:!fir.class<!fir.ptr<none>>}>>>
+! CHECK: %[[V_16:[0-9]+]] = fir.alloca !fir.array<10x!fir.char<1>> {bindc_name = "tar1", fir.target, uniq_name = "_QFforallpolymorphic3Etar1"}
+! CHECK: %[[V_17:[0-9]+]] = fir.declare %[[V_16]](%[[V_8]]) typeparams %c1 {fortran_attrs = #fir.var_attrs<target>, uniq_name = "_QFforallpolymorphic3Etar1"} : (!fir.ref<!fir.array<10x!fir.char<1>>>, !fir.shape<1>, index) -> !fir.ref<!fir.array<10x!fir.char<1>>>
+! CHECK: %[[V_24:[0-9]+]] = fir.convert %c1_i32 : (i32) -> index
+! CHECK: %[[V_25:[0-9]+]] = fir.convert %c10_i32 : (i32) -> index
+! CHECK: fir.do_loop %arg0 = %[[V_24]] to %[[V_25]] step %c1
+! CHECK: {
+! CHECK: %[[V_26:[0-9]+]] = fir.convert %arg0 : (index) -> i32
+! CHECK: %[[V_27:[0-9]+]] = fir.convert %[[V_26]] : (i32) -> i64
+! CHECK: %[[V_28:[0-9]+]] = fir.array_coor %[[V_9]](%[[V_8]]) %[[V_27]] : (!fir.ref<!fir.array<10x!fir.type<_QFforallpolymorphic3Tdt{ptr:!fir.class<!fir.ptr<none>>}>>>, !fir.shape<1>, i64) -> !fir.ref<!fir.type<_QFforallpolymorphic3Tdt{ptr:!fir.class<!fir.ptr<none>>}>>
+! CHECK: %[[V_29:[0-9]+]] = fir.field_index ptr, !fir.type<_QFforallpolymorphic3Tdt{ptr:!fir.class<!fir.ptr<none>>}>
+! CHECK: %[[V_30:[0-9]+]] = fir.coordinate_of %[[V_28]], ptr : (!fir.ref<!fir.type<_QFforallpolymorphic3Tdt{ptr:!fir.class<!fir.ptr<none>>}>>) -> !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: %[[V_31:[0-9]+]] = fir.convert %[[V_26]] : (i32) -> i64
+! CHECK: %[[V_32:[0-9]+]] = fir.array_coor %[[V_17]](%[[V_8]]) %31 : (!fir.ref<!fir.array<10x!fir.char<1>>>, !fir.shape<1>, i64) -> !fir.ref<!fir.char<1>>
+! CHECK: %[[V_33:[0-9]+]] = fir.embox %[[V_32]] : (!fir.ref<!fir.char<1>>) -> !fir.box<!fir.ptr<!fir.char<1>>>
+! CHECK: %[[V_34:[0-9]+]] = fir.rebox %[[V_33]] : (!fir.box<!fir.ptr<!fir.char<1>>>) -> !fir.class<!fir.ptr<none>>
+! CHECK: fir.store %[[V_34]] to %[[V_30]] : !fir.ref<!fir.class<!fir.ptr<none>>>
+! CHECK: }
+
+end subroutine forallPolymorphic3
>From 1582702bd2ac3b41e409888541f90e805a18ee2c Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Tue, 28 Oct 2025 11:11:56 -0400
Subject: [PATCH 2/3] Fix a regression that was exposed by PR #164279, which
also requires to rebox the RHS to the LHS type iif LHS is polymorphic.
---
flang/lib/Lower/Bridge.cpp | 3 +--
flang/test/Lower/forall-polymorphic.f90 | 2 +-
2 files changed, 2 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 67d280cb3e128..94a94d39afacb 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -4778,8 +4778,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
mlir::Value shape = builder->genShape(loc, lbounds, extents);
rhsBox = fir::ReboxOp::create(*builder, loc, lhsBoxType, rhsBox, shape,
/*slice=*/mlir::Value{});
- } else if (fir::isClassStarType(lhsBoxType) &&
- !fir::ConvertOp::canBeConverted(rhsBoxType, lhsBoxType)) {
+ } else if (fir::isPolymorphicType(lhsBoxType)) {
rhsBox = fir::ReboxOp::create(*builder, loc, lhsBoxType, rhsBox,
mlir::Value{}, mlir::Value{});
}
diff --git a/flang/test/Lower/forall-polymorphic.f90 b/flang/test/Lower/forall-polymorphic.f90
index 656b6ecf00628..b0b6003f2e964 100644
--- a/flang/test/Lower/forall-polymorphic.f90
+++ b/flang/test/Lower/forall-polymorphic.f90
@@ -41,7 +41,7 @@ subroutine forallPolymorphic()
! CHECK: %[[V_43:[0-9]+]] = fir.field_index ptr, !fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>
! CHECK: %[[V_44:[0-9]+]] = fir.coordinate_of %[[V_42]], ptr : (!fir.class<!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>) -> !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>>>>
! CHECK: %[[V_45:[0-9]+]] = fir.embox %[[V_18]](%[[V_17]]) : (!fir.ref<!fir.array<10x!fir.type<_QFforallpolymorphicTdt1{dt:!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>}>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<10x!fir.type<_QFforallpolymorphicTdt1{dt:!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>}>>>>
-! CHECK: %[[V_46:[0-9]+]] = fir.convert %[[V_45]] : (!fir.box<!fir.ptr<!fir.array<10x!fir.type<_QFforallpolymorphicTdt1{dt:!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>}>>>>) -> !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>>>
+! CHECK: %[[V_46:[0-9]+]] = fir.rebox %[[V_45]] : (!fir.box<!fir.ptr<!fir.array<10x!fir.type<_QFforallpolymorphicTdt1{dt:!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>}>>>>) -> !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>>>
! CHECK: fir.store %[[V_46]] to %[[V_44]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>>>>
! CHECK: }
>From 3d9986353b90328b711812be63714fd6dcde1ef0 Mon Sep 17 00:00:00 2001
From: cdchen-ca <cdchen at ca.ibm.com>
Date: Wed, 29 Oct 2025 13:36:46 -0400
Subject: [PATCH 3/3] Revert "Fix a regression that was exposed by PR #164279,
which also requires to rebox the RHS to the LHS type iif LHS is polymorphic."
This reverts commit 1582702bd2ac3b41e409888541f90e805a18ee2c.
---
flang/lib/Lower/Bridge.cpp | 3 ++-
flang/test/Lower/forall-polymorphic.f90 | 2 +-
2 files changed, 3 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 94a94d39afacb..67d280cb3e128 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -4778,7 +4778,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
mlir::Value shape = builder->genShape(loc, lbounds, extents);
rhsBox = fir::ReboxOp::create(*builder, loc, lhsBoxType, rhsBox, shape,
/*slice=*/mlir::Value{});
- } else if (fir::isPolymorphicType(lhsBoxType)) {
+ } else if (fir::isClassStarType(lhsBoxType) &&
+ !fir::ConvertOp::canBeConverted(rhsBoxType, lhsBoxType)) {
rhsBox = fir::ReboxOp::create(*builder, loc, lhsBoxType, rhsBox,
mlir::Value{}, mlir::Value{});
}
diff --git a/flang/test/Lower/forall-polymorphic.f90 b/flang/test/Lower/forall-polymorphic.f90
index b0b6003f2e964..656b6ecf00628 100644
--- a/flang/test/Lower/forall-polymorphic.f90
+++ b/flang/test/Lower/forall-polymorphic.f90
@@ -41,7 +41,7 @@ subroutine forallPolymorphic()
! CHECK: %[[V_43:[0-9]+]] = fir.field_index ptr, !fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>
! CHECK: %[[V_44:[0-9]+]] = fir.coordinate_of %[[V_42]], ptr : (!fir.class<!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>) -> !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>>>>
! CHECK: %[[V_45:[0-9]+]] = fir.embox %[[V_18]](%[[V_17]]) : (!fir.ref<!fir.array<10x!fir.type<_QFforallpolymorphicTdt1{dt:!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>}>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<10x!fir.type<_QFforallpolymorphicTdt1{dt:!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>}>>>>
-! CHECK: %[[V_46:[0-9]+]] = fir.rebox %[[V_45]] : (!fir.box<!fir.ptr<!fir.array<10x!fir.type<_QFforallpolymorphicTdt1{dt:!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>}>>>>) -> !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>>>
+! CHECK: %[[V_46:[0-9]+]] = fir.convert %[[V_45]] : (!fir.box<!fir.ptr<!fir.array<10x!fir.type<_QFforallpolymorphicTdt1{dt:!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>}>>>>) -> !fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>>>
! CHECK: fir.store %[[V_46]] to %[[V_44]] : !fir.ref<!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt{ptr:!fir.class<!fir.ptr<!fir.array<?x!fir.type<_QFforallpolymorphicTdt>>>>}>>>>>
! CHECK: }
More information about the flang-commits
mailing list