https://gcc.gnu.org/g:0ae115b2c2faa7cc98132d4369b456be21eb4a71
commit 0ae115b2c2faa7cc98132d4369b456be21eb4a71 Author: Julian Brown <[email protected]> Date: Tue Jul 7 17:43:08 2026 +0000 OpenMP, Fortran: Enable 'declare mapper' mappers for 'target update' directives This patch enables use of 'declare mapper' for 'target update' directives for Fortran. It is based on OG15 commit 6ffe14f3198; the C and C++ support was previously upstreamed as commit r17-680-g09e74059bdb12c, so only the Fortran parts are left here. 2023-08-10 Julian Brown <[email protected]> gcc/fortran/ * openmp.cc (gfc_match_motion_var_list): Add parsing for mapper modifier. (gfc_match_omp_clauses): Adjust error handling for changes to gfc_match_motion_var_list. (gfc_omp_instantiate_mapper): Add code argument to get proper location for diagnostic. (gfc_omp_instantiate_mappers): Adjust for above change. * trans-openmp.cc (gfc_trans_omp_clauses): Use correct ref for update operations. (gfc_trans_omp_target_update): Instantiate mappers. gcc/testsuite/ * gfortran.dg/gomp/declare-mapper-24.f90: New test. * gfortran.dg/gomp/declare-mapper-26.f90: Uncomment 'target update' part of test. * gfortran.dg/gomp/declare-mapper-27.f90: New test. libgomp/ * testsuite/libgomp.fortran/declare-mapper-25.f90: New test. * testsuite/libgomp.fortran/declare-mapper-28.f90: New test. Co-Authored-By: Andrew Stubbs <[email protected]> Co-Authored-By: Kwok Cheung Yeung <[email protected]> Co-Authored-By: Sandra Loosemore <[email protected]> Diff: --- gcc/fortran/openmp.cc | 67 +++++++++++++++++----- gcc/fortran/trans-openmp.cc | 30 +++++++--- .../gfortran.dg/gomp/declare-mapper-24.f90 | 43 ++++++++++++++ .../gfortran.dg/gomp/declare-mapper-26.f90 | 4 +- .../gfortran.dg/gomp/declare-mapper-27.f90 | 25 ++++++++ .../libgomp.fortran/declare-mapper-25.f90 | 44 ++++++++++++++ .../libgomp.fortran/declare-mapper-28.f90 | 38 ++++++++++++ 7 files changed, 225 insertions(+), 26 deletions(-) diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index ccc65dda7b79..a7a67814a93b 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -1441,12 +1441,15 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list, gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns; locus old_loc = gfc_current_locus; + int mapper_modifier = 0; int present_modifier = 0; int iterator_modifier = 0; + locus second_mapper_locus = old_loc; locus second_present_locus = old_loc; locus second_iterator_locus = old_loc; bool saw_modifier = false; - + char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' }; + for (;;) { locus current_locus = gfc_current_locus; @@ -1455,6 +1458,16 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list, if (present_modifier++ == 1) second_present_locus = current_locus; } + else if (gfc_match ("mapper ( ") == MATCH_YES) + { + if (mapper_modifier++ == 1) + second_mapper_locus = current_locus; + m = gfc_match (" %n ) ", mapper_id); + if (m != MATCH_YES) + return m; + if (strcmp (mapper_id, "default") == 0) + mapper_id[0] = '\0'; + } else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES) { if (iterator_modifier++ == 1) @@ -1489,6 +1502,7 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list, { gfc_current_locus = old_loc; present_modifier = 0; + mapper_modifier = 0; iterator_modifier = 0; } @@ -1497,6 +1511,11 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list, gfc_error ("Too many %<present%> modifiers at %L", &second_present_locus); return MATCH_ERROR; } + if (mapper_modifier > 1) + { + gfc_error ("too many %<mapper%> modifiers at %L", &second_mapper_locus); + return MATCH_ERROR; + } if (iterator_modifier > 1) { gfc_error ("Too many %<iterator%> modifiers at %L", @@ -1516,6 +1535,11 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list, { if (present_modifier) n->u.present_modifier = true; + if (mapper_id[0] != '\0') + { + n->u3.udm = gfc_get_omp_namelist_udm (); + n->u3.udm->mapper_id = gfc_get_string ("%s", mapper_id); + } if (iterator_modifier) { n->u2.ns = ns_iter; @@ -3343,10 +3367,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, &c->lists[OMP_LIST_FIRSTPRIVATE], true) == MATCH_YES) continue; - if ((mask & OMP_CLAUSE_FROM) - && gfc_match_motion_var_list ("from (", &c->lists[OMP_LIST_FROM], - &head) == MATCH_YES) - continue; + if (mask & OMP_CLAUSE_FROM) + { + m = gfc_match_motion_var_list ("from (", &c->lists[OMP_LIST_FROM], + &head); + if (m == MATCH_YES) + continue; + else if (m == MATCH_ERROR) + goto error; + } if ((mask & OMP_CLAUSE_FULL) && (m = gfc_match_dupl_check (!c->full, "full")) != MATCH_NO) { @@ -4558,10 +4587,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } } - else if ((mask & OMP_CLAUSE_TO) - && gfc_match_motion_var_list ("to (", &c->lists[OMP_LIST_TO], - &head) == MATCH_YES) - continue; + else if (mask & OMP_CLAUSE_TO) + { + m = gfc_match_motion_var_list ("to (", &c->lists[OMP_LIST_TO], + &head); + if (m == MATCH_YES) + continue; + else if (m == MATCH_ERROR) + goto error; + } break; case 'u': if ((mask & OMP_CLAUSE_UNIFORM) @@ -14471,7 +14505,7 @@ gfc_subst_mapper_var (gfc_symbol **out_sym, gfc_expr **out_expr, } static gfc_omp_namelist ** -gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp, +gfc_omp_instantiate_mapper (gfc_code *code, gfc_omp_namelist **outlistp, gfc_omp_namelist *clause, gfc_omp_map_op outer_map_op, gfc_omp_udm *udm, toc_directive cd, int list) @@ -14577,8 +14611,10 @@ gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp, = omp_split_map_op (map_clause_op, &force_p, &always_p, &present_p); free (new_clause); - gfc_warning (0, "Dropping incompatible %qs mapper clause at %C", - omp_basic_map_kind_name (basic_kind)); + gfc_warning (OPT_Wopenmp, + "Dropping incompatible %qs mapper clause at %L", + omp_basic_map_kind_name (basic_kind), + &code->loc); inform (gfc_get_location (&mapper_clause->where), "Defined here"); continue; @@ -14594,7 +14630,7 @@ gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp, && mapper_clause->u3.udm->udm != udm) { gfc_omp_udm *inner_udm = mapper_clause->u3.udm->udm; - outlistp = gfc_omp_instantiate_mapper (outlistp, new_clause, + outlistp = gfc_omp_instantiate_mapper (code, outlistp, new_clause, outer_map_op, inner_udm, cd, list); } @@ -14612,7 +14648,7 @@ gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp, false if errors were diagnosed. This function is invoked from the translation phase so callers need to handle passing up the error. */ bool -gfc_omp_instantiate_mappers (gfc_code *code ATTRIBUTE_UNUSED, gfc_omp_clauses *clauses, +gfc_omp_instantiate_mappers (gfc_code *code, gfc_omp_clauses *clauses, toc_directive cd, int list) { gfc_omp_namelist *clause = clauses->lists[list]; @@ -14643,7 +14679,8 @@ gfc_omp_instantiate_mappers (gfc_code *code ATTRIBUTE_UNUSED, gfc_omp_clauses *c default: gcc_unreachable (); } - clausep = gfc_omp_instantiate_mapper (clausep, clause, outer_map_op, + clausep = gfc_omp_instantiate_mapper (code, clausep, clause, + outer_map_op, clause->u3.udm->udm, cd, list); *clausep = clause->next; invoked_mappers = true; diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index c517a22e0415..3549d2737379 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -6059,14 +6059,17 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, gcc_unreachable (); } + gfc_ref *lastref = NULL; + if (n->expr) + for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY) + lastref = ref; + /* FIXME: Currently no support for strided target updates with iterators. */ if ((list == OMP_LIST_TO || list == OMP_LIST_FROM) && !iterator - && (!n->expr - || (n->expr - && n->expr->ref - && n->expr->ref->type == REF_ARRAY)) + && (!n->expr || (lastref && lastref->type == REF_ARRAY)) && !gfc_omp_contiguous_update_p (n)) { int ndims; @@ -6088,7 +6091,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, or other data between elements, e.g. of a derived-type array). */ span = gfc_get_array_span (desc, n->expr); - ndims = n->expr->ref->u.ar.dimen; + ndims = lastref->u.ar.dimen; } else { @@ -10624,10 +10627,19 @@ gfc_trans_omp_target_update (gfc_code *code) tree stmt, omp_clauses; gfc_start_block (&block); - omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, - code->loc); - stmt = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node, - omp_clauses); + gfc_omp_clauses *target_update_clauses = code->ext.omp_clauses; + if (gfc_omp_instantiate_mappers (code, target_update_clauses, TOC_OPENMP, + OMP_LIST_TO) + && gfc_omp_instantiate_mappers (code, target_update_clauses, TOC_OPENMP, + OMP_LIST_FROM)) + { + omp_clauses = gfc_trans_omp_clauses (&block, target_update_clauses, + code->loc); + stmt = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node, + omp_clauses); + } + else + stmt = error_mark_node; gfc_add_expr_to_block (&block, stmt); return gfc_finish_block (&block); } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-24.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-24.f90 new file mode 100644 index 000000000000..9555a94badab --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-24.f90 @@ -0,0 +1,43 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +type t +integer :: a, b, c, d +end type t + +type(t) :: tvar + +!$omp declare mapper (T :: t) map(alloc: t%a) map(to: t%b) map(from: t%c) & +!$omp & map(tofrom: t%d) + +!$omp declare mapper (updatey: T :: t) map(t%a) map(t%b) map(t%c) map(t%d) + +!$omp target update to(tvar) +! { dg-warning "Dropping incompatible .ALLOC. mapper clause" "" { target *-*-* } .-1 } +! { dg-warning "Dropping incompatible .FROM. mapper clause" "" { target *-*-* } .-2 } +! { dg-final { scan-tree-dump-times {(?n)update to\(tvar\.b \[len: [0-9]+\]\) to\(tvar\.d \[len: [0-9]+\]\)$} 1 "original" } } +!$omp target update from(tvar) +! { dg-warning "Dropping incompatible .ALLOC. mapper clause" "" { target *-*-* } .-1 } +! { dg-warning "Dropping incompatible .TO. mapper clause" "" { target *-*-* } .-2 } +! { dg-final { scan-tree-dump-times {(?n)update from\(tvar\.c \[len: [0-9]+\]\) from\(tvar\.d \[len: [0-9]+\]\)$} 1 "original" } } + +!$omp target update to(present: tvar) +! { dg-warning "Dropping incompatible .ALLOC. mapper clause" "" { target *-*-* } .-1 } +! { dg-warning "Dropping incompatible .FROM. mapper clause" "" { target *-*-* } .-2 } +! { dg-final { scan-tree-dump-times {(?n)update to\(present:tvar\.b \[len: [0-9]+\]\) to\(present:tvar\.d \[len: [0-9]+\]\)$} 1 "original" } } +!$omp target update from(present: tvar) +! { dg-warning "Dropping incompatible .ALLOC. mapper clause" "" { target *-*-* } .-1 } +! { dg-warning "Dropping incompatible .TO. mapper clause" "" { target *-*-* } .-2 } +! { dg-final { scan-tree-dump-times {(?n)update from\(present:tvar\.c \[len: [0-9]+\]\) from\(present:tvar\.d \[len: [0-9]+\]\)$} 1 "original" } } + +!$omp target update to(mapper(updatey): tvar) +! { dg-final { scan-tree-dump-times {(?n)update to\(tvar\.a \[len: [0-9]+\]\) to\(tvar\.b \[len: [0-9]+\]\) to\(tvar\.c \[len: [0-9]+\]\) to\(tvar\.d \[len: [0-9]+\]\)$} 1 "original" } } +!$omp target update from(mapper(updatey): tvar) +! { dg-final { scan-tree-dump-times {(?n)update from\(tvar\.a \[len: [0-9]+\]\) from\(tvar\.b \[len: [0-9]+\]\) from\(tvar\.c \[len: [0-9]+\]\) from\(tvar\.d \[len: [0-9]+\]\)$} 1 "original" } } + +!$omp target update to(present, mapper(updatey): tvar) +! { dg-final { scan-tree-dump-times {(?n)update to\(present:tvar\.a \[len: [0-9]+\]\) to\(present:tvar\.b \[len: [0-9]+\]\) to\(present:tvar\.c \[len: [0-9]+\]\) to\(present:tvar\.d \[len: [0-9]+\]\)$} 1 "original" } } +!$omp target update from(present, mapper(updatey): tvar) +! { dg-final { scan-tree-dump-times {(?n)update from\(present:tvar\.a \[len: [0-9]+\]\) from\(present:tvar\.b \[len: [0-9]+\]\) from\(present:tvar\.c \[len: [0-9]+\]\) from\(present:tvar\.d \[len: [0-9]+\]\)$} 1 "original" } } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 index c408b37f5a97..16afb51f48a5 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90 @@ -18,8 +18,8 @@ var%arr = 0 var%arr = 1 -! But this is fine. (Re-enabled by later patch.) -!!$omp target update to(mapper(even): var) +! But this is fine. +!$omp target update to(mapper(even): var) ! As 'enter data'. !$omp target exit data map(mapper(even), delete: var) diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-27.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-27.f90 new file mode 100644 index 000000000000..6b3a181acaa5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-27.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } + +type t +integer :: x +end type t + +type(t) :: var + +! Error on attempt to use missing named mapper. +!$omp target update to(mapper(boo): var) +! { dg-error {User-defined mapper .boo. not found} "" { target *-*-* } .-1 } + +var%x = 0 + +!$omp target map(mapper(boo), tofrom: var) +! { dg-error {User-defined mapper .boo. not found} "" { target *-*-* } .-1 } +var%x = 5 +!$omp end target + +! These should be fine though... +!$omp target enter data map(mapper(default), to: var) + +!$omp target exit data map(from: var) + +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-25.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-25.f90 new file mode 100644 index 000000000000..dc1f5272a261 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-25.f90 @@ -0,0 +1,44 @@ +! { dg-do run } +! { dg-require-effective-target offload_device_nonshared_as } + +type t +integer, allocatable :: arr(:) +end type t + +!$omp declare mapper(odd: T :: tv) map(tv%arr(1::2)) +!$omp declare mapper(even: T :: tv) map(tv%arr(2::2)) + +type(t) :: var +integer :: i + +allocate(var%arr(100)) + +var%arr = 0 + +!$omp target enter data map(to: var) + +var%arr = 1 + +!$omp target update to(mapper(odd): var) + +!$omp target +do i=1,100 + if (mod(i,2).eq.0.and.var%arr(i).ne.0) stop 1 + if (mod(i,2).eq.1.and.var%arr(i).ne.1) stop 2 +end do +!$omp end target + +var%arr = 2 + +!$omp target update to(mapper(even): var) + +!$omp target +do i=1,100 + if (mod(i,2).eq.0.and.var%arr(i).ne.2) stop 3 + if (mod(i,2).eq.1.and.var%arr(i).ne.1) stop 4 +end do +!$omp end target + +!$omp target exit data map(delete: var) + +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-28.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-28.f90 new file mode 100644 index 000000000000..6561decc49a9 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-28.f90 @@ -0,0 +1,38 @@ +! { dg-do run } + +program p + +type t +integer :: x, y +end type t + +type(t) :: var + +var%x = 0 +var%y = 0 + +var = sub(7) + +contains + +type(t) function sub(arg) +integer :: arg + +!$omp declare mapper (t :: tvar) map(tvar%x, tvar%y) + +!$omp target enter data map(alloc: sub) + +sub%x = 5 +sub%y = arg + +!$omp target update to(sub) + +!$omp target +if (sub%x.ne.5) stop 1 +if (sub%y.ne.7) stop 2 +!$omp end target + +!$omp target exit data map(release: sub) + +end function sub +end program p
