Testing of the 'declare mapper' and 'declare reduction'
showed that the current code didn't handle renaming of
the derived type via module use.
That's now fixed by this commit r17-1523-g5d4b953d53ee9f.
Besides not properly checking for renamings, the CLASS
part was broken. First, by syntax ('+ : t : omp_out...' and 't :: var'),
only derived types are possible - secondly, the actual declared-type
has to be found differently.
That's now fixed, but I bet that polymorphic types will be mishandled,
before and after this change - something to look into in a later patch.
Tobias
commit 5d4b953d53ee9ff6376f67e572d6308bbd977f75
Author: Tobias Burnus <[email protected]>
Date: Fri Jun 12 23:30:35 2026 +0200
OpenMP/Fortran: Fix module-use renaming with declare mapper/reduction
Use the same logic as in gfc_compare_derived_types to compare the
types. Additionally, the 'declare' part only permits derived types
(per syntax) and not class - while using the mapper/reduction with
CLASS variables is possible.
gcc/fortran/ChangeLog:
* openmp.cc (gfc_omp_udm_find, gfc_omp_udr_find): Fix
to handle derived-type renaming via module use.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/declare-mapper-6.f90: New test.
* gfortran.dg/gomp/declare-mapper-7.f90: New test.
* gfortran.dg/gomp/declare-reduction-3.f90: New test.
* gfortran.dg/gomp/declare-reduction-4.f90: New test.
---
gcc/fortran/openmp.cc | 37 +++++++++++++----
.../gfortran.dg/gomp/declare-mapper-6.f90 | 43 ++++++++++++++++++++
.../gfortran.dg/gomp/declare-mapper-7.f90 | 29 +++++++++++++
.../gfortran.dg/gomp/declare-reduction-3.f90 | 47 ++++++++++++++++++++++
.../gfortran.dg/gomp/declare-reduction-4.f90 | 28 +++++++++++++
5 files changed, 176 insertions(+), 8 deletions(-)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 3d7d12de0c2..4f5e0a8e344 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -5976,11 +5976,21 @@ gfc_omp_udm_find (gfc_symtree *st, gfc_typespec *ts)
if (st == NULL)
return NULL;
+ gfc_symbol *dt = (ts->type == BT_CLASS
+ ? CLASS_DATA (ts->u.derived)->ts.u.derived
+ : ts->u.derived);
for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next)
- if ((omp_udm->ts.type == BT_DERIVED || omp_udm->ts.type == BT_CLASS)
- && (ts->type == BT_DERIVED || ts->type == BT_CLASS)
- && strcmp (omp_udm->ts.u.derived->name, ts->u.derived->name) == 0)
- return omp_udm;
+ {
+ if (dt == omp_udm->ts.u.derived)
+ return omp_udm;
+ /* Special case for comparing derived types across namespaces. If the
+ true names and module names are the same and the module name is
+ nonnull, then they are equal. */
+ if (dt->module && omp_udm->ts.u.derived->module
+ && strcmp (dt->name, omp_udm->ts.u.derived->name) == 0
+ && strcmp (dt->module, omp_udm->ts.u.derived->module) == 0)
+ return omp_udm;
+ }
return NULL;
}
@@ -6292,14 +6302,25 @@ gfc_omp_udr_find (gfc_symtree *st, gfc_typespec *ts)
if (st == NULL)
return NULL;
+ gfc_symbol *dt = NULL;
+ if (ts->type == BT_DERIVED || ts->type == BT_CLASS)
+ dt = (ts->type == BT_CLASS
+ ? CLASS_DATA (ts->u.derived)->ts.u.derived : ts->u.derived);
for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next)
if (omp_udr->ts.type == ts->type
- || ((omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS)
- && (ts->type == BT_DERIVED || ts->type == BT_CLASS)))
+ || (dt && omp_udr->ts.type == BT_DERIVED))
{
- if (omp_udr->ts.type == BT_DERIVED || omp_udr->ts.type == BT_CLASS)
+ if (dt && omp_udr->ts.type == BT_DERIVED)
{
- if (strcmp (omp_udr->ts.u.derived->name, ts->u.derived->name) == 0)
+ gfc_symbol *dtu = omp_udr->ts.u.derived;
+ if (dt == dtu)
+ return omp_udr;
+ /* Special case for comparing derived types across namespaces. If
+ the true names and module names are the same and the module name
+ is nonnull, then they are equal. */
+ if (dt->module && dtu->module
+ && strcmp (dt->name, dtu->name) == 0
+ && strcmp (dt->module, dtu->module) == 0)
return omp_udr;
}
else if (omp_udr->ts.kind == ts->kind)
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-6.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-6.f90
new file mode 100644
index 00000000000..7e3e70627ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-6.f90
@@ -0,0 +1,43 @@
+! Check that type renaming via module use is properly handled.
+
+module first
+ implicit none
+ type t
+ integer, pointer :: x(:)
+ end type t
+ !$omp declare mapper(t :: v) map(v, v%x)
+end module
+
+module second
+ implicit none
+ type t
+ integer, pointer :: y(:)
+ integer, pointer :: z(:)
+ end type t
+ !$omp declare mapper(t :: v) map(v, v%y, v%z)
+end module
+
+subroutine sub2
+ use first, t1 => t
+ use second, t2 => t
+ implicit none
+ type(t1) :: var
+ type(t2) :: var2
+
+ allocate(var%x(1:20))
+ allocate(var2%y(1:3), var2%z(5))
+ var%x = 9
+ var2%y = 1
+ var2%z = 43
+
+ !$omp target map(tofrom: var) ! { dg-error "Sorry, declared mapper 'default', used for 'var' at .1., is not yet supported" }
+ block
+ var%x = 4
+ end block
+
+ !$omp target map(tofrom: var2) ! { dg-error "Sorry, declared mapper 'default', used for 'var2' at .1., is not yet supported" }
+ block
+ var2%y = 3
+ var2%z = 7
+ end block
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-7.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-7.f90
new file mode 100644
index 00000000000..2ed50e069a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-7.f90
@@ -0,0 +1,29 @@
+! Check that type renaming via module use is properly handled.
+
+module zero
+ implicit none
+ type t
+ integer, pointer :: x(:)
+ integer, pointer :: y(:)
+ end type t
+end module zero
+
+module first
+ use zero, only: t1 => t
+ implicit none
+ !$omp declare mapper(t1 :: v1) map(v1, v1%x)
+end module
+
+module second
+ use zero, only: t2 => t
+ implicit none
+ !$omp declare mapper(t2 :: v2) map(v2, v2%x, v2%y)
+end module
+
+subroutine sub2
+ use first ! { dg-note "Previous !.OMP DECLARE MAPPER from module 'first'" }
+ use second ! { dg-error "Ambiguous !.OMP DECLARE MAPPER 'default' for type 't' from module 'second'" }
+ implicit none
+ ! type(t1) :: var1
+ ! type(t2) :: var2
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-reduction-3.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-3.f90
new file mode 100644
index 00000000000..aa5d5bc1b5a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-3.f90
@@ -0,0 +1,47 @@
+! Check that type renaming via module use is properly handled.
+
+module first
+ implicit none
+ type t
+ integer :: x = 0
+ end type t
+ !$omp declare reduction(+: t : omp_out%x = omp_out%x + omp_in%x)
+end module
+
+module second
+ implicit none
+ type t
+ integer :: y = 0
+ end type t
+ !$omp declare reduction(+: t : omp_out%y = omp_out%y + omp_in%y)
+end module
+
+subroutine sub2
+ use first, t1 => t
+ use second, t2 => t
+ implicit none
+ type(t1) :: var(5), sum1
+ type(t2) :: var2(3), sum2
+ integer :: i
+
+ var%x = [(2*i, i = 1,5)]
+ var2%y = [(5*i+1, i = 1,3)]
+ sum1%x = 0
+ sum2%y = 0
+
+ !$omp parallel do reduction(+:sum1)
+ do i = 1, size(var)
+ sum1%x = sum1%x + var(i)%x
+ end do
+
+ !$omp parallel do reduction(+:sum2)
+ do i = 1, size(var2)
+ sum2%y = sum2%y + var2(i)%y
+ end do
+
+ if (sum1%x /= sum(var%x)) stop 1
+ if (sum2%y /= sum(var2%y)) stop 2
+end
+
+call sub2
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-reduction-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-4.f90
new file mode 100644
index 00000000000..da8e87d4914
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-reduction-4.f90
@@ -0,0 +1,28 @@
+! Check that type renaming via module use is properly handled.
+
+module zero
+ implicit none
+ type t
+ integer :: x = 0
+ end type t
+end module zero
+
+module first
+ use zero, only: t1 => t
+ implicit none
+ !$omp declare reduction(+: t1 : omp_out%x = omp_out%x + omp_in%x)
+end module
+
+module second
+ use zero, only: t2 => t
+ implicit none
+ !$omp declare reduction(+: t2 : omp_out%x = omp_out%x + omp_in%x)
+end module
+
+subroutine sub2
+ use first ! { dg-note "Previous !.OMP DECLARE REDUCTION from module 'first'" }
+ use second ! { dg-error "Ambiguous !.OMP DECLARE REDUCTION 'operator \\+' for type 'TYPE\\(t\\)' from module 'second' at .1." }
+ implicit none
+ type(t1) :: var(5), sum1
+ type(t2) :: var2(3), sum2
+end
