https://gcc.gnu.org/g:5d4b953d53ee9ff6376f67e572d6308bbd977f75
commit r17-1523-g5d4b953d53ee9ff6376f67e572d6308bbd977f75 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. Diff: --- 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 3d7d12de0c25..4f5e0a8e344d 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 000000000000..7e3e70627eca --- /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 000000000000..2ed50e069a76 --- /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 000000000000..aa5d5bc1b5a1 --- /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 000000000000..da8e87d49144 --- /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
