[gcc r15-10986] fortran: Preserve scalar class pointers in OpenMP privatization [PR120286]
Jerry DeLisle
jvdelisle@gcc.gnu.org
Wed Mar 18 02:21:12 GMT 2026
https://gcc.gnu.org/g:cdf4e7361118872696353b24acf964b7f4b0ea03
commit r15-10986-gcdf4e7361118872696353b24acf964b7f4b0ea03
Author: Christopher Albert <albert@tugraz.at>
Date: Tue Mar 10 20:59:48 2026 +0100
fortran: Preserve scalar class pointers in OpenMP privatization [PR120286]
OpenMP privatization currently treats scalar class pointers like owned
polymorphic class objects. In the worker cleanup for private/firstprivate
class pointers, the generated code finalizes and frees ptr._data even though
the clause only copied pointer association status from a shared target.
Fix this in gfc_omp_clause_copy_ctor and gfc_omp_clause_dtor by unwrapping
saved descriptors first and by recognizing class-pointer container types
locally in those hooks. That keeps scalar class pointers on the
association-only path without changing the broader polymorphic mapping
classification used for OpenMP warnings and deep mapping.
Add a runtime regression test for the original private(ptr) crash plus a
firstprivate(ptr) association check.
gcc/fortran/ChangeLog:
PR fortran/120286
* trans-openmp.cc (gfc_is_class_pointer_type): New helper.
(gfc_omp_clause_copy_ctor): Unwrap saved descriptors before
deciding whether privatization should preserve only pointer
association. Handle scalar class pointers on that path too.
(gfc_omp_clause_dtor): Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/pr120286.f90: New test.
Signed-off-by: Christopher Albert <albert@tugraz.at>
(cherry picked from commit 60fbabc1a182cca77d14c68a1b623c554310d135)
Diff:
---
gcc/fortran/trans-openmp.cc | 75 +++++++++++++++++++-------
libgomp/testsuite/libgomp.fortran/pr120286.f90 | 49 +++++++++++++++++
2 files changed, 104 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 1dd015f0d9ff..4aa2503fddc4 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -466,8 +466,6 @@ gfc_omp_replace_alloc_by_to_mapping (tree type, tree decl, bool ptr_ok)
}
-/* Return true if TYPE is polymorphic but not with pointer attribute. */
-
static bool
gfc_is_polymorphic_nonptr (tree type)
{
@@ -476,6 +474,30 @@ gfc_is_polymorphic_nonptr (tree type)
return GFC_CLASS_TYPE_P (type);
}
+/* Return true if TYPE is a class container for a POINTER entity. */
+
+static bool
+gfc_is_class_pointer_type (tree type)
+{
+ tree name;
+ const char *s;
+
+ if (POINTER_TYPE_P (type))
+ type = TREE_TYPE (type);
+
+ if (!GFC_CLASS_TYPE_P (type))
+ return false;
+
+ name = TYPE_NAME (type);
+ if (name && TREE_CODE (name) == TYPE_DECL)
+ name = DECL_NAME (name);
+ if (!name)
+ return false;
+
+ s = IDENTIFIER_POINTER (name);
+ return startswith (s, "__class_") && s[strlen (s) - 1] == 'p';
+}
+
/* Return true if TYPE is unlimited polymorphic but not with pointer attribute;
unlimited means also intrinsic types are handled and _len is used. */
@@ -908,22 +930,29 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
{
tree type = TREE_TYPE (dest), ptr, size, call;
tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
+ tree orig_decl = OMP_CLAUSE_DECL (clause);
tree cond, then_b, else_b;
stmtblock_t block, cond_block;
gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
|| OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
- /* Privatize pointer, only; cf. gfc_omp_predetermined_sharing. */
- if (DECL_P (OMP_CLAUSE_DECL (clause))
- && GFC_DECL_ASSOCIATE_VAR_P (OMP_CLAUSE_DECL (clause)))
- return build2 (MODIFY_EXPR, TREE_TYPE (dest), dest, src);
+ if (DECL_ARTIFICIAL (orig_decl)
+ && DECL_LANG_SPECIFIC (orig_decl)
+ && GFC_DECL_SAVED_DESCRIPTOR (orig_decl))
+ {
+ orig_decl = GFC_DECL_SAVED_DESCRIPTOR (orig_decl);
+ decl_type = TREE_TYPE (orig_decl);
+ }
- if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
- && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
- && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
- decl_type
- = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
+ /* Privatize pointer association only; cf. gfc_omp_predetermined_sharing.
+ This includes scalar class pointers, whose tree type is still the class
+ record even though the Fortran entity has POINTER semantics. */
+ if (DECL_P (orig_decl)
+ && (GFC_DECL_ASSOCIATE_VAR_P (orig_decl)
+ || GFC_DECL_GET_SCALAR_POINTER (orig_decl)
+ || gfc_is_class_pointer_type (decl_type)))
+ return build2 (MODIFY_EXPR, TREE_TYPE (dest), dest, src);
if (gfc_is_polymorphic_nonptr (decl_type))
{
@@ -1431,17 +1460,23 @@ gfc_omp_clause_dtor (tree clause, tree decl)
{
tree type = TREE_TYPE (decl), tem;
tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
+ tree orig_decl = OMP_CLAUSE_DECL (clause);
- /* Only pointer was privatized; cf. gfc_omp_clause_copy_ctor. */
- if (DECL_P (OMP_CLAUSE_DECL (clause))
- && GFC_DECL_ASSOCIATE_VAR_P (OMP_CLAUSE_DECL (clause)))
- return NULL_TREE;
+ if (DECL_ARTIFICIAL (orig_decl)
+ && DECL_LANG_SPECIFIC (orig_decl)
+ && GFC_DECL_SAVED_DESCRIPTOR (orig_decl))
+ {
+ orig_decl = GFC_DECL_SAVED_DESCRIPTOR (orig_decl);
+ decl_type = TREE_TYPE (orig_decl);
+ }
- if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
- && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
- && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
- decl_type
- = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
+ /* Only pointer association was privatized; cf. gfc_omp_clause_copy_ctor.
+ Scalar class pointers must not finalize or free their targets here. */
+ if (DECL_P (orig_decl)
+ && (GFC_DECL_ASSOCIATE_VAR_P (orig_decl)
+ || GFC_DECL_GET_SCALAR_POINTER (orig_decl)
+ || gfc_is_class_pointer_type (decl_type)))
+ return NULL_TREE;
if (gfc_is_polymorphic_nonptr (decl_type))
{
if (POINTER_TYPE_P (decl_type))
diff --git a/libgomp/testsuite/libgomp.fortran/pr120286.f90 b/libgomp/testsuite/libgomp.fortran/pr120286.f90
new file mode 100644
index 000000000000..e45ed5539a62
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr120286.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! PR fortran/120286 - scalar class pointers in OpenMP private/firstprivate
+! clauses must preserve association status without taking ownership.
+
+program main
+ implicit none
+
+ type foo_t
+ integer :: dummy
+ end type foo_t
+
+ type fooPtr_t
+ class(foo_t), pointer :: p
+ end type fooPtr_t
+
+ type fooPtrStack_t
+ class(fooPtr_t), allocatable :: list(:)
+ end type fooPtrStack_t
+
+ type(fooPtrStack_t) :: x
+ class(foo_t), pointer :: ptr
+ integer :: it, n
+ logical :: ok
+
+ allocate (x%list(1))
+ allocate (x%list(1)%p)
+ x%list(1)%p%dummy = 7
+
+ do it = 1, 16
+!$omp parallel do default(none) num_threads(2) private(n, ptr) shared(x)
+ do n = 1, 1
+ ptr => x%list(n)%p
+ end do
+!$omp end parallel do
+ end do
+
+ if (.not. associated (x%list(1)%p)) stop 1
+ if (x%list(1)%p%dummy /= 7) stop 2
+
+ ptr => x%list(1)%p
+ ok = .false.
+
+!$omp parallel default(none) num_threads(1) firstprivate(ptr) shared(x, ok)
+ ok = associated (ptr, x%list(1)%p) .and. ptr%dummy == 7
+!$omp end parallel
+
+ if (.not. ok) stop 3
+end program main
More information about the Gcc-cvs
mailing list