From e8654e7bce89b30e43e43ca9d49f654272646f83 Mon Sep 17 00:00:00 2001 From: cdchen-ca Date: Thu, 30 Oct 2025 15:48:37 -0400 Subject: [PATCH 1/4] Use the RHS of a pointer assignment inside of FORALL if it is already a box instead of convertToBox again. --- .../Optimizer/Builder/TemporaryStorage.cpp | 20 +++++--- .../forall-pointer-assignment-codegen.fir | 6 +-- ...phic.f90 => forall-pointer-assignment.f90} | 46 ++++++++++++++++++- 3 files changed, 60 insertions(+), 12 deletions(-) rename flang/test/Lower/{forall-polymorphic.f90 => forall-pointer-assignment.f90} (85%) diff --git a/flang/lib/Optimizer/Builder/TemporaryStorage.cpp b/flang/lib/Optimizer/Builder/TemporaryStorage.cpp index 7e329e357d7b3..4fb546e9cb95d 100644 --- a/flang/lib/Optimizer/Builder/TemporaryStorage.cpp +++ b/flang/lib/Optimizer/Builder/TemporaryStorage.cpp @@ -258,13 +258,19 @@ void fir::factory::AnyVariableStack::pushValue(mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value variable) { hlfir::Entity entity{variable}; - mlir::Type storageElementType = - hlfir::getFortranElementType(retValueBox.getType()); - auto [box, maybeCleanUp] = - hlfir::convertToBox(loc, builder, entity, storageElementType); - fir::runtime::genPushDescriptor(loc, builder, opaquePtr, fir::getBase(box)); - if (maybeCleanUp) - (*maybeCleanUp)(); + if (mlir::isa(entity.getType())) { + mlir::Value box = + hlfir::genVariableBox(loc, builder, entity, entity.getBoxType()); + fir::runtime::genPushDescriptor(loc, builder, opaquePtr, fir::getBase(box)); + } else { + mlir::Type storageElementType = + hlfir::getFortranElementType(retValueBox.getType()); + auto [box, maybeCleanUp] = + hlfir::convertToBox(loc, builder, entity, storageElementType); + fir::runtime::genPushDescriptor(loc, builder, opaquePtr, fir::getBase(box)); + if (maybeCleanUp) + (*maybeCleanUp)(); + } } void fir::factory::AnyVariableStack::resetFetchPosition( diff --git a/flang/test/HLFIR/order_assignments/forall-pointer-assignment-codegen.fir b/flang/test/HLFIR/order_assignments/forall-pointer-assignment-codegen.fir index 1d198765aff9e..855b62ca0ed39 100644 --- a/flang/test/HLFIR/order_assignments/forall-pointer-assignment-codegen.fir +++ b/flang/test/HLFIR/order_assignments/forall-pointer-assignment-codegen.fir @@ -91,10 +91,8 @@ func.func @test_need_to_save_rhs(%n: i64, %arg1: !fir.box>>}>>>, i64) -> !fir.ref>>}>> // CHECK: %[[VAL_22:.*]] = hlfir.designate %[[VAL_21]]{"p"} {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>) -> !fir.ref>>> // CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_22]] : !fir.ref>>> -// CHECK: %[[VAL_24:.*]] = fir.box_addr %[[VAL_23]] : (!fir.box>>) -> !fir.ptr> -// CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_24]] : (!fir.ptr>) -> !fir.box> -// CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (!fir.box>) -> !fir.box -// CHECK: fir.call @_FortranAPushDescriptor(%[[VAL_16]], %[[VAL_26]]) : (!fir.llvm_ptr, !fir.box) -> () +// CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (!fir.box>>) -> !fir.box +// CHECK: fir.call @_FortranAPushDescriptor(%[[VAL_16]], %[[VAL_24]]) : (!fir.llvm_ptr, !fir.box) -> () // CHECK: } // CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_4]] : (i64) -> index // CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_0]] : (i64) -> index diff --git a/flang/test/Lower/forall-polymorphic.f90 b/flang/test/Lower/forall-pointer-assignment.f90 similarity index 85% rename from flang/test/Lower/forall-polymorphic.f90 rename to flang/test/Lower/forall-pointer-assignment.f90 index 656b6ecf00628..946375e443f6f 100644 --- a/flang/test/Lower/forall-polymorphic.f90 +++ b/flang/test/Lower/forall-pointer-assignment.f90 @@ -1,4 +1,4 @@ -! Test lower of FORALL polymorphic pointer assignment +! Test lower of FORALL pointer assignment ! RUN: bbc -emit-fir %s -o - | FileCheck %s @@ -128,3 +128,47 @@ subroutine forallPolymorphic3() ! CHECK: } end subroutine forallPolymorphic3 + + +!! Test the LHS of a pointer assignment gets the isAllocatable flag from the +!! RHS that is a function reference. +! CHECK-LABEL: c.func @_QPforallpointerassignment1 + subroutine forallPointerAssignment1() + type base + real, pointer :: data => null() + end type + + interface + pure function makeData (i) + real, pointer :: makeData + integer*4, intent(in) :: i + end function + end interface + + type(base) :: co1(10) + + forall (i=1:10) + co1(i)%data => makeData (i) + end forall + +! CHECK: %[[V_3:[0-9]+]] = fir.alloca i64 +! CHECK: %[[V_3:[0-9]+]] = fir.alloca i32 {bindc_name = "i"} +! CHECK: %[[V_4:[0-9]+]] = fir.alloca !fir.box> {bindc_name = ".result"} +! CHECK: %[[V_25:[0-9]+]] = fir.convert %c1_i32 : (i32) -> index +! CHECK: %[[V_26:[0-9]+]] = fir.convert %c10_i32 : (i32) -> index +! CHECK: %[[V_27:[0-9]+]] = fir.address_of( +! CHECK: %[[V_28:[0-9]+]] = fir.convert %[[V_27]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[V_29:[0-9]+]] = fir.call @_FortranACreateDescriptorStack(%[[V_28]], %c{{.*}}) : (!fir.ref, i32) -> !fir.llvm_ptr +! CHECK: fir.do_loop %arg0 = %[[V_25]] to %[[V_26]] step %c1 +! CHECK: { +! CHECK: %[[V_32:[0-9]+]] = fir.convert %arg0 : (index) -> i32 +! CHECK: fir.store %[[V_32]] to %[[V_3]] : !fir.ref +! CHECK: %[[V_33:[0-9]+]] = fir.call @_QPmakedata(%[[V_3]]) proc_attrs fastmath : (!fir.ref) -> !fir.box> +! CHECK: fir.save_result %[[V_33]] to %[[V_4]] : !fir.box>, !fir.ref>> +! CHECK: %[[V_34:[0-9]+]] = fir.declare %[[V_4]] {uniq_name = ".tmp.func_result"} : (!fir.ref>>) -> !fir.ref>> +! CHECK: %[[V_35:[0-9]+]] = fir.load %[[V_34]] : !fir.ref>> +! CHECK: %[[V_36:[0-9]+]] = fir.convert %[[V_35]] : (!fir.box>) -> !fir.box +! CHECK: fir.call @_FortranAPushDescriptor(%[[V_29]], %[[V_36]]) : (!fir.llvm_ptr, !fir.box) -> () +! CHECK: } + + end subroutine forallPointerAssignment1 From 72fb4e0d9646cf165071c3bd37d79d5a1dc0ec8e Mon Sep 17 00:00:00 2001 From: cdchen-ca Date: Fri, 31 Oct 2025 10:20:14 -0400 Subject: [PATCH 2/4] To address review comments to simplify the code. --- flang/lib/Optimizer/Builder/TemporaryStorage.cpp | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/flang/lib/Optimizer/Builder/TemporaryStorage.cpp b/flang/lib/Optimizer/Builder/TemporaryStorage.cpp index 4fb546e9cb95d..5db40aff91878 100644 --- a/flang/lib/Optimizer/Builder/TemporaryStorage.cpp +++ b/flang/lib/Optimizer/Builder/TemporaryStorage.cpp @@ -258,19 +258,9 @@ void fir::factory::AnyVariableStack::pushValue(mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value variable) { hlfir::Entity entity{variable}; - if (mlir::isa(entity.getType())) { - mlir::Value box = - hlfir::genVariableBox(loc, builder, entity, entity.getBoxType()); - fir::runtime::genPushDescriptor(loc, builder, opaquePtr, fir::getBase(box)); - } else { - mlir::Type storageElementType = - hlfir::getFortranElementType(retValueBox.getType()); - auto [box, maybeCleanUp] = - hlfir::convertToBox(loc, builder, entity, storageElementType); - fir::runtime::genPushDescriptor(loc, builder, opaquePtr, fir::getBase(box)); - if (maybeCleanUp) - (*maybeCleanUp)(); - } + mlir::Value box = + hlfir::genVariableBox(loc, builder, entity, entity.getBoxType()); + fir::runtime::genPushDescriptor(loc, builder, opaquePtr, fir::getBase(box)); } void fir::factory::AnyVariableStack::resetFetchPosition( From d48e4805e2fcb027f3ce2d7d0e46f8d7a7794391 Mon Sep 17 00:00:00 2001 From: Daniel Chen Date: Fri, 31 Oct 2025 12:42:34 -0400 Subject: [PATCH 3/4] Fix LIT test. --- flang/test/Lower/forall-pointer-assignment.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/test/Lower/forall-pointer-assignment.f90 b/flang/test/Lower/forall-pointer-assignment.f90 index 946375e443f6f..bb70d9b98ece3 100644 --- a/flang/test/Lower/forall-pointer-assignment.f90 +++ b/flang/test/Lower/forall-pointer-assignment.f90 @@ -156,8 +156,8 @@ pure function makeData (i) ! CHECK: %[[V_4:[0-9]+]] = fir.alloca !fir.box> {bindc_name = ".result"} ! CHECK: %[[V_25:[0-9]+]] = fir.convert %c1_i32 : (i32) -> index ! CHECK: %[[V_26:[0-9]+]] = fir.convert %c10_i32 : (i32) -> index -! CHECK: %[[V_27:[0-9]+]] = fir.address_of( -! CHECK: %[[V_28:[0-9]+]] = fir.convert %[[V_27]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[V_27:[0-9]+]] = fir.address_of(@{{_QQcl.*}}) : !fir.ref> +! CHECK: %[[V_28:[0-9]+]] = fir.convert %[[V_27]] : (!fir.ref>) -> !fir.ref ! CHECK: %[[V_29:[0-9]+]] = fir.call @_FortranACreateDescriptorStack(%[[V_28]], %c{{.*}}) : (!fir.ref, i32) -> !fir.llvm_ptr ! CHECK: fir.do_loop %arg0 = %[[V_25]] to %[[V_26]] step %c1 ! CHECK: { From b886c6ac139d43a1c4d71c2730f9c1de88311988 Mon Sep 17 00:00:00 2001 From: cdchen-ca Date: Sat, 1 Nov 2025 00:16:19 -0400 Subject: [PATCH 4/4] Fix the comment in the LIT test to change the incorrect isAllocatable to isPointer to address review comment. --- flang/test/Lower/forall-pointer-assignment.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/flang/test/Lower/forall-pointer-assignment.f90 b/flang/test/Lower/forall-pointer-assignment.f90 index bb70d9b98ece3..ec142e3f13ebc 100644 --- a/flang/test/Lower/forall-pointer-assignment.f90 +++ b/flang/test/Lower/forall-pointer-assignment.f90 @@ -130,8 +130,8 @@ subroutine forallPolymorphic3() end subroutine forallPolymorphic3 -!! Test the LHS of a pointer assignment gets the isAllocatable flag from the -!! RHS that is a function reference. +!! Test the LHS of a pointer assignment gets the isPointer flag from the +!! RHS that is a reference to a function that returns a pointer. ! CHECK-LABEL: c.func @_QPforallpointerassignment1 subroutine forallPointerAssignment1() type base