* [PATCH] openmp, fortran: Add Fortran support for indirect clause on the declare target directive
[not found] <37f412ee-58e7-4bde-a763-591268e8f8f4@codesourcery.com>
@ 2024-01-22 20:41 ` Kwok Cheung Yeung
2024-01-23 19:14 ` Tobias Burnus
0 siblings, 1 reply; 6+ messages in thread
From: Kwok Cheung Yeung @ 2024-01-22 20:41 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 341 bytes --]
Hi
This patch adds support for the indirect clause on the OpenMP 'declare
target' directive in Fortran. As with the C and C++ front-ends, this
applies the 'omp declare target indirect' attribute on affected function
declarations. The C test cases have also been translated to Fortran
where appropriate.
Okay for mainline?
Thanks
Kwok
[-- Attachment #2: 0002-openmp-fortran-Add-Fortran-support-for-indirect-clau.patch --]
[-- Type: text/plain, Size: 13797 bytes --]
From 545bdb2c8ab9a43e79c7a3a2992bd9edc7d08a6f Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Thu, 11 Jan 2024 19:52:53 +0000
Subject: [PATCH 2/2] openmp, fortran: Add Fortran support for indirect clause
on the declare target directive
2024-01-19 Kwok Cheung Yeung <kcy@codesourcery.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.
* 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-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.
---
gcc/fortran/dump-parse-tree.cc | 2 +
gcc/fortran/f95-lang.cc | 2 +
gcc/fortran/gfortran.h | 3 +-
gcc/fortran/openmp.cc | 45 +++++++++++++-
gcc/fortran/trans-decl.cc | 4 ++
.../gomp/declare-target-indirect-1.f90 | 58 +++++++++++++++++++
.../gomp/declare-target-indirect-2.f90 | 25 ++++++++
.../declare-target-indirect-1.f90 | 39 +++++++++++++
.../declare-target-indirect-2.f90 | 53 +++++++++++++++++
9 files changed, 229 insertions(+), 2 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
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..d1c5c323c54 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,6 +5594,13 @@ 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
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-indirect-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90
new file mode 100644
index 00000000000..560a0541e9a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90
@@ -0,0 +1,58 @@
+! { 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 (.true.) indirect (.false.) to (sub7) ! { dg-error "Duplicated .indirect. clause at .1." }
+ end subroutine
+
+ subroutine sub8
+ !$omp declare target to (sub8) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" }
+ end subroutine
+
+ subroutine sub9
+ !$omp declare target to (sub9) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" }
+ end subroutine
+
+ subroutine sub10
+ !$omp declare target indirect (.true.) device_type (host) enter (sub10) ! { dg-error "DEVICE_TYPE must be ANY when used with INDIRECT at .1." }
+ end subroutine
+
+ subroutine sub11
+ !$omp declare target indirect (.false.) device_type (nohost) enter (sub11)
+ 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
--
2.34.1
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH] openmp, fortran: Add Fortran support for indirect clause on the declare target directive
2024-01-22 20:41 ` [PATCH] openmp, fortran: Add Fortran support for indirect clause on the declare target directive Kwok Cheung Yeung
@ 2024-01-23 19:14 ` Tobias Burnus
2024-02-05 21:37 ` [PATCH v2] " Kwok Cheung Yeung
0 siblings, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2024-01-23 19:14 UTC (permalink / raw)
To: Kwok Cheung Yeung, gcc-patches, fortran, Jakub Jelinek
Kwok Cheung Yeung wrote:
> This patch adds support for the indirect clause on the OpenMP 'declare
> target' directive in Fortran. As with the C and C++ front-ends, this
> applies the 'omp declare target indirect' attribute on affected
> function declarations. The C test cases have also been translated to
> Fortran where appropriate.
>
> Okay for mainline?
LGTM – can you also update the following libgomp.texi entry?
@item @code{indirect} clause in @code{declare target} @tab P @tab Only C
and C++
Thanks,
Tobias
^ permalink raw reply [flat|nested] 6+ messages in thread
* [PATCH v2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive
2024-01-23 19:14 ` Tobias Burnus
@ 2024-02-05 21:37 ` Kwok Cheung Yeung
2024-02-06 9:03 ` Tobias Burnus
0 siblings, 1 reply; 6+ messages in thread
From: Kwok Cheung Yeung @ 2024-02-05 21:37 UTC (permalink / raw)
To: tburnus; +Cc: Jakub Jelinek, gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 587 bytes --]
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
[-- Attachment #2: 0001-openmp-fortran-Add-Fortran-support-for-indirect-clau.patch --]
[-- Type: text/plain, Size: 16179 bytes --]
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
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
--
2.34.1
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH v2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive
2024-02-05 21:37 ` [PATCH v2] " Kwok Cheung Yeung
@ 2024-02-06 9:03 ` Tobias Burnus
2024-02-06 9:50 ` Kwok Cheung Yeung
0 siblings, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2024-02-06 9:03 UTC (permalink / raw)
To: Kwok Cheung Yeung; +Cc: Jakub Jelinek, gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 1627 bytes --]
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
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH v2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive
2024-02-06 9:03 ` Tobias Burnus
@ 2024-02-06 9:50 ` Kwok Cheung Yeung
2024-02-12 8:51 ` Tobias Burnus
0 siblings, 1 reply; 6+ messages in thread
From: Kwok Cheung Yeung @ 2024-02-06 9:50 UTC (permalink / raw)
To: Tobias Burnus; +Cc: Jakub Jelinek, gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 912 bytes --]
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
>
[-- Attachment #2: 0001-openmp-fortran-Add-Fortran-support-for-indirect-clau.patch --]
[-- Type: text/plain, Size: 16440 bytes --]
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
--
2.34.1
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH v2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive
2024-02-06 9:50 ` Kwok Cheung Yeung
@ 2024-02-12 8:51 ` Tobias Burnus
0 siblings, 0 replies; 6+ messages in thread
From: Tobias Burnus @ 2024-02-12 8:51 UTC (permalink / raw)
To: Kwok Cheung Yeung; +Cc: Jakub Jelinek, gcc-patches, fortran
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
>>
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2024-02-12 8:51 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <37f412ee-58e7-4bde-a763-591268e8f8f4@codesourcery.com>
2024-01-22 20:41 ` [PATCH] openmp, fortran: Add Fortran support for indirect clause on the declare target directive Kwok Cheung Yeung
2024-01-23 19:14 ` Tobias Burnus
2024-02-05 21:37 ` [PATCH v2] " Kwok Cheung Yeung
2024-02-06 9:03 ` Tobias Burnus
2024-02-06 9:50 ` Kwok Cheung Yeung
2024-02-12 8:51 ` Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).