| Message ID | d77a96ab-d56b-49ca-9860-9bd5fd17555e@baylibre.com |
|---|---|
| State | New |
| Headers | show |
| Series | [v2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive | expand |
Kwok Cheung Yeung wrote: > As previously discussed, this version of the patch adds code to emit a > warning when a directive like this: > > !$omp declare target indirect(.true.) > > is encountered (i.e. a target directive containing at least one > clause, but no to/enter clause, which appears to violate the OpenMP > standard). A test is also added to > gfortran.dg/gomp/declare-target-indirect-1.f90 to test for this. Thanks. And indeed, the 5.1 spec requires under "Restrictions to the declare target directive are as follows:" "If the directive has a clause, it must contain at least one 'to' clause or at least one 'link' clause.". [5.2 replaced 'to' by its alias 'enter' and the 6.0 preview added 'local' to the list.] > I have also added a declare-target-indirect-3.f90 test to libgomp to > check that procedures passed via a dummy argument work properly when > used in an indirect call. > > Okay for mainline? LGTM. I just wonder whether there should be a value test and not just a does-not-crash-when-called test for the latter testcase, i.e. > +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 > @@ -0,0 +1,25 @@ > +! { dg-do run } > + > +! Check that indirect calls work on procedures passed in via a dummy argument > + > +module m > +contains > + subroutine bar > + !$omp declare target enter(bar) indirect e.g. "integer function bar()" ... " bar = 42" > + end subroutine > + > + subroutine foo(f) > + procedure(bar) :: f > + > + !$omp target > + call f And then: if (f() /= 42) stop 1 > + !$omp end target > + end subroutine > +end module Thanks, Tobias
Oops. I thought exactly the same thing yesterday, but forgot to add the changes to my commit! Here is the updated version. Kwok On 06/02/2024 9:03 am, Tobias Burnus wrote: > LGTM. I just wonder whether there should be a value test and not just a > does-not-crash-when-called test for the latter testcase, i.e. > > >> +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 >> @@ -0,0 +1,25 @@ >> +! { dg-do run } >> + >> +! Check that indirect calls work on procedures passed in via a dummy argument >> + >> +module m >> +contains >> + subroutine bar >> + !$omp declare target enter(bar) indirect > e.g. "integer function bar()" ... " bar = 42" >> + end subroutine >> + >> + subroutine foo(f) >> + procedure(bar) :: f >> + >> + !$omp target >> + call f > And then: if (f() /= 42) stop 1 >> + !$omp end target >> + end subroutine >> +end module > > Thanks, > > Tobias > From 83b734aa63aa63ea5bb438bb59ee09b00869e0fd Mon Sep 17 00:00:00 2001 From: Kwok Cheung Yeung <kcyeung@baylibre.com> Date: Mon, 5 Feb 2024 20:31:49 +0000 Subject: [PATCH] openmp, fortran: Add Fortran support for indirect clause on the declare target directive 2024-02-05 Kwok Cheung Yeung <kcyeung@baylibre.com> gcc/fortran/ * dump-parse-tree.cc (show_attr): Handle omp_declare_target_indirect attribute. * f95-lang.cc (gfc_gnu_attributes): Add entry for 'omp declare target indirect'. * gfortran.h (symbol_attribute): Add omp_declare_target_indirect field. (struct gfc_omp_clauses): Add indirect field. * openmp.cc (omp_mask2): Add OMP_CLAUSE_INDIRECT. (gfc_match_omp_clauses): Match indirect clause. (OMP_DECLARE_TARGET_CLAUSES): Add OMP_CLAUSE_INDIRECT. (gfc_match_omp_declare_target): Check omp_device_type and apply omp_declare_target_indirect attribute to symbol if indirect clause active. Show warning if there are only device_type and/or indirect clauses on the directive. * trans-decl.cc (add_attributes_to_decl): Add 'omp declare target indirect' attribute if symbol has indirect attribute set. gcc/testsuite/ * gfortran.dg/gomp/declare-target-4.f90 (f1): Update expected warning. * gfortran.dg/gomp/declare-target-indirect-1.f90: New. * gfortran.dg/gomp/declare-target-indirect-2.f90: New. libgomp/ * testsuite/libgomp.fortran/declare-target-indirect-1.f90: New. * testsuite/libgomp.fortran/declare-target-indirect-2.f90: New. * testsuite/libgomp.fortran/declare-target-indirect-3.f90: New. --- gcc/fortran/dump-parse-tree.cc | 2 + gcc/fortran/f95-lang.cc | 2 + gcc/fortran/gfortran.h | 3 +- gcc/fortran/openmp.cc | 50 ++++++++++++++- gcc/fortran/trans-decl.cc | 4 ++ .../gfortran.dg/gomp/declare-target-4.f90 | 2 +- .../gomp/declare-target-indirect-1.f90 | 62 +++++++++++++++++++ .../gomp/declare-target-indirect-2.f90 | 25 ++++++++ .../declare-target-indirect-1.f90 | 39 ++++++++++++ .../declare-target-indirect-2.f90 | 53 ++++++++++++++++ .../declare-target-indirect-3.f90 | 35 +++++++++++ 11 files changed, 272 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 1563b810b98..7b154eb3ca7 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -914,6 +914,8 @@ show_attr (symbol_attribute *attr, const char * module) fputs (" OMP-DECLARE-TARGET", dumpfile); if (attr->omp_declare_target_link) fputs (" OMP-DECLARE-TARGET-LINK", dumpfile); + if (attr->omp_declare_target_indirect) + fputs (" OMP-DECLARE-TARGET-INDIRECT", dumpfile); if (attr->elemental) fputs (" ELEMENTAL", dumpfile); if (attr->pure) diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 358cb17fce2..67fda27aa3e 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -96,6 +96,8 @@ static const attribute_spec gfc_gnu_attributes[] = gfc_handle_omp_declare_target_attribute, NULL }, { "omp declare target link", 0, 0, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, + { "omp declare target indirect", 0, 0, true, false, false, false, + gfc_handle_omp_declare_target_attribute, NULL }, { "oacc function", 0, -1, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, }; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index fd73e4ce431..fd843a3241d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -999,6 +999,7 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; unsigned omp_declare_target_link:1; + unsigned omp_declare_target_indirect:1; ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2; unsigned omp_allocate:1; @@ -1584,7 +1585,7 @@ typedef struct gfc_omp_clauses unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1; unsigned non_rectangular:1, order_concurrent:1; unsigned contains_teams_construct:1, target_first_st_is_teams:1; - unsigned contained_in_target_construct:1; + unsigned contained_in_target_construct:1, indirect:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 0af80d54fad..30aba4421ff 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -1096,6 +1096,7 @@ enum omp_mask2 OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */ OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */ OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0 */ + OMP_CLAUSE_INDIRECT, /* OpenMP 5.1 */ /* This must come last. */ OMP_MASK2_LAST }; @@ -2798,6 +2799,32 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_INDIRECT) + && (m = gfc_match_dupl_check (!c->indirect, "indirect")) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + gfc_expr *indirect_expr = NULL; + m = gfc_match (" ( %e )", &indirect_expr); + if (m == MATCH_YES) + { + if (!gfc_resolve_expr (indirect_expr) + || indirect_expr->ts.type != BT_LOGICAL + || indirect_expr->expr_type != EXPR_CONSTANT) + { + gfc_error ("INDIRECT clause at %C requires a constant " + "logical expression"); + gfc_free_expr (indirect_expr); + goto error; + } + c->indirect = indirect_expr->value.logical; + gfc_free_expr (indirect_expr); + } + else + c->indirect = 1; + continue; + } if ((mask & OMP_CLAUSE_IS_DEVICE_PTR) && gfc_match_omp_variable_list ("is_device_ptr (", @@ -4460,7 +4487,7 @@ cleanup: (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_ENTER) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE \ - | OMP_CLAUSE_TO) + | OMP_CLAUSE_TO | OMP_CLAUSE_INDIRECT) #define OMP_ATOMIC_CLAUSES \ (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ | OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL \ @@ -5513,6 +5540,15 @@ gfc_match_omp_declare_target (void) n->sym->name, &n->where); n->sym->attr.omp_device_type = c->device_type; } + if (c->indirect) + { + if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) + gfc_error_now ("DEVICE_TYPE must be ANY when used with " + "INDIRECT at %L", &n->where); + n->sym->attr.omp_declare_target_indirect = c->indirect; + } + n->sym->mark = 1; } else if (n->u.common->omp_declare_target @@ -5558,15 +5594,23 @@ gfc_match_omp_declare_target (void) " TARGET directive to a different DEVICE_TYPE", s->name, &n->where); s->attr.omp_device_type = c->device_type; + + if (c->indirect + && s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && s->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) + gfc_error_now ("DEVICE_TYPE must be ANY when used with " + "INDIRECT at %L", &n->where); + s->attr.omp_declare_target_indirect = c->indirect; } } - if (c->device_type + if ((c->device_type || c->indirect) && !c->lists[OMP_LIST_ENTER] && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK]) gfc_warning_now (OPT_Wopenmp, "OMP DECLARE TARGET directive at %L with only " - "DEVICE_TYPE clause is ignored", &old_loc); + "DEVICE_TYPE or INDIRECT clauses is ignored", + &old_loc); gfc_buffer_error (true); diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index de162f6cc75..6d463036966 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1526,6 +1526,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = tree_cons (get_identifier ("omp declare target"), clauses, list); + if (sym_attr.omp_declare_target_indirect) + list = tree_cons (get_identifier ("omp declare target indirect"), + clauses, list); + return list; } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 index 4f5de4bd8c7..55534d8fe99 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 @@ -2,7 +2,7 @@ ! { dg-additional-options "-fdump-tree-original" } subroutine f1 - !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" } + !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" } end subroutine subroutine f2 diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 new file mode 100644 index 00000000000..504c1a29813 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 @@ -0,0 +1,62 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +module m + integer :: a + integer, parameter :: X = 1 + integer, parameter :: Y = 2 + + ! Indirect on a variable should have no effect. + integer :: z + !$omp declare target to (z) indirect +contains + subroutine sub1 + !$omp declare target indirect to (sub1) + end subroutine + + subroutine sub2 + !$omp declare target enter (sub2) indirect (.true.) + end subroutine + + subroutine sub3 + !$omp declare target to (sub3) indirect (.false.) + end subroutine + + subroutine sub4 + !$omp declare target to (sub4) indirect (1) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + ! Compile-time non-constant expressions are not allowed. + subroutine sub5 + !$omp declare target indirect (a > 0) to (sub5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + ! Compile-time constant expressions are permissible. + subroutine sub6 + !$omp declare target indirect (X .eq. Y) to (sub6) + end subroutine + + subroutine sub7 + !$omp declare target indirect ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" } + end subroutine + + subroutine sub8 + !$omp declare target indirect (.true.) indirect (.false.) to (sub8) ! { dg-error "Duplicated .indirect. clause at .1." } + end subroutine + + subroutine sub9 + !$omp declare target to (sub9) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub10 + !$omp declare target to (sub10) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub11 + !$omp declare target indirect (.true.) device_type (host) enter (sub11) ! { dg-error "DEVICE_TYPE must be ANY when used with INDIRECT at .1." } + end subroutine + + subroutine sub12 + !$omp declare target indirect (.false.) device_type (nohost) enter (sub12) + end subroutine +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 new file mode 100644 index 00000000000..f6b3ae17856 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m +contains + subroutine sub1 + !$omp declare target indirect enter (sub1) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub1" "gimple" } } + + subroutine sub2 + !$omp declare target indirect (.false.) to (sub2) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } } + + subroutine sub3 + !$omp declare target indirect (.true.) to (sub3) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub3" "gimple" } } + + subroutine sub4 + !$omp declare target indirect (.false.) enter (sub4) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } } +end module diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 new file mode 100644 index 00000000000..39a91dfcdca --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 @@ -0,0 +1,39 @@ +! { dg-do run } + +module m +contains + integer function foo () + !$omp declare target to (foo) indirect + foo = 5 + end function + + integer function bar () + !$omp declare target to (bar) indirect + bar = 8 + end function + + integer function baz () + !$omp declare target to (baz) indirect + baz = 11 + end function +end module + +program main + use m + implicit none + + integer :: x, expected + procedure (foo), pointer :: foo_ptr, bar_ptr, baz_ptr + + foo_ptr => foo + bar_ptr => bar + baz_ptr => baz + + expected = foo () + bar () + baz () + + !$omp target map (to: foo_ptr, bar_ptr, baz_ptr) map (from: x) + x = foo_ptr () + bar_ptr () + baz_ptr () + !$omp end target + + stop x - expected +end program diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 new file mode 100644 index 00000000000..d3baa81dd07 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 @@ -0,0 +1,53 @@ +! { dg-do run } + +module m +contains + integer function foo () + !$omp declare target to (foo) indirect + foo = 5 + end function + + integer function bar () + !$omp declare target to (bar) indirect + bar = 8 + end function + + integer function baz () + !$omp declare target to (baz) indirect + baz = 11 + end function +end module + +program main + use m + implicit none + + type fp + procedure (foo), pointer, nopass :: f => null () + end type + + integer, parameter :: N = 256 + integer :: i, x = 0, expected = 0; + type (fp) :: fn_ptr (N) + + do i = 1, N + select case (mod (i, 3)) + case (0) + fn_ptr (i)%f => foo + case (1) + fn_ptr (i)%f => bar + case (2) + fn_ptr (i)%f => baz + end select + expected = expected + fn_ptr (i)%f () + end do + + !$omp target teams distribute parallel do & + !$omp & reduction(+: x) map (to: fn_ptr) map (tofrom: x) + do i = 1, N + x = x + fn_ptr (i)%f () + end do + !$omp end target teams distribute parallel do + + stop x - expected +end program diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 new file mode 100644 index 00000000000..00f33bd1170 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 @@ -0,0 +1,35 @@ +! { dg-do run } + +! Check that indirect calls work on procedures passed in via a dummy argument + +module m + integer, parameter :: offset = 123 +contains + function bar(x) + !$omp declare target enter (bar) indirect + integer :: bar + integer, intent(in) :: x + bar = x + offset + end function + + function foo(f, x) + integer :: foo + procedure(bar) :: f + integer, intent(in) :: x + + !$omp target map (to: x) map (from: foo) + foo = f(x) + !$omp end target + end function +end module + +program main + use m + implicit none + + integer :: a = 321 + integer :: b + + b = foo(bar, a) + stop b - (a + offset) +end program
Hi Kwok, Kwok Cheung Yeung wrote: > Oops. I thought exactly the same thing yesterday, but forgot to add > the changes to my commit! Here is the updated version. I regard(ed) this change as obvious - hence, I missed to reply. But for completeness: LGTM. I think it would be useful to commit this now with an xfail for the one failing testcase that depends on the review-pending libgomp patch. I mean something like: --- a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 @@ -1,2 +1,3 @@ ! { dg-do run } +! { dg-xfail-run-if "Requires libgomp bug fix pending review" { offload_device } } Thanks, Tobias > On 06/02/2024 9:03 am, Tobias Burnus wrote: >> LGTM. I just wonder whether there should be a value test and not just >> a does-not-crash-when-called test for the latter testcase, i.e. >> >> >>> +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 >>> @@ -0,0 +1,25 @@ >>> +! { dg-do run } >>> + >>> +! Check that indirect calls work on procedures passed in via a >>> dummy argument >>> + >>> +module m >>> +contains >>> + subroutine bar >>> + !$omp declare target enter(bar) indirect >> e.g. "integer function bar()" ... " bar = 42" >>> + end subroutine >>> + >>> + subroutine foo(f) >>> + procedure(bar) :: f >>> + >>> + !$omp target >>> + call f >> And then: if (f() /= 42) stop 1 >>> + !$omp end target >>> + end subroutine >>> +end module >> >> Thanks, >> >> Tobias >>
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 1563b810b98..7b154eb3ca7 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -914,6 +914,8 @@ show_attr (symbol_attribute *attr, const char * module) fputs (" OMP-DECLARE-TARGET", dumpfile); if (attr->omp_declare_target_link) fputs (" OMP-DECLARE-TARGET-LINK", dumpfile); + if (attr->omp_declare_target_indirect) + fputs (" OMP-DECLARE-TARGET-INDIRECT", dumpfile); if (attr->elemental) fputs (" ELEMENTAL", dumpfile); if (attr->pure) diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 358cb17fce2..67fda27aa3e 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -96,6 +96,8 @@ static const attribute_spec gfc_gnu_attributes[] = gfc_handle_omp_declare_target_attribute, NULL }, { "omp declare target link", 0, 0, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, + { "omp declare target indirect", 0, 0, true, false, false, false, + gfc_handle_omp_declare_target_attribute, NULL }, { "oacc function", 0, -1, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, }; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index fd73e4ce431..fd843a3241d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -999,6 +999,7 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; unsigned omp_declare_target_link:1; + unsigned omp_declare_target_indirect:1; ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2; unsigned omp_allocate:1; @@ -1584,7 +1585,7 @@ typedef struct gfc_omp_clauses unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1; unsigned non_rectangular:1, order_concurrent:1; unsigned contains_teams_construct:1, target_first_st_is_teams:1; - unsigned contained_in_target_construct:1; + unsigned contained_in_target_construct:1, indirect:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 0af80d54fad..30aba4421ff 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -1096,6 +1096,7 @@ enum omp_mask2 OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */ OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */ OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0 */ + OMP_CLAUSE_INDIRECT, /* OpenMP 5.1 */ /* This must come last. */ OMP_MASK2_LAST }; @@ -2798,6 +2799,32 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_INDIRECT) + && (m = gfc_match_dupl_check (!c->indirect, "indirect")) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + gfc_expr *indirect_expr = NULL; + m = gfc_match (" ( %e )", &indirect_expr); + if (m == MATCH_YES) + { + if (!gfc_resolve_expr (indirect_expr) + || indirect_expr->ts.type != BT_LOGICAL + || indirect_expr->expr_type != EXPR_CONSTANT) + { + gfc_error ("INDIRECT clause at %C requires a constant " + "logical expression"); + gfc_free_expr (indirect_expr); + goto error; + } + c->indirect = indirect_expr->value.logical; + gfc_free_expr (indirect_expr); + } + else + c->indirect = 1; + continue; + } if ((mask & OMP_CLAUSE_IS_DEVICE_PTR) && gfc_match_omp_variable_list ("is_device_ptr (", @@ -4460,7 +4487,7 @@ cleanup: (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_ENTER) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE \ - | OMP_CLAUSE_TO) + | OMP_CLAUSE_TO | OMP_CLAUSE_INDIRECT) #define OMP_ATOMIC_CLAUSES \ (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ | OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL \ @@ -5513,6 +5540,15 @@ gfc_match_omp_declare_target (void) n->sym->name, &n->where); n->sym->attr.omp_device_type = c->device_type; } + if (c->indirect) + { + if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) + gfc_error_now ("DEVICE_TYPE must be ANY when used with " + "INDIRECT at %L", &n->where); + n->sym->attr.omp_declare_target_indirect = c->indirect; + } + n->sym->mark = 1; } else if (n->u.common->omp_declare_target @@ -5558,15 +5594,23 @@ gfc_match_omp_declare_target (void) " TARGET directive to a different DEVICE_TYPE", s->name, &n->where); s->attr.omp_device_type = c->device_type; + + if (c->indirect + && s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && s->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) + gfc_error_now ("DEVICE_TYPE must be ANY when used with " + "INDIRECT at %L", &n->where); + s->attr.omp_declare_target_indirect = c->indirect; } } - if (c->device_type + if ((c->device_type || c->indirect) && !c->lists[OMP_LIST_ENTER] && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK]) gfc_warning_now (OPT_Wopenmp, "OMP DECLARE TARGET directive at %L with only " - "DEVICE_TYPE clause is ignored", &old_loc); + "DEVICE_TYPE or INDIRECT clauses is ignored", + &old_loc); gfc_buffer_error (true); diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index de162f6cc75..6d463036966 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1526,6 +1526,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = tree_cons (get_identifier ("omp declare target"), clauses, list); + if (sym_attr.omp_declare_target_indirect) + list = tree_cons (get_identifier ("omp declare target indirect"), + clauses, list); + return list; } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 index 4f5de4bd8c7..55534d8fe99 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 @@ -2,7 +2,7 @@ ! { dg-additional-options "-fdump-tree-original" } subroutine f1 - !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" } + !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" } end subroutine subroutine f2 diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 new file mode 100644 index 00000000000..504c1a29813 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 @@ -0,0 +1,62 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +module m + integer :: a + integer, parameter :: X = 1 + integer, parameter :: Y = 2 + + ! Indirect on a variable should have no effect. + integer :: z + !$omp declare target to (z) indirect +contains + subroutine sub1 + !$omp declare target indirect to (sub1) + end subroutine + + subroutine sub2 + !$omp declare target enter (sub2) indirect (.true.) + end subroutine + + subroutine sub3 + !$omp declare target to (sub3) indirect (.false.) + end subroutine + + subroutine sub4 + !$omp declare target to (sub4) indirect (1) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + ! Compile-time non-constant expressions are not allowed. + subroutine sub5 + !$omp declare target indirect (a > 0) to (sub5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + ! Compile-time constant expressions are permissible. + subroutine sub6 + !$omp declare target indirect (X .eq. Y) to (sub6) + end subroutine + + subroutine sub7 + !$omp declare target indirect ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" } + end subroutine + + subroutine sub8 + !$omp declare target indirect (.true.) indirect (.false.) to (sub8) ! { dg-error "Duplicated .indirect. clause at .1." } + end subroutine + + subroutine sub9 + !$omp declare target to (sub9) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub10 + !$omp declare target to (sub10) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub11 + !$omp declare target indirect (.true.) device_type (host) enter (sub11) ! { dg-error "DEVICE_TYPE must be ANY when used with INDIRECT at .1." } + end subroutine + + subroutine sub12 + !$omp declare target indirect (.false.) device_type (nohost) enter (sub12) + end subroutine +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 new file mode 100644 index 00000000000..f6b3ae17856 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m +contains + subroutine sub1 + !$omp declare target indirect enter (sub1) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub1" "gimple" } } + + subroutine sub2 + !$omp declare target indirect (.false.) to (sub2) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } } + + subroutine sub3 + !$omp declare target indirect (.true.) to (sub3) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub3" "gimple" } } + + subroutine sub4 + !$omp declare target indirect (.false.) enter (sub4) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } } +end module diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 new file mode 100644 index 00000000000..39a91dfcdca --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 @@ -0,0 +1,39 @@ +! { dg-do run } + +module m +contains + integer function foo () + !$omp declare target to (foo) indirect + foo = 5 + end function + + integer function bar () + !$omp declare target to (bar) indirect + bar = 8 + end function + + integer function baz () + !$omp declare target to (baz) indirect + baz = 11 + end function +end module + +program main + use m + implicit none + + integer :: x, expected + procedure (foo), pointer :: foo_ptr, bar_ptr, baz_ptr + + foo_ptr => foo + bar_ptr => bar + baz_ptr => baz + + expected = foo () + bar () + baz () + + !$omp target map (to: foo_ptr, bar_ptr, baz_ptr) map (from: x) + x = foo_ptr () + bar_ptr () + baz_ptr () + !$omp end target + + stop x - expected +end program diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 new file mode 100644 index 00000000000..d3baa81dd07 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 @@ -0,0 +1,53 @@ +! { dg-do run } + +module m +contains + integer function foo () + !$omp declare target to (foo) indirect + foo = 5 + end function + + integer function bar () + !$omp declare target to (bar) indirect + bar = 8 + end function + + integer function baz () + !$omp declare target to (baz) indirect + baz = 11 + end function +end module + +program main + use m + implicit none + + type fp + procedure (foo), pointer, nopass :: f => null () + end type + + integer, parameter :: N = 256 + integer :: i, x = 0, expected = 0; + type (fp) :: fn_ptr (N) + + do i = 1, N + select case (mod (i, 3)) + case (0) + fn_ptr (i)%f => foo + case (1) + fn_ptr (i)%f => bar + case (2) + fn_ptr (i)%f => baz + end select + expected = expected + fn_ptr (i)%f () + end do + + !$omp target teams distribute parallel do & + !$omp & reduction(+: x) map (to: fn_ptr) map (tofrom: x) + do i = 1, N + x = x + fn_ptr (i)%f () + end do + !$omp end target teams distribute parallel do + + stop x - expected +end program diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 new file mode 100644 index 00000000000..ff99892f25c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 @@ -0,0 +1,25 @@ +! { dg-do run } + +! Check that indirect calls work on procedures passed in via a dummy argument + +module m +contains + subroutine bar + !$omp declare target enter(bar) indirect + end subroutine + + subroutine foo(f) + procedure(bar) :: f + + !$omp target + call f + !$omp end target + end subroutine +end module + +program main + use m + implicit none + + call foo(bar) +end program
Hi As previously discussed, this version of the patch adds code to emit a warning when a directive like this: !$omp declare target indirect(.true.) is encountered (i.e. a target directive containing at least one clause, but no to/enter clause, which appears to violate the OpenMP standard). A test is also added to gfortran.dg/gomp/declare-target-indirect-1.f90 to test for this. I have also added a declare-target-indirect-3.f90 test to libgomp to check that procedures passed via a dummy argument work properly when used in an indirect call. Okay for mainline? Thanks Kwok From f6662a7bc76d400fecb5013ad6d6ab3b00b8a6e7 Mon Sep 17 00:00:00 2001 From: Kwok Cheung Yeung <kcyeung@baylibre.com> Date: Mon, 5 Feb 2024 20:31:49 +0000 Subject: [PATCH] openmp, fortran: Add Fortran support for indirect clause on the declare target directive 2024-02-05 Kwok Cheung Yeung <kcyeung@baylibre.com> gcc/fortran/ * dump-parse-tree.cc (show_attr): Handle omp_declare_target_indirect attribute. * f95-lang.cc (gfc_gnu_attributes): Add entry for 'omp declare target indirect'. * gfortran.h (symbol_attribute): Add omp_declare_target_indirect field. (struct gfc_omp_clauses): Add indirect field. * openmp.cc (omp_mask2): Add OMP_CLAUSE_INDIRECT. (gfc_match_omp_clauses): Match indirect clause. (OMP_DECLARE_TARGET_CLAUSES): Add OMP_CLAUSE_INDIRECT. (gfc_match_omp_declare_target): Check omp_device_type and apply omp_declare_target_indirect attribute to symbol if indirect clause active. Show warning if there are only device_type and/or indirect clauses on the directive. * trans-decl.cc (add_attributes_to_decl): Add 'omp declare target indirect' attribute if symbol has indirect attribute set. gcc/testsuite/ * gfortran.dg/gomp/declare-target-4.f90 (f1): Update expected warning. * gfortran.dg/gomp/declare-target-indirect-1.f90: New. * gfortran.dg/gomp/declare-target-indirect-2.f90: New. libgomp/ * testsuite/libgomp.fortran/declare-target-indirect-1.f90: New. * testsuite/libgomp.fortran/declare-target-indirect-2.f90: New. * testsuite/libgomp.fortran/declare-target-indirect-3.f90: New. --- gcc/fortran/dump-parse-tree.cc | 2 + gcc/fortran/f95-lang.cc | 2 + gcc/fortran/gfortran.h | 3 +- gcc/fortran/openmp.cc | 50 ++++++++++++++- gcc/fortran/trans-decl.cc | 4 ++ .../gfortran.dg/gomp/declare-target-4.f90 | 2 +- .../gomp/declare-target-indirect-1.f90 | 62 +++++++++++++++++++ .../gomp/declare-target-indirect-2.f90 | 25 ++++++++ .../declare-target-indirect-1.f90 | 39 ++++++++++++ .../declare-target-indirect-2.f90 | 53 ++++++++++++++++ .../declare-target-indirect-3.f90 | 25 ++++++++ 11 files changed, 262 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90