From cd8927e25f755382a228bc51ab80210895369136 Mon Sep 17 00:00:00 2001 From: cdchen-ca 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.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>}>> {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.shape<1>) -> !fir.ref>}>>> +! 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, uniq_name = "_QFforallpolymorphic3Etar1"} : (!fir.ref>>, !fir.shape<1>, index) -> !fir.ref>> +! 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.shape<1>, i64) -> !fir.ref>}>> +! CHECK: %[[V_29:[0-9]+]] = fir.field_index ptr, !fir.type<_QFforallpolymorphic3Tdt{ptr:!fir.class>}> +! CHECK: %[[V_30:[0-9]+]] = fir.coordinate_of %[[V_28]], ptr : (!fir.ref>}>>) -> !fir.ref>> +! 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.shape<1>, i64) -> !fir.ref> +! CHECK: %[[V_33:[0-9]+]] = fir.embox %[[V_32]] : (!fir.ref>) -> !fir.box>> +! CHECK: %[[V_34:[0-9]+]] = fir.rebox %[[V_33]] : (!fir.box>>) -> !fir.class> +! CHECK: fir.store %[[V_34]] to %[[V_30]] : !fir.ref>> +! CHECK: } + +end subroutine forallPolymorphic3 From 1582702bd2ac3b41e409888541f90e805a18ee2c Mon Sep 17 00:00:00 2001 From: cdchen-ca 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>>>}> ! CHECK: %[[V_44:[0-9]+]] = fir.coordinate_of %[[V_42]], ptr : (!fir.class>>>}>>) -> !fir.ref>>>}>>>>> ! CHECK: %[[V_45:[0-9]+]] = fir.embox %[[V_18]](%[[V_17]]) : (!fir.ref>>>}>}>>>, !fir.shape<1>) -> !fir.box>>>}>}>>>> -! CHECK: %[[V_46:[0-9]+]] = fir.convert %[[V_45]] : (!fir.box>>>}>}>>>>) -> !fir.class>>>}>>>> +! CHECK: %[[V_46:[0-9]+]] = fir.rebox %[[V_45]] : (!fir.box>>>}>}>>>>) -> !fir.class>>>}>>>> ! CHECK: fir.store %[[V_46]] to %[[V_44]] : !fir.ref>>>}>>>>> ! CHECK: } From 3d9986353b90328b711812be63714fd6dcde1ef0 Mon Sep 17 00:00:00 2001 From: cdchen-ca 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>>>}> ! CHECK: %[[V_44:[0-9]+]] = fir.coordinate_of %[[V_42]], ptr : (!fir.class>>>}>>) -> !fir.ref>>>}>>>>> ! CHECK: %[[V_45:[0-9]+]] = fir.embox %[[V_18]](%[[V_17]]) : (!fir.ref>>>}>}>>>, !fir.shape<1>) -> !fir.box>>>}>}>>>> -! CHECK: %[[V_46:[0-9]+]] = fir.rebox %[[V_45]] : (!fir.box>>>}>}>>>>) -> !fir.class>>>}>>>> +! CHECK: %[[V_46:[0-9]+]] = fir.convert %[[V_45]] : (!fir.box>>>}>}>>>>) -> !fir.class>>>}>>>> ! CHECK: fir.store %[[V_46]] to %[[V_44]] : !fir.ref>>>}>>>>> ! CHECK: }