https://gcc.gnu.org/g:4a44f6b8991274c03e5bfee2c3ba3be343dce35b
commit r17-5337-g4a44f6b8991274c03e5bfee2c3ba3be343dce35b Author: Tobias Burnus <[email protected]> Date: Mon Oct 19 15:50:44 2026 +0200 walk_tree_1: Fix tree-walking of OMP_METADIRECTIVE [PR128001] OpenMP's metadirective uses TREE_PURPOSE of TREE_LIST, which is not walked by default, leading to a missing 'omp declare target' attribute. Solution: Handle OMP_METADIRECTIVE explicitly. PR middle-end/128001 gcc/ChangeLog: * tree.cc (walk_tree_1): Add comment; handle OMP_METADIRECTIVE explicitly. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/metadirective-14.f90: New test. Diff: --- .../gfortran.dg/gomp/metadirective-14.f90 | 43 ++++++++++++++++++++++ gcc/tree.cc | 13 ++++++- 2 files changed, 55 insertions(+), 1 deletion(-) diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-14.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-14.f90 new file mode 100644 index 000000000000..a1a09a4f6d4e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-14.f90 @@ -0,0 +1,43 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-gimple" } +! +! PR middle-end/128001 +! +! Based on OpenMP example-document's metadirective.2.f90 +! + +! Ensure 'work_on_chunk' is marked as 'omp declare target' +! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare target\\)\\)\[\\r\\n\]+__attribute__\\(\\(fn spec \\(\"\\. w w \"\\)\\)\\)\[\\r\\n\]+void work_on_chunk" "gimple" } } + +program main + !use omp_lib + implicit none + integer, parameter :: N = 1000 + external :: work_on_chunk + integer :: i, idev + + do idev = 0, 0 ! omp_get_num_devices() - 1 + + !$omp target device(idev) + !$omp begin metadirective & + !$omp& when( implementation={vendor(nvidia)}, & + !$omp& device={arch("kepler")}: & + !$omp& teams num_teams(512) thread_limit(32) ) & + !$omp& when( implementation={vendor(amd)}, & + !$omp& device={arch("fiji" )}: & + !$omp& teams num_teams(512) thread_limit(64) ) & + !$omp& otherwise( teams ) + !$omp distribute parallel do + do i = 1, N + call work_on_chunk(idev, i) + end do + !$omp end metadirective + !$omp end target + + end do + +end program + +subroutine work_on_chunk(idev, i) + integer :: i, idev +end subroutine diff --git a/gcc/tree.cc b/gcc/tree.cc index 49531e52a3b7..63edf1959ce2 100644 --- a/gcc/tree.cc +++ b/gcc/tree.cc @@ -11840,7 +11840,8 @@ walk_type_fields (tree type, walk_tree_fn func, void *data, called with the DATA and the address of each sub-tree. If FUNC returns a non-NULL value, the traversal is stopped, and the value returned by FUNC is returned. If PSET is non-NULL it is used to record the nodes visited, - and to avoid visiting a node more than once. */ + and to avoid visiting a node more than once. + Note that TREE_PURPOSE is not walked. */ tree walk_tree_1 (tree *tp, walk_tree_fn func, void *data, @@ -11997,6 +11998,16 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data, WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (t)); } + case OMP_METADIRECTIVE: + /* Handle this explicitly as TREE_PURPOSE is usually not walked. */ + for (tree t2 = OMP_METADIRECTIVE_VARIANTS (t); t2; t2 = TREE_CHAIN (t2)) + { + WALK_SUBTREE (OMP_METADIRECTIVE_VARIANT_SELECTOR (t2)); + WALK_SUBTREE (OMP_METADIRECTIVE_VARIANT_DIRECTIVE (t2)); + WALK_SUBTREE (OMP_METADIRECTIVE_VARIANT_BODY (t2)); + } + break; + case TARGET_EXPR: { int i, len;
