[flang-commits] [flang] [flang][OpenMP] Fix privatization of procedure pointers (PR #130336)
via flang-commits
flang-commits at lists.llvm.org
Fri Mar 7 12:01:14 PST 2025
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-openmp
Author: Leandro Lupori (luporl)
<details>
<summary>Changes</summary>
Fixes #<!-- -->121720
---
Full diff: https://github.com/llvm/llvm-project/pull/130336.diff
4 Files Affected:
- (modified) flang/lib/Lower/Bridge.cpp (+3)
- (modified) flang/lib/Lower/ConvertVariable.cpp (+1-1)
- (modified) flang/lib/Optimizer/Dialect/FIRType.cpp (+82-60)
- (added) flang/test/Lower/OpenMP/privatization-proc-ptr.f90 (+165)
``````````diff
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index cc19f335cd017..425007da6b563 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -1274,6 +1274,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
[](const fir::FortranVariableOpInterface &box) {
return fir::FortranVariableOpInterface(box).isPointer();
},
+ [](const fir::AbstractBox &box) {
+ return fir::isBoxProcAddressType(box.getAddr().getType());
+ },
[](const auto &box) { return false; });
copyVarHLFIR(loc, dst, src, isBoxAllocatable, isBoxPointer, flags);
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index cc55191170c65..4bca4641a1b2e 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1842,7 +1842,7 @@ void Fortran::lower::genDeclareSymbol(
bool force) {
if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
(!Fortran::semantics::IsProcedure(sym) ||
- Fortran::semantics::IsPointer(sym)) &&
+ Fortran::semantics::IsPointer(sym.GetUltimate())) &&
!sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
const mlir::Location loc = genLocation(converter, sym);
diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp
index 719cb1b9d75aa..6aa8ba4c9e7f4 100644
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -553,70 +553,92 @@ std::string getTypeAsString(mlir::Type ty, const fir::KindMapping &kindMap,
llvm::raw_string_ostream name{buf};
if (!prefix.empty())
name << "_";
- while (ty) {
- if (fir::isa_trivial(ty)) {
- if (mlir::isa<mlir::IndexType>(ty)) {
- name << "idx";
- } else if (ty.isIntOrIndex()) {
- name << 'i' << ty.getIntOrFloatBitWidth();
- } else if (mlir::isa<mlir::FloatType>(ty)) {
- name << 'f' << ty.getIntOrFloatBitWidth();
- } else if (auto cplxTy = mlir::dyn_cast_or_null<mlir::ComplexType>(ty)) {
- name << 'z';
- auto floatTy = mlir::cast<mlir::FloatType>(cplxTy.getElementType());
- name << floatTy.getWidth();
- } else if (auto logTy = mlir::dyn_cast_or_null<fir::LogicalType>(ty)) {
- name << 'l' << kindMap.getLogicalBitsize(logTy.getFKind());
+
+ std::function<void(mlir::Type)> appendTypeName = [&](mlir::Type ty) {
+ while (ty) {
+ if (fir::isa_trivial(ty)) {
+ if (mlir::isa<mlir::IndexType>(ty)) {
+ name << "idx";
+ } else if (ty.isIntOrIndex()) {
+ name << 'i' << ty.getIntOrFloatBitWidth();
+ } else if (mlir::isa<mlir::FloatType>(ty)) {
+ name << 'f' << ty.getIntOrFloatBitWidth();
+ } else if (auto cplxTy =
+ mlir::dyn_cast_or_null<mlir::ComplexType>(ty)) {
+ name << 'z';
+ auto floatTy = mlir::cast<mlir::FloatType>(cplxTy.getElementType());
+ name << floatTy.getWidth();
+ } else if (auto logTy = mlir::dyn_cast_or_null<fir::LogicalType>(ty)) {
+ name << 'l' << kindMap.getLogicalBitsize(logTy.getFKind());
+ } else {
+ llvm::report_fatal_error("unsupported type");
+ }
+ break;
+ } else if (mlir::isa<mlir::NoneType>(ty)) {
+ name << "none";
+ break;
+ } else if (auto charTy = mlir::dyn_cast_or_null<fir::CharacterType>(ty)) {
+ name << 'c' << kindMap.getCharacterBitsize(charTy.getFKind());
+ if (charTy.getLen() == fir::CharacterType::unknownLen())
+ name << "xU";
+ else if (charTy.getLen() != fir::CharacterType::singleton())
+ name << "x" << charTy.getLen();
+ break;
+ } else if (auto seqTy = mlir::dyn_cast_or_null<fir::SequenceType>(ty)) {
+ for (auto extent : seqTy.getShape()) {
+ if (extent == fir::SequenceType::getUnknownExtent())
+ name << "Ux";
+ else
+ name << extent << 'x';
+ }
+ ty = seqTy.getEleTy();
+ } else if (auto refTy = mlir::dyn_cast_or_null<fir::ReferenceType>(ty)) {
+ name << "ref_";
+ ty = refTy.getEleTy();
+ } else if (auto ptrTy = mlir::dyn_cast_or_null<fir::PointerType>(ty)) {
+ name << "ptr_";
+ ty = ptrTy.getEleTy();
+ } else if (auto ptrTy =
+ mlir::dyn_cast_or_null<fir::LLVMPointerType>(ty)) {
+ name << "llvmptr_";
+ ty = ptrTy.getEleTy();
+ } else if (auto heapTy = mlir::dyn_cast_or_null<fir::HeapType>(ty)) {
+ name << "heap_";
+ ty = heapTy.getEleTy();
+ } else if (auto classTy = mlir::dyn_cast_or_null<fir::ClassType>(ty)) {
+ name << "class_";
+ ty = classTy.getEleTy();
+ } else if (auto boxTy = mlir::dyn_cast_or_null<fir::BoxType>(ty)) {
+ name << "box_";
+ ty = boxTy.getEleTy();
+ } else if (auto boxcharTy =
+ mlir::dyn_cast_or_null<fir::BoxCharType>(ty)) {
+ name << "boxchar_";
+ ty = boxcharTy.getEleTy();
+ } else if (auto boxprocTy =
+ mlir::dyn_cast_or_null<fir::BoxProcType>(ty)) {
+ name << "boxproc_";
+ auto procTy = mlir::dyn_cast<mlir::FunctionType>(boxprocTy.getEleTy());
+ assert(procTy.getNumResults() <= 1 &&
+ "function type with more than one result");
+ for (const auto &result : procTy.getResults())
+ appendTypeName(result);
+ name << "_args";
+ for (const auto &arg : procTy.getInputs()) {
+ name << '_';
+ appendTypeName(arg);
+ }
+ break;
+ } else if (auto recTy = mlir::dyn_cast_or_null<fir::RecordType>(ty)) {
+ name << "rec_" << recTy.getName();
+ break;
} else {
llvm::report_fatal_error("unsupported type");
}
- break;
- } else if (mlir::isa<mlir::NoneType>(ty)) {
- name << "none";
- break;
- } else if (auto charTy = mlir::dyn_cast_or_null<fir::CharacterType>(ty)) {
- name << 'c' << kindMap.getCharacterBitsize(charTy.getFKind());
- if (charTy.getLen() == fir::CharacterType::unknownLen())
- name << "xU";
- else if (charTy.getLen() != fir::CharacterType::singleton())
- name << "x" << charTy.getLen();
- break;
- } else if (auto seqTy = mlir::dyn_cast_or_null<fir::SequenceType>(ty)) {
- for (auto extent : seqTy.getShape()) {
- if (extent == fir::SequenceType::getUnknownExtent())
- name << "Ux";
- else
- name << extent << 'x';
- }
- ty = seqTy.getEleTy();
- } else if (auto refTy = mlir::dyn_cast_or_null<fir::ReferenceType>(ty)) {
- name << "ref_";
- ty = refTy.getEleTy();
- } else if (auto ptrTy = mlir::dyn_cast_or_null<fir::PointerType>(ty)) {
- name << "ptr_";
- ty = ptrTy.getEleTy();
- } else if (auto ptrTy = mlir::dyn_cast_or_null<fir::LLVMPointerType>(ty)) {
- name << "llvmptr_";
- ty = ptrTy.getEleTy();
- } else if (auto heapTy = mlir::dyn_cast_or_null<fir::HeapType>(ty)) {
- name << "heap_";
- ty = heapTy.getEleTy();
- } else if (auto classTy = mlir::dyn_cast_or_null<fir::ClassType>(ty)) {
- name << "class_";
- ty = classTy.getEleTy();
- } else if (auto boxTy = mlir::dyn_cast_or_null<fir::BoxType>(ty)) {
- name << "box_";
- ty = boxTy.getEleTy();
- } else if (auto boxcharTy = mlir::dyn_cast_or_null<fir::BoxCharType>(ty)) {
- name << "boxchar_";
- ty = boxcharTy.getEleTy();
- } else if (auto recTy = mlir::dyn_cast_or_null<fir::RecordType>(ty)) {
- name << "rec_" << recTy.getName();
- break;
- } else {
- llvm::report_fatal_error("unsupported type");
}
- }
+ };
+
+ appendTypeName(ty);
return buf;
}
diff --git a/flang/test/Lower/OpenMP/privatization-proc-ptr.f90 b/flang/test/Lower/OpenMP/privatization-proc-ptr.f90
new file mode 100644
index 0000000000000..168580edac878
--- /dev/null
+++ b/flang/test/Lower/OpenMP/privatization-proc-ptr.f90
@@ -0,0 +1,165 @@
+! Test privatization of procedure pointers.
+
+!RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s
+!RUN: bbc -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s
+
+program proc_ptr_test
+ implicit none
+
+contains
+
+!CHECK: omp.private {type = private} @_QFFtest_namesEpf2_private_boxproc_z32_args_ref_3x4xf32_ref_z32 : !fir.boxproc<(!fir.ref<!fir.array<3x4xf32>>, !fir.ref<complex<f32>>) -> complex<f32>>
+!CHECK: omp.private {type = private} @_QFFtest_namesEpf1_private_boxproc_f32_args_ref_f32 : !fir.boxproc<(!fir.ref<f32>) -> f32>
+!CHECK: omp.private {type = private} @_QFFtest_namesEpf0_private_boxproc_i32_args : !fir.boxproc<() -> i32>
+!CHECK: omp.private {type = private} @_QFFtest_namesEps2_private_boxproc__args_ref_i32_boxchar_c8xU : !fir.boxproc<(!fir.ref<i32>, !fir.boxchar<1>) -> ()>
+!CHECK: omp.private {type = private} @_QFFtest_namesEps1_private_boxproc__args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> ()>
+!CHECK: omp.private {type = private} @_QFFtest_namesEps0_private_boxproc__args : !fir.boxproc<() -> ()>
+
+!CHECK: omp.private {type = private} @_QFFtest_lastprivateEps_private_boxproc__args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> ()>
+!CHECK: omp.private {type = private} @_QFFtest_lastprivateEpf_private_boxproc_i32_args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> i32>
+
+!CHECK: omp.private {type = firstprivate} @_QFFtest_firstprivateEps_firstprivate_boxproc__args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> ()> copy {
+!CHECK: ^bb0(%[[ARG0:.*]]: !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>, %[[ARG1:.*]]: !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>):
+!CHECK: %[[TEMP:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>
+!CHECK: fir.store %[[TEMP]] to %[[ARG1]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>
+!CHECK: omp.yield(%[[ARG1]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>)
+!CHECK: }
+
+!CHECK: omp.private {type = firstprivate} @_QFFtest_firstprivateEpf_firstprivate_boxproc_i32_args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> i32>
+!CHECK: omp.private {type = private} @_QFFtest_privateEps_private_boxproc__args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> ()>
+!CHECK: omp.private {type = private} @_QFFtest_privateEpf_private_boxproc_i32_args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> i32>
+
+!CHECK-LABEL: func private @_QFPtest_private
+!CHECK: %[[PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_privateEpf"}
+!CHECK: %[[PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_privateEps"}
+!CHECK: omp.parallel
+!CHECK: %[[PRIV_PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_privateEpf"}
+!CHECK: %[[PRIV_PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_privateEps"}
+!CHECK: %[[PF_VAL:.*]] = fir.load %[[PRIV_PF]]#0
+!CHECK: %[[PF_BOX:.*]] = fir.box_addr %[[PF_VAL]]
+!CHECK: fir.call %[[PF_BOX]]({{.*}})
+!CHECK: %[[PS_VAL:.*]] = fir.load %[[PRIV_PS]]#0
+!CHECK: %[[PS_BOX:.*]] = fir.box_addr %[[PS_VAL]]
+!CHECK: fir.call %[[PS_BOX]]({{.*}})
+subroutine test_private
+ procedure(f), pointer :: pf
+ procedure(sub), pointer :: ps
+ integer :: res
+
+ !$omp parallel private(pf, ps)
+ pf => f
+ ps => sub
+ res = pf(123)
+ call ps(456)
+ !$omp end parallel
+end subroutine
+
+!CHECK-LABEL: func private @_QFPtest_firstprivate
+!CHECK: %[[PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_firstprivateEpf"}
+!CHECK: %[[PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_firstprivateEps"}
+!CHECK: omp.parallel
+!CHECK: %[[PRIV_PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_firstprivateEpf"}
+!CHECK: %[[PRIV_PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_firstprivateEps"}
+subroutine test_firstprivate
+ procedure(f), pointer :: pf
+ procedure(sub), pointer :: ps
+
+ !$omp parallel firstprivate(pf, ps)
+ !$omp end parallel
+end subroutine
+
+!CHECK-LABEL: func private @_QFPtest_lastprivate
+!CHECK: %[[PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_lastprivateEpf"}
+!CHECK: %[[PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_lastprivateEps"}
+!CHECK: omp.parallel
+!CHECK: %[[PRIV_PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_lastprivateEpf"}
+!CHECK: %[[PRIV_PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_lastprivateEps"}
+!CHECK: %[[PF_VAL:.*]] = fir.load %[[PRIV_PF]]#0
+!CHECK: fir.store %[[PF_VAL]] to %[[PF]]#0
+!CHECK: %[[PS_VAL:.*]] = fir.load %[[PRIV_PS]]#0
+!CHECK: fir.store %[[PS_VAL]] to %[[PS]]#0
+subroutine test_lastprivate
+ procedure(f), pointer :: pf
+ procedure(sub), pointer :: ps
+ integer :: i
+
+ !$omp parallel do lastprivate(pf, ps)
+ do i = 1, 5
+ end do
+ !$omp end parallel do
+end subroutine
+
+!CHECK-LABEL: func private @_QFPtest_sections
+!CHECK: %[[PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_sectionsEpf"}
+!CHECK: %[[PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_sectionsEps"}
+!CHECK: %[[PRIV_PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_sectionsEpf"}
+!CHECK: %[[PF_VAL:.*]] = fir.load %[[PF]]#0
+!CHECK: fir.store %[[PF_VAL]] to %[[PRIV_PF]]#0
+!CHECK: %[[PRIV_PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_sectionsEps"}
+!CHECK: %[[PS_VAL:.*]] = fir.load %[[PS]]#0
+!CHECK: fir.store %[[PS_VAL]] to %[[PRIV_PS]]#0
+!CHECK: omp.sections
+!CHECK: %[[PF_VAL:.*]] = fir.load %[[PRIV_PF]]#0
+!CHECK: fir.store %[[PF_VAL]] to %[[PF]]#0
+!CHECK: %[[PS_VAL:.*]] = fir.load %[[PRIV_PS]]#0
+!CHECK: fir.store %[[PS_VAL]] to %[[PS]]#0
+subroutine test_sections
+ procedure(f), pointer :: pf
+ procedure(sub), pointer :: ps
+
+ !$omp sections firstprivate(pf, ps) lastprivate(pf, ps)
+ !$omp end sections
+end subroutine
+
+integer function f(arg)
+ integer :: arg
+ f = arg
+end function
+
+subroutine sub(arg)
+ integer :: arg
+end subroutine
+
+subroutine test_names
+ procedure(s0), pointer :: ps0
+ procedure(s1), pointer :: ps1
+ procedure(s2), pointer :: ps2
+
+ procedure(f0), pointer :: pf0
+ procedure(f1), pointer :: pf1
+ procedure(f2), pointer :: pf2
+
+ !$omp parallel private(ps0, ps1, ps2, pf0, pf1, pf2)
+ !$omp end parallel
+end subroutine
+
+subroutine s0
+end subroutine
+
+subroutine s1(i)
+ integer :: i
+end subroutine
+
+subroutine s2(i, j)
+ integer :: i
+ character(*) :: j
+end subroutine
+
+integer function f0
+ f0 = 0
+end function
+
+real function f1(r)
+ real :: r
+
+ f1 = 0.0
+end function
+
+function f2(a, c)
+ real :: a(3, 4)
+ complex :: f2, c
+
+ f2 = (0.0, 0.0)
+end function
+
+end program
``````````
</details>
https://github.com/llvm/llvm-project/pull/130336
More information about the flang-commits
mailing list