aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--contrib/ChangeLog.omp6
-rwxr-xr-xcontrib/gcc-changelog/git_repository.py7
-rwxr-xr-xcontrib/gcc-changelog/git_update_version.py54
-rw-r--r--gcc/ChangeLog.omp845
-rw-r--r--gcc/DATESTAMP.omp1
-rw-r--r--gcc/Makefile.in2
-rw-r--r--gcc/builtin-types.def6
-rw-r--r--gcc/builtins.cc71
-rw-r--r--gcc/c-family/ChangeLog.omp90
-rw-r--r--gcc/c-family/c-common.h21
-rw-r--r--gcc/c-family/c-cppbuiltin.cc2
-rw-r--r--gcc/c-family/c-omp.cc865
-rw-r--r--gcc/c-family/c-pragma.h1
-rw-r--r--gcc/c-family/c-pretty-print.cc5
-rw-r--r--gcc/c/ChangeLog.omp237
-rw-r--r--gcc/c/c-decl.cc172
-rw-r--r--gcc/c/c-lang.h8
-rw-r--r--gcc/c/c-objc-common.h12
-rw-r--r--gcc/c/c-parser.cc2391
-rw-r--r--gcc/c/c-tree.h13
-rw-r--r--gcc/c/c-typeck.cc616
-rw-r--r--gcc/cgraphunit.cc11
-rw-r--r--gcc/common.opt29
-rw-r--r--gcc/config/gcn/gcn-tree.cc624
-rw-r--r--gcc/config/gcn/gcn.cc6
-rw-r--r--gcc/config/nvptx/mkoffload.cc13
-rw-r--r--gcc/config/nvptx/nvptx-protos.h2
-rw-r--r--gcc/config/nvptx/nvptx.cc919
-rw-r--r--gcc/config/nvptx/nvptx.h3
-rw-r--r--gcc/config/nvptx/nvptx.md75
-rw-r--r--gcc/coretypes.h7
-rw-r--r--gcc/cp/ChangeLog.omp332
-rw-r--r--gcc/cp/constexpr.cc25
-rw-r--r--gcc/cp/cp-gimplify.cc6
-rw-r--r--gcc/cp/cp-objcp-common.cc1
-rw-r--r--gcc/cp/cp-objcp-common.h9
-rw-r--r--gcc/cp/cp-tree.def12
-rw-r--r--gcc/cp/cp-tree.h56
-rw-r--r--gcc/cp/decl.cc410
-rw-r--r--gcc/cp/decl2.cc26
-rw-r--r--gcc/cp/error.cc30
-rw-r--r--gcc/cp/mangle.cc1
-rw-r--r--gcc/cp/operators.def1
-rw-r--r--gcc/cp/parser.cc2630
-rw-r--r--gcc/cp/parser.h12
-rw-r--r--gcc/cp/pt.cc285
-rw-r--r--gcc/cp/semantics.cc1800
-rw-r--r--gcc/cp/typeck.cc21
-rw-r--r--gcc/doc/extend.texi2
-rw-r--r--gcc/doc/invoke.texi21
-rw-r--r--gcc/dwarf2out.cc70
-rw-r--r--gcc/expr.cc3
-rw-r--r--gcc/flag-types.h6
-rw-r--r--gcc/fortran/ChangeLog.omp448
-rw-r--r--gcc/fortran/cpp.cc2
-rw-r--r--gcc/fortran/dump-parse-tree.cc18
-rw-r--r--gcc/fortran/f95-lang.cc20
-rw-r--r--gcc/fortran/gfortran.h84
-rw-r--r--gcc/fortran/intrinsic.texi6
-rw-r--r--gcc/fortran/match.cc17
-rw-r--r--gcc/fortran/match.h1
-rw-r--r--gcc/fortran/module.cc257
-rw-r--r--gcc/fortran/openmp.cc2295
-rw-r--r--gcc/fortran/parse.cc13
-rw-r--r--gcc/fortran/resolve.cc2
-rw-r--r--gcc/fortran/st.cc2
-rw-r--r--gcc/fortran/symbol.cc16
-rw-r--r--gcc/fortran/trans-array.cc13
-rw-r--r--gcc/fortran/trans-decl.cc37
-rw-r--r--gcc/fortran/trans-openmp.cc1858
-rw-r--r--gcc/fortran/trans-stmt.cc12
-rw-r--r--gcc/fortran/trans-stmt.h1
-rw-r--r--gcc/fortran/trans.h11
-rw-r--r--gcc/fortran/types.def6
-rw-r--r--gcc/gimple-expr.cc2
-rw-r--r--gcc/gimple-pretty-print.cc6
-rw-r--r--gcc/gimple.cc8
-rw-r--r--gcc/gimple.def2
-rw-r--r--gcc/gimple.h42
-rw-r--r--gcc/gimplify.cc2784
-rw-r--r--gcc/gimplify.h9
-rw-r--r--gcc/gsstruct.def1
-rw-r--r--gcc/langhooks-def.h20
-rw-r--r--gcc/langhooks.cc41
-rw-r--r--gcc/langhooks.h23
-rw-r--r--gcc/lto-wrapper.cc1
-rw-r--r--gcc/omp-builtins.def13
-rw-r--r--gcc/omp-expand.cc85
-rw-r--r--gcc/omp-general.cc319
-rw-r--r--gcc/omp-general.h97
-rw-r--r--gcc/omp-low.cc1853
-rw-r--r--gcc/omp-oacc-kernels-decompose.cc5
-rw-r--r--gcc/omp-oacc-neuter-broadcast.cc124
-rw-r--r--gcc/omp-offload.cc652
-rw-r--r--gcc/omp-offload.h11
-rw-r--r--gcc/opts.cc8
-rw-r--r--gcc/target-insns.def5
-rw-r--r--gcc/testsuite/ChangeLog.omp435
-rw-r--r--gcc/testsuite/c-c++-common/cpp/openacc-define-3.c2
-rw-r--r--gcc/testsuite/c-c++-common/goacc/acc-data-chain.c24
-rw-r--r--gcc/testsuite/c-c++-common/goacc/combined-reduction.c2
-rw-r--r--gcc/testsuite/c-c++-common/goacc/data-clause-1.c2
-rw-r--r--gcc/testsuite/c-c++-common/goacc/deviceptr-4.c2
-rw-r--r--gcc/testsuite/c-c++-common/goacc/implied-copy-1.c4
-rw-r--r--gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-2.c2
-rw-r--r--gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-3.c4
-rw-r--r--gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-4.c4
-rw-r--r--gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-2.c18
-rw-r--r--gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-3.c12
-rw-r--r--gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-4.c12
-rw-r--r--gcc/testsuite/c-c++-common/goacc/loop-auto-1.c50
-rw-r--r--gcc/testsuite/c-c++-common/goacc/loop-auto-2.c4
-rw-r--r--gcc/testsuite/c-c++-common/goacc/loop-auto-3.c78
-rw-r--r--gcc/testsuite/c-c++-common/goacc/noncontig_array-1.c26
-rw-r--r--gcc/testsuite/c-c++-common/goacc/readonly-1.c20
-rw-r--r--gcc/testsuite/c-c++-common/goacc/readonly-2.c16
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-1.c4
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-10.c94
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-11.c81
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-12.c60
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-13.c60
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-14.c46
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-15.c51
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-16.c30
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-2.c4
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-3.c4
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-4.c4
-rw-r--r--gcc/testsuite/c-c++-common/goacc/reduction-9.c111
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-10.c15
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-11.c58
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-12.c20
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-13.c53
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-14.c57
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-15.c15
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-7.c529
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-8.c405
-rw-r--r--gcc/testsuite/c-c++-common/gomp/adjust-args-9.c125
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-10.c11
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-11.c29
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-12.c33
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-14.c3
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-15.c3
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-16.c9
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-17.c2
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-18.c18
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-19.c15
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-20.c337
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-5.c26
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-9.c76
-rw-r--r--gcc/testsuite/c-c++-common/gomp/allocate-allocator-handle.h17
-rw-r--r--gcc/testsuite/c-c++-common/gomp/clauses-2.c2
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c22
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c59
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c39
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-17.c38
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-19.c40
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c30
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c78
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c26
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c23
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c29
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c43
-rw-r--r--gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c34
-rw-r--r--gcc/testsuite/c-c++-common/gomp/delim-declare-variant-1.c55
-rw-r--r--gcc/testsuite/c-c++-common/gomp/delim-declare-variant-2.c66
-rw-r--r--gcc/testsuite/c-c++-common/gomp/delim-declare-variant-3.c50
-rw-r--r--gcc/testsuite/c-c++-common/gomp/delim-declare-variant-4.c31
-rw-r--r--gcc/testsuite/c-c++-common/gomp/delim-declare-variant-5.c26
-rw-r--r--gcc/testsuite/c-c++-common/gomp/delim-declare-variant-6.c71
-rw-r--r--gcc/testsuite/c-c++-common/gomp/delim-declare-variant-7.c27
-rw-r--r--gcc/testsuite/c-c++-common/gomp/directive-1.c1
-rw-r--r--gcc/testsuite/c-c++-common/gomp/map-6.c14
-rw-r--r--gcc/testsuite/c-c++-common/gomp/pr118579.c3
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-map-iterators-1.c23
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-map-iterators-2.c25
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-map-iterators-3.c23
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-map-iterators-4.c18
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-map-iterators-5.c14
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-update-iterators-1.c20
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-update-iterators-2.c23
-rw-r--r--gcc/testsuite/c-c++-common/gomp/target-update-iterators-3.c17
-rw-r--r--gcc/testsuite/c-c++-common/gomp/uses_allocators-1.c46
-rw-r--r--gcc/testsuite/c-c++-common/gomp/uses_allocators-2.c33
-rw-r--r--gcc/testsuite/g++.dg/goacc/data-clause-1.C2
-rw-r--r--gcc/testsuite/g++.dg/goacc/loop-1.c23
-rw-r--r--gcc/testsuite/g++.dg/goacc/loop-2.c70
-rw-r--r--gcc/testsuite/g++.dg/goacc/loop-3.c43
-rw-r--r--gcc/testsuite/g++.dg/goacc/reductions-1.C548
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-1.C35
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-10.C56
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-11.C112
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-12.C62
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-13.C95
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-14.C24
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-15.C23
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-16.C30
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-17.C44
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-2.C11
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-5.C42
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-6.C97
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-7.C100
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-8.C23
-rw-r--r--gcc/testsuite/g++.dg/gomp/adjust-args-9.C39
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-10.C1019
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-11.C50
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-12.C108
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-13.C172
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-14.C172
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-15.C148
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-16.C81
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-17.C69
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-18.C60
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-19.C27
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-20.C18
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-21.C26
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-5.C321
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-6.C391
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-7.C99
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-8.C45
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-9.C45
-rw-r--r--gcc/testsuite/g++.dg/gomp/allocate-allocator-handle.h16
-rw-r--r--gcc/testsuite/g++.dg/gomp/append-args-1.C5
-rw-r--r--gcc/testsuite/g++.dg/gomp/append-args-10.C36
-rw-r--r--gcc/testsuite/g++.dg/gomp/append-args-11.C96
-rw-r--r--gcc/testsuite/g++.dg/gomp/append-args-9.C21
-rw-r--r--gcc/testsuite/g++.dg/gomp/append-args-omp-interop-t.h11
-rw-r--r--gcc/testsuite/g++.dg/gomp/array-shaping-1.C22
-rw-r--r--gcc/testsuite/g++.dg/gomp/array-shaping-2.C134
-rw-r--r--gcc/testsuite/g++.dg/gomp/bad-array-shaping-1.C47
-rw-r--r--gcc/testsuite/g++.dg/gomp/bad-array-shaping-2.C52
-rw-r--r--gcc/testsuite/g++.dg/gomp/bad-array-shaping-3.C53
-rw-r--r--gcc/testsuite/g++.dg/gomp/bad-array-shaping-4.C60
-rw-r--r--gcc/testsuite/g++.dg/gomp/bad-array-shaping-5.C55
-rw-r--r--gcc/testsuite/g++.dg/gomp/bad-array-shaping-6.C59
-rw-r--r--gcc/testsuite/g++.dg/gomp/bad-array-shaping-7.C44
-rw-r--r--gcc/testsuite/g++.dg/gomp/bad-array-shaping-8.C50
-rw-r--r--gcc/testsuite/g++.dg/gomp/declare-mapper-1.C58
-rw-r--r--gcc/testsuite/g++.dg/gomp/declare-mapper-2.C30
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-1.C39
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-2.C53
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-3.C37
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-4.C57
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-40.C51
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-41.C31
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-5.C53
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-50.C99
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-51.C181
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-52.C24
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-6.C72
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-7.C57
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-70.C206
-rw-r--r--gcc/testsuite/g++.dg/gomp/delim-declare-variant-71.C157
-rw-r--r--gcc/testsuite/gcc.dg/goacc/loop-processing-1.c4
-rw-r--r--gcc/testsuite/gcc.dg/gomp/adjust-args-1.c27
-rw-r--r--gcc/testsuite/gcc.dg/gomp/adjust-args-3.c47
-rw-r--r--gcc/testsuite/gcc.dg/gomp/append-args-1.c7
-rw-r--r--gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-1.c26
-rw-r--r--gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-2.c24
-rw-r--r--gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-3.c30
-rw-r--r--gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-4.c27
-rw-r--r--gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-5.c17
-rw-r--r--gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-6.c26
-rw-r--r--gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-7.c15
-rw-r--r--gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c61
-rw-r--r--gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c33
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/array-reduction.f9047
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/assumed-size.f9035
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/common-block-3.f908
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/declare-3.f953
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/declare-allocatable-1.f9025
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/enter-exit-data-2.f908
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/finalize-1.f4
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/implied-copy-1.f904
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/kernels-decompose-1.f9510
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f954
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f954
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f954
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/loop-auto-1.f9088
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/loop-tree-1.f902
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/modules.f953
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/pr70828.f9022
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/private-explicit-kernels-1.f958
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/private-predetermined-kernels-1.f958
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f906
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/privatization-1-compute.f9012
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/readonly-1.f9020
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/reduction.f95176
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/sie.f9536
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/tile-1.f9016
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f902
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/allocate-1.f907
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f9071
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f9026
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f9060
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f9025
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-24.f9043
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f9028
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-27.f9025
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-29.f9022
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f9034
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f9045
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/noncontig-updates-1.f9019
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/noncontig-updates-2.f9016
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/noncontig-updates-3.f9016
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/noncontig-updates-4.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/num-teams-2.f9012
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/pr67500.f908
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/pr77516.f902
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/scope-6.f902
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f9026
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f9033
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f9024
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f9031
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/target-map-iterators-5.f9021
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/target-update-iterators-1.f9025
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/target-update-iterators-2.f9028
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/target-update-iterators-3.f9023
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/uses_allocators-1.f9037
-rw-r--r--gcc/testsuite/gfortran.dg/openacc-define-3.f902
-rw-r--r--gcc/testsuite/gfortran.dg/pr67170.f902
-rw-r--r--gcc/tree-core.h14
-rw-r--r--gcc/tree-inline.cc9
-rw-r--r--gcc/tree-loop-distribution.cc20
-rw-r--r--gcc/tree-nested.cc10
-rw-r--r--gcc/tree-pretty-print.cc175
-rw-r--r--gcc/tree-ssanames.cc3
-rw-r--r--gcc/tree-vect-data-refs.cc16
-rw-r--r--gcc/tree.cc17
-rw-r--r--gcc/tree.def9
-rw-r--r--gcc/tree.h73
-rw-r--r--include/ChangeLog.omp45
-rw-r--r--include/gomp-constants.h44
-rw-r--r--libgcc/ChangeLog.omp10
-rw-r--r--libgcc/config/gcn/crt0.c32
-rw-r--r--libgcc/config/nvptx/gbl-ctors.c16
-rw-r--r--libgomp/ChangeLog.omp863
-rw-r--r--libgomp/Makefile.am3
-rw-r--r--libgomp/Makefile.in11
-rw-r--r--libgomp/acc_prof.h6
-rw-r--r--libgomp/config/accel/target-cxa-dso-dtor.c62
-rw-r--r--libgomp/config/gcn/bar.h3
-rw-r--r--libgomp/config/gcn/target.c39
-rw-r--r--libgomp/config/gcn/team.c4
-rw-r--r--libgomp/config/linux/allocator.c206
-rw-r--r--libgomp/config/nvptx/libgomp-nvptx.h35
-rw-r--r--libgomp/config/nvptx/oacc-profiling-acc_register_library.c0
-rw-r--r--libgomp/config/nvptx/oacc-profiling.c0
-rw-r--r--libgomp/config/nvptx/target.c53
-rw-r--r--libgomp/config/nvptx/team.c3
-rw-r--r--libgomp/env.c6
-rw-r--r--libgomp/libgomp-plugin.c4
-rw-r--r--libgomp/libgomp-plugin.h4
-rw-r--r--libgomp/libgomp.h39
-rw-r--r--libgomp/libgomp.map1
-rw-r--r--libgomp/libgomp.texi60
-rw-r--r--libgomp/libgomp_g.h3
-rw-r--r--libgomp/oacc-init.c21
-rw-r--r--libgomp/oacc-int.h52
-rw-r--r--libgomp/oacc-mem.c86
-rw-r--r--libgomp/oacc-parallel.c207
-rw-r--r--libgomp/oacc-profiling-acc_register_library.c39
-rw-r--r--libgomp/oacc-profiling.c32
-rw-r--r--libgomp/openacc.f902
-rw-r--r--libgomp/openacc_lib.h2
-rw-r--r--libgomp/plugin/plugin-gcn.c8
-rw-r--r--libgomp/plugin/plugin-nvptx.c112
-rw-r--r--libgomp/target-cxa-dso-dtor.c3
-rw-r--r--libgomp/target.c987
-rw-r--r--libgomp/testsuite/libgomp.c++/allocate-2.C329
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-1.C469
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-10.C61
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-11.C63
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-12.C65
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-13.C89
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-2.C38
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-3.C38
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-4.C38
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-5.C38
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-6.C54
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-7.C54
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-8.C65
-rw-r--r--libgomp/testsuite/libgomp.c++/array-shaping-9.C95
-rw-r--r--libgomp/testsuite/libgomp.c++/c++.exp9
-rw-r--r--libgomp/testsuite/libgomp.c++/declare-mapper-1.C87
-rw-r--r--libgomp/testsuite/libgomp.c++/declare-mapper-2.C55
-rw-r--r--libgomp/testsuite/libgomp.c++/declare-mapper-3.C63
-rw-r--r--libgomp/testsuite/libgomp.c++/declare-mapper-4.C63
-rw-r--r--libgomp/testsuite/libgomp.c++/declare-mapper-5.C52
-rw-r--r--libgomp/testsuite/libgomp.c++/declare-mapper-6.C37
-rw-r--r--libgomp/testsuite/libgomp.c++/declare-mapper-7.C48
-rw-r--r--libgomp/testsuite/libgomp.c++/declare-mapper-8.C61
-rw-r--r--libgomp/testsuite/libgomp.c++/delim-declare-variant-1.C29
-rw-r--r--libgomp/testsuite/libgomp.c++/delim-declare-variant-2.C37
-rw-r--r--libgomp/testsuite/libgomp.c++/delim-declare-variant-7.C39
-rw-r--r--libgomp/testsuite/libgomp.c++/need-device-ptr.C175
-rw-r--r--libgomp/testsuite/libgomp.c++/target-cdtor-1.C104
-rw-r--r--libgomp/testsuite/libgomp.c++/target-cdtor-2.C140
-rw-r--r--libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-GCN.C6
-rw-r--r--libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-nvptx.C6
-rw-r--r--libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1.C6
-rw-r--r--libgomp/testsuite/libgomp.c++/target-exceptions-throw-1.C3
-rw-r--r--libgomp/testsuite/libgomp.c++/target-exceptions-throw-2.C3
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/alloc-pinned-1.c28
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/allocate-4.c (renamed from libgomp/testsuite/libgomp.c/allocate-4.c)3
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/allocate-5.c (renamed from libgomp/testsuite/libgomp.c/allocate-5.c)3
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/allocate-6.c (renamed from libgomp/testsuite/libgomp.c/allocate-6.c)3
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/array-shaping-14.c34
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/collapse-4.c23
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c60
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c59
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c87
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c55
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c57
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/declare-mapper-18.c33
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c62
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/delim-declare-variant-1.c45
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/dispatch-3.c35
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/for-17.c69
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/for-18.c5
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-1.c83
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-2.c81
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-3.c98
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-cdtor-1.c89
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-1.c47
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-2.c44
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-3.c56
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-4.c48
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-5.c59
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-1.c65
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-2.c58
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-3.c67
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-4.c66
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/uses_allocators-1.c53
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/uses_allocators-2.c39
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/uses_allocators-3.c37
-rw-r--r--libgomp/testsuite/libgomp.c-c++-common/uses_allocators-4.c53
-rw-r--r--libgomp/testsuite/libgomp.c/alloc-pinned-1.c26
-rw-r--r--libgomp/testsuite/libgomp.c/alloc-pinned-2.c26
-rw-r--r--libgomp/testsuite/libgomp.c/alloc-pinned-3.c45
-rw-r--r--libgomp/testsuite/libgomp.c/alloc-pinned-4.c44
-rw-r--r--libgomp/testsuite/libgomp.c/alloc-pinned-5.c26
-rw-r--r--libgomp/testsuite/libgomp.c/alloc-pinned-6.c34
-rw-r--r--libgomp/testsuite/libgomp.c/alloc-pinned-7.c63
-rw-r--r--libgomp/testsuite/libgomp.c/alloc-pinned-8.c122
-rw-r--r--libgomp/testsuite/libgomp.c/array-shaping-1.c236
-rw-r--r--libgomp/testsuite/libgomp.c/array-shaping-2.c39
-rw-r--r--libgomp/testsuite/libgomp.c/array-shaping-3.c42
-rw-r--r--libgomp/testsuite/libgomp.c/array-shaping-4.c36
-rw-r--r--libgomp/testsuite/libgomp.c/array-shaping-5.c38
-rw-r--r--libgomp/testsuite/libgomp.c/array-shaping-6.c45
-rw-r--r--libgomp/testsuite/libgomp.c/c.exp8
-rw-r--r--libgomp/testsuite/libgomp.c/reverse-offload-threads-1.c26
-rw-r--r--libgomp/testsuite/libgomp.c/reverse-offload-threads-2.c31
-rw-r--r--libgomp/testsuite/libgomp.fortran/adjust-args-array-descriptor.f9089
-rw-r--r--libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f9061
-rw-r--r--libgomp/testsuite/libgomp.fortran/collapse5.f9023
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-10.f9040
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-11.f9038
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-12.f9033
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-13.f9049
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-15.f9024
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-17.f9092
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-18.f9046
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-19.f9029
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-2.f9032
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-20.f9029
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-21.f9024
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-25.f9044
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-28.f9038
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-3.f9033
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-30.f9024
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-4.f9040
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-6.f9028
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-7.f9029
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90115
-rw-r--r--libgomp/testsuite/libgomp.fortran/declare-mapper-9.f9027
-rw-r--r--libgomp/testsuite/libgomp.fortran/mapper-iterators-1.f9038
-rw-r--r--libgomp/testsuite/libgomp.fortran/mapper-iterators-2.f9049
-rw-r--r--libgomp/testsuite/libgomp.fortran/mapper-iterators-3.f9033
-rw-r--r--libgomp/testsuite/libgomp.fortran/mapper-iterators-4.f9052
-rw-r--r--libgomp/testsuite/libgomp.fortran/need-device-ptr.f90132
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-1.f9054
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-10.f9029
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-11.f9051
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-12.f9059
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-13.f9042
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-2.f90101
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-3.f9047
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-4.f9078
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-5.f9055
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-6.f9034
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-7.f9036
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-8.f9039
-rw-r--r--libgomp/testsuite/libgomp.fortran/noncontig-updates-9.f9034
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-13.f9013
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-enter-data-3a.f90567
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f9045
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f9045
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f9056
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-map-iterators-4.f9048
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-map-iterators-5.f9061
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-update-iterators-1.f9068
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-update-iterators-2.f9063
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-update-iterators-3.f9078
-rw-r--r--libgomp/testsuite/libgomp.fortran/target-update-iterators-4.f9070
-rw-r--r--libgomp/testsuite/libgomp.fortran/uses_allocators_2.f9022
-rw-r--r--libgomp/testsuite/libgomp.fortran/uses_allocators_3.f9062
-rw-r--r--libgomp/testsuite/libgomp.fortran/uses_allocators_4.f9054
-rw-r--r--libgomp/testsuite/libgomp.fortran/uses_allocators_5.f9014
-rw-r--r--libgomp/testsuite/libgomp.fortran/uses_allocators_6.f9050
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/exceptions-bad_cast-3.C2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-1.C3
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-2.C3
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-3.C2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/firstprivate-int.C83
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/pr119692-1-1.C2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/pr119692-1-2.C2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/pr119692-1-3.C2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c++/privatized-ref-3.C8
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-dispatch-1.c2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-init-1.c2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-kernels-1.c19
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-parallel-1.c2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-valid_bytes-1.c2
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-version-1.c4
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/data-firstprivate-1.c6
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/firstprivate-int.c67
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/implicit-mapping-1.c25
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-69.c55
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-70.c79
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-72.c60
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-73.c64
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-74.c87
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-75.c81
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-76.c80
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-78.c83
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-79.c83
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-81.c102
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-82.c43
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/lib-93.c19
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/loop-auto-1.c20
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/loop-default-compile.c13
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/loop-gwv-1.c15
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-gwv-1.c17
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-wv-1.c16
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/loop-wv-1.c16
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-1.c103
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-2.c37
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-3.c45
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-4.c36
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-utils.h44
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/par-reduction-3.c29
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/pr70828-2.c34
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/pr70828.c27
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/privatize-reduction-1.c41
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/privatize-reduction-2.c23
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-1.c69
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-2.c115
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-3.c114
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-4.c115
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-5.c113
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-cplx-flt-2.c32
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-structs-1.c121
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/reduction.h52
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/routine-gwv-1.c17
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/routine-wv-1.c16
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/subr.h45
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/subr.ptx222
-rw-r--r--libgomp/testsuite/libgomp.oacc-c-c++-common/timer.h103
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/allocatable-scalar.f9033
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/data-3.f9012
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f9013
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-runtime.f9013
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f9012
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-2.f9048
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90219
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-4.f9066
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f9041
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90107
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1.f90405
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-create-1.f9022
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-create-2.f9026
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/declare-create-3.f9026
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90197
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/firstprivate-int.f90209
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-1.f9029
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-2.f9041
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/openacc_version-1.f2
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/openacc_version-2.f902
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/optional-private.f904
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f9012
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/parallel-reduction.f908
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/pr70643.f903
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/pr70828-2.f9031
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/pr70828-3.f9034
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/pr70828-4.f9031
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/pr70828-5.f9029
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/pr70828-6.f9028
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/pr70828.f9024
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/privatized-ref-1.f958
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-10.f90598
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-11.f90424
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-12.f90424
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-13.f90134
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-14.f9068
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-15.f9098
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-16.f9099
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f9018
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-7.f906
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reduction-9.f9054
-rw-r--r--libgomp/testsuite/libgomp.oacc-fortran/reference-reductions.f906
-rw-r--r--libgomp/usmpin-allocator.c319
612 files changed, 50353 insertions, 4374 deletions
diff --git a/contrib/ChangeLog.omp b/contrib/ChangeLog.omp
new file mode 100644
index 0000000..024f5ba
--- /dev/null
+++ b/contrib/ChangeLog.omp
@@ -0,0 +1,6 @@
+2025-05-15 Tobias Burnus <tburnus@baylibre.com>
+
+ * gcc-changelog/git_repository.py (parse_git_revisions): Optional
+ exclude_branch_name argument
+ * gcc-changelog/git_update_version.py: Add --suffix, --exclude-branch
+ and --last-commit to handle vendor branches. \ No newline at end of file
diff --git a/contrib/gcc-changelog/git_repository.py b/contrib/gcc-changelog/git_repository.py
index 2b2efff..dc658af 100755
--- a/contrib/gcc-changelog/git_repository.py
+++ b/contrib/gcc-changelog/git_repository.py
@@ -31,7 +31,8 @@ except ImportError:
from git_commit import GitCommit, GitInfo, decode_path
-def parse_git_revisions(repo_path, revisions, ref_name=None):
+def parse_git_revisions(repo_path, revisions, ref_name=None,
+ exclude_branch_name=None):
repo = Repo(repo_path)
def commit_to_info(commit):
@@ -67,6 +68,8 @@ def parse_git_revisions(repo_path, revisions, ref_name=None):
except ValueError:
return None
+ exclude_branch = (repo.commit(exclude_branch_name)
+ if exclude_branch_name is not None else None)
parsed_commits = []
if '..' in revisions:
commits = list(repo.iter_commits(revisions))
@@ -74,6 +77,8 @@ def parse_git_revisions(repo_path, revisions, ref_name=None):
commits = [repo.commit(revisions)]
for commit in commits:
+ if exclude_branch is not None and repo.is_ancestor(commit, exclude_branch):
+ continue
git_commit = GitCommit(commit_to_info(commit.hexsha),
commit_to_info_hook=commit_to_info,
ref_name=ref_name)
diff --git a/contrib/gcc-changelog/git_update_version.py b/contrib/gcc-changelog/git_update_version.py
index 8e36c74..ec5951c 100755
--- a/contrib/gcc-changelog/git_update_version.py
+++ b/contrib/gcc-changelog/git_update_version.py
@@ -23,6 +23,8 @@ import datetime
import logging
import os
import re
+import shutil
+import sys
from git import Repo
@@ -62,14 +64,14 @@ def read_timestamp(path):
return f.read()
-def prepend_to_changelog_files(repo, folder, git_commit, add_to_git):
+def prepend_to_changelog_files(repo, folder, git_commit, add_to_git, suffix):
if not git_commit.success:
logging.info(f"While processing {git_commit.info.hexsha}:")
for error in git_commit.errors:
logging.info(error)
raise AssertionError()
for entry, output in git_commit.to_changelog_entries(use_commit_ts=True):
- full_path = os.path.join(folder, entry, 'ChangeLog')
+ full_path = os.path.join(folder, entry, 'ChangeLog' + suffix)
logging.info('writing to %s' % full_path)
if os.path.exists(full_path):
with open(full_path) as f:
@@ -89,7 +91,10 @@ active_refs = ['master',
'releases/gcc-12', 'releases/gcc-13', 'releases/gcc-14']
parser = argparse.ArgumentParser(description='Update DATESTAMP and generate '
- 'ChangeLog entries')
+ 'ChangeLog entries',
+ epilog='For vendor branches, only; e.g: -s .suffix '
+ '-x releases/gcc-15 -l '
+ '`git log -1 --pretty=format:%H --grep "Vendor Bump"`')
parser.add_argument('-g', '--git-path', default='.',
help='Path to git repository')
parser.add_argument('-p', '--push', action='store_true',
@@ -102,18 +107,31 @@ parser.add_argument('-c', '--current', action='store_true',
help='Modify current branch (--push argument is ignored)')
parser.add_argument('-i', '--ignore', action='append',
help='list of commits to ignore')
+# Useful only for vendor branches
+parser.add_argument('-s', '--suffix', default="",
+ help='suffix for the ChangeLog and DATESTAMP files')
+parser.add_argument('-l', '--last-commit',
+ help='hash of the last DATESTAMP commit')
+parser.add_argument('-x', '--exclude-branch',
+ help='commits to be ignored if in this branch')
args = parser.parse_args()
repo = Repo(args.git_path)
origin = repo.remotes['origin']
-def update_current_branch(ref_name=None):
+def update_current_branch(ref_name=None, suffix="", last_commit_ref=None,
+ exclude_branch=None):
commit = repo.head.commit
commit_count = 1
+ last_commit = (repo.commit(last_commit_ref)
+ if last_commit_ref is not None else None)
while commit:
- if (commit.author.email == 'gccadmin@gcc.gnu.org'
- and commit.message.strip() == 'Daily bump.'):
+ if last_commit is not None:
+ if last_commit == commit:
+ break
+ elif (commit.author.email == 'gccadmin@gcc.gnu.org'
+ and commit.message.strip() == 'Daily bump.'):
break
# We support merge commits but only with 2 parensts
assert len(commit.parents) <= 2
@@ -122,6 +140,12 @@ def update_current_branch(ref_name=None):
logging.info('%d revisions since last Daily bump' % commit_count)
datestamp_path = os.path.join(args.git_path, 'gcc/DATESTAMP')
+ if suffix != "":
+ if not os.path.exists(datestamp_path + suffix):
+ logging.info('Create DATESTAMP%s by copying DATESTAMP' % suffix)
+ shutil.copyfile(datestamp_path, datestamp_path + suffix)
+ datestamp_path += suffix
+
if (read_timestamp(datestamp_path) != current_timestamp
or args.dry_mode or args.current):
head = repo.head.commit
@@ -131,11 +155,12 @@ def update_current_branch(ref_name=None):
if len(head.parents) == 2:
head = head.parents[1]
commits = parse_git_revisions(args.git_path, '%s..%s'
- % (commit.hexsha, head.hexsha), ref_name)
+ % (commit.hexsha, head.hexsha), ref_name,
+ exclude_branch)
commits = [c for c in commits if c.info.hexsha not in ignored_commits]
for git_commit in reversed(commits):
prepend_to_changelog_files(repo, args.git_path, git_commit,
- not args.dry_mode)
+ not args.dry_mode, args.suffix)
if args.dry_mode:
diff = repo.git.diff('HEAD')
patch = os.path.join(args.dry_mode,
@@ -168,8 +193,17 @@ if args.ignore is not None:
if args.current:
logging.info('=== Working on the current branch ===')
- update_current_branch()
+ if args.suffix != "" and args.last_commit is None:
+ logging.error('--suffix requires --last-commit')
+ sys.exit(1)
+ update_current_branch(None, args.suffix, args.last_commit,
+ args.exclude_branch)
else:
+ if args.suffix != "" or args.last_commit is not None \
+ or update_current_branch is not None:
+ logging.error('--suffix, --last-commit and --exclude-branch '
+ 'require --current')
+ sys.exit(1)
for ref in origin.refs:
assert ref.name.startswith('origin/')
name = ref.name[len('origin/'):]
@@ -182,7 +216,7 @@ else:
branch.checkout()
origin.pull(rebase=True)
logging.info('branch pulled and checked out')
- update_current_branch(name)
+ update_current_branch(name, args.suffix)
assert not repo.index.diff(None)
logging.info('branch is done')
logging.info('')
diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
new file mode 100644
index 0000000..d522b49
--- /dev/null
+++ b/gcc/ChangeLog.omp
@@ -0,0 +1,845 @@
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ * gimplify.cc (modify_call_for_omp_dispatch): Rework logic for
+ need_device_ptr and need_device_addr adjustments.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+
+ PR c++/119659
+ PR c++/118859
+ PR c++/119601
+ PR c++/119602
+ PR c++/119775
+ * gimplify.cc (modify_call_for_omp_dispatch): Refactor and change
+ attribute unpacking. For adjust_args variadic functions, expand
+ numeric ranges with relative bounds. Refactor argument adjustment.
+
+2025-05-15 Andrew Pinski <quic_apinski@quicinc.com>
+
+ Backported from master:
+ 2025-04-25 Andrew Pinski <quic_apinski@quicinc.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+
+ PR target/119737
+ * config/gcn/gcn.cc (gcn_hsa_declare_function_name): Properly
+ switch sections.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * langhooks-def.h (lhd_omp_deep_mapping): Add new argument.
+ * langhooks.cc (lhd_omp_deep_mapping): Likewise.
+ * langhooks.h (omp_deep_mapping): Likewise.
+ * omp-low.cc (allocate_omp_iterator_elems): Work on the supplied
+ iterator set instead of the iterators in a supplied set of clauses.
+ (free_omp_iterator_elems): Likewise.
+ (lower_omp_target): Maintain vector of new iterators generated by
+ deep-mapping. Allocate and free iterator element arrays using
+ iterators found in clauses and in the new iterator vector.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gimplify.cc (enter_omp_iterator_loop_context): New function variant.
+ (enter_omp_iterator_loop_context): Delegate to new variant.
+ (exit_omp_iterator_loop_context): New function variant.
+ (exit_omp_iterator_loop_context): Delegate to new variant.
+ (assign_to_iterator_elems_array): New.
+ (add_new_omp_iterators_entry): New.
+ (add_new_omp_iterators_clause): Delegate to
+ add_new_omp_iterators_entry.
+ * gimplify.h (enter_omp_iterator_loop_context): New prototype.
+ (enter_omp_iterator_loop_context): Remove default argument.
+ (exit_omp_iterator_loop_context): Remove argument.
+ (assign_to_iterator_elems_array): New prototype.
+ (add_new_omp_iterators_entry): New prototype.
+ (add_new_omp_iterators_clause): New prototype.
+ * langhooks-def.h (lhd_omp_deep_mapping_cnt): Remove const from
+ argument.
+ (lhd_omp_deep_mapping): Likewise.
+ * langhooks.cc (lhd_omp_deep_mapping_cnt): Likewise.
+ (lhd_omp_deep_mapping): Likewise.
+ * langhooks.h (omp_deep_mapping_cnt): Likewise.
+ (omp_deep_mapping): Likewise.
+ * omp-low.cc (lower_omp_map_iterator_expr): Delegate to
+ assign_to_iterator_elems_array.
+ (lower_omp_map_iterator_size): Likewise.
+ (lower_omp_target): Remove sorry for deep mapping.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gimplify.cc (add_new_omp_iterators_clause): New.
+ (build_omp_struct_comp_nodes): Add extra argument for loops sequence.
+ Call add_new_omp_iterators_clause on newly generated clauses.
+ (omp_accumulate_sibling_list): Add extra argument for loops sequence.
+ Pass to calls to build_omp_struct_comp_nodes. Add iterators to newly
+ generator clauses for struct accesses.
+ (omp_build_struct_sibling_lists): Add extra argument for loops
+ sequence. Pass to call to omp_accumulate_sibling_list.
+ (gimplify_adjust_omp_clauses): Pass loops sequence to
+ omp_build_struct_sibling_lists.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gimplify.cc (gimplify_omp_affinity): Use macros for accessing
+ iterator elements.
+ (compute_omp_iterator_count): Likewise.
+ (build_omp_iterator_loop): Likewise.
+ (remove_unused_omp_iterator_vars): Likewise.
+ (build_omp_iterators_loops): Likewise.
+ (enter_omp_iterator_loop_context_1): Likewise.
+ (extract_base_bit_offset): Likewise.
+ * omp-low.cc (lower_omp_map_iterator_expr): Likewise.
+ (lower_omp_map_iterator_size): Likewise.
+ (allocate_omp_iterator_elems): Likewise.
+ (free_omp_iterator_elems): Likewise.
+ * tree-inline.cc (copy_tree_body_r): Likewise.
+ * tree-pretty-print.cc (dump_omp_iterators): Likewise.
+ * tree.h (OMP_ITERATORS_VAR, OMP_ITERATORS_BEGIN, OMP_ITERATORS_END,
+ OMP_ITERATORS_STEP, OMP_ITERATORS_ORIG_STEP, OMP_ITERATORS_BLOCK,
+ OMP_ITERATORS_LABEL, OMP_ITERATORS_INDEX, OMP_ITERATORS_ELEMS,
+ OMP_ITERATORS_COUNT, OMP_ITERATORS_EXPANDED_P): New macros.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gimplify.cc (omp_iterator_elems_length): New.
+ (build_omp_iterators_loops): Change type of elements
+ array to pointer of pointers if array length is non-constant, and
+ assign size with indirect reference. Reorder elements added to
+ iterator vector and add element containing the iteration count. Use
+ omp_iterator_elems_length to compute element array size required.
+ * gimplify.h (omp_iterator_elems_length): New prototype.
+ * omp-low.cc (lower_omp_map_iterator_expr): Reorder elements read
+ from iterator vector. If elements field is a pointer type, assign
+ using pointer arithmetic followed by indirect reference, and return
+ the field directly.
+ (lower_omp_map_iterator_size): Reorder elements read from iterator
+ vector. If elements field is a pointer type, assign using pointer
+ arithmetic followed by indirect reference.
+ (allocate_omp_iterator_elems): New.
+ (free_omp_iterator_elems): New.
+ (lower_omp_target): Call allocate_omp_iterator_elems before inserting
+ loops sequence, and call free_omp_iterator_elems afterwards.
+ * tree-pretty-print.cc (dump_omp_iterators): Print extra elements in
+ iterator vector.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * gimplify.cc (compute_omp_iterator_count): Account for difference
+ in loop boundaries in Fortran.
+ (build_omp_iterator_loop): Change upper boundary condition for
+ Fortran. Insert block statements into innermost loop.
+ (remove_unused_omp_iterator_vars): Copy block subblocks of old
+ iterator to new iterator and remove original.
+ (contains_vars_1): New.
+ (contains_vars): New.
+ (extract_base_bit_offset): Add iterator argument. Remove iterator
+ variables from base. Do not set variable_offset if the offset
+ does not contain any remaining variables.
+ (omp_accumulate_sibling_list): Add iterator argument to
+ extract_base_bit_offset.
+ * tree-pretty-print.cc (dump_block_node): Ignore BLOCK_SUBBLOCKS
+ containing iterator block statements.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gimplify.cc (gimplify_scan_omp_clauses): Add argument for iterator
+ loop sequence. Gimplify the clause decl and size into the iterator
+ loop if iterators are used.
+ (gimplify_omp_workshare): Add argument for iterator loops sequence
+ in call to gimplify_scan_omp_clauses.
+ (gimplify_omp_target_update): Call remove_unused_omp_iterator_vars and
+ build_omp_iterators_loops. Add loop sequence as argument when calling
+ gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses and building
+ the Gimple statement.
+ * tree-pretty-print.cc (dump_omp_clause): Call dump_omp_iterators
+ for to/from clauses with iterators.
+ * tree.cc (omp_clause_num_ops): Add extra operand for OMP_CLAUSE_FROM
+ and OMP_CLAUSE_TO.
+ * tree.h (OMP_CLAUSE_HAS_ITERATORS): Add check for OMP_CLAUSE_TO and
+ OMP_CLAUSE_FROM.
+ (OMP_CLAUSE_ITERATORS): Likewise.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * gimple-pretty-print.cc (dump_gimple_omp_target): Print expanded
+ iterator loops.
+ * gimple.cc (gimple_build_omp_target): Add argument for iterator
+ loops sequence. Initialize iterator loops field.
+ * gimple.def (GIMPLE_OMP_TARGET): Set GSS symbol to GSS_OMP_TARGET.
+ * gimple.h (gomp_target): Set GSS symbol to GSS_OMP_TARGET. Add extra
+ field for iterator loops.
+ (gimple_build_omp_target): Add argument for iterator loops sequence.
+ (gimple_omp_target_iterator_loops): New.
+ (gimple_omp_target_iterator_loops_ptr): New.
+ (gimple_omp_target_set_iterator_loops): New.
+ * gimplify.cc (find_var_decl): New.
+ (copy_omp_iterator): New.
+ (remap_omp_iterator_var_1): New.
+ (remap_omp_iterator_var): New.
+ (remove_unused_omp_iterator_vars): New.
+ (struct iterator_loop_info_t): New type.
+ (iterator_loop_info_map_t): New type.
+ (build_omp_iterators_loops): New.
+ (enter_omp_iterator_loop_context_1): New.
+ (enter_omp_iterator_loop_context): New.
+ (enter_omp_iterator_loop_context): New.
+ (exit_omp_iterator_loop_context): New.
+ (gimplify_adjust_omp_clauses): Add argument for iterator loop
+ sequence. Gimplify the clause decl and size into the iterator
+ loop if iterators are used.
+ (gimplify_omp_workshare): Call remove_unused_omp_iterator_vars and
+ build_omp_iterators_loops for OpenMP target expressions. Add
+ loop sequence as argument when calling gimplify_adjust_omp_clauses
+ and building the Gimple statement.
+ * gimplify.h (enter_omp_iterator_loop_context): New prototype.
+ (exit_omp_iterator_loop_context): New prototype.
+ * gsstruct.def (GSS_OMP_TARGET): New.
+ * omp-low.cc (lower_omp_map_iterator_expr): New.
+ (lower_omp_map_iterator_size): New.
+ (finish_omp_map_iterators): New.
+ (lower_omp_target): Add sorry if iterators used with deep mapping.
+ Call lower_omp_map_iterator_expr before assigning to sender ref.
+ Call lower_omp_map_iterator_size before setting the size. Insert
+ iterator loop sequence before the statements for the target clause.
+ * tree-nested.cc (convert_nonlocal_reference_stmt): Walk the iterator
+ loop sequence of OpenMP target statements.
+ (convert_local_reference_stmt): Likewise.
+ (convert_tramp_reference_stmt): Likewise.
+ * tree-pretty-print.cc (dump_omp_iterators): Dump extra iterator
+ information if present.
+ (dump_omp_clause): Call dump_omp_iterators for iterators in map
+ clauses.
+ * tree.cc (omp_clause_num_ops): Add operand for OMP_CLAUSE_MAP.
+ (walk_tree_1): Do not walk last operand of OMP_CLAUSE_MAP.
+ * tree.h (OMP_CLAUSE_HAS_ITERATORS): New.
+ (OMP_CLAUSE_ITERATORS): New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gimplify.cc (gimplify_omp_affinity): Use OMP_ITERATOR_DECL_P.
+ (compute_omp_iterator_count): New.
+ (build_omp_iterator_loop): New.
+ (gimplify_omp_depend): Use OMP_ITERATOR_DECL_P,
+ compute_omp_iterator_count and build_omp_iterator_loop.
+ * tree-inline.cc (copy_tree_body_r): Use OMP_ITERATOR_DECL_P.
+ * tree-pretty-print.cc (dump_omp_clause): Likewise.
+ * tree.h (OMP_ITERATOR_DECL_P): New macro.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * doc/extend.texi: Adjust version references to 2.7 from 2.6.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * config/gcn/gcn-tree.cc (gcn_goacc_reduction_setup): Fix array case
+ copy source into reduction buffer.
+ * config/nvptx/nvptx.cc (nvptx_expand_shared_addr): Move default size
+ init setting place.
+ (enum nvptx_builtins): Add NVPTX_BUILTIN_BAR_WARPSYNC.
+ (nvptx_init_builtins): Add DEF() of nvptx_builtin_bar_warpsync.
+ (nvptx_expand_builtin): Expand NVPTX_BUILTIN_BAR_WARPSYNC.
+ (nvptx_goacc_reduction_setup): Fix array case copy source into reduction
+ buffer.
+ (nvptx_goacc_reduction_fini): Add bar.warpsync for at end of vector-mode
+ reductions for sm_70 and above.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * config/gcn/gcn-tree.cc (#include "omp-offload.h"): Add include.
+ (#include "memmodel.h"): Add include.
+ (gcn_array_reduction_buffers): New vec<tree>
+ for holding DECLs for reduction buffer pointer variables.
+ (gcn_lockfull_update): Add pointer type fold_converts.
+ (gcn_reduction_update): Additions for handling ARRAY_TYPE, pointer to
+ ARRAY_TYPE, and RECORD_TYPE reductions.
+ (gcn_goacc_get_worker_red_decl): Adjust parameters to handle
+ non-constant offset case.
+ (gcn_goacc_get_worker_array_reduction_buffer): New function.
+ (gcn_create_if_else_seq): New function.
+ (gcn_create_do_while_loop_seq): New function.
+ (gcn_goacc_reduction_setup): Adjustments to handle arrays and records.
+ (gcn_goacc_reduction_init): Likewise.
+ (gcn_goacc_reduction_fini): Likewise.
+ (gcn_goacc_reduction_teardown): Likewise.
+ * config/nvptx/nvptx.cc (nvptx_gen_shuffle): Properly generate
+ V2SI shuffle using vec_extract op.
+ (nvptx_expand_shared_addr): Adjustments to handle non-constant size.
+ (nvptx_get_shared_red_addr): Adjust type/alignment calculations to
+ use TYPE_SIZE/ALIGN_UNIT instead of machine mode based.
+ (nvptx_get_shared_red_addr): New function with array_max_idx parameter.
+ (nvptx_reduction_update): Additions for handling ARRAY_TYPE, pointer to
+ ARRA_TYPE, and RECORD_TYPE reductions.
+ (nvptx_goacc_reduction_setup): Likewise.
+ (nvptx_goacc_reduction_init): Likewise.
+ (nvptx_goacc_reduction_fini): Likewise.
+ (nvptx_goacc_reduction_teardown): Likewise.
+ * gimplify.cc (gimplify_scan_omp_clauses): Gimplify inside COMPONENT_REF
+ and convert codes for OMP_CLAUSE_REDUCTION cases. Add DECL_P check for
+ do_add/do_add_decl goto case.
+ (gimplify_adjust_omp_clauses): Avoid GOMP_MAP_POINTER OMP_CLAUSE_SIZE
+ handling for OpenACC kernels. Call omp_add_variable for ARRAY_REF index.
+ Peel away array MEM_REF for decl lookup.
+ * omp-low.cc (struct omp_context):
+ Add 'hash_map<tree, tree> *block_vars_map' field.
+ (omp_copy_decl_2): Create/lookup using ctx->block_vars_map first. Add
+ new copy into ctx->block_vars_map.
+ (install_var_field): Add 'bool field_may_exist = false' parameter.
+ Adjust lookup assertions.
+ (delete_omp_context): Add delete of ctx->block_vars_map.
+ (scan_sharing_clauses): Adjust calls to install_var_field. Adjust
+ ARRAY_REF pointer type building to use decl type, rather than generic
+ ptr_type_node. For ARRAY_REFs on offloaded constructs, also add base
+ expression as field lookup key.
+ (omp_reduction_init_op): Add ARRAY_TYPE and RECORD_TYPE init op
+ construction.
+ (oacc_array_reduction_bias): New function.
+ (lower_oacc_reductions): Add array reduction handling code. Arrays use
+ a different mode of IFN parameters, using additional 'array_addr' and
+ 'array_max_idx' arguments. The LHS var is a simple integer for
+ dependency ordering.
+ (lower_omp_target): Adjust 'offload' condition for GOMP_MAP_POINTER
+ case. Generate BUILT_IN_ALLOCA_WITH_ALIGN to create private copy
+ for reductions of non-constant size types.
+ * omp-oacc-neuter-broadcast.cc (worker_single_copy):
+ Add 'hash_set<tree> *array_reduction_base_vars' parameter. Avoid
+ propagation for SSA_NAMEs used for array reduction accesses.
+ (neuter_worker_single): Add 'hash_set<tree> *array_reduction_base_vars'
+ parameter. Adjust recursive calls to self and worker_single_copy.
+ (oacc_do_neutering): Add 'hash_set<tree> *array_reduction_base_vars'
+ parameter. Adjust call to neuter_worker_single.
+ (execute_omp_oacc_neuter_broadcast): Add local
+ 'hash_set<tree> array_reduction_base_vars' declaration. Collect MEM_REF
+ base-pointer SSA_NAMEs of arrays into array_reduction_base_vars. Add
+ '&array_reduction_base_vars' argument to call of oacc_do_neutering.
+ * omp-offload.cc (#include "cfghooks.h"): Add include.
+ (oacc_build_array_copy): New function.
+ (oacc_build_array_copy_loop): New function.
+ (oacc_build_indexed_ssa_loop): New function.
+ (default_goacc_reduction): Adjustments to handle arrays.
+ * omp-offload.h (oacc_build_array_copy): New declaration.
+ (oacc_build_array_copy_loop): New declaration.
+ (oacc_build_indexed_ssa_loop): New declaration.
+ * tree-loop-distribution.cc (generate_memset_builtin): Under OpenACC,
+ when last stmt of pre-header block is a UNIQUE(OACC_FORK) internal-fn,
+ split a new basic block to serve as place of insertion, otherwise
+ may fail later checking because UNIQUE(OACC_FORK) counts as control
+ flow stmt.
+ (generate_memcpy_builtin): Likewise.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+
+ * omp-general.cc (omp_context_selector_matches): Add an optional
+ bool argument for the code elision case.
+ * omp-general.h (omp_context_selector_matches): Likewise.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+
+ * omp-general.cc (omp_mangle_variant_name): New.
+ (omp_check_for_duplicate_variant): New.
+ (omp_copy_trait_set): New.
+ (omp_trait_selectors_equivalent): New.
+ (omp_combine_trait_sets): New.
+ (omp_merge_context_selectors): New.
+ * omp-general.h (omp_mangle_variant_name): Declare.
+ (omp_check_for_duplicate_variant): Declare.
+ (omp_merge_context_selectors): Declare.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * gimple-expr.cc (copy_var_decl): Copy VAR_POINTS_TO_READONLY
+ for VAR_DECLs.
+ * omp-low.cc (lower_omp_target): Set VAR_POINTS_TO_READONLY for
+ variables of receiver refs.
+ * tree-pretty-print.cc (dump_omp_clause):
+ Print OMP_CLAUSE_MAP_POINTS_TO_READONLY.
+ (dump_generic_node): Print SSA_NAME_POINTS_TO_READONLY_MEMORY.
+ * tree-ssanames.cc (make_ssa_name_fn): Set
+ SSA_NAME_POINTS_TO_READONLY_MEMORY if DECL_POINTS_TO_READONLY is set.
+ * tree.h (OMP_CLAUSE_MAP_POINTS_TO_READONLY): New macro.
+ (VAR_POINTS_TO_READONLY): New macro.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+ Tobias Burnus <tobias@codesourcery.com>
+
+ * cgraphunit.cc (varpool_node::finalize_decl): Add assert.
+ * gimplify.cc (gimplify_bind_expr): Handle C++ specific
+ implementation details.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * gimplify.cc (gimplify_adjust_omp_clauses): Don't gimplify
+ VIEW_CONVERT_EXPR away in GOMP_MAP_TO_GRID/GOMP_MAP_FROM_GRID clauses.
+ * omp-low.cc (omp_noncontig_descriptor_type): Add SPAN field.
+ (scan_sharing_clauses): Don't store descriptor size in its
+ OMP_CLAUSE_SIZE field.
+ (lower_omp_target): Add missing OMP_CLAUSE_MAP check. Add special-case
+ string handling. Handle span and bias. Use low bound instead of zero
+ as index for trailing full dimensions.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gimplify.cc (omp_group_last, omp_group_base): Add GOMP_MAP_TO_GRID,
+ GOMP_MAP_FROM_GRID support.
+ (gimplify_adjust_omp_clauses): Support new GOMP_MAP_GRID_DIM,
+ GOMP_MAP_GRID_STRIDE mapping nodes. Don't crash on e.g. misuse of
+ ADDR_EXPR in mapping clauses.
+ * omp-general.cc (omp_parse_noncontiguous_array): New function.
+ (omp_parse_access_method): Add noncontiguous array support.
+ (omp_parse_structure_base): Add array-shaping support.
+ (debug_omp_tokenized_addr): Add ACCESS_NONCONTIG_ARRAY,
+ ACCESS_NONCONTIG_REF_TO_ARRAY token support.
+ * omp-general.h (access_method_kinds): Add ACCESS_NONCONTIG_ARRAY and
+ ACCESS_NONCONTIG_REF_TO_ARRAY access kinds.
+ * omp-low.cc (omp_noncontig_descriptor_type): New function.
+ (scan_sharing_clauses): Support noncontiguous array updates.
+ (lower_omp_target): Likewise.
+ * tree-pretty-print.cc (dump_omp_clause): Add GOMP_MAP_TO_GRID,
+ GOMP_MAP_FROM_GRID, GOMP_MAP_GRID_DIM, GOMP_MAP_GRID_STRIDE map kinds.
+ (dump_generic_node): Add stride support for OMP_ARRAY_SECTION.
+ * tree.def (OMP_ARRAY_SECTION): Add stride argument.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gimplify.cc (dwarf2out.h): Include.
+ (omp_maybe_get_descriptor_from_ptr): New function.
+ (build_omp_struct_comp_nodes): Use above function to locate array
+ descriptor when necessary.
+ (omp_mapping_group_data, omp_mapping_group_ptr,
+ omp_mapping_group_pset): New functions.
+ (omp_instantiate_mapper): Handle inlining of "declare mapper" function
+ bodies containing setup code (e.g. for Fortran). Handle pointers to
+ derived types. Handle GOMP_MAP_MAPPING_GROUPs.
+ * tree-pretty-print.cc (dump_omp_clause): Handle
+ GOMP_MAP_MAPPING_GROUP.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gimplify.cc (gimplify_omp_ctx): Add IMPLICIT_MAPPERS field.
+ (new_omp_context): Initialise IMPLICIT_MAPPERS hash map.
+ (delete_omp_context): Delete IMPLICIT_MAPPERS hash map.
+ (instantiate_mapper_info): New structs.
+ (remap_mapper_decl_1, omp_mapper_copy_decl, omp_instantiate_mapper,
+ omp_instantiate_implicit_mappers): New functions.
+ (gimplify_scan_omp_clauses): Handle MAPPER_BINDING clauses.
+ (gimplify_adjust_omp_clauses): Instantiate implicit declared mappers.
+ (gimplify_omp_declare_mapper): New function.
+ (gimplify_expr): Call above function.
+ * langhooks-def.h (lhd_omp_finish_mapper_clauses,
+ lhd_omp_mapper_lookup, lhd_omp_extract_mapper_directive,
+ lhd_omp_map_array_section): Add prototypes.
+ (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES,
+ LANG_HOOKS_OMP_MAPPER_LOOKUP, LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE,
+ LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define macros.
+ (LANG_HOOK_DECLS): Add above macros.
+ * langhooks.cc (lhd_omp_finish_mapper_clauses,
+ lhd_omp_mapper_lookup, lhd_omp_extract_mapper_directive,
+ lhd_omp_map_array_section): New dummy functions.
+ * langhooks.h (lang_hooks_for_decls): Add OMP_FINISH_MAPPER_CLAUSES,
+ OMP_MAPPER_LOOKUP, OMP_EXTRACT_MAPPER_DIRECTIVE, OMP_MAP_ARRAY_SECTION
+ hooks.
+ * omp-general.h (omp_name_type<T>): Add templatized struct, hash type
+ traits (for omp_name_type<tree> specialization).
+ (omp_mapper_list<T>): Add struct.
+ * tree-core.h (omp_clause_code): Add OMP_CLAUSE__MAPPER_BINDING_.
+ * tree-pretty-print.cc (dump_omp_clause): Support GOMP_MAP_UNSET,
+ GOMP_MAP_PUSH_MAPPER_NAME, GOMP_MAP_POP_MAPPER_NAME artificial mapping
+ clauses. Support OMP_CLAUSE__MAPPER_BINDING_ and OMP_DECLARE_MAPPER.
+ * tree.cc (omp_clause_num_ops, omp_clause_code_name): Add
+ OMP_CLAUSE__MAPPER_BINDING_.
+ * tree.def (OMP_DECLARE_MAPPER): New tree code.
+ * tree.h (OMP_DECLARE_MAPPER_ID, OMP_DECLARE_MAPPER_DECL,
+ OMP_DECLARE_MAPPER_CLAUSES): New defines.
+ (OMP_CLAUSE__MAPPER_BINDING__ID, OMP_CLAUSE__MAPPER_BINDING__DECL,
+ OMP_CLAUSE__MAPPER_BINDING__MAPPER): New defines.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * gimplify.cc (gimplify_adjust_omp_clauses_1): Set
+ OMP_CLAUSE_MAP_RUNTIME_IMPLICIT_P for OpenACC also.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+ Sandra Loosemore <sandra@baylibre.com>
+
+ * gimplify.cc (gimplify_adjust_omp_clauses_1): Handle "oacc declare
+ create" attribute.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gimplify.cc (omp_tsort_mark, omp_mapping_group): Move before
+ gimplify_omp_ctx. Add constructor to omp_mapping_group.
+ (gimplify_omp_ctx): Add DECL_DATA_CLAUSE field.
+ (new_omp_context, delete_omp_context): Initialise and free above field.
+ (omp_gather_mapping_groups_1): Use constructor for omp_mapping_group.
+ (gimplify_scan_omp_clauses): Record mappings that might be lexically
+ inherited. Don't remove
+ GOMP_MAP_FIRSTPRIVATE_POINTER/GOMP_MAP_FIRSTPRIVATE_REFERENCE yet.
+ (gomp_oacc_needs_data_present): New function.
+ (gimplify_adjust_omp_clauses_1): Implement lexical inheritance
+ behaviour for OpenACC.
+ (gimplify_adjust_omp_clauses): Remove
+ GOMP_MAP_FIRSTPRIVATE_POINTER/GOMP_MAP_FIRSTPRIVATE_REFERENCE here
+ instead, after lexical inheritance is done.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+
+ Backported from master:
+ 2023-05-19 Chung-Lin Tang <cltang@codesourcery.com>
+
+ * builtins.cc (expand_builtin_omp_builtins): New function.
+ (expand_builtin): Add expand cases for BUILT_IN_GOMP_BARRIER,
+ BUILT_IN_OMP_GET_THREAD_NUM, BUILT_IN_OMP_GET_NUM_THREADS,
+ BUILT_IN_OMP_GET_TEAM_NUM, and BUILT_IN_OMP_GET_NUM_TEAMS using
+ expand_builtin_omp_builtins, enabled under -fopenmp-target=acc.
+ * cgraphunit.cc (analyze_functions): Add call to
+ omp_ompacc_attribute_tagging, enabled under -fopenmp-target=acc.
+ * common.opt (fopenmp-target=): Add new option and enums.
+ * config/nvptx/mkoffload.cc (main): Handle -fopenmp-target=.
+ * config/nvptx/nvptx-protos.h (nvptx_expand_omp_get_num_threads): New
+ prototype.
+ (nvptx_mem_shared_p): Likewise.
+ * config/nvptx/nvptx.cc (omp_num_threads_sym): New global static RTX
+ symbol for number of threads in team.
+ (omp_num_threads_align): New var for alignment of omp_num_threads_sym.
+ (need_omp_num_threads): New bool for if any function references
+ omp_num_threads_sym.
+ (nvptx_option_override): Initialize omp_num_threads_sym/align.
+ (write_as_kernel): Disable normal OpenMP kernel entry under OMPACC mode.
+ (nvptx_declare_function_name): Disable shim function under OMPACC mode.
+ Disable soft-stack under OMPACC mode. Add generation of neutering init
+ code under OMPACC mode.
+ (nvptx_output_set_softstack): Return "" under OMPACC mode.
+ (nvptx_expand_call): Set parallelism to vector for function calls with
+ "ompacc for" attached.
+ (nvptx_expand_oacc_fork): Set mode to GOMP_DIM_VECTOR under OMPACC mode.
+ (nvptx_expand_oacc_join): Likewise.
+ (nvptx_expand_omp_get_num_threads): New function.
+ (nvptx_mem_shared_p): New function.
+ (nvptx_mach_max_workers): Return 1 under OMPACC mode.
+ (nvptx_mach_vector_length): Return 32 under OMPACC mode.
+ (nvptx_single): Add adjustments for OMPACC mode, which have
+ parallel-construct fork/joins, and regions of code where neutering is
+ dynamically determined.
+ (nvptx_reorg): Enable neutering under OMPACC mode when "ompacc for"
+ attribute is attached to function. Disable uniform-simt when under
+ OMPACC mode.
+ (nvptx_file_end): Write __nvptx_omp_num_threads out when needed.
+ (nvptx_goacc_fork_join): Return true under OMPACC mode.
+ * config/nvptx/nvptx.h (struct GTY(()) machine_function): Add
+ omp_parallel_predicate and omp_fn_entry_num_threads_reg fields.
+ * config/nvptx/nvptx.md (unspecv): Add UNSPECV_GET_TID,
+ UNSPECV_GET_NTID, UNSPECV_GET_CTAID, UNSPECV_GET_NCTAID,
+ UNSPECV_OMP_PARALLEL_FORK, UNSPECV_OMP_PARALLEL_JOIN entries.
+ (nvptx_shared_mem_operand): New predicate.
+ (gomp_barrier): New expand pattern.
+ (omp_get_num_threads): New expand pattern.
+ (omp_get_num_teams): New insn pattern.
+ (omp_get_thread_num): Likewise.
+ (omp_get_team_num): Likewise.
+ (get_ntid): Likewise.
+ (nvptx_omp_parallel_fork): Likewise.
+ (nvptx_omp_parallel_join): Likewise.
+ * expr.cc (expand_expr_real_1): Call expand_var_decl target hook.
+ * flag-types.h (omp_target_mode_kind): New flag value enum.
+ * gimplify.cc (struct gimplify_omp_ctx): Add 'bool ompacc' field.
+ (gimplify_scan_omp_clauses): Handle OMP_CLAUSE__OMPACC_.
+ (gimplify_adjust_omp_clauses): Likewise.
+ (gimplify_omp_ctx_ompacc_p): New function.
+ (gimplify_omp_for): Handle combined loops under OMPACC.
+ * lto-wrapper.cc (append_compiler_options): Add OPT_fopenmp_target_.
+ * omp-builtins.def (BUILT_IN_OMP_GET_THREAD_NUM): Remove CONST.
+ (BUILT_IN_OMP_GET_NUM_THREADS): Likewise.
+ * omp-expand.cc (remove_exit_barrier): Disable addressable-var
+ processing for parallel construct child functions under OMPACC mode.
+ (expand_oacc_for): Add OMPACC mode handling.
+ (get_target_arguments): Force thread_limit clause value to 1 under
+ OMPACC mode.
+ (expand_omp): Under OMPACC mode, avoid child function expanding of
+ GIMPLE_OMP_PARALLEL.
+ * omp-general.cc (omp_extract_for_data): Adjustments for OMPACC mode.
+ * omp-low.cc (struct omp_context): Add 'bool ompacc_p' field.
+ (scan_sharing_clauses): Handle OMP_CLAUSE__OMPACC_.
+ (ompacc_ctx_p): New function.
+ (scan_omp_parallel): Handle OMPACC mode, avoid creating child function.
+ (scan_omp_target): Tag "ompacc"/"ompacc for" attributes for target
+ construct child function, remove OMP_CLAUSE__OMPACC_ clauses.
+ (lower_oacc_head_mark): Handle OMPACC mode cases.
+ (lower_omp_for): Adjust OMP_FOR kind from OpenMP to OpenACC kinds, add
+ vector/gang clauses as needed. Add other OMPACC handling.
+ (lower_omp_taskreg): Add call to lower_oacc_head_tail for OMPACC case.
+ (lower_omp_target): Do OpenACC gang privatization under OMPACC case.
+ (lower_omp_teams): Forward OpenACC privatization variables to outer
+ target region under OMPACC mode.
+ (lower_omp_1): Do OpenACC gang privatization under OMPACC case for
+ GIMPLE_BIND.
+ * omp-offload.cc (ompacc_supported_clauses_p): New function.
+ (struct target_region_data): New struct type for tree walk.
+ (scan_fndecl_for_ompacc): New function.
+ (scan_omp_target_region_r): New function.
+ (scan_omp_target_construct_r): New function.
+ (omp_ompacc_attribute_tagging): New function.
+ (oacc_dim_call): Add OMPACC case handling.
+ (execute_oacc_device_lower): Make parts explicitly only OpenACC enabled.
+ (pass_oacc_device_lower::gate): Enable pass under OMPACC mode.
+ * omp-offload.h (omp_ompacc_attribute_tagging): New prototype.
+ * opts.cc (finish_options): Only allow -fopenmp-target= when -fopenmp
+ and no -fopenacc.
+ * target-insns.def (gomp_barrier): New defined insn pattern.
+ (omp_get_thread_num): Likewise.
+ (omp_get_num_threads): Likewise.
+ (omp_get_team_num): Likewise.
+ (omp_get_num_teams): Likewise.
+ * tree-core.h (enum omp_clause_code): Add new OMP_CLAUSE__OMPACC_ entry
+ for internal clause.
+ * tree-nested.cc (convert_nonlocal_omp_clauses): Handle
+ OMP_CLAUSE__OMPACC_.
+ * tree-pretty-print.cc (dump_omp_clause): Handle OMP_CLAUSE__OMPACC_.
+ * tree.cc (omp_clause_num_ops): Add OMP_CLAUSE__OMPACC_ entry.
+ (omp_clause_code_name): Likewise.
+ * tree.h (OMP_CLAUSE__OMPACC__FOR): New macro for OMP_CLAUSE__OMPACC_.
+
+2025-05-15 Andrew Stubbs <ams@codesourcery.com>
+
+ * tree-vect-data-refs.cc (vect_analyze_data_refs): Workaround an
+ address-space bug.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * builtin-types.def (BT_FN_VOID_PTRMODE): Add.
+ (BT_FN_PTRMODE_PTRMODE_INT_PTR): Add.
+ * gimplify.cc (gimplify_bind_expr): Diagnose missing
+ uses_allocators clause.
+ (gimplify_scan_omp_clauses, gimplify_adjust_omp_clauses,
+ gimplify_omp_workshare): Handle uses_allocators.
+ * omp-builtins.def (BUILT_IN_OMP_INIT_ALLOCATOR,
+ BUILT_IN_OMP_DESTROY_ALLOCATOR): Add.
+ * omp-low.cc (scan_sharing_clauses): Handle OMP_CLAUSE_USES_ALLOCATORS
+ and OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR clauses.
+ * tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_USES_ALLOCATORS.
+ * tree.cc (omp_clause_num_ops, omp_clause_code_name): Likewise.
+ * tree-pretty-print.cc (dump_omp_clause): Handle it.
+ * tree.h (OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR,
+ OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE,
+ OMP_CLAUSE_USES_ALLOCATORS_TRAITS): New.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * omp-oacc-kernels-decompose.cc (top_level_omp_for_in_stmt,
+ decompose_kernels_region_body): Handle GIMPLE_DEBUG like
+ simple assignment.
+
+2025-05-15 Andrew Stubbs <ams@baylibre.com>
+
+ * omp-builtins.def (BUILT_IN_GOMP_ENABLE_PINNED_MODE): New.
+ * omp-low.cc (omp_enable_pinned_mode): New function.
+ (execute_lower_omp): Call omp_enable_pinned_mode.
+
+2025-05-15 Andrew Stubbs <ams@baylibre.com>
+
+ * common.opt: Add -foffload-memory and its enum values.
+ * coretypes.h (enum offload_memory): New.
+ * doc/invoke.texi: Document -foffload-memory.
+
+2025-05-15 Kwok Cheung Yeung <kcy@codesourcery.com>
+
+ * omp-expand.cc (expand_oacc_for): Convert .tile variable to
+ diff_type before multiplying.
+ * omp-general.cc (omp_extract_for_data): Use accumulated precision
+ of all collapsed for-loops as precision of iteration variable, up
+ to the precision of a long long.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * omp-low.cc (install_var_field): Add new 'tree key_expr = NULL_TREE'
+ default parameter. Set splay-tree lookup key to key_expr instead of
+ var if key_expr is non-NULL. Adjust call to install_parm_decl.
+ Update comments.
+ (scan_sharing_clauses): Use clause tree expression as splay-tree key
+ for map/to/from and OpenACC firstprivate cases when installing the
+ variable field into the send/receive record type.
+ (maybe_lookup_field_in_outer_ctx): Add code to search through
+ construct clauses instead of entirely based on splay-tree lookup.
+ (lower_oacc_reductions): Adjust to find map-clause of reduction
+ variable, then create receiver-ref.
+ (lower_omp_target): Adjust to lookup var field using clause expression.
+
+2025-05-15 Andrew Stubbs <ams@codesourcery.com>
+
+ * dwarf2out.cc (add_location_or_const_value_attribute): Set
+ DW_AT_address_class, if appropriate.
+
+2025-05-15 Andrew Stubbs <ams@codesourcery.com>
+
+ * dwarf2out.cc (notional_parents_list): New file variable.
+ (gen_subprogram_die): Record offload kernel functions in
+ notional_parents_list.
+ (fixup_notional_parents): New function.
+ (dwarf2out_finish): Call fixup_notional_parents.
+ (dwarf2out_c_finalize): Reset notional_parents_list.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * omp-offload.cc (oacc_thread_numbers): Add VF_BY_VECTORIZER parameter.
+ Add overloaded wrapper for previous arguments & behaviour.
+ (oacc_xform_loop): Lower vector loops to iterate a multiple of
+ omp_max_vf times over contiguous steps on non-SIMT targets.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <thomas@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * gimplify.cc (omp_group_base): Handle GOMP_MAP_DECLARE_ALLOCATE
+ and GOMP_MAP_DECLARE_DEALLOCATE.
+ (gimplify_adjust_omp_clauses): Likewise.
+ * omp-low.cc (scan_sharing_clauses): Update handling of OpenACC declare
+ create, declare copyin and declare deviceptr to have local lifetimes.
+ (convert_to_firstprivate_int): Handle pointer types.
+ (convert_from_firstprivate_int): Likewise. Create local storage for
+ the values being pointed to. Add new orig_type argument. Use
+ VIEW_CONVERT also for vectors.
+ (lower_omp_target): Handle GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}.
+ Add orig_type argument to convert_from_firstprivate_int call.
+ Allow pointer types with GOMP_MAP_FIRSTPRIVATE_INT. Don't privatize
+ firstprivate VLAs.
+ * tree-pretty-print.cc (dump_omp_clause): Handle
+ GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Sandra Loosemore <sandra@baylibre.com>
+
+ * gimplify.cc (localize_reductions): Rewrite references for
+ OMP_CLAUSE_PRIVATE also. Do not create local variable for
+ privatized arrays as the size is not directly known by the type.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * gimplify.cc (privatize_reduction): New struct.
+ (localize_reductions_r, localize_reductions): New functions.
+ (gimplify_omp_for): Call localize_reductions.
+ (gimplify_omp_workshare): Likewise.
+ * omp-low.cc (lower_oacc_reductions): Handle localized reductions.
+ Create fewer temp vars.
+ * tree-core.h (omp_clause_code): Add OMP_CLAUSE_REDUCTION_PRIVATE_DECL
+ documentation.
+ * tree.cc (omp_clause_num_ops): Bump number of ops for
+ OMP_CLAUSE_REDUCTION to 6.
+ (walk_tree_1): Adjust accordingly.
+ * tree.h (OMP_CLAUSE_REDUCTION_PRIVATE_DECL): Add macro.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Chung-Lin Tang <cltang@codesourcery.com>
+
+ * gimplify.cc (omp_add_variable): Enable firstprivate reduction
+ variables.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+
+ * omp-low.cc (lower_oacc_head_mark): Don't mark OpenACC auto
+ loops as independent inside acc parallel regions.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+
+ * omp-low.cc (maybe_lookup_field_in_outer_ctx): New function.
+ (convert_to_firstprivate_int): New function.
+ (convert_from_firstprivate_int): New function.
+ (lower_omp_target): Enable GOMP_MAP_FIRSTPRIVATE_INT in OpenACC.
+ Remove unused variable.
+
+2025-05-15 Nathan Sidwell <nathan@acm.org>
+ Tom de Vries <tdevries@suse.de>
+ Thomas Schwinge <thomas@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+
+ * doc/invoke.texi (fopenacc-dim): Document syntax for using
+ runtime value from environment variable.
+ * omp-offload.cc (oacc_parse_default_dims): Implement it.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+
+ * config/nvptx/nvptx.cc (nvptx_propagate_unified): New.
+ (nvptx_split_blocks): Call it for cond_uni insn.
+ (nvptx_expand_cond_uni): New.
+ (enum nvptx_builtins): Add NVPTX_BUILTIN_COND_UNI.
+ (nvptx_init_builtins): Initialize it.
+ (nvptx_expand_builtin): Handle NVPTX_BUILTIN_COND_UNI.
+ (nvptx_generate_vector_shuffle): Change integral SHIFT operand to
+ tree BITS operand.
+ (nvptx_vector_reduction): New.
+ (nvptx_adjust_reduction_type): New.
+ (nvptx_goacc_reduction_setup): Use it to adjust the type of ref_to_res.
+ (nvptx_goacc_reduction_init): Don't update LHS if it doesn't exist.
+ (nvptx_goacc_reduction_fini): Call nvptx_vector_reduction for vector.
+ Use it to adjust the type of ref_to_res.
+ (nvptx_goacc_reduction_teardown): Call nvptx_adjust_reduction_type.
+ * config/nvptx/nvptx.md (cond_uni): New pattern.
+ * gimplify.cc (gimplify_adjust_omp_clauses): Add DECL_P check
+ for OMP_CLAUSE_TASK_REDUCTION.
+ * omp-low.cc (lower_oacc_reductions): Handle
+ GOMP_MAP_FIRSTPRIVATE_POINTER.
+ * omp-offload.cc (default_goacc_reduction): Likewise.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ James Norris <jnorris@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+
+ * gimplify.cc (enum gimplify_omp_var_data): Add GOVD_DEVICETPR.
+ (oacc_default_clause): Privatize fortran common blocks.
+ (omp_notice_variable): Add GOVD_DEVICEPTR attribute when appropriate.
+ Defer the expansion of DECL_VALUE_EXPR for common block decls.
+ (gimplify_scan_omp_clauses): Add GOVD_DEVICEPTR attribute when
+ appropriate.
+ (gimplify_adjust_omp_clauses_1): Set GOMP_MAP_FORCE_DEVICEPTR for
+ implicit deviceptr mappings.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ PR other/76739
+ * builtin-types.def (BT_FN_VOID_INT_SIZE_PTR_PTR_PTR_VAR): New type.
+ * gimplify.cc (omp_group_base): Handle GOMP_MAP_NONCONTIG_ARRAY_*.
+ (gimplify_scan_omp_clauses): Handle OMP_TARGET_UPDATE.
+ (gimplify_adjust_omp_clauses): Skip gimplification of
+ OMP_CLAUSE_SIZE of non-contiguous array maps (which is a TREE_LIST).
+ * omp-builtins.def (BUILT_IN_GOACC_DATA_START): Adjust function type
+ to new BT_FN_VOID_INT_SIZE_PTR_PTR_PTR_VAR.
+ * omp-expand.cc (expand_omp_target): Add non-contiguous array
+ descriptor pointers to variadic arguments.
+ * omp-low.cc (append_field_to_record_type): New function.
+ (create_noncontig_array_descr_type): Likewise.
+ (create_noncontig_array_descr_init_code): Likewise.
+ (scan_sharing_clauses): For non-contiguous array map kinds, check for
+ supported dimension structure, and install non-contiguous array
+ variable into current omp_context.
+ (reorder_noncontig_array_clauses): New function.
+ (scan_omp_target): Call reorder_noncontig_array_clauses to place
+ non-contiguous array map clauses at beginning of clause sequence.
+ (lower_omp_target): Add handling for non-contiguous array map kinds,
+ add all created non-contiguous array descriptors to
+ gimple_omp_target_data_arg.
+ * tree-pretty-print.cc (dump_omp_clause): Handle
+ GOMP_MAP_NONCONTIG_ARRAY_*.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+
+ * Makefile.in (REVISION_s): Change default message. \ No newline at end of file
diff --git a/gcc/DATESTAMP.omp b/gcc/DATESTAMP.omp
new file mode 100644
index 0000000..e01bdfb
--- /dev/null
+++ b/gcc/DATESTAMP.omp
@@ -0,0 +1 @@
+20250516
diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index 55b4cd7..72e53b9 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -965,7 +965,7 @@ ifdef REVISION_c
REVISION_s := \
"\"$(if $(DEVPHASE_c)$(filter-out 0,$(PATCHLEVEL_c)), $(REVISION_c))\""
else
-REVISION_s := "\"\""
+REVISION_s := "\" [OG15]\""
endif
# Shorthand variables for dependency lists.
diff --git a/gcc/builtin-types.def b/gcc/builtin-types.def
index 9583d30..c7c5f06 100644
--- a/gcc/builtin-types.def
+++ b/gcc/builtin-types.def
@@ -393,6 +393,7 @@ DEF_FUNCTION_TYPE_1 (BT_FN_DFLOAT64_DFLOAT64, BT_DFLOAT64, BT_DFLOAT64)
DEF_FUNCTION_TYPE_1 (BT_FN_DFLOAT128_DFLOAT128, BT_DFLOAT128, BT_DFLOAT128)
DEF_FUNCTION_TYPE_1 (BT_FN_DFLOAT64X_DFLOAT64X, BT_DFLOAT64X, BT_DFLOAT64X)
DEF_FUNCTION_TYPE_1 (BT_FN_VOID_VPTR, BT_VOID, BT_VOLATILE_PTR)
+DEF_FUNCTION_TYPE_1 (BT_FN_VOID_PTRMODE, BT_VOID, BT_PTRMODE)
DEF_FUNCTION_TYPE_1 (BT_FN_VOID_PTRPTR, BT_VOID, BT_PTR_PTR)
DEF_FUNCTION_TYPE_1 (BT_FN_VOID_CONST_PTR, BT_VOID, BT_CONST_PTR)
DEF_FUNCTION_TYPE_1 (BT_FN_UINT_UINT, BT_UINT, BT_UINT)
@@ -862,6 +863,8 @@ DEF_FUNCTION_TYPE_3 (BT_FN_UINT64_UINT64_UINT32_CONST_SIZE, BT_UINT64,
BT_UINT64, BT_UINT32, BT_CONST_SIZE)
DEF_FUNCTION_TYPE_3 (BT_FN_UINT64_UINT64_UINT64_CONST_SIZE, BT_UINT64,
BT_UINT64, BT_UINT64, BT_CONST_SIZE)
+DEF_FUNCTION_TYPE_3 (BT_FN_PTRMODE_PTRMODE_INT_PTR, BT_PTRMODE, BT_PTRMODE,
+ BT_INT, BT_PTR)
DEF_FUNCTION_TYPE_4 (BT_FN_SIZE_CONST_PTR_SIZE_SIZE_FILEPTR,
BT_SIZE, BT_CONST_PTR, BT_SIZE, BT_SIZE, BT_FILEPTR)
@@ -1073,6 +1076,9 @@ DEF_FUNCTION_TYPE_VAR_5 (BT_FN_INT_STRING_SIZE_INT_SIZE_CONST_STRING_VAR,
DEF_FUNCTION_TYPE_VAR_5 (BT_FN_INT_INT_INT_INT_INT_INT_VAR,
BT_INT, BT_INT, BT_INT, BT_INT, BT_INT, BT_INT)
+DEF_FUNCTION_TYPE_VAR_5 (BT_FN_VOID_INT_SIZE_PTR_PTR_PTR_VAR,
+ BT_VOID, BT_INT, BT_SIZE, BT_PTR, BT_PTR, BT_PTR)
+
DEF_FUNCTION_TYPE_VAR_6 (BT_FN_VOID_INT_OMPFN_SIZE_PTR_PTR_PTR_VAR,
BT_VOID, BT_INT, BT_PTR_FN_VOID_PTR, BT_SIZE,
BT_PTR, BT_PTR, BT_PTR)
diff --git a/gcc/builtins.cc b/gcc/builtins.cc
index a5f711a..b57f04d 100644
--- a/gcc/builtins.cc
+++ b/gcc/builtins.cc
@@ -7553,6 +7553,62 @@ expand_builtin_goacc_parlevel_id_size (tree exp, rtx target, int ignore)
return target;
}
+static rtx
+expand_builtin_omp_builtins (tree exp, rtx target, int ignore)
+{
+ rtx ret = NULL;
+ rtx_insn *(*gen_fn) (rtx) = NULL;
+
+ switch (DECL_FUNCTION_CODE (get_callee_fndecl (exp)))
+ {
+ case BUILT_IN_GOMP_BARRIER:
+ if (targetm.have_gomp_barrier ())
+ {
+ emit_insn (targetm.gen_gomp_barrier ());
+ return target;
+ }
+ break;
+
+ case BUILT_IN_OMP_GET_THREAD_NUM:
+ if (targetm.have_omp_get_thread_num ())
+ gen_fn = targetm.gen_omp_get_thread_num;
+ break;
+
+ case BUILT_IN_OMP_GET_NUM_THREADS:
+ if (targetm.have_omp_get_num_threads ())
+ gen_fn = targetm.gen_omp_get_num_threads;
+ break;
+
+ case BUILT_IN_OMP_GET_TEAM_NUM:
+ if (targetm.have_omp_get_team_num ())
+ gen_fn = targetm.gen_omp_get_team_num;
+ break;
+
+ case BUILT_IN_OMP_GET_NUM_TEAMS:
+ if (targetm.have_omp_get_num_teams ())
+ gen_fn = targetm.gen_omp_get_num_teams;
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ if (ignore)
+ return const0_rtx;
+
+ if (gen_fn)
+ {
+ rtx reg = (MEM_P (target)
+ ? gen_reg_rtx (GET_MODE (target))
+ : target);
+ emit_insn (gen_fn (reg));
+ if (reg != target)
+ emit_move_insn (target, reg);
+ ret = target;
+ }
+ return ret;
+}
+
/* Expand a string compare operation using a sequence of char comparison
to get rid of the calling overhead, with result going to TARGET if
that's convenient.
@@ -8984,6 +9040,21 @@ expand_builtin (tree exp, rtx target, rtx subtarget, machine_mode mode,
case BUILT_IN_GOACC_PARLEVEL_SIZE:
return expand_builtin_goacc_parlevel_id_size (exp, target, ignore);
+ case BUILT_IN_GOMP_BARRIER:
+ case BUILT_IN_OMP_GET_THREAD_NUM:
+ case BUILT_IN_OMP_GET_NUM_THREADS:
+ case BUILT_IN_OMP_GET_TEAM_NUM:
+ case BUILT_IN_OMP_GET_NUM_TEAMS:
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && lookup_attribute ("ompacc",
+ DECL_ATTRIBUTES (current_function_decl)))
+ {
+ target = expand_builtin_omp_builtins (exp, target, ignore);
+ if (target)
+ return target;
+ }
+ break;
+
case BUILT_IN_SPECULATION_SAFE_VALUE_PTR:
return expand_speculation_safe_value (VOIDmode, exp, target, ignore);
diff --git a/gcc/c-family/ChangeLog.omp b/gcc/c-family/ChangeLog.omp
new file mode 100644
index 0000000..e7d477a
--- /dev/null
+++ b/gcc/c-family/ChangeLog.omp
@@ -0,0 +1,90 @@
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * c-omp.cc (omp_instantiate_mapper): Apply iterator to new clauses
+ generated from mapper.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * c-omp.cc (c_finish_omp_depobj): Use OMP_ITERATOR_DECL_P.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-cppbuiltin.cc (c_cpp_builtins): Updated _OPENACC to "201811"
+ for OpenACC 2.7.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * c-omp.cc (c_omp_address_inspector::expand_array_base):
+ Set OMP_CLAUSE_MAP_POINTS_TO_READONLY on pointer clause.
+ (c_omp_address_inspector::expand_component_selector): Likewise.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Andrew Stubbs <ams@baylibre.com>
+ Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-common.h (c_omp_region_type): Add C_ORT_UPDATE and C_ORT_OMP_UPDATE
+ codes.
+ * c-omp.cc (omp_basic_map_kind_name): New function.
+ (omp_instantiate_mapper): Add LOC parameter. Add 'target update'
+ support.
+ (c_omp_instantiate_mappers): Add 'target update' support.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-omp.cc (c_omp_address_inspector::map_supported_p): Support
+ VIEW_CONVERT_EXPR and ADDR_EXPR codes.
+ (omp_expand_grid_dim): New function.
+ (omp_handle_noncontig_array): New function.
+ (c_omp_address_inspector:expand_array_base): Support noncontiguous
+ array updates.
+ (c_omp_address_inspector::expand_component_selector): Support
+ noncontiguous array updates.
+ * c-pretty-print.cc (c_pretty_printer::postfix_expression): Add
+ OMP_ARRAY_SECTION stride support.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-common.h (expand_array_base, expand_component_selector,
+ expand_map_clause): Adjust member declarations.
+ * c-omp.cc (omp_expand_access_chain): Pass and return pointer to
+ clause.
+ (c_omp_address_inspector::expand_array_base): Likewise.
+ (c_omp_address_inspector::expand_component_selector): Likewise.
+ (c_omp_address_inspector::expand_map_clause): Likewise.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-common.h (c_omp_region_type): Add C_ORT_EXIT_DATA,
+ C_ORT_OMP_EXIT_DATA.
+ (c_omp_instantiate_mappers): Add region type parameter.
+ * c-omp.cc (omp_split_map_kind, omp_join_map_kind,
+ omp_map_decayed_kind): New functions.
+ (omp_instantiate_mapper): Add ORT parameter. Implement map kind decay
+ for instantiated mapper clauses.
+ (c_omp_instantiate_mappers): Add ORT parameter, pass to
+ omp_instantiate_mapper.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-common.h (c_omp_region_type): Add C_ORT_DECLARE_MAPPER and
+ C_ORT_OMP_DECLARE_MAPPER codes.
+ (omp_mapper_list): Add forward declaration.
+ (c_omp_find_nested_mappers, c_omp_instantiate_mappers): Add prototypes.
+ * c-omp.cc (c_omp_find_nested_mappers): New function.
+ (remap_mapper_decl_info): New struct.
+ (remap_mapper_decl_1, omp_instantiate_mapper,
+ c_omp_instantiate_mappers): New functions.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-omp.cc (c_omp_address_inspector::expand_array_base): Don't omit
+ pointer nodes for OpenACC.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * c-omp.cc (c_omp_split_clauses): Hande uses_allocators.
+ * c-pragma.h (enum pragma_omp_clause): Add
+ PRAGMA_OMP_CLAUSE_USES_ALLOCATORS. \ No newline at end of file
diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h
index ea6c297..e0a9715 100644
--- a/gcc/c-family/c-common.h
+++ b/gcc/c-family/c-common.h
@@ -1301,11 +1301,15 @@ enum c_omp_region_type
C_ORT_TARGET = 1 << 3,
C_ORT_EXIT_DATA = 1 << 4,
C_ORT_INTEROP = 1 << 5,
+ C_ORT_DECLARE_MAPPER = 1 << 6,
+ C_ORT_UPDATE = 1 << 7,
C_ORT_OMP_DECLARE_SIMD = C_ORT_OMP | C_ORT_DECLARE_SIMD,
C_ORT_OMP_TARGET = C_ORT_OMP | C_ORT_TARGET,
C_ORT_OMP_EXIT_DATA = C_ORT_OMP | C_ORT_EXIT_DATA,
C_ORT_OMP_INTEROP = C_ORT_OMP | C_ORT_INTEROP,
- C_ORT_ACC_TARGET = C_ORT_ACC | C_ORT_TARGET
+ C_ORT_OMP_DECLARE_MAPPER = C_ORT_OMP | C_ORT_DECLARE_MAPPER,
+ C_ORT_ACC_TARGET = C_ORT_ACC | C_ORT_TARGET,
+ C_ORT_OMP_UPDATE = C_ORT_OMP | C_ORT_UPDATE
};
extern tree c_finish_omp_master (location_t, tree);
@@ -1343,6 +1347,9 @@ extern enum omp_clause_defaultmap_kind c_omp_predetermined_mapping (tree);
extern tree c_omp_check_context_selector (location_t, tree);
extern void c_omp_mark_declare_variant (location_t, tree, tree);
extern void c_omp_adjust_map_clauses (tree, bool);
+template<typename T> struct omp_mapper_list;
+extern void c_omp_find_nested_mappers (struct omp_mapper_list<tree> *, tree);
+extern tree c_omp_instantiate_mappers (tree, enum c_omp_region_type);
namespace omp_addr_tokenizer { struct omp_addr_token; }
typedef omp_addr_tokenizer::omp_addr_token omp_addr_token;
@@ -1402,12 +1409,12 @@ public:
bool maybe_zero_length_array_section (tree);
- tree expand_array_base (tree, vec<omp_addr_token *> &, tree, unsigned *,
- c_omp_region_type);
- tree expand_component_selector (tree, vec<omp_addr_token *> &, tree,
- unsigned *, c_omp_region_type);
- tree expand_map_clause (tree, tree, vec<omp_addr_token *> &,
- c_omp_region_type);
+ tree * expand_array_base (tree *, vec<omp_addr_token *> &, tree, unsigned *,
+ c_omp_region_type);
+ tree * expand_component_selector (tree *, vec<omp_addr_token *> &, tree,
+ unsigned *, c_omp_region_type);
+ tree * expand_map_clause (tree *, tree, vec<omp_addr_token *> &,
+ c_omp_region_type);
};
enum c_omp_directive_kind {
diff --git a/gcc/c-family/c-cppbuiltin.cc b/gcc/c-family/c-cppbuiltin.cc
index 4589ee4..15596db 100644
--- a/gcc/c-family/c-cppbuiltin.cc
+++ b/gcc/c-family/c-cppbuiltin.cc
@@ -1631,7 +1631,7 @@ c_cpp_builtins (cpp_reader *pfile)
cpp_define (pfile, "__SSP__=1");
if (flag_openacc)
- cpp_define (pfile, "_OPENACC=201711");
+ cpp_define (pfile, "_OPENACC=201811");
if (flag_openmp)
cpp_define (pfile, "_OPENMP=201511");
diff --git a/gcc/c-family/c-omp.cc b/gcc/c-family/c-omp.cc
index a92c6e3..a3cd1ae 100644
--- a/gcc/c-family/c-omp.cc
+++ b/gcc/c-family/c-omp.cc
@@ -764,9 +764,7 @@ c_finish_omp_depobj (location_t loc, tree depobj,
kind = OMP_CLAUSE_DEPEND_KIND (clause);
t = OMP_CLAUSE_DECL (clause);
gcc_assert (t);
- if (TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (t))
{
error_at (OMP_CLAUSE_LOCATION (clause),
"%<iterator%> modifier may not be specified on "
@@ -2178,6 +2176,7 @@ c_omp_split_clauses (location_t loc, enum tree_code code,
case OMP_CLAUSE_HAS_DEVICE_ADDR:
case OMP_CLAUSE_DEFAULTMAP:
case OMP_CLAUSE_DEPEND:
+ case OMP_CLAUSE_USES_ALLOCATORS:
s = C_OMP_CLAUSE_SPLIT_TARGET;
break;
case OMP_CLAUSE_DOACROSS:
@@ -3546,7 +3545,9 @@ c_omp_address_inspector::map_supported_p ()
|| TREE_CODE (t) == POINTER_PLUS_EXPR
|| TREE_CODE (t) == NON_LVALUE_EXPR
|| TREE_CODE (t) == OMP_ARRAY_SECTION
- || TREE_CODE (t) == NOP_EXPR)
+ || TREE_CODE (t) == NOP_EXPR
+ || TREE_CODE (t) == VIEW_CONVERT_EXPR
+ || TREE_CODE (t) == ADDR_EXPR)
if (TREE_CODE (t) == COMPOUND_EXPR)
t = TREE_OPERAND (t, 1);
else
@@ -3641,11 +3642,12 @@ c_omp_address_inspector::maybe_zero_length_array_section (tree clause)
expression types here, because e.g. you can't have an array of
references. */
-static tree
-omp_expand_access_chain (tree c, tree expr, vec<omp_addr_token *> &addr_tokens,
- unsigned *idx, c_omp_region_type ort)
+static tree *
+omp_expand_access_chain (tree *pc, tree expr,
+ vec<omp_addr_token *> &addr_tokens, unsigned *idx, c_omp_region_type ort)
{
using namespace omp_addr_tokenizer;
+ tree c = *pc;
location_t loc = OMP_CLAUSE_LOCATION (c);
unsigned i = *idx;
tree c2 = NULL_TREE;
@@ -3688,39 +3690,114 @@ omp_expand_access_chain (tree c, tree expr, vec<omp_addr_token *> &addr_tokens,
break;
default:
- return error_mark_node;
+ return NULL;
}
if (c2)
{
OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (c);
OMP_CLAUSE_CHAIN (c) = c2;
- c = c2;
+ pc = &OMP_CLAUSE_CHAIN (c);
}
*idx = ++i;
if (i < addr_tokens.length ()
&& addr_tokens[i]->type == ACCESS_METHOD)
- return omp_expand_access_chain (c, expr, addr_tokens, idx, ort);
+ return omp_expand_access_chain (pc, expr, addr_tokens, idx, ort);
- return c;
+ return pc;
+}
+
+static tree *
+omp_expand_grid_dim (location_t loc, tree *pc, tree decl)
+{
+ if (TREE_CODE (decl) == OMP_ARRAY_SECTION)
+ pc = omp_expand_grid_dim (loc, pc, TREE_OPERAND (decl, 0));
+ else
+ return pc;
+
+ tree c = *pc;
+ tree low_bound = TREE_OPERAND (decl, 1);
+ tree length = TREE_OPERAND (decl, 2);
+ tree stride = TREE_OPERAND (decl, 3);
+
+ tree cd = build_omp_clause (loc, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (cd, GOMP_MAP_GRID_DIM);
+ OMP_CLAUSE_DECL (cd) = unshare_expr (low_bound);
+ OMP_CLAUSE_SIZE (cd) = unshare_expr (length);
+
+ if (stride && !integer_onep (stride))
+ {
+ tree cs = build_omp_clause (loc, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (cs, GOMP_MAP_GRID_STRIDE);
+ OMP_CLAUSE_DECL (cs) = unshare_expr (stride);
+
+ OMP_CLAUSE_CHAIN (cs) = OMP_CLAUSE_CHAIN (c);
+ OMP_CLAUSE_CHAIN (cd) = cs;
+ OMP_CLAUSE_CHAIN (c) = cd;
+ pc = &OMP_CLAUSE_CHAIN (cd);
+ }
+ else
+ {
+ OMP_CLAUSE_CHAIN (cd) = OMP_CLAUSE_CHAIN (c);
+ OMP_CLAUSE_CHAIN (c) = cd;
+ pc = &OMP_CLAUSE_CHAIN (c);
+ }
+
+ return pc;
+}
+
+tree *
+omp_handle_noncontig_array (location_t loc, tree *pc, tree c, tree base)
+{
+ tree type;
+
+ if (POINTER_TYPE_P (TREE_TYPE (base)))
+ type = TREE_TYPE (TREE_TYPE (base));
+ else
+ type = strip_array_types (TREE_TYPE (base));
+
+ tree c_map = build_omp_clause (loc, OMP_CLAUSE_MAP);
+
+ OMP_CLAUSE_DECL (c_map) = unshare_expr (base);
+ /* Use the element size (or pointed-to type size) here. */
+ OMP_CLAUSE_SIZE (c_map) = TYPE_SIZE_UNIT (type);
+
+ switch (OMP_CLAUSE_CODE (c))
+ {
+ case OMP_CLAUSE_TO:
+ OMP_CLAUSE_SET_MAP_KIND (c_map, GOMP_MAP_TO_GRID);
+ break;
+ case OMP_CLAUSE_FROM:
+ OMP_CLAUSE_SET_MAP_KIND (c_map, GOMP_MAP_FROM_GRID);
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ OMP_CLAUSE_CHAIN (c_map) = OMP_CLAUSE_CHAIN (c);
+
+ *pc = c_map;
+
+ return omp_expand_grid_dim (loc, pc, OMP_CLAUSE_DECL (c));
}
/* Translate "array_base_decl access_method" to OMP mapping clauses. */
-tree
-c_omp_address_inspector::expand_array_base (tree c,
+tree *
+c_omp_address_inspector::expand_array_base (tree *pc,
vec<omp_addr_token *> &addr_tokens,
tree expr, unsigned *idx,
c_omp_region_type ort)
{
using namespace omp_addr_tokenizer;
+ tree c = *pc;
location_t loc = OMP_CLAUSE_LOCATION (c);
int i = *idx;
tree decl = addr_tokens[i + 1]->expr;
bool decl_p = DECL_P (decl);
- bool declare_target_p = (decl_p
+ bool declare_target_p = (DECL_P (decl)
&& is_global_var (decl)
&& lookup_attribute ("omp declare target",
DECL_ATTRIBUTES (decl)));
@@ -3731,6 +3808,7 @@ c_omp_address_inspector::expand_array_base (tree c,
unsigned consume_tokens = 2;
bool target_p = (ort & C_ORT_TARGET) != 0;
bool openmp_p = (ort & C_ORT_OMP) != 0;
+ unsigned acc = i + 1;
gcc_assert (i == 0);
@@ -3741,10 +3819,18 @@ c_omp_address_inspector::expand_array_base (tree c,
{
i += 2;
*idx = i;
- return c;
+ return pc;
+ }
+
+ if (!map_p && chain_p)
+ {
+ /* See comment in c_omp_address_inspector::expand_component_selector. */
+ while (acc + 1 < addr_tokens.length ()
+ && addr_tokens[acc + 1]->type == ACCESS_METHOD)
+ acc++;
}
- switch (addr_tokens[i + 1]->u.access_kind)
+ switch (addr_tokens[acc]->u.access_kind)
{
case ACCESS_DIRECT:
if (decl_p && !target_p)
@@ -3867,7 +3953,8 @@ c_omp_address_inspector::expand_array_base (tree c,
/* The code handling "firstprivatize_array_bases" in gimplify.cc is
relevant here. What do we need to create for arrays at this
stage? (This condition doesn't feel quite right. FIXME?) */
- if (!target_p
+ if (openmp_p
+ && !target_p
&& (TREE_CODE (TREE_TYPE (addr_tokens[i + 1]->expr))
== ARRAY_TYPE))
break;
@@ -3878,7 +3965,7 @@ c_omp_address_inspector::expand_array_base (tree c,
virtual_origin);
tree data_addr = omp_accessed_addr (addr_tokens, i + 1, expr);
c2 = build_omp_clause (loc, OMP_CLAUSE_MAP);
- if (decl_p && target_p)
+ if (decl_p && (!openmp_p || target_p))
{
/* See comment for ACCESS_INDEXED_REF_TO_ARRAY above. */
enum gomp_map_kind k = chain_p ? GOMP_MAP_POINTER
@@ -3934,9 +4021,11 @@ c_omp_address_inspector::expand_array_base (tree c,
tree data_addr = omp_accessed_addr (addr_tokens, last_access, expr);
c2 = build_omp_clause (loc, OMP_CLAUSE_MAP);
/* For OpenACC, use FIRSTPRIVATE_POINTER for decls even on non-compute
- regions (e.g. "acc data" constructs). It'll be removed anyway in
- gimplify.cc, but doing it this way maintains diagnostic
- behaviour. */
+ regions (e.g. "acc data" constructs). It is used during "lexical
+ inheritance" of mapping clauses on enclosed target
+ (parallel/serial/kernels) regions, i.e. creating "present" mappings
+ for sections of pointer-based arrays. It's also used for
+ diagnostics. */
if (decl_p && (target_p || !openmp_p) && !chain_p && !declare_target_p)
OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_FIRSTPRIVATE_POINTER);
else
@@ -4013,9 +4102,43 @@ c_omp_address_inspector::expand_array_base (tree c,
}
break;
+ case ACCESS_NONCONTIG_ARRAY:
+ {
+ gcc_assert (!map_p);
+
+ tree base = addr_tokens[acc]->expr;
+
+ if (decl_p)
+ c_common_mark_addressable_vec (base);
+
+ pc = omp_handle_noncontig_array (loc, pc, c, base);
+ consume_tokens = (acc + 1) - i;
+ chain_p = false;
+ }
+ break;
+
+ case ACCESS_NONCONTIG_REF_TO_ARRAY:
+ {
+ gcc_assert (!map_p);
+
+ if (decl_p)
+ c_common_mark_addressable_vec (addr_tokens[acc]->expr);
+
+ /* Or here. */
+ gcc_assert (!chain_p);
+
+ tree base = addr_tokens[i + 1]->expr;
+ base = convert_from_reference (base);
+
+ pc = omp_handle_noncontig_array (loc, pc, c, base);
+ consume_tokens = (acc + 1) - i;
+ chain_p = false;
+ }
+ break;
+
default:
*idx = i + consume_tokens;
- return error_mark_node;
+ return NULL;
}
if (c3)
@@ -4028,43 +4151,65 @@ c_omp_address_inspector::expand_array_base (tree c,
OMP_CLAUSE_MAP_IMPLICIT (c2) = 1;
OMP_CLAUSE_MAP_IMPLICIT (c3) = 1;
}
- c = c3;
+ pc = &OMP_CLAUSE_CHAIN (c2);
}
else if (c2)
{
+ if (OMP_CLAUSE_MAP_READONLY (c))
+ OMP_CLAUSE_MAP_POINTS_TO_READONLY (c2) = 1;
OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (c);
OMP_CLAUSE_CHAIN (c) = c2;
if (implicit_p)
OMP_CLAUSE_MAP_IMPLICIT (c2) = 1;
- c = c2;
+ pc = &OMP_CLAUSE_CHAIN (c);
}
i += consume_tokens;
*idx = i;
if (chain_p && map_p)
- return omp_expand_access_chain (c, expr, addr_tokens, idx, ort);
+ return omp_expand_access_chain (pc, expr, addr_tokens, idx, ort);
- return c;
+ return pc;
}
/* Translate "component_selector access_method" to OMP mapping clauses. */
-tree
-c_omp_address_inspector::expand_component_selector (tree c,
+tree *
+c_omp_address_inspector::expand_component_selector (tree *pc,
vec<omp_addr_token *>
&addr_tokens,
tree expr, unsigned *idx,
c_omp_region_type ort)
{
using namespace omp_addr_tokenizer;
+ tree c = *pc;
location_t loc = OMP_CLAUSE_LOCATION (c);
unsigned i = *idx;
tree c2 = NULL_TREE, c3 = NULL_TREE;
bool chain_p = omp_access_chain_p (addr_tokens, i + 1);
bool map_p = OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP;
+ unsigned acc = i + 1;
+
+ if (!map_p && chain_p)
+ {
+ /* We have a non-map clause (i.e. to/from for an "update" directive),
+ and we might have a noncontiguous array section at the end of a
+ chain of other accesses, e.g. pointer indirections like this:
+
+ struct_base_decl access_pointer access_pointer component_selector
+ access_pointer access_pointer access_noncontig_array
- switch (addr_tokens[i + 1]->u.access_kind)
+ We only need to process the last access in this case, so skip
+ over previous accesses. */
+
+ while (acc + 1 < addr_tokens.length ()
+ && addr_tokens[acc + 1]->type == ACCESS_METHOD)
+ acc++;
+ chain_p = false;
+ }
+
+ switch (addr_tokens[acc]->u.access_kind)
{
case ACCESS_DIRECT:
case ACCESS_INDEXED_ARRAY:
@@ -4074,7 +4219,7 @@ c_omp_address_inspector::expand_component_selector (tree c,
{
/* Copy the referenced object. Note that we also do this for !MAP_P
clauses. */
- tree obj = convert_from_reference (addr_tokens[i + 1]->expr);
+ tree obj = convert_from_reference (addr_tokens[acc]->expr);
OMP_CLAUSE_DECL (c) = obj;
OMP_CLAUSE_SIZE (c) = TYPE_SIZE_UNIT (TREE_TYPE (obj));
@@ -4083,7 +4228,7 @@ c_omp_address_inspector::expand_component_selector (tree c,
c2 = build_omp_clause (loc, OMP_CLAUSE_MAP);
OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_ATTACH_DETACH);
- OMP_CLAUSE_DECL (c2) = addr_tokens[i + 1]->expr;
+ OMP_CLAUSE_DECL (c2) = addr_tokens[acc]->expr;
OMP_CLAUSE_SIZE (c2) = size_zero_node;
}
break;
@@ -4094,15 +4239,15 @@ c_omp_address_inspector::expand_component_selector (tree c,
break;
tree virtual_origin
- = convert_from_reference (addr_tokens[i + 1]->expr);
+ = convert_from_reference (addr_tokens[acc]->expr);
virtual_origin = build_fold_addr_expr (virtual_origin);
virtual_origin = fold_convert_loc (loc, ptrdiff_type_node,
virtual_origin);
- tree data_addr = omp_accessed_addr (addr_tokens, i + 1, expr);
+ tree data_addr = omp_accessed_addr (addr_tokens, acc, expr);
c2 = build_omp_clause (loc, OMP_CLAUSE_MAP);
OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_ATTACH_DETACH);
- OMP_CLAUSE_DECL (c2) = addr_tokens[i + 1]->expr;
+ OMP_CLAUSE_DECL (c2) = addr_tokens[acc]->expr;
OMP_CLAUSE_SIZE (c2)
= fold_build2_loc (loc, MINUS_EXPR, ptrdiff_type_node,
fold_convert_loc (loc, ptrdiff_type_node,
@@ -4119,12 +4264,12 @@ c_omp_address_inspector::expand_component_selector (tree c,
tree virtual_origin
= fold_convert_loc (loc, ptrdiff_type_node,
- addr_tokens[i + 1]->expr);
- tree data_addr = omp_accessed_addr (addr_tokens, i + 1, expr);
+ addr_tokens[acc]->expr);
+ tree data_addr = omp_accessed_addr (addr_tokens, acc, expr);
c2 = build_omp_clause (loc, OMP_CLAUSE_MAP);
OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_ATTACH_DETACH);
- OMP_CLAUSE_DECL (c2) = addr_tokens[i + 1]->expr;
+ OMP_CLAUSE_DECL (c2) = addr_tokens[acc]->expr;
OMP_CLAUSE_SIZE (c2)
= fold_build2_loc (loc, MINUS_EXPR, ptrdiff_type_node,
fold_convert_loc (loc, ptrdiff_type_node,
@@ -4139,10 +4284,10 @@ c_omp_address_inspector::expand_component_selector (tree c,
if (!map_p)
break;
- tree ptr = convert_from_reference (addr_tokens[i + 1]->expr);
+ tree ptr = convert_from_reference (addr_tokens[acc]->expr);
tree virtual_origin = fold_convert_loc (loc, ptrdiff_type_node,
ptr);
- tree data_addr = omp_accessed_addr (addr_tokens, i + 1, expr);
+ tree data_addr = omp_accessed_addr (addr_tokens, acc, expr);
/* Attach the pointer... */
c2 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
@@ -4157,14 +4302,39 @@ c_omp_address_inspector::expand_component_selector (tree c,
/* ...and also the reference. */
c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_ATTACH_DETACH);
- OMP_CLAUSE_DECL (c3) = addr_tokens[i + 1]->expr;
+ OMP_CLAUSE_DECL (c3) = addr_tokens[acc]->expr;
OMP_CLAUSE_SIZE (c3) = size_zero_node;
}
break;
+ case ACCESS_NONCONTIG_ARRAY:
+ {
+ gcc_assert (!map_p);
+
+ /* We don't expect to see further accesses here. */
+ gcc_assert (!chain_p);
+
+ pc = omp_handle_noncontig_array (loc, pc, c, addr_tokens[acc]->expr);
+ }
+ break;
+
+ case ACCESS_NONCONTIG_REF_TO_ARRAY:
+ {
+ gcc_assert (!map_p);
+
+ /* Or here. */
+ gcc_assert (!chain_p);
+
+ tree base = addr_tokens[acc]->expr;
+ base = convert_from_reference (base);
+
+ pc = omp_handle_noncontig_array (loc, pc, c, base);
+ }
+ break;
+
default:
- *idx = i + 2;
- return error_mark_node;
+ *idx = acc + 1;
+ return NULL;
}
if (c3)
@@ -4172,29 +4342,30 @@ c_omp_address_inspector::expand_component_selector (tree c,
OMP_CLAUSE_CHAIN (c3) = OMP_CLAUSE_CHAIN (c);
OMP_CLAUSE_CHAIN (c2) = c3;
OMP_CLAUSE_CHAIN (c) = c2;
- c = c3;
+ pc = &OMP_CLAUSE_CHAIN (c2);
}
else if (c2)
{
+ if (OMP_CLAUSE_MAP_READONLY (c))
+ OMP_CLAUSE_MAP_POINTS_TO_READONLY (c2) = 1;
OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (c);
OMP_CLAUSE_CHAIN (c) = c2;
- c = c2;
+ pc = &OMP_CLAUSE_CHAIN (c);
}
- i += 2;
- *idx = i;
+ *idx = acc + 1;
if (chain_p && map_p)
- return omp_expand_access_chain (c, expr, addr_tokens, idx, ort);
+ return omp_expand_access_chain (pc, expr, addr_tokens, idx, ort);
- return c;
+ return pc;
}
/* Expand a map clause into a group of mapping clauses, creating nodes to
attach/detach pointers and so forth as necessary. */
-tree
-c_omp_address_inspector::expand_map_clause (tree c, tree expr,
+tree *
+c_omp_address_inspector::expand_map_clause (tree *pc, tree expr,
vec<omp_addr_token *> &addr_tokens,
c_omp_region_type ort)
{
@@ -4210,18 +4381,18 @@ c_omp_address_inspector::expand_map_clause (tree c, tree expr,
&& addr_tokens[i]->u.structure_base_kind == BASE_DECL
&& addr_tokens[i + 1]->type == ACCESS_METHOD)
{
- c = expand_array_base (c, addr_tokens, expr, &i, ort);
- if (c == error_mark_node)
- return error_mark_node;
+ pc = expand_array_base (pc, addr_tokens, expr, &i, ort);
+ if (pc == NULL)
+ return NULL;
}
else if (remaining >= 2
&& addr_tokens[i]->type == ARRAY_BASE
&& addr_tokens[i]->u.structure_base_kind == BASE_ARBITRARY_EXPR
&& addr_tokens[i + 1]->type == ACCESS_METHOD)
{
- c = expand_array_base (c, addr_tokens, expr, &i, ort);
- if (c == error_mark_node)
- return error_mark_node;
+ pc = expand_array_base (pc, addr_tokens, expr, &i, ort);
+ if (pc == NULL)
+ return NULL;
}
else if (remaining >= 2
&& addr_tokens[i]->type == STRUCTURE_BASE
@@ -4248,18 +4419,18 @@ c_omp_address_inspector::expand_map_clause (tree c, tree expr,
i++;
break;
default:
- return error_mark_node;
+ return NULL;
}
}
else if (remaining >= 2
&& addr_tokens[i]->type == COMPONENT_SELECTOR
&& addr_tokens[i + 1]->type == ACCESS_METHOD)
{
- c = expand_component_selector (c, addr_tokens, expr, &i, ort);
+ pc = expand_component_selector (pc, addr_tokens, expr, &i, ort);
/* We used 'expr', so these must have been the last tokens. */
gcc_assert (i == length);
- if (c == error_mark_node)
- return error_mark_node;
+ if (pc == NULL)
+ return NULL;
}
else if (remaining >= 3
&& addr_tokens[i]->type == COMPONENT_SELECTOR
@@ -4277,9 +4448,579 @@ c_omp_address_inspector::expand_map_clause (tree c, tree expr,
}
if (i == length)
- return c;
+ return pc;
- return error_mark_node;
+ return NULL;
+}
+
+/* Given a mapper function MAPPER_FN, recursively scan through the map clauses
+ for that mapper, and if any of those should use a (named or unnamed) mapper
+ themselves, add it to MLIST. */
+
+void
+c_omp_find_nested_mappers (omp_mapper_list<tree> *mlist, tree mapper_fn)
+{
+ tree mapper = lang_hooks.decls.omp_extract_mapper_directive (mapper_fn);
+ tree mapper_name = NULL_TREE;
+
+ if (mapper == error_mark_node)
+ return;
+
+ gcc_assert (TREE_CODE (mapper) == OMP_DECLARE_MAPPER);
+
+ for (tree clause = OMP_DECLARE_MAPPER_CLAUSES (mapper);
+ clause;
+ clause = OMP_CLAUSE_CHAIN (clause))
+ {
+ tree expr = OMP_CLAUSE_DECL (clause);
+ enum gomp_map_kind clause_kind = OMP_CLAUSE_MAP_KIND (clause);
+ tree elem_type;
+
+ if (clause_kind == GOMP_MAP_PUSH_MAPPER_NAME)
+ {
+ mapper_name = expr;
+ continue;
+ }
+ else if (clause_kind == GOMP_MAP_POP_MAPPER_NAME)
+ {
+ mapper_name = NULL_TREE;
+ continue;
+ }
+
+ gcc_assert (TREE_CODE (expr) != TREE_LIST);
+ if (TREE_CODE (expr) == OMP_ARRAY_SECTION)
+ {
+ while (TREE_CODE (expr) == OMP_ARRAY_SECTION)
+ expr = TREE_OPERAND (expr, 0);
+
+ elem_type = TREE_TYPE (expr);
+ }
+ else
+ elem_type = TREE_TYPE (expr);
+
+ /* This might be too much... or not enough? */
+ while (TREE_CODE (elem_type) == ARRAY_TYPE
+ || TREE_CODE (elem_type) == POINTER_TYPE
+ || TREE_CODE (elem_type) == REFERENCE_TYPE)
+ elem_type = TREE_TYPE (elem_type);
+
+ elem_type = TYPE_MAIN_VARIANT (elem_type);
+
+ if (AGGREGATE_TYPE_P (elem_type)
+ && !mlist->contains (mapper_name, elem_type))
+ {
+ tree nested_mapper_fn
+ = lang_hooks.decls.omp_mapper_lookup (mapper_name, elem_type);
+
+ if (nested_mapper_fn)
+ {
+ mlist->add_mapper (mapper_name, elem_type, nested_mapper_fn);
+ c_omp_find_nested_mappers (mlist, nested_mapper_fn);
+ }
+ else if (mapper_name)
+ {
+ error ("mapper %qE not found for type %qT", mapper_name,
+ elem_type);
+ continue;
+ }
+ }
+ }
+}
+
+struct remap_mapper_decl_info
+{
+ tree dummy_var;
+ tree expr;
+};
+
+/* Helper for rewriting DUMMY_VAR into EXPR in a map clause decl. */
+
+static tree
+remap_mapper_decl_1 (tree *tp, int *walk_subtrees, void *data)
+{
+ remap_mapper_decl_info *map_info = (remap_mapper_decl_info *) data;
+
+ if (operand_equal_p (*tp, map_info->dummy_var))
+ {
+ *tp = map_info->expr;
+ *walk_subtrees = 0;
+ }
+
+ return NULL_TREE;
+}
+
+static enum gomp_map_kind
+omp_split_map_kind (enum gomp_map_kind op, bool *force_p, bool *always_p,
+ bool *present_p)
+{
+ *force_p = *always_p = *present_p = false;
+
+ switch (op)
+ {
+ case GOMP_MAP_FORCE_ALLOC:
+ case GOMP_MAP_FORCE_TO:
+ case GOMP_MAP_FORCE_FROM:
+ case GOMP_MAP_FORCE_TOFROM:
+ case GOMP_MAP_FORCE_PRESENT:
+ *force_p = true;
+ break;
+ case GOMP_MAP_ALWAYS_TO:
+ case GOMP_MAP_ALWAYS_FROM:
+ case GOMP_MAP_ALWAYS_TOFROM:
+ *always_p = true;
+ break;
+ case GOMP_MAP_ALWAYS_PRESENT_TO:
+ case GOMP_MAP_ALWAYS_PRESENT_FROM:
+ case GOMP_MAP_ALWAYS_PRESENT_TOFROM:
+ *always_p = true;
+ /* Fallthrough. */
+ case GOMP_MAP_PRESENT_ALLOC:
+ case GOMP_MAP_PRESENT_TO:
+ case GOMP_MAP_PRESENT_FROM:
+ case GOMP_MAP_PRESENT_TOFROM:
+ *present_p = true;
+ break;
+ default:
+ ;
+ }
+
+ switch (op)
+ {
+ case GOMP_MAP_ALLOC:
+ case GOMP_MAP_FORCE_ALLOC:
+ case GOMP_MAP_PRESENT_ALLOC:
+ return GOMP_MAP_ALLOC;
+ case GOMP_MAP_TO:
+ case GOMP_MAP_FORCE_TO:
+ case GOMP_MAP_ALWAYS_TO:
+ case GOMP_MAP_PRESENT_TO:
+ case GOMP_MAP_ALWAYS_PRESENT_TO:
+ return GOMP_MAP_TO;
+ case GOMP_MAP_FROM:
+ case GOMP_MAP_FORCE_FROM:
+ case GOMP_MAP_ALWAYS_FROM:
+ case GOMP_MAP_PRESENT_FROM:
+ case GOMP_MAP_ALWAYS_PRESENT_FROM:
+ return GOMP_MAP_FROM;
+ case GOMP_MAP_TOFROM:
+ case GOMP_MAP_FORCE_TOFROM:
+ case GOMP_MAP_ALWAYS_TOFROM:
+ case GOMP_MAP_PRESENT_TOFROM:
+ case GOMP_MAP_ALWAYS_PRESENT_TOFROM:
+ return GOMP_MAP_TOFROM;
+ default:
+ ;
+ }
+
+ return op;
+}
+
+static enum gomp_map_kind
+omp_join_map_kind (enum gomp_map_kind op, bool force_p, bool always_p,
+ bool present_p)
+{
+ gcc_assert (!force_p || !(always_p || present_p));
+
+ switch (op)
+ {
+ case GOMP_MAP_ALLOC:
+ if (force_p)
+ return GOMP_MAP_FORCE_ALLOC;
+ else if (present_p)
+ return GOMP_MAP_PRESENT_ALLOC;
+ break;
+
+ case GOMP_MAP_TO:
+ if (force_p)
+ return GOMP_MAP_FORCE_TO;
+ else if (always_p && present_p)
+ return GOMP_MAP_ALWAYS_PRESENT_TO;
+ else if (always_p)
+ return GOMP_MAP_ALWAYS_TO;
+ else if (present_p)
+ return GOMP_MAP_PRESENT_TO;
+ break;
+
+ case GOMP_MAP_FROM:
+ if (force_p)
+ return GOMP_MAP_FORCE_FROM;
+ else if (always_p && present_p)
+ return GOMP_MAP_ALWAYS_PRESENT_FROM;
+ else if (always_p)
+ return GOMP_MAP_ALWAYS_FROM;
+ else if (present_p)
+ return GOMP_MAP_PRESENT_FROM;
+ break;
+
+ case GOMP_MAP_TOFROM:
+ if (force_p)
+ return GOMP_MAP_FORCE_TOFROM;
+ else if (always_p && present_p)
+ return GOMP_MAP_ALWAYS_PRESENT_TOFROM;
+ else if (always_p)
+ return GOMP_MAP_ALWAYS_TOFROM;
+ else if (present_p)
+ return GOMP_MAP_PRESENT_TOFROM;
+ break;
+
+ default:
+ ;
+ }
+
+ return op;
+}
+
+/* Map kind decay (OpenMP 5.2, 5.8.8 "declare mapper Directive"). Return the
+ map kind to use given MAPPER_KIND specified in the mapper and INVOKED_AS
+ specified on the clause that invokes the mapper. See also
+ fortran/trans-openmp.cc:omp_map_decayed_kind. */
+
+static enum gomp_map_kind
+omp_map_decayed_kind (enum gomp_map_kind mapper_kind,
+ enum gomp_map_kind invoked_as, bool exit_p)
+{
+ if (invoked_as == GOMP_MAP_RELEASE || invoked_as == GOMP_MAP_DELETE)
+ return invoked_as;
+
+ bool force_p, always_p, present_p;
+
+ invoked_as = omp_split_map_kind (invoked_as, &force_p, &always_p, &present_p);
+ gomp_map_kind decay_to;
+
+ switch (mapper_kind)
+ {
+ case GOMP_MAP_ALLOC:
+ if (exit_p && invoked_as == GOMP_MAP_FROM)
+ decay_to = GOMP_MAP_RELEASE;
+ else
+ decay_to = GOMP_MAP_ALLOC;
+ break;
+
+ case GOMP_MAP_TO:
+ if (invoked_as == GOMP_MAP_FROM)
+ decay_to = exit_p ? GOMP_MAP_RELEASE : GOMP_MAP_ALLOC;
+ else if (invoked_as == GOMP_MAP_ALLOC)
+ decay_to = GOMP_MAP_ALLOC;
+ else
+ decay_to = GOMP_MAP_TO;
+ break;
+
+ case GOMP_MAP_FROM:
+ if (invoked_as == GOMP_MAP_ALLOC || invoked_as == GOMP_MAP_TO)
+ decay_to = GOMP_MAP_ALLOC;
+ else
+ decay_to = GOMP_MAP_FROM;
+ break;
+
+ case GOMP_MAP_TOFROM:
+ case GOMP_MAP_UNSET:
+ decay_to = invoked_as;
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ return omp_join_map_kind (decay_to, force_p, always_p, present_p);
+}
+
+/* Return a name to use for a "basic" map kind, e.g. as output from
+ omp_split_map_kind above. */
+
+static const char *
+omp_basic_map_kind_name (enum gomp_map_kind kind)
+{
+ switch (kind)
+ {
+ case GOMP_MAP_ALLOC:
+ return "alloc";
+ case GOMP_MAP_TO:
+ return "to";
+ case GOMP_MAP_FROM:
+ return "from";
+ case GOMP_MAP_TOFROM:
+ return "tofrom";
+ case GOMP_MAP_RELEASE:
+ return "release";
+ case GOMP_MAP_DELETE:
+ return "delete";
+ default:
+ gcc_unreachable ();
+ }
+}
+
+/* Instantiate a mapper MAPPER for expression EXPR, adding new clauses to
+ OUTLIST. OUTER_KIND is the mapping kind to use if not already specified in
+ the mapper declaration. */
+
+static tree *
+omp_instantiate_mapper (location_t loc, tree *outlist, tree mapper, tree expr,
+ enum gomp_map_kind outer_kind,
+ enum c_omp_region_type ort)
+{
+ tree clauses = OMP_DECLARE_MAPPER_CLAUSES (mapper);
+ tree dummy_var = OMP_DECLARE_MAPPER_DECL (mapper);
+ tree mapper_name = NULL_TREE;
+ tree iterator = *outlist ? OMP_CLAUSE_ITERATORS (*outlist) : NULL_TREE;
+
+ remap_mapper_decl_info map_info;
+ map_info.dummy_var = dummy_var;
+ map_info.expr = expr;
+
+ for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
+ {
+ tree unshared = unshare_expr (c);
+ enum gomp_map_kind clause_kind = OMP_CLAUSE_MAP_KIND (c);
+ tree t = OMP_CLAUSE_DECL (unshared);
+ tree type = NULL_TREE;
+ bool nonunit_array_with_mapper = false;
+
+ if (clause_kind == GOMP_MAP_PUSH_MAPPER_NAME)
+ {
+ mapper_name = t;
+ continue;
+ }
+ else if (clause_kind == GOMP_MAP_POP_MAPPER_NAME)
+ {
+ mapper_name = NULL_TREE;
+ continue;
+ }
+
+ if (TREE_CODE (t) == OMP_ARRAY_SECTION)
+ {
+ tree t2 = lang_hooks.decls.omp_map_array_section (loc, t);
+
+ if (t2 == t)
+ {
+ nonunit_array_with_mapper = true;
+ /* We'd want use the mapper for the element type if this worked:
+ look that one up. */
+ type = TREE_TYPE (TREE_TYPE (t));
+ }
+ else
+ {
+ t = t2;
+ type = TREE_TYPE (t);
+ }
+ }
+ else
+ type = TREE_TYPE (t);
+
+ gcc_assert (type);
+
+ if (type == error_mark_node)
+ continue;
+
+ walk_tree (&unshared, remap_mapper_decl_1, &map_info, NULL);
+
+ OMP_CLAUSE_LOCATION (unshared) = loc;
+
+ enum gomp_map_kind decayed_kind
+ = omp_map_decayed_kind (clause_kind, outer_kind,
+ (ort & C_ORT_EXIT_DATA) != 0
+ || (outer_kind == GOMP_MAP_FROM
+ && (ort & C_ORT_UPDATE) != 0));
+ OMP_CLAUSE_SET_MAP_KIND (unshared, decayed_kind);
+
+ type = TYPE_MAIN_VARIANT (type);
+
+ tree mapper_fn = lang_hooks.decls.omp_mapper_lookup (mapper_name, type);
+
+ if (mapper_fn && nonunit_array_with_mapper)
+ {
+ sorry ("user-defined mapper with non-unit length array section");
+ continue;
+ }
+ else if (mapper_fn)
+ {
+ tree nested_mapper
+ = lang_hooks.decls.omp_extract_mapper_directive (mapper_fn);
+ if (nested_mapper != mapper)
+ {
+ outlist = omp_instantiate_mapper (loc, outlist, nested_mapper,
+ t, outer_kind, ort);
+ continue;
+ }
+ }
+ else if (mapper_name)
+ {
+ error ("mapper %qE not found for type %qT", mapper_name, type);
+ continue;
+ }
+
+ if (ort & C_ORT_UPDATE)
+ {
+ bool force_p, always_p, present_p;
+ decayed_kind
+ = omp_split_map_kind (decayed_kind, &force_p, &always_p,
+ &present_p);
+ /* We don't expect to see these flags here. */
+ gcc_assert (!force_p && !always_p);
+ /* For a "target update" operation, we want to turn the map node
+ expanded from the mapper back into a OMP_CLAUSE_TO or
+ OMP_CLAUSE_FROM node. If we can do neither, emit a warning and
+ drop the clause. */
+ switch (decayed_kind)
+ {
+ case GOMP_MAP_TO:
+ case GOMP_MAP_FROM:
+ {
+ tree xfer
+ = build_omp_clause (loc, (decayed_kind == GOMP_MAP_TO
+ ? OMP_CLAUSE_TO : OMP_CLAUSE_FROM));
+ OMP_CLAUSE_DECL (xfer) = OMP_CLAUSE_DECL (unshared);
+ OMP_CLAUSE_SIZE (xfer) = OMP_CLAUSE_SIZE (unshared);
+ /* For FROM/TO clauses, "present" is represented by a flag.
+ Set it for the expanded clause here. */
+ if (present_p)
+ OMP_CLAUSE_MOTION_PRESENT (xfer) = 1;
+ *outlist = xfer;
+ outlist = &OMP_CLAUSE_CHAIN (xfer);
+ }
+ break;
+ default:
+ clause_kind
+ = omp_split_map_kind (clause_kind, &force_p, &always_p,
+ &present_p);
+ warning_at (loc, 0, "dropping %qs clause during mapper expansion "
+ "in %<#pragma omp target update%>",
+ omp_basic_map_kind_name (clause_kind));
+ inform (OMP_CLAUSE_LOCATION (c), "for map clause here");
+ }
+ }
+ else
+ {
+ OMP_CLAUSE_ITERATORS (unshared) = iterator;
+ *outlist = unshared;
+ outlist = &OMP_CLAUSE_CHAIN (unshared);
+ }
+ }
+
+ return outlist;
+}
+
+/* Given a list of CLAUSES, scan each clause and invoke a user-defined mapper
+ appropriate to the type of the data in that clause, if such a mapper is
+ visible in the current parsing context. */
+
+tree
+c_omp_instantiate_mappers (tree clauses, enum c_omp_region_type ort)
+{
+ tree c, *pc, mapper_name = NULL_TREE;
+
+ for (pc = &clauses, c = clauses; c; c = *pc)
+ {
+ bool using_mapper = false;
+ bool update_p = false, update_present_p = false;
+
+ switch (OMP_CLAUSE_CODE (c))
+ {
+ case OMP_CLAUSE_TO:
+ case OMP_CLAUSE_FROM:
+ update_p = true;
+ if (OMP_CLAUSE_MOTION_PRESENT (c))
+ update_present_p = true;
+ /* Fallthrough. */
+ case OMP_CLAUSE_MAP:
+ {
+ tree t = OMP_CLAUSE_DECL (c);
+ tree type = NULL_TREE;
+ bool nonunit_array_with_mapper = false;
+
+ if (!update_p
+ && (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_PUSH_MAPPER_NAME
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POP_MAPPER_NAME))
+ {
+ if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_PUSH_MAPPER_NAME)
+ mapper_name = OMP_CLAUSE_DECL (c);
+ else
+ mapper_name = NULL_TREE;
+ pc = &OMP_CLAUSE_CHAIN (c);
+ continue;
+ }
+
+ if (TREE_CODE (t) == OMP_ARRAY_SECTION)
+ {
+ location_t loc = OMP_CLAUSE_LOCATION (c);
+ tree t2 = lang_hooks.decls.omp_map_array_section (loc, t);
+
+ if (t2 == t)
+ {
+ /* !!! Array sections of size >1 with mappers for elements
+ are hard to support. Do something here. */
+ nonunit_array_with_mapper = true;
+ type = TREE_TYPE (TREE_TYPE (t));
+ }
+ else
+ {
+ t = t2;
+ type = TREE_TYPE (t);
+ }
+ }
+ else
+ type = TREE_TYPE (t);
+
+ if (type == NULL_TREE || type == error_mark_node)
+ {
+ pc = &OMP_CLAUSE_CHAIN (c);
+ continue;
+ }
+
+ enum gomp_map_kind kind;
+ if (update_p)
+ {
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO)
+ kind = update_present_p ? GOMP_MAP_PRESENT_TO
+ : GOMP_MAP_TO;
+ else
+ kind = update_present_p ? GOMP_MAP_PRESENT_FROM
+ : GOMP_MAP_FROM;
+ }
+ else
+ {
+ kind = OMP_CLAUSE_MAP_KIND (c);
+ if (kind == GOMP_MAP_UNSET)
+ kind = GOMP_MAP_TOFROM;
+ }
+
+ type = TYPE_MAIN_VARIANT (type);
+
+ tree mapper_fn
+ = lang_hooks.decls.omp_mapper_lookup (mapper_name, type);
+
+ if (mapper_fn && nonunit_array_with_mapper)
+ {
+ sorry ("user-defined mapper with non-unit length "
+ "array section");
+ using_mapper = true;
+ }
+ else if (mapper_fn)
+ {
+ tree mapper
+ = lang_hooks.decls.omp_extract_mapper_directive (mapper_fn);
+ pc = omp_instantiate_mapper (OMP_CLAUSE_LOCATION (c),
+ pc, mapper, t, kind, ort);
+ using_mapper = true;
+ }
+ else if (mapper_name)
+ {
+ error ("mapper %qE not found for type %qT", mapper_name, type);
+ using_mapper = true;
+ }
+ }
+ break;
+
+ default:
+ ;
+ }
+
+ if (using_mapper)
+ *pc = OMP_CLAUSE_CHAIN (c);
+ else
+ pc = &OMP_CLAUSE_CHAIN (c);
+ }
+
+ return clauses;
}
const struct c_omp_directive c_omp_directives[] = {
diff --git a/gcc/c-family/c-pragma.h b/gcc/c-family/c-pragma.h
index 13df9ea..21cbc34 100644
--- a/gcc/c-family/c-pragma.h
+++ b/gcc/c-family/c-pragma.h
@@ -174,6 +174,7 @@ enum pragma_omp_clause {
PRAGMA_OMP_CLAUSE_USE,
PRAGMA_OMP_CLAUSE_USE_DEVICE_PTR,
PRAGMA_OMP_CLAUSE_USE_DEVICE_ADDR,
+ PRAGMA_OMP_CLAUSE_USES_ALLOCATORS,
/* Clauses for OpenACC. */
PRAGMA_OACC_CLAUSE_ASYNC,
diff --git a/gcc/c-family/c-pretty-print.cc b/gcc/c-family/c-pretty-print.cc
index 1ce19f5..1aac37b 100644
--- a/gcc/c-family/c-pretty-print.cc
+++ b/gcc/c-family/c-pretty-print.cc
@@ -1644,6 +1644,11 @@ c_pretty_printer::postfix_expression (tree e)
pp_colon (this);
if (TREE_OPERAND (e, 2))
expression (TREE_OPERAND (e, 2));
+ if (TREE_OPERAND (e, 3))
+ {
+ pp_colon (this);
+ expression (TREE_OPERAND (e, 3));
+ }
pp_c_right_bracket (this);
break;
diff --git a/gcc/c/ChangeLog.omp b/gcc/c/ChangeLog.omp
new file mode 100644
index 0000000..ff881b5
--- /dev/null
+++ b/gcc/c/ChangeLog.omp
@@ -0,0 +1,237 @@
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+
+ PR c++/119659
+ PR c++/118859
+ PR c++/119601
+ PR c++/119602
+ PR c++/119775
+ * c-parser.cc (c_omp_numeric_ranges_always_overlap): New function.
+ (c_parser_omp_parm_list): New function.
+ (c_finish_omp_declare_variant): Use c_parser_omp_parm_list instead
+ of c_parser_omp_variable_list. Refactor, change format of
+ "omp declare variant variant args" attribute.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * c-parser.cc (c_parser_omp_clause_map): Apply iterator to push and
+ pop mapper clauses.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * c-parser.cc (c_parser_omp_iterators): Use macros for accessing
+ iterator elements.
+ (c_parser_omp_clause_affinity): Likewise.
+ (c_parser_omp_clause_depend): Likewise.
+ (c_parser_omp_clause_map): Likewise.
+ (c_parser_omp_clause_from_to): Likewise.
+ * c-typeck.cc (c_omp_finish_iterators): Likewise.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * c-typeck.cc (handle_omp_array_sections): Add extra argument. Set
+ argument to true if array section has a stride that is not one.
+ (c_finish_omp_clauses): Disable strided updates when iterators are
+ used in the clause. Emit sorry if strided.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * c-parser.cc (c_parser_omp_clause_from_to): Parse 'iterator' modifier.
+ * c-typeck.cc (c_finish_omp_clauses): Finish iterators for to/from
+ clauses.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * c-parser.cc (c_parser_omp_clause_map): Parse 'iterator' modifier.
+ * c-typeck.cc (c_finish_omp_clauses): Finish iterators. Apply
+ iterators to generated clauses.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * c-typeck.cc (handle_omp_array_sections): Use OMP_ITERATOR_DECL_P.
+ (c_finish_omp_clauses): Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * c-parser.cc (c_parser_omp_variable_list): Adjust parsing of opening
+ square bracket.
+ (c_parser_omp_clause_reduction): Adjustments for
+ OpenACC-specific cases.
+ * c-typeck.cc (c_oacc_reduction_defined_type_p): New function.
+ (c_oacc_reduction_code_name): Likewise.
+ (c_finish_omp_clauses): Handle OpenACC cases using new functions.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Julian Brown <julian@codesourcery.com>
+
+ * c-decl.cc (current_omp_declare_variant_attribute): Define.
+ * c-lang.h (struct c_omp_declare_variant_attr): Declare.
+ (current_omp_declare_variant_attribute): Declare.
+ * c-parser.cc (c_parser_skip_to_pragma_omp_end_declare_variant): New.
+ (c_parser_translation_unit): Check for "omp begin declare variant"
+ with no matching "end".
+ (c_parser_declaration_or_fndef): Handle functions in "omp begin
+ declare variant" block.
+ (c_finish_omp_declare_variant): Merge context selectors with
+ surrounding "omp begin declare variant".
+ (JOIN_STR): Define.
+ (omp_start_variant_function): New.
+ (omp_finish_variant_function): New.
+ (c_parser_omp_begin): Handle "omp begin declare variant".
+ (c_parser_omp_end): Likewise.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+ Tobias Burnus <tobias@codesourcery.com>
+
+ * c-parser.cc (c_parser_omp_allocate): Fix typo in diagnostic.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Andrew Stubbs <ams@baylibre.com>
+ Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-parser.cc (c_parser_omp_variable_list): Support array-shaping
+ operator in 'declare mapper' definitions.
+ (c_parser_omp_clause_map): Pass C_ORT_OMP_DECLARE_MAPPER to
+ c_parser_omp_variable_list in mapper definitions.
+ (c_parser_omp_clause_from_to): Add parsing for mapper modifier.
+ (c_parser_omp_target_update): Instantiate mappers.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-parser.cc (c_parser_braced_init): Disallow array-shaping operator
+ in braced init.
+ (c_parser_conditional_expression): Disallow array-shaping operator in
+ conditional expression.
+ (c_parser_cast_expression): Add array-shaping operator support.
+ (c_parser_postfix_expression): Disallow array-shaping operator in
+ statement expressions.
+ (c_parser_postfix_expression_after_primary): Add OpenMP array section
+ stride support.
+ (c_parser_expr_list): Disallow array-shaping operator in expression
+ lists.
+ (c_array_type_nelts_total): New function.
+ (c_parser_omp_variable_list): Support array-shaping operator.
+ (c_parser_omp_target_update): Recognize GOMP_MAP_TO_GRID and
+ GOMP_MAP_FROM_GRID map kinds as well as OMP_CLAUSE_TO/OMP_CLAUSE_FROM.
+ * c-tree.h (c_omp_array_shaping_op_p, c_omp_has_array_shape_p): New
+ extern declarations.
+ (create_omp_arrayshape_type): Add prototype.
+ * c-typeck.cc (c_omp_array_shaping_op_p, c_omp_has_array_shape_p): New
+ globals.
+ (build_omp_array_section): Permit integral types, not just integer
+ constants, when creating array types for array sections.
+ (create_omp_arrayshape_type): New function.
+ (handle_omp_array_sections_1): Add DISCONTIGUOUS parameter. Add
+ strided/rectangular array section support.
+ (omp_array_section_low_bound): New function.
+ (handle_omp_array_sections): Add DISCONTIGUOUS parameter. Add
+ strided/rectangular array section support.
+ (c_finish_omp_clauses): Update calls to handle_omp_array_sections.
+ Handle discontiguous updates.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-parser.cc (c_parser_postfix_expression_after_primary): Dummy stride
+ support (for now).
+ (struct omp_dim): Add stride support.
+ (c_parser_omp_variable_list): Likewise.
+ * c-tree.h (build_omp_array_section): Update prototype.
+ * c-typeck.cc (mark_exp_read): Add stride support for
+ OMP_ARRAY_SECTION.
+ (build_omp_array_section): Add stride support.
+ (handle_omp_array_sections_1): Add minimal stride support.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-typeck.cc (handle_omp_array_sections): Pass pointer to clause to
+ process instead of clause.
+ (c_finish_omp_clauses): Update calls to handle_omp_array_sections.
+ Handle cases where initial clause might be replaced.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-parser.cc (c_parser_omp_target_data): Instantiate mappers for
+ 'omp target data'.
+ (c_parser_omp_target_enter_data): Instantiate mappers for 'omp target
+ enter data'.
+ (c_parser_omp_target_exit_data): Instantiate mappers for 'omp target
+ exit data'.
+ (c_parser_omp_target): Add c_omp_region_type argument to
+ c_omp_instantiate_mappers call.
+ * c-tree.h (c_omp_instantiate_mappers): Remove spurious prototype.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-decl.cc (c_omp_mapper_id, c_omp_mapper_decl, c_omp_mapper_lookup,
+ c_omp_extract_mapper_directive, c_omp_map_array_section,
+ c_omp_scan_mapper_bindings_r, c_omp_scan_mapper_bindings): New
+ functions.
+ * c-objc-common.h (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES,
+ LANG_HOOKS_OMP_MAPPER_LOOKUP, LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE,
+ LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define langhooks for C.
+ * c-parser.cc (c_parser_omp_clause_map): Add KIND parameter. Handle
+ mapper modifier.
+ (c_parser_omp_all_clauses): Update call to c_parser_omp_clause_map with
+ new kind argument.
+ (c_parser_omp_target): Instantiate explicit mappers and record bindings
+ for implicit mappers.
+ (c_parser_omp_declare_mapper): Parse "declare mapper" directives.
+ (c_parser_omp_declare): Support "declare mapper".
+ * c-tree.h (c_omp_finish_mapper_clauses, c_omp_mapper_lookup,
+ c_omp_extract_mapper_directive, c_omp_map_array_section,
+ c_omp_mapper_id, c_omp_mapper_decl, c_omp_scan_mapper_bindings,
+ c_omp_instantiate_mappers): Add prototypes.
+ * c-typeck.cc (c_finish_omp_clauses): Handle GOMP_MAP_PUSH_MAPPER_NAME
+ and GOMP_MAP_POP_MAPPER_NAME.
+ (c_omp_finish_mapper_clauses): New function (langhook).
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * c-parser.cc (c_parser_omp_clause_uses_allocators): New.
+ (c_parser_omp_clause_name, c_parser_omp_all_clauses,
+ OMP_TARGET_CLAUSE_MASK): Handle uses_allocators.
+ * c-typeck.cc (c_finish_omp_clauses): Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * c-typeck.cc (c_finish_omp_clauses): Adjust to allow duplicate
+ mapped variables for OpenMP.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+ Nathan Sidwell <nathan@acm.org>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+
+ * c-parser.cc (c_parser_omp_variable_list): New c_omp_region_type
+ argument. Use it to specialize handling of OMP_CLAUSE_REDUCTION for
+ OpenACC.
+ (c_parser_omp_var_list_parens): Add region-type argument to call.
+ (c_parser_oacc_data_clause): Likewise.
+ (c_parser_oacc_data_clause_deviceptr): Likewise.
+ (c_parser_omp_clause_reduction): Change is_omp boolean parameter to
+ c_omp_region_type. Update call to c_parser_omp_variable_list.
+ (c_parser_omp_clause_map): Update call to
+ c_parser_omp_variable_list.
+ (c_parser_omp_clause_from_to): Likewise.
+ (c_parser_omp_clause_init): Likewise.
+ (c_parser_oacc_all_clauses): Update calls to
+ c_parser_omp_clause_reduction.
+ (c_parser_omp_all_clauses): Likewise.
+ (c_parser_oacc_cache): Update call to c_parser_omp_variable_list.
+ * c-typeck.cc (c_finish_omp_clauses): Emit an error on orphan OpenACC
+ gang reductions. Suppress user-defined reduction error for OpenACC.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ PR other/76739
+ * c-typeck.cc (handle_omp_array_sections_1): Add 'bool &non_contiguous'
+ parameter, adjust recursive call site, add cases for allowing
+ pointer based multi-dimensional arrays for OpenACC. Reject
+ non-DECL base-pointer cases as unsupported.
+ (handle_omp_array_sections): Adjust handle_omp_array_sections_1 call,
+ handle non-contiguous case to create dynamic array map. \ No newline at end of file
diff --git a/gcc/c/c-decl.cc b/gcc/c/c-decl.cc
index 8c420f2..00cf955 100644
--- a/gcc/c/c-decl.cc
+++ b/gcc/c/c-decl.cc
@@ -163,6 +163,9 @@ vec<c_omp_declare_target_attr, va_gc> *current_omp_declare_target_attribute;
we are in. */
vec<c_omp_begin_assumes_data, va_gc> *current_omp_begin_assumes;
+/* Vector of "omp begin/end declare variant" blocks we are in. */
+vec<c_omp_declare_variant_attr, va_gc> *current_omp_declare_variant_attribute;
+
/* Vector of loop names with C_DECL_LOOP_NAME or C_DECL_SWITCH_NAME marked
LABEL_DECL as the last and canonical for each loop or switch. */
static vec<tree> loop_names;
@@ -13857,6 +13860,175 @@ c_check_omp_declare_reduction_r (tree *tp, int *, void *data)
return NULL_TREE;
}
+/* Return identifier to look up for omp declare reduction. */
+
+tree
+c_omp_mapper_id (tree mapper_id)
+{
+ const char *p = NULL;
+
+ const char prefix[] = "omp declare mapper ";
+
+ if (mapper_id == NULL_TREE)
+ p = "<default>";
+ else if (TREE_CODE (mapper_id) == IDENTIFIER_NODE)
+ p = IDENTIFIER_POINTER (mapper_id);
+ else
+ return error_mark_node;
+
+ size_t lenp = sizeof (prefix);
+ size_t len = strlen (p);
+ char *name = XALLOCAVEC (char, lenp + len);
+ memcpy (name, prefix, lenp - 1);
+ memcpy (name + lenp - 1, p, len + 1);
+ return get_identifier (name);
+}
+
+/* Lookup MAPPER_ID in the current scope, or create an artificial
+ VAR_DECL, bind it into the current scope and return it. */
+
+tree
+c_omp_mapper_decl (tree mapper_id)
+{
+ struct c_binding *b = I_SYMBOL_BINDING (mapper_id);
+ if (b != NULL && B_IN_CURRENT_SCOPE (b))
+ return b->decl;
+
+ tree decl = build_decl (BUILTINS_LOCATION, VAR_DECL,
+ mapper_id, integer_type_node);
+ DECL_ARTIFICIAL (decl) = 1;
+ DECL_EXTERNAL (decl) = 1;
+ TREE_STATIC (decl) = 1;
+ TREE_PUBLIC (decl) = 0;
+ bind (mapper_id, decl, current_scope, true, false, BUILTINS_LOCATION);
+ return decl;
+}
+
+/* Lookup MAPPER_ID in the first scope where it has entry for TYPE. */
+
+tree
+c_omp_mapper_lookup (tree mapper_id, tree type)
+{
+ if (TREE_CODE (type) != RECORD_TYPE
+ && TREE_CODE (type) != UNION_TYPE)
+ return NULL_TREE;
+
+ mapper_id = c_omp_mapper_id (mapper_id);
+
+ struct c_binding *b = I_SYMBOL_BINDING (mapper_id);
+ while (b)
+ {
+ tree t;
+ for (t = DECL_INITIAL (b->decl); t; t = TREE_CHAIN (t))
+ if (comptypes (TREE_PURPOSE (t), type))
+ return TREE_VALUE (t);
+ b = b->shadowed;
+ }
+ return NULL_TREE;
+}
+
+/* For C, we record a pointer to the mapper itself without wrapping it in an
+ artificial function or similar. So, just return it. */
+
+tree
+c_omp_extract_mapper_directive (tree mapper)
+{
+ return mapper;
+}
+
+/* For now we can handle singleton OMP_ARRAY_SECTIONs with custom mappers, but
+ nothing more complicated. */
+
+tree
+c_omp_map_array_section (location_t loc, tree t)
+{
+ tree low = TREE_OPERAND (t, 1);
+ tree len = TREE_OPERAND (t, 2);
+
+ if (len && integer_onep (len))
+ {
+ t = TREE_OPERAND (t, 0);
+
+ if (!low)
+ low = integer_zero_node;
+
+ t = build_array_ref (loc, t, low);
+ }
+
+ return t;
+}
+
+/* Helper function for below function. */
+
+static tree
+c_omp_scan_mapper_bindings_r (tree *tp, int *walk_subtrees, void *ptr)
+{
+ tree t = *tp;
+ omp_mapper_list<tree> *mlist = (omp_mapper_list<tree> *) ptr;
+ tree aggr_type = NULL_TREE;
+
+ if (TREE_CODE (t) == SIZEOF_EXPR
+ || TREE_CODE (t) == ALIGNOF_EXPR)
+ {
+ *walk_subtrees = 0;
+ return NULL_TREE;
+ }
+
+ if (TREE_CODE (t) == OMP_CLAUSE)
+ return NULL_TREE;
+
+ if (TREE_CODE (t) == COMPONENT_REF
+ && AGGREGATE_TYPE_P (TREE_TYPE (TREE_OPERAND (t, 0))))
+ aggr_type = TREE_TYPE (TREE_OPERAND (t, 0));
+ else if ((TREE_CODE (t) == VAR_DECL
+ || TREE_CODE (t) == PARM_DECL
+ || TREE_CODE (t) == RESULT_DECL)
+ && AGGREGATE_TYPE_P (TREE_TYPE (t)))
+ aggr_type = TREE_TYPE (t);
+
+ if (aggr_type)
+ {
+ tree mapper_fn = c_omp_mapper_lookup (NULL_TREE, aggr_type);
+ if (mapper_fn)
+ mlist->add_mapper (NULL_TREE, aggr_type, mapper_fn);
+ }
+
+ return NULL_TREE;
+}
+
+/* Scan an offload region's body, and record uses of struct- or union-typed
+ variables. Add _mapper_binding_ fake clauses to *CLAUSES_PTR. */
+
+void
+c_omp_scan_mapper_bindings (location_t loc, tree *clauses_ptr, tree body)
+{
+ hash_set<omp_name_type<tree>> seen_types;
+ auto_vec<tree> mappers;
+ omp_mapper_list<tree> mlist (&seen_types, &mappers);
+
+ walk_tree_without_duplicates (&body, c_omp_scan_mapper_bindings_r, &mlist);
+
+ unsigned int i;
+ tree mapper;
+ FOR_EACH_VEC_ELT (mappers, i, mapper)
+ c_omp_find_nested_mappers (&mlist, mapper);
+
+ FOR_EACH_VEC_ELT (mappers, i, mapper)
+ {
+ if (mapper == error_mark_node)
+ continue;
+ tree mapper_name = OMP_DECLARE_MAPPER_ID (mapper);
+ tree decl = OMP_DECLARE_MAPPER_DECL (mapper);
+
+ tree c = build_omp_clause (loc, OMP_CLAUSE__MAPPER_BINDING_);
+ OMP_CLAUSE__MAPPER_BINDING__ID (c) = mapper_name;
+ OMP_CLAUSE__MAPPER_BINDING__DECL (c) = decl;
+ OMP_CLAUSE__MAPPER_BINDING__MAPPER (c) = mapper;
+
+ OMP_CLAUSE_CHAIN (c) = *clauses_ptr;
+ *clauses_ptr = c;
+ }
+}
bool
c_check_in_current_scope (tree decl)
diff --git a/gcc/c/c-lang.h b/gcc/c/c-lang.h
index 4b93d18..cd68fc0 100644
--- a/gcc/c/c-lang.h
+++ b/gcc/c/c-lang.h
@@ -72,6 +72,11 @@ struct GTY(()) c_omp_begin_assumes_data {
bool attr_syntax;
};
+struct GTY(()) c_omp_declare_variant_attr {
+ bool attr_syntax;
+ tree selector;
+};
+
/* If non-empty, implicit "omp declare target" attribute is added into the
attribute lists. */
extern GTY(()) vec<c_omp_declare_target_attr, va_gc>
@@ -80,5 +85,8 @@ extern GTY(()) vec<c_omp_declare_target_attr, va_gc>
#pragma omp end assumes (and how many times when nested). */
extern GTY(()) vec<c_omp_begin_assumes_data, va_gc>
*current_omp_begin_assumes;
+/* And similarly for #pragma omp begin/end declare variant. */
+extern GTY(()) vec<c_omp_declare_variant_attr, va_gc>
+ *current_omp_declare_variant_attribute;
#endif /* ! GCC_C_LANG_H */
diff --git a/gcc/c/c-objc-common.h b/gcc/c/c-objc-common.h
index 84bd357..84f6fd3 100644
--- a/gcc/c/c-objc-common.h
+++ b/gcc/c/c-objc-common.h
@@ -137,6 +137,18 @@ static const scoped_attribute_specs *const c_objc_attribute_table[] =
#undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
#define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP c_omp_clause_copy_ctor
+#undef LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES
+#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES c_omp_finish_mapper_clauses
+
+#undef LANG_HOOKS_OMP_MAPPER_LOOKUP
+#define LANG_HOOKS_OMP_MAPPER_LOOKUP c_omp_mapper_lookup
+
+#undef LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE
+#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE c_omp_extract_mapper_directive
+
+#undef LANG_HOOKS_OMP_MAP_ARRAY_SECTION
+#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION c_omp_map_array_section
+
#undef LANG_HOOKS_TREE_INLINING_VAR_MOD_TYPE_P
#define LANG_HOOKS_TREE_INLINING_VAR_MOD_TYPE_P c_var_mod_p
#endif /* GCC_C_OBJC_COMMON */
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 22ec0f8..9af7440 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -1456,6 +1456,55 @@ c_parser_skip_to_pragma_eol (c_parser *parser, bool error_if_not_eol = true)
parser->error = false;
}
+/* Skip tokens up to and including "#pragma omp end declare variant".
+ Properly handle nested "#pragma omp begin declare variant" pragmas. */
+static void
+c_parser_skip_to_pragma_omp_end_declare_variant (c_parser *parser)
+{
+ for (int depth = 0; depth >= 0; )
+ {
+ c_token *token = c_parser_peek_token (parser);
+
+ switch (token->type)
+ {
+ case CPP_PRAGMA_EOL:
+ if (!parser->in_pragma)
+ break;
+ /* FALLTHRU */
+ case CPP_EOF:
+ /* If we've run out of tokens, stop. */
+ return;
+
+ case CPP_PRAGMA:
+ if ((token->pragma_kind == PRAGMA_OMP_BEGIN
+ || token->pragma_kind == PRAGMA_OMP_END)
+ && c_parser_peek_nth_token (parser, 2)->type == CPP_NAME
+ && c_parser_peek_nth_token (parser, 3)->type == CPP_NAME)
+ {
+ tree id1 = c_parser_peek_nth_token (parser, 2)->value;
+ tree id2 = c_parser_peek_nth_token (parser, 3)->value;
+ if (strcmp (IDENTIFIER_POINTER (id1), "declare") == 0
+ && strcmp (IDENTIFIER_POINTER (id2), "variant") == 0)
+ {
+ if (token->pragma_kind == PRAGMA_OMP_BEGIN)
+ depth++;
+ else
+ depth--;
+ }
+ }
+ c_parser_consume_pragma (parser);
+ c_parser_skip_to_pragma_eol (parser, false);
+ continue;
+
+ default:
+ break;
+ }
+
+ /* Consume the token. */
+ c_parser_consume_token (parser);
+ }
+}
+
/* Skip tokens until we have consumed an entire block, or until we
have consumed a non-nested ';'. */
@@ -1979,6 +2028,13 @@ c_parser_translation_unit (c_parser *parser)
"#pragma omp end declare target");
vec_safe_truncate (current_omp_declare_target_attribute, 0);
}
+ if (vec_safe_length (current_omp_declare_variant_attribute))
+ {
+ if (!errorcount)
+ error ("%<omp begin declare variant%> without corresponding "
+ "%<omp end declare variant%>");
+ vec_safe_truncate (current_omp_declare_variant_attribute, 0);
+ }
if (vec_safe_length (current_omp_begin_assumes))
{
if (!errorcount)
@@ -2112,6 +2168,8 @@ static void c_parser_handle_directive_omp_attributes (tree &, vec<c_token> *&,
vec<c_token> *);
static void c_finish_omp_declare_simd (c_parser *, tree, tree, vec<c_token> *);
static void c_finish_oacc_routine (struct oacc_routine_data *, tree, bool);
+static tree omp_start_variant_function (c_declarator *, tree);
+static void omp_finish_variant_function (tree, tree, tree);
/* Build and add a DEBUG_BEGIN_STMT statement with location LOC. */
@@ -3064,6 +3122,21 @@ c_parser_declaration_or_fndef (c_parser *parser, bool fndef_ok,
pedwarn (here, OPT_Wpedantic, "ISO C forbids nested functions");
c_push_function_context ();
}
+
+ /* If we're in an OpenMP "begin declare variant" block, the
+ name in the declarator refers to the base function. We need
+ to save that and modify the declarator to have the mangled
+ name for the variant function instead. */
+ tree dv_base = NULL_TREE;
+ tree dv_ctx = NULL_TREE;
+ if (!vec_safe_is_empty (current_omp_declare_variant_attribute))
+ {
+ c_omp_declare_variant_attr a
+ = current_omp_declare_variant_attribute->last ();
+ dv_ctx = copy_list (a.selector);
+ dv_base = omp_start_variant_function (declarator, dv_ctx);
+ }
+
if (!start_function (specs, declarator, all_prefix_attrs))
{
/* At this point we've consumed:
@@ -3141,6 +3214,11 @@ c_parser_declaration_or_fndef (c_parser *parser, bool fndef_ok,
DECL_STRUCT_FUNCTION (current_function_decl)->function_start_locus
= startloc;
location_t endloc = startloc;
+ /* If this function was in a "begin declare variant" block,
+ store the pointer back to the base function and fix up
+ the attributes for the middle end. */
+ if (dv_base && current_function_decl != error_mark_node)
+ omp_finish_variant_function (current_function_decl, dv_base, dv_ctx);
/* If the definition was marked with __RTL, use the RTL parser now,
consuming the function body. */
@@ -6438,7 +6516,9 @@ c_parser_braced_init (c_parser *parser, tree type, bool nested_p,
gcc_obstack_init (&braced_init_obstack);
gcc_assert (c_parser_next_token_is (parser, CPP_OPEN_BRACE));
bool save_c_omp_array_section_p = c_omp_array_section_p;
+ bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p;
c_omp_array_section_p = false;
+ c_omp_array_shaping_op_p = false;
bool zero_init_padding_bits = false;
matching_braces braces;
braces.consume_open (parser);
@@ -6500,6 +6580,7 @@ c_parser_braced_init (c_parser *parser, tree type, bool nested_p,
}
}
c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
c_token *next_tok = c_parser_peek_token (parser);
if (next_tok->type != CPP_CLOSE_BRACE)
{
@@ -9900,6 +9981,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after,
struct c_expr cond, exp1, exp2, ret;
location_t start, cond_loc, colon_loc;
bool save_c_omp_array_section_p = c_omp_array_section_p;
+ bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p;
gcc_assert (!after || c_dialect_objc ());
@@ -9908,6 +9990,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after,
if (c_parser_next_token_is_not (parser, CPP_QUERY))
return cond;
c_omp_array_section_p = false;
+ c_omp_array_shaping_op_p = false;
if (cond.value != error_mark_node)
start = cond.get_start ();
else
@@ -9961,6 +10044,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after,
ret.original_code = ERROR_MARK;
ret.original_type = NULL;
c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
return ret;
}
{
@@ -10008,6 +10092,7 @@ c_parser_conditional_expression (c_parser *parser, struct c_expr *after,
set_c_expr_source_range (&ret, start, exp2.get_finish ());
ret.m_decimal = 0;
c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
return ret;
}
@@ -10389,6 +10474,8 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after)
if (after)
return c_parser_postfix_expression_after_primary (parser,
cast_loc, *after);
+ bool save_c_omp_has_array_shape_p = c_omp_has_array_shape_p;
+ c_omp_has_array_shape_p = false;
/* If the expression begins with a parenthesized type name, it may
be either a cast or a compound literal; we need to see whether
the next character is '{' to tell the difference. If not, it is
@@ -10397,6 +10484,10 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after)
if (c_parser_next_token_is (parser, CPP_OPEN_PAREN)
&& c_token_starts_compound_literal (c_parser_peek_2nd_token (parser)))
{
+ bool save_c_omp_array_section_p = c_omp_array_section_p;
+ bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p;
+ c_omp_array_section_p = false;
+ c_omp_array_shaping_op_p = false;
struct c_declspecs *scspecs;
struct c_type_name *type_name;
struct c_expr ret;
@@ -10408,6 +10499,8 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after)
parens.skip_until_found_close (parser);
if (type_name == NULL)
{
+ c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
ret.set_error ();
ret.original_code = ERROR_MARK;
ret.original_type = NULL;
@@ -10418,9 +10511,15 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after)
used_types_insert (type_name->specs->type);
if (c_parser_next_token_is (parser, CPP_OPEN_BRACE))
- return c_parser_postfix_expression_after_paren_type (parser, scspecs,
- type_name,
- cast_loc);
+ {
+ c_expr r = c_parser_postfix_expression_after_paren_type (parser,
+ scspecs,
+ type_name,
+ cast_loc);
+ c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
+ return r;
+ }
if (scspecs)
error_at (cast_loc, "storage class specifier in cast");
if (type_name->specs->alignas_p)
@@ -10437,10 +10536,61 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after)
ret.original_code = ERROR_MARK;
ret.original_type = NULL;
ret.m_decimal = 0;
+ c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
+ return ret;
+ }
+ else if (c_omp_array_shaping_op_p
+ && c_parser_next_token_is (parser, CPP_OPEN_PAREN)
+ && c_parser_peek_2nd_token (parser)->type == CPP_OPEN_SQUARE)
+ {
+ bool save_c_omp_array_section_p = c_omp_array_section_p;
+ bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p;
+ c_omp_array_section_p = false;
+ c_omp_array_shaping_op_p = false;
+ auto_vec<tree, 4> omp_shape_dims;
+ struct c_expr expr, ret;
+ matching_parens parens;
+ parens.consume_open (parser);
+ while (c_parser_next_token_is (parser, CPP_OPEN_SQUARE))
+ {
+ c_parser_consume_token (parser);
+ c_expr e = c_parser_expression (parser);
+ if (e.value == error_mark_node)
+ break;
+ omp_shape_dims.safe_push (e.value);
+ if (!c_parser_require (parser, CPP_CLOSE_SQUARE,
+ "expected %<]%>"))
+ break;
+ }
+ parens.require_close (parser);
+ c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
+ {
+ location_t expr_loc = c_parser_peek_token (parser)->location;
+ bool save_c_omp_has_array_shape_p = c_omp_has_array_shape_p;
+ c_omp_has_array_shape_p = true;
+ expr = c_parser_cast_expression (parser, NULL);
+ c_omp_has_array_shape_p = save_c_omp_has_array_shape_p;
+ /* NOTE: We don't want to introduce conversions here. */
+ expr = convert_lvalue_to_rvalue (expr_loc, expr, false, true);
+ }
+ tree arrtype
+ = create_omp_arrayshape_type (expr.value, &omp_shape_dims);
+ ret.value = build1_loc (cast_loc, VIEW_CONVERT_EXPR, arrtype,
+ expr.value);
+ if (ret.value && expr.value)
+ set_c_expr_source_range (&ret, cast_loc, expr.get_finish ());
+ ret.original_code = ERROR_MARK;
+ ret.original_type = NULL;
+ ret.m_decimal = 0;
return ret;
}
else
- return c_parser_unary_expression (parser);
+ {
+ c_omp_has_array_shape_p = save_c_omp_has_array_shape_p;
+ return c_parser_unary_expression (parser);
+ }
}
/* Parse an unary expression (C90 6.3.3, C99 6.5.3, C11 6.5.3).
@@ -11528,6 +11678,7 @@ c_parser_postfix_expression (c_parser *parser)
tree stmt;
location_t brace_loc;
bool save_c_omp_array_section_p = c_omp_array_section_p;
+ bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p;
c_parser_consume_token (parser);
brace_loc = c_parser_peek_token (parser)->location;
c_parser_consume_token (parser);
@@ -11545,6 +11696,7 @@ c_parser_postfix_expression (c_parser *parser)
break;
}
c_omp_array_section_p = false;
+ c_omp_array_shaping_op_p = false;
stmt = c_begin_stmt_expr ();
c_parser_compound_statement_nostart (parser);
location_t close_loc = c_parser_peek_token (parser)->location;
@@ -11556,6 +11708,7 @@ c_parser_postfix_expression (c_parser *parser)
set_c_expr_source_range (&expr, loc, close_loc);
mark_exp_read (expr.value);
c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
}
else
{
@@ -13628,15 +13781,38 @@ c_parser_postfix_expression_after_primary (c_parser *parser,
if (c_omp_array_section_p
&& c_parser_next_token_is (parser, CPP_COLON))
{
+ tree stride = NULL_TREE;
+
c_parser_consume_token (parser);
if (c_parser_next_token_is_not (parser, CPP_CLOSE_SQUARE))
len = c_parser_expression (parser).value;
+ if (c_parser_next_token_is (parser, CPP_COLON))
+ {
+ c_parser_consume_token (parser);
+ if (c_parser_next_token_is_not (parser, CPP_CLOSE_SQUARE))
+ stride = c_parser_expression (parser).value;
+ }
+
expr.value = build_omp_array_section (op_loc, expr.value, idx,
- len);
+ len, stride);
}
else
- expr.value = build_array_ref (op_loc, expr.value, idx);
+ {
+ if (c_omp_has_array_shape_p)
+ /* If we have an array-shaping operator, we may not be able to
+ represent a well-formed ARRAY_REF here, because we are
+ coercing the type of the innermost array base and the
+ original type may not be compatible. Use the
+ OMP_ARRAY_SECTION code instead. We also want to explicitly
+ avoid creating INDIRECT_REFs for pointer bases, because
+ that can lead to parsing ambiguities (see
+ c_parser_omp_variable_list). */
+ expr.value = build_omp_array_section (op_loc, expr.value, idx,
+ size_one_node, NULL_TREE);
+ else
+ expr.value = build_array_ref (op_loc, expr.value, idx);
+ }
c_parser_skip_until_found (parser, CPP_CLOSE_SQUARE,
"expected %<]%>");
@@ -13834,8 +14010,8 @@ c_parser_postfix_expression_after_primary (c_parser *parser,
finish = c_parser_peek_token (parser)->get_finish ();
c_parser_consume_token (parser);
expr = default_function_array_read_conversion (expr_loc, expr);
- expr.value = build_unary_op (op_loc, POSTINCREMENT_EXPR,
- expr.value, false);
+ expr.value
+ = build_unary_op (op_loc, POSTINCREMENT_EXPR, expr.value, false);
set_c_expr_source_range (&expr, start, finish);
expr.original_code = ERROR_MARK;
expr.original_type = NULL;
@@ -13987,7 +14163,9 @@ c_parser_expr_list (c_parser *parser, bool convert_p, bool fold_p,
struct c_expr expr;
unsigned int idx = 0;
bool save_c_omp_array_section_p = c_omp_array_section_p;
+ bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p;
c_omp_array_section_p = false;
+ c_omp_array_shaping_op_p = false;
ret = make_tree_vector ();
if (p_orig_types == NULL)
@@ -14069,6 +14247,7 @@ c_parser_expr_list (c_parser *parser, bool convert_p, bool fold_p,
if (orig_types)
*p_orig_types = orig_types;
c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
return ret;
}
@@ -16244,6 +16423,8 @@ c_parser_omp_clause_name (c_parser *parser)
result = PRAGMA_OMP_CLAUSE_USE_DEVICE_ADDR;
else if (!strcmp ("use_device_ptr", p))
result = PRAGMA_OMP_CLAUSE_USE_DEVICE_PTR;
+ else if (!strcmp ("uses_allocators", p))
+ result = PRAGMA_OMP_CLAUSE_USES_ALLOCATORS;
break;
case 'v':
if (!strcmp ("vector", p))
@@ -16319,6 +16500,24 @@ c_parser_oacc_wait_list (c_parser *parser, location_t clause_loc, tree list)
return list;
}
+/* Return, as an INTEGER_CST node, the number of elements for TYPE
+ (which is an ARRAY_TYPE). This one is a recursive count of all
+ ARRAY_TYPEs that are clumped together. (From cp/tree.cc). */
+
+static tree
+c_array_type_nelts_total (tree type)
+{
+ tree sz = array_type_nelts_top (type);
+ type = TREE_TYPE (type);
+ while (TREE_CODE (type) == ARRAY_TYPE)
+ {
+ tree n = array_type_nelts_top (type);
+ sz = fold_build2_loc (input_location, MULT_EXPR, sizetype, sz, n);
+ type = TREE_TYPE (type);
+ }
+ return sz;
+}
+
/* OpenACC 2.0, OpenMP 2.5:
variable-list:
identifier
@@ -16332,22 +16531,23 @@ c_parser_oacc_wait_list (c_parser *parser, location_t clause_loc, tree list)
in TREE_PURPOSE and the location in TREE_VALUE (accessible using
EXPR_LOCATION); return the list created.
- The optional ALLOW_DEREF argument is true if list items can use the deref
+ The optional MAP_LVALUE argument is true if list items can use the deref
(->) operator. */
struct omp_dim
{
- tree low_bound, length;
+ tree low_bound, length, stride;
location_t loc;
bool no_colon;
- omp_dim (tree lb, tree len, location_t lo, bool nc)
- : low_bound (lb), length (len), loc (lo), no_colon (nc) {}
+ omp_dim (tree lb, tree len, tree str, location_t lo, bool nc)
+ : low_bound (lb), length (len), stride (str), loc (lo), no_colon (nc) {}
};
static tree
c_parser_omp_variable_list (c_parser *parser,
location_t clause_loc,
enum omp_clause_code kind, tree list,
+ enum c_omp_region_type ort = C_ORT_OMP,
bool map_lvalue = false)
{
auto_vec<omp_dim> dims;
@@ -16447,12 +16647,26 @@ c_parser_omp_variable_list (c_parser *parser,
{
location_t loc = c_parser_peek_token (parser)->location;
bool save_c_omp_array_section_p = c_omp_array_section_p;
+ bool save_c_omp_array_shaping_op_p = c_omp_array_shaping_op_p;
c_omp_array_section_p = true;
+ c_omp_array_shaping_op_p
+ = (kind == OMP_CLAUSE_TO
+ || kind == OMP_CLAUSE_FROM
+ || ort == C_ORT_OMP_DECLARE_MAPPER);
c_expr expr = c_parser_expr_no_commas (parser, NULL);
if (expr.value != error_mark_node)
mark_exp_read (expr.value);
c_omp_array_section_p = save_c_omp_array_section_p;
+ c_omp_array_shaping_op_p = save_c_omp_array_shaping_op_p;
tree decl = expr.value;
+ tree reshaped_to = NULL_TREE;
+
+ if (TREE_CODE (decl) == VIEW_CONVERT_EXPR
+ && TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
+ {
+ reshaped_to = TREE_TYPE (decl);
+ decl = TREE_OPERAND (decl, 0);
+ }
/* This code rewrites a parsed expression containing various tree
codes used to represent array accesses into a more uniform nest of
@@ -16465,41 +16679,143 @@ c_parser_omp_variable_list (c_parser *parser,
dims.truncate (0);
if (TREE_CODE (decl) == OMP_ARRAY_SECTION)
{
+ size_t sections = 0;
+ tree orig_decl = decl;
+ bool update_p = (kind == OMP_CLAUSE_TO
+ || kind == OMP_CLAUSE_FROM);
+ bool maybe_ptr_based_noncontig_update = false;
+
+ while (update_p
+ && !reshaped_to
+ && (TREE_CODE (decl) == OMP_ARRAY_SECTION
+ || TREE_CODE (decl) == ARRAY_REF
+ || TREE_CODE (decl) == COMPOUND_EXPR))
+ {
+ if (TREE_CODE (decl) == COMPOUND_EXPR)
+ decl = TREE_OPERAND (decl, 1);
+ else
+ {
+ if (TREE_CODE (decl) == OMP_ARRAY_SECTION)
+ maybe_ptr_based_noncontig_update = true;
+ decl = TREE_OPERAND (decl, 0);
+ sections++;
+ }
+ }
+
+ decl = orig_decl;
+
while (TREE_CODE (decl) == OMP_ARRAY_SECTION)
{
tree low_bound = TREE_OPERAND (decl, 1);
tree length = TREE_OPERAND (decl, 2);
- dims.safe_push (omp_dim (low_bound, length, loc, false));
+ tree stride = TREE_OPERAND (decl, 3);
+ dims.safe_push (omp_dim (low_bound, length, stride, loc,
+ false));
decl = TREE_OPERAND (decl, 0);
+ if (sections > 0)
+ sections--;
}
+ /* The handling of INDIRECT_REF here in the presence of
+ array-shaping operations is a little tricky. We need to
+ avoid treating a pointer dereference as a unit-sized array
+ section when we have an array shaping operation, because we
+ don't want an indirection to consume one of the user's
+ requested array dimensions. E.g. if we have a
+ double-indirect pointer like:
+
+ int **foopp;
+ #pragma omp target update from(([N][N]) (*foopp)[0:X][0:Y])
+
+ We don't want to interpret this as:
+
+ foopp[0:1][0:X][0:Y]
+
+ else the array shape [N][N] won't match. Also we can't match
+ the array sections right-to-left instead, else this:
+
+ #pragma omp target update from(([N][N]) (*foopp)[0:X])
+
+ would not copy the dimensions:
+
+ (*foopp)[0:X][0:N]
+
+ as required. So, avoid descending through INDIRECT_REFs if
+ we have an array-shaping op.
+
+ If we *don't* have an array-shaping op, but we have a
+ multiply-indirected pointer and an array section like this:
+
+ int ***fooppp;
+ #pragma omp target update from((**fooppp)[0:X:S]
+
+ also avoid descending through more indirections than we have
+ array sections, since the noncontiguous update processing code
+ won't understand them (and doesn't need to traverse them
+ anyway). */
+
while (TREE_CODE (decl) == ARRAY_REF
- || TREE_CODE (decl) == INDIRECT_REF
+ || (TREE_CODE (decl) == INDIRECT_REF
+ && !reshaped_to)
|| TREE_CODE (decl) == COMPOUND_EXPR)
{
+ if (maybe_ptr_based_noncontig_update && sections == 0)
+ break;
+
if (TREE_CODE (decl) == COMPOUND_EXPR)
{
decl = TREE_OPERAND (decl, 1);
STRIP_NOPS (decl);
}
- else if (TREE_CODE (decl) == INDIRECT_REF)
+ else if (TREE_CODE (decl) == INDIRECT_REF
+ && !reshaped_to)
{
dims.safe_push (omp_dim (integer_zero_node,
- integer_one_node, loc, true));
+ integer_one_node, NULL_TREE, loc,
+ true));
decl = TREE_OPERAND (decl, 0);
}
else /* ARRAY_REF. */
{
tree index = TREE_OPERAND (decl, 1);
- dims.safe_push (omp_dim (index, integer_one_node, loc,
- true));
+ dims.safe_push (omp_dim (index, integer_one_node,
+ NULL_TREE, loc, true));
decl = TREE_OPERAND (decl, 0);
+ if (sections > 0)
+ sections--;
+ }
+ }
+
+ if (reshaped_to)
+ {
+ unsigned reshaped_dims = 0;
+
+ for (tree t = reshaped_to;
+ TREE_CODE (t) == ARRAY_TYPE;
+ t = TREE_TYPE (t))
+ reshaped_dims++;
+
+ if (dims.length () > reshaped_dims)
+ {
+ error_at (loc, "too many array section specifiers "
+ "for %qT", reshaped_to);
+ decl = error_mark_node;
+ }
+ else
+ {
+ /* We have a pointer DECL whose target should be
+ interpreted as an array with particular dimensions,
+ not "the pointer itself". So, add an indirection
+ here. */
+ decl = build_indirect_ref (loc, decl, RO_UNARY_STAR);
+ decl = build1_loc (loc, VIEW_CONVERT_EXPR, reshaped_to,
+ decl);
}
}
for (int i = dims.length () - 1; i >= 0; i--)
decl = build_omp_array_section (loc, decl, dims[i].low_bound,
- dims[i].length);
+ dims[i].length, dims[i].stride);
}
else if (TREE_CODE (decl) == INDIRECT_REF)
{
@@ -16508,7 +16824,7 @@ c_parser_omp_variable_list (c_parser *parser,
STRIP_NOPS (decl);
decl = build_omp_array_section (loc, decl, integer_zero_node,
- integer_one_node);
+ integer_one_node, NULL_TREE);
}
else if (TREE_CODE (decl) == ARRAY_REF)
{
@@ -16517,7 +16833,16 @@ c_parser_omp_variable_list (c_parser *parser,
decl = TREE_OPERAND (decl, 0);
STRIP_NOPS (decl);
- decl = build_omp_array_section (loc, decl, idx, integer_one_node);
+ decl = build_omp_array_section (loc, decl, idx, integer_one_node,
+ NULL_TREE);
+ }
+ else if (reshaped_to)
+ {
+ /* We're copying the whole of a reshaped array, originally a
+ base pointer. Rewrite as an array section. */
+ tree elems = c_array_type_nelts_total (reshaped_to);
+ decl = build_omp_array_section (loc, decl, size_zero_node, elems,
+ NULL_TREE);
}
else if (TREE_CODE (decl) == NON_LVALUE_EXPR
|| CONVERT_EXPR_P (decl))
@@ -16670,7 +16995,8 @@ c_parser_omp_variable_list (c_parser *parser,
break;
}
- dims.safe_push (omp_dim (low_bound, length, loc, no_colon));
+ dims.safe_push (omp_dim (low_bound, length, NULL_TREE, loc,
+ no_colon));
}
if (t != error_mark_node)
@@ -16694,7 +17020,8 @@ c_parser_omp_variable_list (c_parser *parser,
for (unsigned i = 0; i < dims.length (); i++)
t = build_omp_array_section (clause_loc, t,
dims[i].low_bound,
- dims[i].length);
+ dims[i].length,
+ dims[i].stride);
}
if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
@@ -16754,12 +17081,14 @@ c_parser_omp_variable_list (c_parser *parser,
}
/* Similarly, but expect leading and trailing parenthesis. This is a very
- common case for OpenACC and OpenMP clauses. The optional ALLOW_DEREF
+ common case for OpenACC and OpenMP clauses. The optional MAP_LVALUE
argument is true if list items can use the deref (->) operator. */
static tree
c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind,
- tree list, bool map_lvalue = false)
+ tree list,
+ enum c_omp_region_type ort = C_ORT_OMP,
+ bool map_lvalue = false)
{
/* The clauses location. */
location_t loc = c_parser_peek_token (parser)->location;
@@ -16780,12 +17109,729 @@ c_parser_omp_var_list_parens (c_parser *parser, enum omp_clause_code kind,
matching_parens parens;
if (parens.require_open (parser))
{
- list = c_parser_omp_variable_list (parser, loc, kind, list, map_lvalue);
+ list = c_parser_omp_variable_list (parser, loc, kind, list, ort,
+ map_lvalue);
parens.skip_until_found_close (parser);
}
return list;
}
+/* Helper for c_parser_omp_parm_list and c_finish_omp_declare_variant.
+ Compare two OpenMP parameter-list-item numeric ranges with a relative bound.
+ Returns true if they always overlap for any value of omp_num_args,
+ returns false otherwise.
+
+ Literal bounds are never compared with each other here,
+ c_parser_omp_parm_list already handles that case.
+
+ In hindsight, this was never really worth doing. If there is ever a case
+ found that this function gets wrong the best course of action is probably
+ to just disable the section that causes a problem. This function only
+ serves to diagnose overlapping numeric ranges in variadic functions early,
+ gimplify.cc:modify_call_for_omp_dispatch will always catch these problems
+ when the numeric range is expanded even if this function misses any cases.
+
+ If I could go back in time, I would stop myself from writing this, but it's
+ already done now. It technically does serve its purpose of providing better
+ diagnostics for niche scenarios, so until it breaks, here it is. */
+
+static bool
+c_omp_numeric_ranges_always_overlap (tree first, tree second)
+{
+ gcc_assert (first && TREE_CODE (first) == TREE_LIST
+ && second && TREE_CODE (second) == TREE_LIST);
+
+ auto bound_is_relative = [] (tree bound) -> bool
+ {
+ gcc_assert (!TREE_PURPOSE (bound)
+ || TREE_PURPOSE (bound)
+ == get_identifier ("omp relative bound"));
+ /* NULL_TREE means literal, the only other possible value is
+ get_identifier ("omp relative bound"), I hate this design though. */
+ return TREE_PURPOSE (bound);
+ };
+
+ tree lb1 = TREE_PURPOSE (first);
+ tree ub1 = TREE_VALUE (first);
+ gcc_assert (lb1 && ub1);
+ const bool lb1_relative = bound_is_relative (lb1);
+ const bool ub1_relative = bound_is_relative (ub1);
+ const bool first_mixed = !(lb1_relative && ub1_relative);
+
+ tree lb2 = TREE_PURPOSE (second);
+ tree ub2 = TREE_VALUE (second);
+ gcc_assert (lb2 && ub2);
+ const bool lb2_relative = bound_is_relative (lb2);
+ const bool ub2_relative = bound_is_relative (ub2);
+ const bool second_mixed = !(lb2_relative && ub2_relative);
+
+ /* Both ranges must have a relative bound. */
+ gcc_assert ((lb1_relative || ub1_relative)
+ && (lb2_relative || ub2_relative));
+
+ /* Both fully relative. */
+ if (!first_mixed && !second_mixed)
+ {
+ /* (relative : relative), (relative : relative) */
+ wi::tree_to_widest_ref lb1_v = wi::to_widest (TREE_VALUE (lb1));
+ wi::tree_to_widest_ref ub1_v = wi::to_widest (TREE_VALUE (ub1));
+ wi::tree_to_widest_ref lb2_v = wi::to_widest (TREE_VALUE (lb2));
+ wi::tree_to_widest_ref ub2_v = wi::to_widest (TREE_VALUE (ub2));
+ /* We compare lower bound to upper bound including equality because
+ upper bounds are stored as one past the end of the range. */
+ return (lb1_v >= lb2_v && lb1_v < ub2_v)
+ || (ub1_v > lb2_v && ub1_v <= ub2_v);
+ }
+ else if (first_mixed && second_mixed)
+ {
+ /* Note that this is a comparison, not logical and/or. */
+ if (lb1_relative == lb2_relative)
+ {
+ /* FIRST SECOND
+ LB1 UB1 LB2 UB2
+ (literal : relative), (literal : relative)
+ (relative : literal), (relative : literal) */
+
+ /* Simply compare the relative bounds, if they match the two ranges
+ will always overlap.
+ There is some other static analysis that can be done, but it isn't
+ worth the time to implement. */
+ gcc_assert (ub1_relative == ub2_relative);
+ if (lb1_relative)
+ {
+ /* (relative : literal), (relative : literal) */
+ return wi::to_widest (TREE_VALUE (lb1))
+ == wi::to_widest (TREE_VALUE (lb2));
+ }
+ else
+ {
+ /* (literal : relative), (literal : relative) */
+ return wi::to_widest (TREE_VALUE (ub1))
+ == wi::to_widest (TREE_VALUE (ub2));
+ }
+ }
+ else
+ {
+ /* FIRST SECOND
+ LB1 UB1 LB2 UB2
+ (literal : relative), (relative : literal)
+ (relative : literal), (literal : relative) */
+ gcc_assert (lb1_relative != lb2_relative
+ && ub2_relative != ub2_relative
+ && (lb1_relative == ub2_relative
+ || lb2_relative == ub1_relative));
+ /* There is definitely more interesting static analysis that can
+ be done here but it would probably be a waste of time. */
+ tree relative_lb = lb1_relative ? lb1 : lb2;
+ tree relative_ub = ub1_relative ? ub1 : ub2;
+ return wi::to_widest (TREE_VALUE (relative_lb))
+ >= wi::to_widest (TREE_VALUE (relative_ub));
+ }
+ }
+ else
+ {
+ /* FIRST SECOND
+ LB1 UB1 LB2 UB2
+ (literal : relative), (relative : relative)
+ (relative : relative), (literal : relative)
+
+ (relative : relative), (relative : literal)
+ (relative : literal), (relative : relative) */
+ gcc_assert ((first_mixed && !second_mixed)
+ || (!first_mixed && second_mixed));
+ tree lb_mixed = first_mixed ? lb1 : lb2;
+ tree ub_mixed = first_mixed ? ub1 : ub2;
+
+ tree lb_full_relative = !first_mixed ? lb1 : lb2;
+ tree ub_full_relative = !first_mixed ? ub1 : ub2;
+
+ if (bound_is_relative (lb_mixed))
+ {
+ return wi::to_widest (TREE_VALUE (lb_mixed))
+ >= wi::to_widest (TREE_VALUE (lb_full_relative))
+ && wi::to_widest (TREE_VALUE (lb_mixed))
+ < wi::to_widest (TREE_VALUE (ub_full_relative));
+ }
+ else
+ {
+ gcc_assert (bound_is_relative (ub_mixed));
+ return wi::to_widest (TREE_VALUE (ub_mixed))
+ > wi::to_widest (TREE_VALUE (lb_full_relative))
+ && wi::to_widest (TREE_VALUE (ub_mixed))
+ <= wi::to_widest (TREE_VALUE (ub_full_relative));
+ }
+ }
+ gcc_unreachable ();
+}
+
+
+/* Parse an OpenMP parameter-list.
+ parameter-list:
+ parameter-list-item[, parameter-list-item [, ...]]
+
+ parameter-list-item:
+ named parameter list item
+ parameter index (1 based)
+ numeric-range
+
+
+ numeric-range:
+ [bound]:[bound]
+
+ bound:
+ index-expr
+ omp_num_args[±logical_offset]
+
+ A named parameter list item is the name of a parameter. A parameter index
+ is a positive integer literal that is the 1 based index of a parameter.
+ A numeric-range is a pair of bounds of the form lb:ub, the values of each
+ bound form a closed interval of parameter indices. Bounds can be literal or
+ relative. An index-expr is a non-negative integer constant-expression that
+ is the value of a literal bound. The special identifier omp_num_args is
+ equal to the number of arguments passed to the function at the call site,
+ including the number of varargs. Optionally, a plus or minus with a
+ logical_offset may follow omp_num_args, logical_offset is a non-negative
+ integer constant-expression. A bound formed with omp_num_args is a relative
+ bound. If a bound is omitted, a default value is used. The default value
+ of lb is as if 1 were specified, the default value of ub is as if
+ omp_num_args were specified.
+
+ Each parameter-list-item is stored in a TREE_LIST. The PURPOSE is for
+ general use and left NULL_TREE here, and the item is stored in the VALUE.
+ An item is a TREE_LIST, the PURPOSE is an expression with the location of
+ the list item, and the VALUE is a representation of the item.
+ Each parameter-list-item is stored in a TREE_LIST node VALUE. The PURPOSE
+ is unused, and the VALUE is the item-repr.
+
+ Node - PUPOSE: NULL_TREE
+ - VALUE: item-with-location
+ item-with-location - PURPOSE: expr-with-location
+ - VALUE: item-repr
+
+ An item-repr is a INTEGER_CST or a TREE_LIST. An INTEGER_CST is the 0 based
+ index of a specified parameter, derived from a named parameter list item or
+ a parameter index. A TREE_LIST is a numeric-range where its PURPOSE is a
+ TREE_LIST representing the lb, and its VALUE is a TREE_LIST representing the
+ ub.
+
+ item-repr
+ INTEGER_CST - parameter index (0 based)
+ TREE_LIST - PURPOSE: TREE_LIST (lb)
+ - VALUE: TREE_LIST (ub)
+
+ lb and ub are a TREE_LIST of the following form;
+ TREE_LIST - PURPOSE: relative bound marker (NULL_TREE if literal)
+ - VALUE: expr-value
+
+ In non-variadic functions numeric ranges are immediately expanded into
+ INTEGER_CST nodes corresponding to each index specified by the interval.
+
+ The expr-value is an INTEGER_CST node of type integer_type_node, the value
+ corresponding to the expr. The value of lb is adjusted to be 0 based, while
+ the value of ub is adjusted to be 0 based, and one past the end to support
+ empty ranges. In other words, lb is adjusted by -1, and ub remains the
+ same.
+
+ Parameters that are specified but are not defined, out of range indices and
+ duplicate specifications are diagnosed. Additionally, numeric ranges that
+ can be proven to always overlap for any value of omp_num_args even before
+ expansion are also diagnosed. This provides diagnostics that occur before
+ the function is used. In hindsight, I wish I didn't waste my time on that
+ last one.
+ If a diagnostic is issued for a list item, it is not appened to the list and
+ parsing continues. Returns NULL_TREE if no valid list items are parsed.
+
+ This function strictly handles a parameter-list, it does not parse clause
+ modifiers, or parenthesis other than in the expr of a numeric range. */
+
+static tree
+c_parser_omp_parm_list (c_parser *parser, tree decl, const int parm_count)
+{
+ /* TODO: C++ front end was enhanced a little, gotta make changes in here
+ to match it. */
+ tree list = NULL_TREE;
+ /* Even though an adjust_args clause on a non-variadic function with 0
+ parameters is silly, we should still probably handle it gracefully. */
+ const bool variadic_p = TYPE_ARG_TYPES (TREE_TYPE (decl)) != void_list_node
+ && parm_count == 0;
+ const int omp_num_args_value = parm_count;
+
+ auto unique_append_to_list = [&list, &variadic_p] (int idx, location_t loc)
+ {
+ gcc_assert (idx >= 0);
+ /* Keep track of the last chain to append to the list. */
+ tree *chain = &list;
+ for (tree node = list; node; node = TREE_CHAIN (node))
+ {
+ chain = &TREE_CHAIN (node);
+ tree item = TREE_VALUE (node);
+ /* Skip numeric range nodes, only valid for variadic functions. */
+ if (variadic_p && TREE_CODE (TREE_VALUE (item)) != INTEGER_CST)
+ /* Early exit. */;
+ else if (wi::to_widest (TREE_VALUE (item)) == idx)
+ /* Return the item for diagnostic purposes. */
+ return item;
+ }
+ gcc_assert (*chain == NULL_TREE);
+ /* Store the location in PURPOSE for use in diagnostics. */
+ tree item = build_tree_list (build_empty_stmt (loc),
+ build_int_cst (integer_type_node, idx));
+ /* Leave PURPOSE unused for use by the caller of
+ c_parser_omp_parm_list. */
+ *chain = build_tree_list (NULL_TREE, item);
+ return NULL_TREE;
+ };
+
+ auto tok_terminates_item_p = [] (c_token *tok)
+ {
+ return tok->type == CPP_COMMA
+ || tok->type == CPP_CLOSE_PAREN;
+ };
+ /* The first list item is (obviously) not preceded by a comma. */
+ goto first_element;
+ do
+ {
+ /* Consume the comma. */
+ c_parser_consume_token (parser);
+ first_element:
+ c_token *const tok = c_parser_peek_token (parser);
+
+ /* OpenMP 6.0 (162:29-34)
+ A parameter list item can be one of the following:
+ • A named parameter list item;
+ • The position of a parameter in a parameter specification specified
+ by a positive integer, where 1 represents the first parameter; or
+ • A parameter range specified by lb : ub where both lb and ub must
+ be an expression of integer OpenMP type with the constant property
+ and the positive property.
+
+ The spec does not support arbitrary expression outside of a numeric
+ range. In theory they could be supported as a parameter index, but
+ for now we do not support that case. */
+
+ /* If we don't see a comma or close paren this can't be a named parameter
+ list item or a parameter index, it can only be a numeric range.
+ As far as I can tell, there is no well-formed code that could break
+ this assumption. */
+ if (!tok_terminates_item_p (c_parser_peek_2nd_token (parser))
+ /* Or this edge case, there is a default lower bound. */
+ || tok->type == CPP_COLON)
+ /* Early exit, numeric range case handled below. */;
+ else if (tok->type == CPP_NAME
+ && tok->id_kind == C_ID_ID)
+ {
+ if (strcmp (IDENTIFIER_POINTER (tok->value), "omp_num_args") == 0)
+ {
+ error_at (tok->location, "%<omp_num_args%> may only be used at "
+ "the start of a numeric range bound");
+ c_parser_consume_token (parser);
+ continue;
+ }
+ tree parm_decl = lookup_name (tok->value);
+
+ if (parm_decl && TREE_CODE (parm_decl) == PARM_DECL)
+ {
+ tree parm = DECL_ARGUMENTS (decl);
+ /* We store indices in 0 based form internally. */
+ int idx = 0;
+ while (parm != parm_decl)
+ {
+ gcc_assert (parm != NULL_TREE && parm != void_list_node);
+ ++idx;
+ parm = DECL_CHAIN (parm);
+ }
+ if (tree dupe = unique_append_to_list (idx, tok->location))
+ {
+ error_at (tok->location,
+ "OpenMP parameter list items must specify a "
+ "unique parameter");
+ inform (EXPR_LOCATION (TREE_PURPOSE (dupe)),
+ "parameter previously specified here");
+ }
+ }
+ else
+ {
+ /* It feels like the only reasonable solution is to cook our own
+ solution for this, undeclared_variable doesn't give us what
+ we wan't for more than a few reasons. */
+ error_at (tok->location,
+ "%qs is not a function parameter",
+ IDENTIFIER_POINTER (tok->value));
+ /* FIXME: Something like this is a good idea. */
+ /* if (parm_decl && TREE_CONSTANT (parm_decl))
+ inform (tok->location,
+ "an expression is only allowed in a "
+ "numeric range"); */
+ /* Don't use undeclared_variable if we are parsing a decl
+ instead of a declaration, it breaks subsequent lookups in
+ later functions. */
+ }
+ c_parser_consume_token (parser);
+ continue;
+ }
+ else if (tok->type == CPP_NUMBER)
+ {
+ if (wi::to_widest (tok->value) <= 0)
+ error_at (tok->location, "parameter indices in an OpenMP "
+ "parameter list must be positive");
+ else if (wi::to_widest (tok->value) > INT_MAX)
+ error_at (tok->location, "parameter index is too big");
+ else
+ {
+ /* We store indices 0 based internally, OpenMP specifies
+ 1 based indices, modify it. */
+ const int idx = tree_to_shwi (tok->value) - 1;
+ if (!variadic_p && idx >= parm_count)
+ error_at (tok->location,
+ "parameter list item index is out of range");
+ else
+ {
+ if (tree dupe = unique_append_to_list (idx, tok->location))
+ {
+ error_at (tok->location,
+ "OpenMP parameter list items must specify a "
+ "unique parameter");
+ inform (EXPR_LOCATION (TREE_PURPOSE (dupe)),
+ "parameter previously specified here");
+ }
+ }
+ }
+ c_parser_consume_token (parser);
+ continue;
+ }
+ else
+ {
+ gcc_checking_assert (tok_terminates_item_p
+ (c_parser_peek_2nd_token (parser)));
+ error_at (tok->location, "expected parameter or integer");
+ c_parser_consume_token (parser);
+ continue;
+ }
+ /* We have a numeric range or something ill formed now, this can be
+ an arbitrary expression. */
+
+ /* Empty bounds are delimited differently for lower and upper bounds,
+ handle them before calling parse_bound. */
+ auto parse_bound = [&] ()
+ {
+ enum omp_num_args
+ {
+ num_args_none,
+ num_args_plus,
+ num_args_minus,
+ num_args_no_offset
+ };
+ /* (OpenMP 6.0, 162:35-37)
+ In both lb and ub, an expression using omp_num_args, that enables
+ identification of parameters relative to the last argument of the
+ call, can be used with the form:
+ omp_num_args [± logical_offset] */
+
+ const omp_num_args parsed_omp_num_args = [&] ()
+ {
+ c_token *tok = c_parser_peek_token (parser);
+ if (tok->type == CPP_NAME
+ && tok->id_kind == C_ID_ID
+ && strcmp (IDENTIFIER_POINTER (tok->value), "omp_num_args")
+ == 0)
+ {
+ /* Consume omp_num_args. */
+ c_parser_consume_token (parser);
+ c_token *op_tok = c_parser_peek_token (parser);
+ if (op_tok->type == CPP_PLUS)
+ {
+ c_parser_consume_token (parser);
+ return num_args_plus;
+ }
+ else if (op_tok->type == CPP_MINUS)
+ {
+ c_parser_consume_token (parser);
+ return num_args_minus;
+ }
+ return num_args_no_offset;
+ }
+ else
+ return num_args_none;
+ } (); /* IILE. */
+
+ /* If there was omp_num_args but no operator an expr is not
+ permitted, we are finished with this bound. */
+ if (parsed_omp_num_args == num_args_no_offset)
+ return build_int_cst (integer_type_node, omp_num_args_value);
+ gcc_assert (parsed_omp_num_args < num_args_no_offset);
+
+ c_expr expr = c_parser_expr_no_commas (parser, NULL);
+ /* I don't know if this location is correct. */
+ const location_t expr_loc = expr.get_location ();
+ /* I don't think read_p true is correct. */
+ expr = convert_lvalue_to_rvalue (expr_loc, expr, false, true);
+ if (expr.value == error_mark_node)
+ return error_mark_node;
+ tree folded = c_fully_fold (expr.value, false, NULL);
+ if (!TREE_CONSTANT (folded))
+ {
+ error_at (expr_loc, "expression of a bound must be a "
+ "constant expression");
+ return error_mark_node;
+ }
+ /* This seems wrong... */
+ gcc_assert (TREE_CODE (folded) == INTEGER_CST);
+ /* If we have omp_num_args, expr can be 0,
+ if we don't, expr must be positive. */
+ const int sgn = tree_int_cst_sgn (folded);
+ /* I'm sure this is wrong but I dunno a better way right now. */
+ const ptrdiff_t value = tree_to_shwi (folded);
+ switch (parsed_omp_num_args)
+ {
+ case num_args_none:
+ {
+ if (sgn != 1)
+ {
+ error_at (expr_loc, "expression of bound must be "
+ "positive");
+ return error_mark_node;
+ }
+ if (!variadic_p && value > omp_num_args_value)
+ {
+ error_at (expr_loc, "expression of bound is out "
+ "of range");
+ return error_mark_node;
+ }
+ return build_int_cst (integer_type_node, value);
+ }
+ case num_args_plus:
+ {
+ if (sgn != 0)
+ {
+ error_at (expr_loc,
+ "logical offset must be equal to 0 in a bound "
+ "of the form %<omp_num_args+logical-offset%>");
+ return error_mark_node;
+ }
+ return build_int_cst (integer_type_node, omp_num_args_value);
+ }
+ case num_args_minus:
+ {
+ if (sgn == -1)
+ {
+ error_at (expr_loc,
+ "logical offset must be non-negative");
+ return error_mark_node;
+ }
+ if (variadic_p)
+ return build_int_cst (integer_type_node, -value);
+ const ptrdiff_t parm_index = omp_num_args_value - value;
+ if (parm_index <= 0)
+ {
+ error_at (expr_loc,
+ "bound with logical offset evaluates to an "
+ "out of range index");
+ return error_mark_node;
+ }
+ return build_int_cst (integer_type_node, parm_index);
+ }
+ case num_args_no_offset:
+ /* Handled above. */
+ default:
+ gcc_unreachable ();
+ }
+ gcc_unreachable ();
+ };
+ const location_t num_range_loc_begin = tok->location;
+
+ /* As stated above, empty bounds are handled here. */
+ tree lb = c_parser_next_token_is (parser, CPP_COLON) ? NULL_TREE
+ : parse_bound ();
+ /* I wish we could error here saying that we expect an unqualified-id,
+ an integer, or an expression. Parsing the expression emits the error
+ right away though. */
+ if (lb && error_operand_p (lb))
+ {
+ c_parser_skip_to_end_of_parameter (parser);
+ continue;
+ }
+ /* Tokens get consumed by parse_bound. */
+ if (c_parser_next_token_is_not (parser, CPP_COLON))
+ {
+ /* lower_bound can only be null if the next token was a colon. */
+ gcc_assert (lb != NULL_TREE);
+ c_parser_error (parser, "expected %<:%>");
+ if (tok_terminates_item_p (c_parser_peek_token (parser)))
+ {
+ const location_t loc = make_location (num_range_loc_begin,
+ num_range_loc_begin,
+ input_location);
+ inform (loc, "an expression is only allowed in a numeric range");
+ }
+ c_parser_skip_to_end_of_parameter (parser);
+ continue;
+ }
+ const location_t colon_loc = c_parser_peek_token (parser)->location;
+ c_parser_consume_token (parser);
+
+ tree ub = tok_terminates_item_p (c_parser_peek_token (parser))
+ ? NULL_TREE : parse_bound ();
+ if (!ub || ub == error_mark_node)
+ c_parser_skip_to_end_of_parameter (parser);
+
+ location_t num_range_loc_end = ub != NULL_TREE ? input_location
+ : colon_loc;
+ location_t num_range_loc = make_location (num_range_loc_begin,
+ num_range_loc_begin,
+ num_range_loc_end);
+ /* I think we are supposed to have some sort of diagnostic here, I'm just
+ not sure what it should be. */
+ if (lb == error_mark_node || ub == error_mark_node)
+ continue;
+ /* Handle default bounds. */
+ const ptrdiff_t lb_val = lb ? tree_to_shwi (lb)
+ : 1;
+ const ptrdiff_t ub_val = ub ? tree_to_shwi (ub)
+ : omp_num_args_value;
+
+ gcc_assert (variadic_p || (lb_val > 0 && ub_val > 0));
+ /* We only know this at this point if they are both negative/zero or both
+ positive, so basically if both or neither use omp_num_args. */
+ /* FIXME: need a test for this case, I think we are missing this case
+ in the C++ front end, so add it. */
+ if (((lb_val <= 0) == (ub_val <= 0)) && lb_val > ub_val)
+ {
+ error_at (num_range_loc,
+ "numeric range lower bound must be less than "
+ "or equal to upper bound");
+ continue;
+ }
+
+ auto add_range_known = [&] (const int lb, const int ub)
+ {
+ gcc_assert (lb > 0 && ub > 0 && lb <= ub);
+
+ for (int idx = lb; idx <= ub; ++idx)
+ {
+ gcc_assert (variadic_p || idx <= parm_count);
+ if (tree dupe = unique_append_to_list (idx - 1, num_range_loc))
+ {
+ error_at (num_range_loc,
+ "expansion of numeric range specifies "
+ "non-unique index %d", idx);
+ inform (EXPR_LOCATION (TREE_PURPOSE (dupe)),
+ "parameter previously specified here");
+ }
+ }
+ };
+ /* Store ub as exclusive (one past the end) so we can differentiate an
+ empty range from a range of one index without ever encoding lb as
+ greater than ub.
+ Semantically, OpenMP does not allow this as numeric range bounds are
+ specified to be inclusive, but we utilize it for diagnostic purposes.
+ This is explained in detail below. */
+ auto add_range_unknown = [&] (const int lb_in,
+ const bool lb_relative_p,
+ const int ub_in,
+ const bool ub_relative_p)
+ {
+ /* If both bounds are relative, then lb should be <= ub. */
+ gcc_assert ((!(lb_relative_p && ub_relative_p) || lb_in <= ub_in)
+ /* We only deal with ranges that aren't known here, so
+ at least one bound should be relative to num args. */
+ && (lb_relative_p || ub_relative_p));
+ /* Adjust to be 0 based, -1 now corresponds to the last arg. */
+ const int lb = lb_in - 1;
+ /* Adjust to be 0 based, but add 1 to make it one past the end. */
+ const int ub = ub_in - 1 + 1;
+ /* We don't check against the non-range indices, we already check
+ that by adding any indices we can be sure of WAY below. */
+ auto build_bound = [] (int val, bool add_num_args)
+ {
+ return build_tree_list (add_num_args
+ ? get_identifier ("omp relative bound")
+ : NULL_TREE,
+ build_int_cst (integer_type_node, val));
+ };
+ tree lb_node = build_bound (lb, lb_relative_p);
+ tree ub_node = build_bound (ub, ub_relative_p);
+ tree new_range = build_tree_list (lb_node, ub_node);
+ /* Keep track of the last chain to append to the list. */
+ tree *chain = &list;
+ for (tree node = list; node; node = TREE_CHAIN (node))
+ {
+ chain = &TREE_CHAIN (node);
+ tree item = TREE_VALUE (node);
+ gcc_assert (TREE_PURPOSE (item));
+ if (TREE_CODE (TREE_VALUE (item)) == INTEGER_CST)
+ continue;
+
+ tree range = TREE_VALUE (item);
+ if (c_omp_numeric_ranges_always_overlap (range, new_range))
+ {
+ error_at (num_range_loc,
+ "numeric range always overlaps with another "
+ "range");
+ inform (EXPR_LOCATION (TREE_PURPOSE (item)),
+ "overlaps with this range");
+ /* Do not add this range. */
+ return;
+ }
+ }
+ tree item = build_tree_list (build_empty_stmt (num_range_loc),
+ new_range);
+ /* Leave PURPOSE unused for use by the caller of
+ c_parser_omp_parm_list. */
+ *chain = build_tree_list (NULL_TREE, item);
+ };
+
+ if (lb_val > 0 && ub_val > 0)
+ {
+ gcc_assert (variadic_p
+ || (lb_val <= parm_count && ub_val <= parm_count));
+ add_range_known (lb_val, ub_val);
+ }
+ else if (lb_val <= 0 && ub_val <= 0)
+ {
+ gcc_assert (variadic_p);
+ add_range_unknown (lb_val, true, ub_val, true);
+ }
+ /* Add the indices that will be specified for all well-formed calls to
+ the function. This lets us diagnose indices that were specified
+ (or rather, will be when the numeric range is expanded) multiple times
+ before the function is even called. We must adjust the literal bound
+ of the numeric range accordingly depending on how many indices we
+ add to prevent them from being specified again erroneously once the
+ range is expanded at the call site.
+ We can do this because we support expansion of unknown ranges
+ evaluating to an empty interval, as mentioned above in
+ add_range_unknown. */
+ else if (lb_val > 0)
+ {
+ gcc_assert (variadic_p);
+ /* FIXME: Make sure to add a test where lb > parm_count, that
+ originally could break this realized that would break this
+ optimization. */
+ /* In the case that UB refers to the last argument, we can assume all
+ non-variadic arguments between LB and the last non-variadic arg,
+ if any, will always be specified. */
+ const int known_upper_bound = ub_val == 0 && lb_val <= parm_count
+ ? parm_count : lb_val;
+ add_range_known (lb_val, known_upper_bound);
+ add_range_unknown (known_upper_bound + 1, false, ub_val, true);
+ }
+ else if (ub_val > 0)
+ {
+ gcc_assert (variadic_p);
+ /* We can do this because numeric ranges are inclusive, any
+ well-formed call to this function will cause the range to evaluate
+ to include the literal index. */
+ add_range_known (ub_val, ub_val);
+ add_range_unknown (lb_val, true, ub_val - 1, false);
+ }
+ else
+ gcc_unreachable ();
+
+ } while (c_parser_next_token_is (parser, CPP_COMMA));
+ return list;
+}
+
+
/* OpenACC 2.0:
copy ( variable-list )
copyin ( variable-list )
@@ -16875,7 +17921,7 @@ c_parser_oacc_data_clause (c_parser *parser, pragma_omp_clause c_kind,
}
}
nl = c_parser_omp_variable_list (parser, open_loc, OMP_CLAUSE_MAP, list,
- false);
+ C_ORT_ACC, false);
parens.skip_until_found_close (parser);
}
@@ -16900,7 +17946,8 @@ c_parser_oacc_data_clause_deviceptr (c_parser *parser, tree list)
/* Can't use OMP_CLAUSE_MAP here (that is, can't use the generic
c_parser_oacc_data_clause), as for PRAGMA_OACC_CLAUSE_DEVICEPTR,
variable-list must only allow for pointer variables. */
- vars = c_parser_omp_var_list_parens (parser, OMP_CLAUSE_ERROR, NULL);
+ vars = c_parser_omp_var_list_parens (parser, OMP_CLAUSE_ERROR, NULL,
+ C_ORT_ACC);
for (t = vars; t && t; t = TREE_CHAIN (t))
{
tree v = TREE_PURPOSE (t);
@@ -18459,7 +19506,7 @@ c_parser_omp_clause_private (c_parser *parser, tree list)
static tree
c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind,
- bool is_omp, tree list)
+ enum c_omp_region_type ort, tree list)
{
location_t clause_loc = c_parser_peek_token (parser)->location;
matching_parens parens;
@@ -18470,7 +19517,7 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind,
enum tree_code code = ERROR_MARK;
tree reduc_id = NULL_TREE;
- if (kind == OMP_CLAUSE_REDUCTION && is_omp)
+ if (kind == OMP_CLAUSE_REDUCTION && ort == C_ORT_OMP)
{
if (c_parser_next_token_is_keyword (parser, RID_DEFAULT)
&& c_parser_peek_2nd_token (parser)->type == CPP_COMMA)
@@ -18535,13 +19582,21 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind,
code = MAX_EXPR;
break;
}
+ if (ort == C_ORT_ACC)
+ goto name_error;
reduc_id = c_parser_peek_token (parser)->value;
break;
}
default:
- c_parser_error (parser,
- "expected %<+%>, %<*%>, %<-%>, %<&%>, "
- "%<^%>, %<|%>, %<&&%>, %<||%> or identifier");
+ name_error:
+ if (ort == C_ORT_OMP)
+ c_parser_error (parser,
+ "expected %<+%>, %<*%>, %<-%>, %<&%>, "
+ "%<^%>, %<|%>, %<&&%>, %<||%> or identifier");
+ else
+ c_parser_error (parser,
+ "expected %<+%>, %<*%>, %<-%>, %<&%>, "
+ "%<^%>, %<|%>, %<&&%>, %<||%>, %<min%> or %<max%>");
c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, 0);
return list;
}
@@ -18551,9 +19606,15 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind,
{
tree nl, c;
- nl = c_parser_omp_variable_list (parser, clause_loc, kind, list);
+ nl = c_parser_omp_variable_list (parser, clause_loc, kind, list, ort);
+
for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
{
+ OMP_CLAUSE_REDUCTION_CODE (c) = code;
+ /* OpenACC does not require anything below. */
+ if (ort == C_ORT_ACC)
+ continue;
+
tree d = OMP_CLAUSE_DECL (c), type;
if (TREE_CODE (d) != OMP_ARRAY_SECTION)
type = TREE_TYPE (d);
@@ -18577,7 +19638,6 @@ c_parser_omp_clause_reduction (c_parser *parser, enum omp_clause_code kind,
}
while (TREE_CODE (type) == ARRAY_TYPE)
type = TREE_TYPE (type);
- OMP_CLAUSE_REDUCTION_CODE (c) = code;
if (task)
OMP_CLAUSE_REDUCTION_TASK (c) = 1;
else if (inscan)
@@ -19212,6 +20272,213 @@ c_parser_omp_clause_allocate (c_parser *parser, tree list)
return nl;
}
+/* OpenMP 5.0:
+ uses_allocators ( allocator-list )
+
+ allocator-list:
+ allocator
+ allocator , allocator-list
+ allocator ( traits-array )
+ allocator ( traits-array ) , allocator-list
+
+ OpenMP 5.2:
+
+ uses_allocators ( modifier : allocator-list )
+ uses_allocators ( modifier , modifier : allocator-list )
+
+ modifier:
+ traits ( traits-array )
+ memspace ( mem-space-handle ) */
+
+static tree
+c_parser_omp_clause_uses_allocators (c_parser *parser, tree list)
+{
+ location_t clause_loc = c_parser_peek_token (parser)->location;
+ tree t = NULL_TREE, nl = list;
+ matching_parens parens;
+ if (!parens.require_open (parser))
+ return list;
+
+ tree memspace_expr = NULL_TREE;
+ tree traits_var = NULL_TREE;
+
+ struct item_tok
+ {
+ location_t loc;
+ tree id;
+ item_tok (void) : loc (UNKNOWN_LOCATION), id (NULL_TREE) {}
+ };
+ struct item { item_tok name, arg; };
+ auto_vec<item> *modifiers = NULL, *allocators = NULL;
+ auto_vec<item> *cur_list = new auto_vec<item> (4);
+
+ while (true)
+ {
+ item it;
+
+ if (c_parser_next_token_is (parser, CPP_NAME))
+ {
+ c_token *tok = c_parser_peek_token (parser);
+ it.name.id = tok->value;
+ it.name.loc = tok->location;
+ c_parser_consume_token (parser);
+
+ if (c_parser_next_token_is (parser, CPP_OPEN_PAREN))
+ {
+ matching_parens parens2;
+ parens2.consume_open (parser);
+
+ if (c_parser_next_token_is (parser, CPP_NAME))
+ {
+ tok = c_parser_peek_token (parser);
+ it.arg.id = tok->value;
+ it.arg.loc = tok->location;
+ c_parser_consume_token (parser);
+ }
+ else
+ {
+ c_parser_error (parser, "expected identifier");
+ parens2.skip_until_found_close (parser);
+ goto end;
+ }
+ parens2.skip_until_found_close (parser);
+ }
+ }
+
+ cur_list->safe_push (it);
+
+ if (c_parser_next_token_is (parser, CPP_COMMA))
+ c_parser_consume_token (parser);
+ else if (c_parser_next_token_is (parser, CPP_COLON))
+ {
+ if (modifiers)
+ {
+ c_parser_error (parser, "expected %<)%>");
+ goto end;
+ }
+ else
+ {
+ c_parser_consume_token (parser);
+ modifiers = cur_list;
+ cur_list = new auto_vec<item> (4);
+ }
+ }
+ else if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN))
+ {
+ gcc_assert (allocators == NULL);
+ allocators = cur_list;
+ cur_list = NULL;
+ break;
+ }
+ else
+ {
+ c_parser_error (parser, "expected %<)%>");
+ goto end;
+ }
+ }
+
+ if (modifiers)
+ for (unsigned i = 0; i < modifiers->length (); i++)
+ {
+ item& it = (*modifiers)[i];
+ const char *p = IDENTIFIER_POINTER (it.name.id);
+ int strcmp_traits = 1, strcmp_memspace = 1;
+
+ if ((strcmp_traits = strcmp ("traits", p)) == 0
+ || (strcmp_memspace = strcmp ("memspace", p)) == 0)
+ {
+ if ((strcmp_traits == 0 && traits_var != NULL_TREE)
+ || (strcmp_memspace == 0 && memspace_expr != NULL_TREE))
+ {
+ error_at (it.name.loc, "duplicate %qs modifier", p);
+ goto end;
+ }
+ t = lookup_name (it.arg.id);
+ if (t == NULL_TREE)
+ {
+ undeclared_variable (it.arg.loc, it.arg.id);
+ t = error_mark_node;
+ }
+ else if (strcmp_memspace == 0)
+ memspace_expr = t;
+ else if (strcmp_traits == 0)
+ traits_var = t;
+ else
+ gcc_unreachable ();
+ }
+ else
+ {
+ error_at (it.name.loc, "unknown modifier %qE", it.name.id);
+ goto end;
+ }
+ }
+
+ if (allocators)
+ {
+ if (modifiers)
+ {
+ if (allocators->length () > 1)
+ {
+ error_at ((*allocators)[1].name.loc,
+ "%<uses_allocators%> clause only accepts a single "
+ "allocator when using modifiers");
+ goto end;
+ }
+ else if ((*allocators)[0].arg.id)
+ {
+ error_at ((*allocators)[0].arg.loc,
+ "legacy %<%E(%E)%> traits syntax not allowed in "
+ "%<uses_allocators%> clause when using modifiers",
+ (*allocators)[0].name.id, (*allocators)[0].arg.id);
+ goto end;
+ }
+ }
+
+ for (unsigned i = 0; i < allocators->length (); i++)
+ {
+ item& it = (*allocators)[i];
+ t = lookup_name (it.name.id);
+ if (t == NULL_TREE)
+ {
+ undeclared_variable (it.name.loc, it.name.id);
+ goto end;
+ }
+ else if (t != error_mark_node)
+ {
+ tree t2 = NULL_TREE;
+ if (it.arg.id)
+ {
+ t2 = lookup_name (it.arg.id);
+ if (t2 == NULL_TREE)
+ {
+ undeclared_variable (it.arg.loc, it.arg.id);
+ goto end;
+ }
+ }
+ else
+ t2 = traits_var;
+
+ tree c = build_omp_clause (clause_loc,
+ OMP_CLAUSE_USES_ALLOCATORS);
+ OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c) = t;
+ OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c) = memspace_expr;
+ OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c) = t2;
+ OMP_CLAUSE_CHAIN (c) = nl;
+ nl = c;
+ }
+ }
+ }
+ end:
+ if (cur_list)
+ delete cur_list;
+ if (modifiers)
+ delete modifiers;
+ if (allocators)
+ delete allocators;
+ parens.skip_until_found_close (parser);
+ return nl;
+}
+
/* OpenMP 4.0:
linear ( variable-list )
linear ( variable-list : expression )
@@ -19651,10 +20918,10 @@ c_parser_omp_iterators (c_parser *parser)
pushdecl (iter_var);
*last = make_tree_vec (6);
- TREE_VEC_ELT (*last, 0) = iter_var;
- TREE_VEC_ELT (*last, 1) = begin;
- TREE_VEC_ELT (*last, 2) = end;
- TREE_VEC_ELT (*last, 3) = step;
+ OMP_ITERATORS_VAR (*last) = iter_var;
+ OMP_ITERATORS_BEGIN (*last) = begin;
+ OMP_ITERATORS_END (*last) = end;
+ OMP_ITERATORS_STEP (*last) = step;
last = &TREE_CHAIN (*last);
if (c_parser_next_token_is (parser, CPP_COMMA))
@@ -19719,7 +20986,7 @@ c_parser_omp_clause_affinity (c_parser *parser, tree list)
tree block = pop_scope ();
if (iterators != error_mark_node)
{
- TREE_VEC_ELT (iterators, 5) = block;
+ OMP_ITERATORS_BLOCK (iterators) = block;
for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
OMP_CLAUSE_DECL (c) = build_tree_list (iterators,
OMP_CLAUSE_DECL (c));
@@ -19836,7 +21103,7 @@ c_parser_omp_clause_depend (c_parser *parser, tree list)
if (iterators == error_mark_node)
iterators = NULL_TREE;
else
- TREE_VEC_ELT (iterators, 5) = block;
+ OMP_ITERATORS_BLOCK (iterators) = block;
}
for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
@@ -19936,13 +21203,12 @@ c_parser_omp_clause_doacross (c_parser *parser, tree list)
map ( [map-type-modifier[,] ...] map-kind: variable-list )
map-type-modifier:
- always | close */
+ always | close | present | iterator (iterators-definition) */
static tree
-c_parser_omp_clause_map (c_parser *parser, tree list)
+c_parser_omp_clause_map (c_parser *parser, tree list, enum gomp_map_kind kind)
{
location_t clause_loc = c_parser_peek_token (parser)->location;
- enum gomp_map_kind kind = GOMP_MAP_TOFROM;
tree nl, c;
matching_parens parens;
@@ -19951,22 +21217,57 @@ c_parser_omp_clause_map (c_parser *parser, tree list)
int pos = 1;
int map_kind_pos = 0;
- while (c_parser_peek_nth_token_raw (parser, pos)->type == CPP_NAME)
+ int iterator_length = 0;
+ for (;;)
{
- if (c_parser_peek_nth_token_raw (parser, pos + 1)->type == CPP_COLON)
+ c_token *tok = c_parser_peek_nth_token_raw (parser, pos);
+ if (tok->type != CPP_NAME)
+ break;
+
+ const char *p = IDENTIFIER_POINTER (tok->value);
+ c_token *next_tok = c_parser_peek_nth_token_raw (parser, pos + 1);
+ if (strcmp (p, "iterator") == 0 && next_tok->type == CPP_OPEN_PAREN)
+ {
+ unsigned n = pos + 2;
+ if (c_parser_check_balanced_raw_token_sequence (parser, &n)
+ && c_parser_peek_nth_token_raw (parser, n)->type
+ == CPP_CLOSE_PAREN)
+ {
+ iterator_length = n - pos + 1;
+ pos = n;
+ next_tok = c_parser_peek_nth_token_raw (parser, pos + 1);
+ }
+ }
+
+ if (next_tok->type == CPP_COLON)
{
map_kind_pos = pos;
break;
}
- if (c_parser_peek_nth_token_raw (parser, pos + 1)->type == CPP_COMMA)
+ if (next_tok->type == CPP_COMMA)
pos++;
+ else if (c_parser_peek_nth_token_raw (parser, pos + 1)->type
+ == CPP_OPEN_PAREN)
+ {
+ unsigned int npos = pos + 2;
+ if (c_parser_check_balanced_raw_token_sequence (parser, &npos)
+ && (c_parser_peek_nth_token_raw (parser, npos)->type
+ == CPP_CLOSE_PAREN)
+ && (c_parser_peek_nth_token_raw (parser, npos + 1)->type
+ == CPP_COMMA))
+ pos = npos + 1;
+ }
+
pos++;
}
int always_modifier = 0;
int close_modifier = 0;
int present_modifier = 0;
+ int mapper_modifier = 0;
+ tree mapper_name = NULL_TREE;
+ tree iterators = NULL_TREE;
for (int pos = 1; pos < map_kind_pos; ++pos)
{
c_token *tok = c_parser_peek_token (parser);
@@ -19987,6 +21288,7 @@ c_parser_omp_clause_map (c_parser *parser, tree list)
return list;
}
always_modifier++;
+ c_parser_consume_token (parser);
}
else if (strcmp ("close", p) == 0)
{
@@ -19997,6 +21299,60 @@ c_parser_omp_clause_map (c_parser *parser, tree list)
return list;
}
close_modifier++;
+ c_parser_consume_token (parser);
+ }
+ else if (strcmp ("mapper", p) == 0)
+ {
+ c_parser_consume_token (parser);
+
+ matching_parens mparens;
+ if (mparens.require_open (parser))
+ {
+ if (mapper_modifier)
+ {
+ c_parser_error (parser, "too many %<mapper%> modifiers");
+ /* Assume it's a well-formed mapper modifier, even if it
+ seems to be in the wrong place. */
+ c_parser_consume_token (parser);
+ mparens.require_close (parser);
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+
+ tok = c_parser_peek_token (parser);
+
+ switch (tok->type)
+ {
+ case CPP_NAME:
+ {
+ mapper_name = tok->value;
+ c_parser_consume_token (parser);
+ }
+ break;
+
+ case CPP_KEYWORD:
+ if (tok->keyword == RID_DEFAULT)
+ {
+ c_parser_consume_token (parser);
+ break;
+ }
+ /* Fallthrough. */
+
+ default:
+ error_at (tok->location,
+ "expected identifier or %<default%>");
+ return list;
+ }
+
+ if (!mparens.require_close (parser))
+ {
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+
+ mapper_modifier++;
+ pos += 3;
+ }
}
else if (strcmp ("present", p) == 0)
{
@@ -20007,16 +21363,29 @@ c_parser_omp_clause_map (c_parser *parser, tree list)
return list;
}
present_modifier++;
+ c_parser_consume_token (parser);
+ }
+ else if (strcmp ("iterator", p) == 0
+ && c_parser_peek_2nd_token (parser)->type == CPP_OPEN_PAREN)
+ {
+ if (iterators)
+ {
+ c_parser_error (parser, "too many %<iterator%> modifiers");
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+ iterators = c_parser_omp_iterators (parser);
+ pos += iterator_length - 1;
+ continue;
}
else
{
c_parser_error (parser, "%<map%> clause with map-type modifier other "
- "than %<always%>, %<close%> or %<present%>");
+ "than %<always%>, %<close%>, %<iterator%>, "
+ "%<mapper%> or %<present%>");
parens.skip_until_found_close (parser);
return list;
}
-
- c_parser_consume_token (parser);
}
if (c_parser_next_token_is (parser, CPP_NAME)
@@ -20058,10 +21427,48 @@ c_parser_omp_clause_map (c_parser *parser, tree list)
}
nl = c_parser_omp_variable_list (parser, clause_loc, OMP_CLAUSE_MAP, list,
- true);
+ (kind == GOMP_MAP_UNSET
+ ? C_ORT_OMP_DECLARE_MAPPER
+ : C_ORT_OMP), true);
+
+ tree last_new = NULL_TREE;
+
+ if (iterators)
+ {
+ tree block = pop_scope ();
+ if (iterators == error_mark_node)
+ iterators = NULL_TREE;
+ else
+ OMP_ITERATORS_BLOCK (iterators) = block;
+ }
for (c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
- OMP_CLAUSE_SET_MAP_KIND (c, kind);
+ {
+ OMP_CLAUSE_SET_MAP_KIND (c, kind);
+ OMP_CLAUSE_ITERATORS (c) = iterators;
+ last_new = c;
+ }
+
+ if (mapper_name)
+ {
+ tree name = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_PUSH_MAPPER_NAME);
+ OMP_CLAUSE_DECL (name) = mapper_name;
+ if (iterators)
+ OMP_CLAUSE_ITERATORS (name) = iterators;
+ OMP_CLAUSE_CHAIN (name) = nl;
+ nl = name;
+
+ gcc_assert (last_new);
+
+ name = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_POP_MAPPER_NAME);
+ OMP_CLAUSE_DECL (name) = null_pointer_node;
+ if (iterators)
+ OMP_CLAUSE_ITERATORS (name) = iterators;
+ OMP_CLAUSE_CHAIN (name) = OMP_CLAUSE_CHAIN (last_new);
+ OMP_CLAUSE_CHAIN (last_new) = name;
+ }
parens.skip_until_found_close (parser);
return nl;
@@ -20301,8 +21708,11 @@ c_parser_omp_clause_device_type (c_parser *parser, tree list)
to ( variable-list )
OpenMP 5.1:
- from ( [present :] variable-list )
- to ( [present :] variable-list ) */
+ from ( [motion-modifier[,] [motion-modifier[,]...]:] variable-list )
+ to ( [motion-modifier[,] [motion-modifier[,]...]:] variable-list )
+
+ motion-modifier:
+ present | iterator (iterators-definition) */
static tree
c_parser_omp_clause_from_to (c_parser *parser, enum omp_clause_code kind,
@@ -20313,25 +21723,179 @@ c_parser_omp_clause_from_to (c_parser *parser, enum omp_clause_code kind,
if (!parens.require_open (parser))
return list;
- bool present = false;
- c_token *token = c_parser_peek_token (parser);
+ int pos = 1, colon_pos = 0;
+ int iterator_length = 0;
- if (token->type == CPP_NAME
- && strcmp (IDENTIFIER_POINTER (token->value), "present") == 0
- && c_parser_peek_2nd_token (parser)->type == CPP_COLON)
+ while (c_parser_peek_nth_token_raw (parser, pos)->type == CPP_NAME)
{
- present = true;
- c_parser_consume_token (parser);
- c_parser_consume_token (parser);
+ const char *identifier =
+ IDENTIFIER_POINTER (c_parser_peek_nth_token_raw (parser, pos)->value);
+ if (c_parser_peek_nth_token_raw (parser, pos + 1)->type
+ == CPP_OPEN_PAREN)
+ {
+ unsigned int npos = pos + 2;
+ if (c_parser_check_balanced_raw_token_sequence (parser, &npos)
+ && (c_parser_peek_nth_token_raw (parser, npos)->type
+ == CPP_CLOSE_PAREN))
+ {
+ if (strcmp (identifier, "iterator") == 0)
+ iterator_length = npos - pos + 1;
+ pos = npos;
+ }
+ }
+ if (c_parser_peek_nth_token_raw (parser, pos + 1)->type == CPP_COMMA)
+ pos += 2;
+ else
+ pos++;
+ if (c_parser_peek_nth_token_raw (parser, pos)->type == CPP_COLON)
+ {
+ colon_pos = pos;
+ break;
+ }
+ }
+
+ int present_modifier = false;
+ int mapper_modifier = false;
+ tree mapper_name = NULL_TREE;
+ tree iterators = NULL_TREE;
+
+ for (int pos = 1; pos < colon_pos; ++pos)
+ {
+ c_token *tok = c_parser_peek_token (parser);
+ if (tok->type == CPP_COMMA)
+ {
+ c_parser_consume_token (parser);
+ continue;
+ }
+ const char *p = IDENTIFIER_POINTER (tok->value);
+ if (strcmp ("present", p) == 0)
+ {
+ if (present_modifier)
+ {
+ c_parser_error (parser, "too many %<present%> modifiers");
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+ present_modifier++;
+ c_parser_consume_token (parser);
+ }
+ else if (strcmp ("iterator", p) == 0)
+ {
+ if (iterators)
+ {
+ c_parser_error (parser, "too many %<iterator%> modifiers");
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+ iterators = c_parser_omp_iterators (parser);
+ pos += iterator_length - 1;
+ }
+ else if (strcmp ("mapper", p) == 0)
+ {
+ c_parser_consume_token (parser);
+
+ matching_parens mparens;
+ if (mparens.require_open (parser))
+ {
+ if (mapper_modifier)
+ {
+ c_parser_error (parser, "too many %<mapper%> modifiers");
+ /* Assume it's a well-formed mapper modifier, even if it
+ seems to be in the wrong place. */
+ c_parser_consume_token (parser);
+ mparens.require_close (parser);
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+
+ tok = c_parser_peek_token (parser);
+
+ switch (tok->type)
+ {
+ case CPP_NAME:
+ {
+ mapper_name = tok->value;
+ c_parser_consume_token (parser);
+ }
+ break;
+
+ case CPP_KEYWORD:
+ if (tok->keyword == RID_DEFAULT)
+ {
+ c_parser_consume_token (parser);
+ break;
+ }
+ /* Fallthrough. */
+
+ default:
+ error_at (tok->location,
+ "expected identifier or %<default%>");
+ return list;
+ }
+
+ if (!mparens.require_close (parser))
+ {
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+
+ mapper_modifier++;
+ pos += 3;
+ }
+ }
+ else
+ {
+ c_parser_error (parser, "%<to%> or %<from%> clause with modifier "
+ "other than %<iterator%>, %<mapper%> or %<present%>");
+ parens.skip_until_found_close (parser);
+ return list;
+ }
}
- tree nl = c_parser_omp_variable_list (parser, loc, kind, list);
+ if (colon_pos)
+ c_parser_require (parser, CPP_COLON, "expected %<:%>");
+
+ tree nl = c_parser_omp_variable_list (parser, loc, kind, list, C_ORT_OMP, true);
parens.skip_until_found_close (parser);
- if (present)
+ if (present_modifier)
for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
OMP_CLAUSE_MOTION_PRESENT (c) = 1;
+ if (mapper_name)
+ {
+ tree last_new = NULL_TREE;
+ for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
+ last_new = c;
+
+ tree name = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_PUSH_MAPPER_NAME);
+ OMP_CLAUSE_DECL (name) = mapper_name;
+ OMP_CLAUSE_CHAIN (name) = nl;
+ nl = name;
+
+ gcc_assert (last_new);
+
+ name = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_POP_MAPPER_NAME);
+ OMP_CLAUSE_DECL (name) = null_pointer_node;
+ OMP_CLAUSE_CHAIN (name) = OMP_CLAUSE_CHAIN (last_new);
+ OMP_CLAUSE_CHAIN (last_new) = name;
+ }
+
+ if (iterators)
+ {
+ tree block = pop_scope ();
+ if (iterators == error_mark_node)
+ iterators = NULL_TREE;
+ else
+ OMP_ITERATORS_BLOCK (iterators) = block;
+ }
+
+ if (iterators)
+ for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_ITERATORS (c) = iterators;
+
return nl;
}
@@ -20876,8 +22440,7 @@ c_parser_omp_clause_init (c_parser *parser, tree list)
error_at (loc,
"missing required %<target%> and/or %<targetsync%> modifier");
- tree nl = c_parser_omp_variable_list (parser, loc, OMP_CLAUSE_INIT, list,
- false);
+ tree nl = c_parser_omp_variable_list (parser, loc, OMP_CLAUSE_INIT, list);
parens.skip_until_found_close (parser);
for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
@@ -21069,7 +22632,7 @@ c_parser_oacc_all_clauses (c_parser *parser, omp_clause_mask mask,
case PRAGMA_OACC_CLAUSE_REDUCTION:
clauses
= c_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION,
- false, clauses);
+ C_ORT_ACC, clauses);
c_name = "reduction";
break;
case PRAGMA_OACC_CLAUSE_SELF:
@@ -21235,7 +22798,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
case PRAGMA_OMP_CLAUSE_IN_REDUCTION:
clauses
= c_parser_omp_clause_reduction (parser, OMP_CLAUSE_IN_REDUCTION,
- true, clauses);
+ C_ORT_OMP, clauses);
c_name = "in_reduction";
break;
case PRAGMA_OMP_CLAUSE_INDIRECT:
@@ -21281,7 +22844,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
case PRAGMA_OMP_CLAUSE_REDUCTION:
clauses
= c_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION,
- true, clauses);
+ C_ORT_OMP, clauses);
c_name = "reduction";
break;
case PRAGMA_OMP_CLAUSE_SCHEDULE:
@@ -21295,7 +22858,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
case PRAGMA_OMP_CLAUSE_TASK_REDUCTION:
clauses
= c_parser_omp_clause_reduction (parser, OMP_CLAUSE_TASK_REDUCTION,
- true, clauses);
+ C_ORT_OMP, clauses);
c_name = "task_reduction";
break;
case PRAGMA_OMP_CLAUSE_UNTIED:
@@ -21397,6 +22960,10 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
clauses = c_parser_omp_clause_allocate (parser, clauses);
c_name = "allocate";
break;
+ case PRAGMA_OMP_CLAUSE_USES_ALLOCATORS:
+ clauses = c_parser_omp_clause_uses_allocators (parser, clauses);
+ c_name = "uses_allocators";
+ break;
case PRAGMA_OMP_CLAUSE_LINEAR:
clauses = c_parser_omp_clause_linear (parser, clauses);
c_name = "linear";
@@ -21430,7 +22997,7 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
c_name = "interop";
break;
case PRAGMA_OMP_CLAUSE_MAP:
- clauses = c_parser_omp_clause_map (parser, clauses);
+ clauses = c_parser_omp_clause_map (parser, clauses, GOMP_MAP_TOFROM);
c_name = "map";
break;
case PRAGMA_OMP_CLAUSE_USE_DEVICE_PTR:
@@ -21588,7 +23155,7 @@ c_parser_oacc_cache (location_t loc, c_parser *parser)
readonly = true;
}
clauses = c_parser_omp_variable_list (parser, open_loc,
- OMP_CLAUSE__CACHE_, NULL_TREE);
+ OMP_CLAUSE__CACHE_, NULL_TREE, C_ORT_ACC);
parens.skip_until_found_close (parser);
}
@@ -22457,7 +24024,7 @@ c_parser_omp_allocate (c_parser *parser)
!= get_identifier ("omp_allocator_handle_t"))
{
error_at (expr_loc,
- "%<allocator%> clause allocator expression has type "
+ "%<allocator%> clause expression has type "
"%qT rather than %<omp_allocator_handle_t%>",
TREE_TYPE (allocator));
allocator = NULL_TREE;
@@ -25890,7 +27457,9 @@ c_parser_omp_target_data (location_t loc, c_parser *parser, bool *if_p)
tree clauses
= c_parser_omp_all_clauses (parser, OMP_TARGET_DATA_CLAUSE_MASK,
- "#pragma omp target data");
+ "#pragma omp target data", false);
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP);
+ clauses = c_finish_omp_clauses (clauses, C_ORT_OMP);
c_omp_adjust_map_clauses (clauses, false);
int map_seen = 0;
for (tree *pc = &clauses; *pc;)
@@ -25981,9 +27550,41 @@ c_parser_omp_target_update (location_t loc, c_parser *parser,
tree clauses
= c_parser_omp_all_clauses (parser, OMP_TARGET_UPDATE_CLAUSE_MASK,
- "#pragma omp target update");
- if (omp_find_clause (clauses, OMP_CLAUSE_TO) == NULL_TREE
- && omp_find_clause (clauses, OMP_CLAUSE_FROM) == NULL_TREE)
+ "#pragma omp target update", false);
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_UPDATE);
+ clauses = c_finish_omp_clauses (clauses, C_ORT_OMP_UPDATE);
+ bool to_clause = false, from_clause = false;
+ for (tree c = clauses;
+ c && !to_clause && !from_clause;
+ c = OMP_CLAUSE_CHAIN (c))
+ {
+ switch (OMP_CLAUSE_CODE (c))
+ {
+ case OMP_CLAUSE_TO:
+ to_clause = true;
+ break;
+ case OMP_CLAUSE_FROM:
+ from_clause = true;
+ break;
+ case OMP_CLAUSE_MAP:
+ switch (OMP_CLAUSE_MAP_KIND (c))
+ {
+ case GOMP_MAP_TO_GRID:
+ to_clause = true;
+ break;
+ case GOMP_MAP_FROM_GRID:
+ from_clause = true;
+ break;
+ default:
+ ;
+ }
+ break;
+ default:
+ ;
+ }
+ }
+
+ if (!to_clause && !from_clause)
{
error_at (loc,
"%<#pragma omp target update%> must contain at least one "
@@ -26048,7 +27649,9 @@ c_parser_omp_target_enter_data (location_t loc, c_parser *parser,
tree clauses
= c_parser_omp_all_clauses (parser, OMP_TARGET_ENTER_DATA_CLAUSE_MASK,
- "#pragma omp target enter data");
+ "#pragma omp target enter data", false);
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP);
+ clauses = c_finish_omp_clauses (clauses, C_ORT_OMP);
c_omp_adjust_map_clauses (clauses, false);
int map_seen = 0;
for (tree *pc = &clauses; *pc;)
@@ -26159,6 +27762,7 @@ c_parser_omp_target_exit_data (location_t loc, c_parser *parser,
tree clauses
= c_parser_omp_all_clauses (parser, OMP_TARGET_EXIT_DATA_CLAUSE_MASK,
"#pragma omp target exit data", false);
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_EXIT_DATA);
clauses = c_finish_omp_clauses (clauses, C_ORT_OMP_EXIT_DATA);
c_omp_adjust_map_clauses (clauses, false);
int map_seen = 0;
@@ -26242,14 +27846,15 @@ c_parser_omp_target_exit_data (location_t loc, c_parser *parser,
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_THREAD_LIMIT) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IS_DEVICE_PTR)\
- | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_HAS_DEVICE_ADDR))
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_HAS_DEVICE_ADDR)\
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_USES_ALLOCATORS))
static bool
c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p)
{
location_t loc = c_parser_peek_token (parser)->location;
c_parser_consume_pragma (parser);
- tree *pc = NULL, stmt, block;
+ tree *pc = NULL, stmt, block, body, clauses;
if (context != pragma_stmt && context != pragma_compound)
{
@@ -26404,10 +28009,9 @@ c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p)
stmt = make_node (OMP_TARGET);
TREE_TYPE (stmt) = void_type_node;
- OMP_TARGET_CLAUSES (stmt)
- = c_parser_omp_all_clauses (parser, OMP_TARGET_CLAUSE_MASK,
- "#pragma omp target", false);
- for (tree c = OMP_TARGET_CLAUSES (stmt); c; c = OMP_CLAUSE_CHAIN (c))
+ clauses = c_parser_omp_all_clauses (parser, OMP_TARGET_CLAUSE_MASK,
+ "#pragma omp target", false);
+ for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION)
{
tree nc = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
@@ -26416,14 +28020,19 @@ c_parser_omp_target (c_parser *parser, enum pragma_context context, bool *if_p)
OMP_CLAUSE_CHAIN (nc) = OMP_CLAUSE_CHAIN (c);
OMP_CLAUSE_CHAIN (c) = nc;
}
- OMP_TARGET_CLAUSES (stmt)
- = c_finish_omp_clauses (OMP_TARGET_CLAUSES (stmt), C_ORT_OMP_TARGET);
- c_omp_adjust_map_clauses (OMP_TARGET_CLAUSES (stmt), true);
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_TARGET);
+ clauses = c_finish_omp_clauses (clauses, C_ORT_OMP_TARGET);
+ c_omp_adjust_map_clauses (clauses, true);
- pc = &OMP_TARGET_CLAUSES (stmt);
keep_next_level ();
block = c_begin_compound_stmt (true);
- add_stmt (c_parser_omp_structured_block (parser, if_p));
+ body = c_parser_omp_structured_block (parser, if_p);
+
+ c_omp_scan_mapper_bindings (loc, &clauses, body);
+
+ add_stmt (body);
+ OMP_TARGET_CLAUSES (stmt) = clauses;
+ pc = &OMP_TARGET_CLAUSES (stmt);
OMP_TARGET_BODY (stmt) = c_end_compound_stmt (loc, block, true);
SET_EXPR_LOCATION (stmt, loc);
@@ -26938,16 +28547,56 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
parens.require_close (parser);
+ const int parm_count = [&] ()
+ {
+ tree parm = TYPE_ARG_TYPES (TREE_TYPE (fndecl));
+ int parm_count = 0;
+ while (parm != NULL_TREE && parm != void_list_node)
+ {
+ ++parm_count;
+ parm = TREE_CHAIN (parm);
+ }
+ gcc_assert (!parm || parm == void_list_node);
+ return parm == void_list_node ? parm_count : 0;
+ } (); /* IILE. */
+ /* Do we care about non-variadic functions with 0 parameters? I don't think
+ we do, but lets handle for that case anyway, at least as long as we aren't
+ diagnosing for it. */
+ const bool variadic_p = TYPE_ARG_TYPES (TREE_TYPE (fndecl)) == void_list_node
+ ? false : parm_count == 0;
+
tree append_args_tree = NULL_TREE;
tree append_args_last;
- vec<tree> adjust_args_list = vNULL;
+ hash_map<int_hash<int, -1, -2>, tree> adjust_args_idxs;
bool has_match = false, has_adjust_args = false;
location_t adjust_args_loc = UNKNOWN_LOCATION;
location_t append_args_loc = UNKNOWN_LOCATION;
location_t match_loc = UNKNOWN_LOCATION;
- tree need_device_ptr_list = NULL_TREE;
tree ctx = error_mark_node;
+ tree adjust_args_list = NULL_TREE;
+ auto append_adjust_args = [chain = &adjust_args_list] (tree node) mutable
+ {
+ gcc_assert (chain && *chain == NULL_TREE);
+ *chain = node;
+ chain = &TREE_CHAIN (node);
+ };
+
+ auto compare_ranges = [&] (tree item)
+ {
+ for (tree n2 = adjust_args_list; n2; n2 = TREE_CHAIN (n2))
+ {
+ tree item2 = TREE_VALUE (n2);
+ if (TREE_CODE (TREE_VALUE (item2)) == INTEGER_CST)
+ continue;
+ else if (c_omp_numeric_ranges_always_overlap (TREE_VALUE (item2),
+ TREE_VALUE (item)))
+ /* Return the location. */
+ return TREE_PURPOSE (item2);
+ }
+ return NULL_TREE;
+ };
+
do
{
if (c_parser_next_token_is (parser, CPP_COMMA)
@@ -26992,7 +28641,8 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
if (!parens.require_open (parser))
goto fail;
-
+ /* This almost certainly causes problems with technically correct, but
+ insane functions that are variadic with no params. */
if (parms == NULL_TREE)
parms = error_mark_node;
@@ -27006,6 +28656,20 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
goto fail;
ctx = omp_check_context_selector (match_loc, ctx,
OMP_CTX_DECLARE_VARIANT);
+
+ /* The OpenMP spec says the merging rules for enclosing
+ "begin declare variant" contexts apply to "declare variant
+ directives" -- the term it uses to refer to both directive
+ forms. */
+ if (ctx != error_mark_node
+ && !vec_safe_is_empty (current_omp_declare_variant_attribute))
+ {
+ c_omp_declare_variant_attr a
+ = current_omp_declare_variant_attribute->last ();
+ tree outer_ctx = a.selector;
+ ctx = omp_merge_context_selectors (match_loc, outer_ctx, ctx,
+ OMP_CTX_DECLARE_VARIANT);
+ }
if (ctx != error_mark_node && variant != error_mark_node)
{
if (TREE_CODE (variant) != FUNCTION_DECL)
@@ -27037,62 +28701,119 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
if (c_parser_next_token_is (parser, CPP_NAME)
&& c_parser_peek_2nd_token (parser)->type == CPP_COLON)
{
- const char *p
- = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+ tree modifier_id = c_parser_peek_token (parser)->value;
+ const char *p = IDENTIFIER_POINTER (modifier_id);
if (strcmp (p, "need_device_ptr") == 0
|| strcmp (p, "nothing") == 0)
{
- c_parser_consume_token (parser); // need_device_ptr
+ c_parser_consume_token (parser); // need_device_ptr / nothing
c_parser_consume_token (parser); // :
loc = c_parser_peek_token (parser)->location;
- tree list
- = c_parser_omp_variable_list (parser, loc, OMP_CLAUSE_ERROR,
- NULL_TREE);
+ const tree parm_list
+ = c_parser_omp_parm_list (parser, fndecl, parm_count);
- tree arg;
if (variant != error_mark_node)
- for (tree c = list; c != NULL_TREE; c = TREE_CHAIN (c))
+ for (tree next, n = parm_list; n != NULL_TREE; n = next)
{
- tree decl = TREE_PURPOSE (c);
- location_t arg_loc = EXPR_LOCATION (TREE_VALUE (c));
- int idx;
- for (arg = parms, idx = 0; arg != NULL;
- arg = TREE_CHAIN (arg), idx++)
- if (arg == decl)
- break;
- if (arg == NULL_TREE)
+ next = TREE_CHAIN (n);
+ TREE_CHAIN (n) = NULL_TREE;
+ TREE_PURPOSE (n) = modifier_id;
+
+ tree item = TREE_VALUE (n);
+ const location_t item_loc
+ = EXPR_LOCATION (TREE_PURPOSE (item));
+ if (TREE_CODE (TREE_VALUE (item)) == TREE_LIST)
{
- error_at (arg_loc,
- "%qD is not a function argument",
- decl);
- goto fail;
+ /* Ranges are expanded by c_parser_omp_parm_list
+ in non-variadic functions. */
+ gcc_assert (variadic_p);
+ if (tree dupe = compare_ranges (item))
+ {
+ const location_t dupe_item_loc
+ = EXPR_LOCATION (dupe);
+
+ error_at (item_loc,
+ "numeric range always overlaps with "
+ "previously specified numeric "
+ "range");
+ inform (dupe_item_loc,
+ "previously specified here");
+ }
+ else
+ append_adjust_args (n);
+ continue;
}
- if (adjust_args_list.contains (arg))
+ gcc_assert (TREE_CODE (TREE_VALUE (item))
+ == INTEGER_CST);
+ const int idx = tree_to_shwi (TREE_VALUE (item));
+ /* Indices are 0 based, c_parser_omp_parm_list is
+ supposed to handle out of range indices. */
+ gcc_assert (idx >= 0
+ && (variadic_p || idx < parm_count));
+
+ if (tree *dupe = adjust_args_idxs.get (idx))
{
- error_at (arg_loc,
- "%qD is specified more than once",
- decl);
+ const location_t prev_item_loc
+ = EXPR_LOCATION (TREE_PURPOSE (*dupe));
+ /* Ensure the wording matches that in
+ c_parser_omp_parm_list. */
+ error_at (item_loc,
+ "parameter list item specified more "
+ "than once");
+ inform (prev_item_loc,
+ "previously specified here");
+ /* FIXME: Don't fail, keep going. */
goto fail;
}
- if (strcmp (p, "need_device_ptr") == 0
- && TREE_CODE (TREE_TYPE (arg)) != POINTER_TYPE)
+ /* Unconditionally push idx so we don't emit the
+ following errors multiple times. */
+ if (adjust_args_idxs.put (idx, item))
+ gcc_unreachable ();
+
+ if (strcmp (p, "need_device_ptr") == 0)
{
- error_at (loc, "%qD is not of pointer type", decl);
- goto fail;
+ const tree parm = [&] ()
+ {
+ if (idx >= parm_count)
+ return NULL_TREE;
+ int curr_idx = 0;
+ tree parm = parms;
+ while (parm != NULL_TREE)
+ {
+ if (curr_idx == idx)
+ return parm;
+ ++curr_idx;
+ parm = TREE_CHAIN (parm);
+ }
+ /* We already confirmed a parm exists in
+ c_parser_omp_parm_list. */
+ gcc_unreachable ();
+ } (); /* IILE. */
+ /* If we don't have an argument (because the index
+ is to a variadic arg) we can't check this. */
+ if (parm
+ && TREE_CODE (TREE_TYPE (parm))
+ != POINTER_TYPE)
+ {
+ error_at (DECL_SOURCE_LOCATION (parm),
+ "%qD is not of pointer type", parm);
+ inform (item_loc, "specified here");
+ /* FIXME: Don't fail, keep going. */
+ goto fail;
+ }
+ append_adjust_args (n);
}
- adjust_args_list.safe_push (arg);
- if (strcmp (p, "need_device_ptr") == 0)
+ else if (strcmp (p, "nothing") == 0)
{
- need_device_ptr_list = chainon (
- need_device_ptr_list,
- build_tree_list (
- NULL_TREE,
- build_int_cst (
- integer_type_node,
- idx))); // Store 0-based argument index,
- // as in gimplify_call_expr
+ /* We only need to save parameter list items from a
+ clause with the nothing modifier if the function
+ is variadic. */
+ if (variadic_p)
+ append_adjust_args (n);
}
+ else
+ gcc_unreachable ();
}
}
else
@@ -27321,11 +29042,13 @@ c_finish_omp_declare_variant (c_parser *parser, tree fndecl, tree parms)
}
if ((ctx != error_mark_node && variant != error_mark_node)
- && (need_device_ptr_list || append_args_tree))
+ && (adjust_args_list || append_args_tree))
{
tree variant_decl = tree_strip_nop_conversions (variant);
- tree t = build_tree_list (need_device_ptr_list,
- NULL_TREE /* need_device_addr */);
+ tree t = build_tree_list (CHECKING_P
+ ? get_identifier ("omp adjust args idxs")
+ : NULL_TREE,
+ adjust_args_list);
TREE_CHAIN (t) = append_args_tree;
DECL_ATTRIBUTES (variant_decl)
= tree_cons (get_identifier ("omp declare variant variant args"), t,
@@ -27412,6 +29135,87 @@ c_finish_omp_declare_simd (c_parser *parser, tree fndecl, tree parms,
clauses[0].type = CPP_PRAGMA;
}
+/* This is consistent with the C++ front end. */
+
+#if !defined (NO_DOT_IN_LABEL)
+#define JOIN_STR "."
+#elif !defined (NO_DOLLAR_IN_LABEL)
+#define JOIN_STR "$"
+#else
+#define JOIN_STR "_"
+#endif
+
+/* Helper function for OpenMP "begin declare variant" directives.
+ Function definitions inside the construct need to have their names
+ mangled according to the context selector CTX. The DECLARATOR is
+ modified in place to point to a new identifier; the original name of
+ the function is returned. */
+static tree
+omp_start_variant_function (c_declarator *declarator, tree ctx)
+{
+ c_declarator *id = declarator;
+ while (id->kind != cdk_id)
+ {
+ id = id->declarator;
+ gcc_assert (id);
+ }
+ tree name = id->u.id.id;
+ id->u.id.id = omp_mangle_variant_name (name, ctx, JOIN_STR);
+ return name;
+}
+
+/* Helper function for OpenMP "begin declare variant" directives. Now
+ that we have a DECL for the variant function, and BASE_NAME for the
+ base function, add an "omp declare variant base" attribute pointing
+ at CTX to the base decl, and an "omp declare variant variant"
+ attribute to the variant DECL. */
+static void
+omp_finish_variant_function (tree decl, tree base_name, tree ctx)
+{
+ /* First look up BASE_NAME and ensure it matches DECL. */
+ tree base_decl = lookup_name (base_name);
+ if (base_decl == error_mark_node)
+ base_decl = NULL_TREE;
+ if (!base_decl)
+ {
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "no previous declaration of base function");
+ return;
+ }
+
+ if (!comptypes (TREE_TYPE (decl), TREE_TYPE (base_decl)))
+ {
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "variant function definition does not match previous "
+ "declaration of %qE", base_decl);
+ return;
+ }
+
+ /* Now set the attributes on the base and variant decls for the middle
+ end. */
+ omp_check_for_duplicate_variant (DECL_SOURCE_LOCATION (decl),
+ base_decl, ctx);
+ tree construct
+ = omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
+ omp_mark_declare_variant (DECL_SOURCE_LOCATION (decl), decl, construct);
+ tree attrs = DECL_ATTRIBUTES (base_decl);
+ tree match_loc_node
+ = maybe_wrap_with_location (integer_zero_node,
+ DECL_SOURCE_LOCATION (base_decl));
+ tree loc_node = tree_cons (match_loc_node, integer_zero_node,
+ build_tree_list (match_loc_node,
+ integer_zero_node));
+ attrs = tree_cons (get_identifier ("omp declare variant base"),
+ tree_cons (decl, ctx, loc_node), attrs);
+ DECL_ATTRIBUTES (base_decl) = attrs;
+
+ /* Variant functions are essentially anonymous and cannot be referenced
+ outside the compilation unit. */
+ TREE_PUBLIC (decl) = 0;
+ DECL_COMDAT (decl) = 0;
+}
+
+
/* D should be C_TOKEN_VEC from omp::decl attribute. If it contains
a threadprivate, groupprivate, allocate or declare target directive,
return true and parse it for DECL. */
@@ -27644,7 +29448,9 @@ c_parser_omp_declare_target (c_parser *parser)
/* OpenMP 5.1
#pragma omp begin assumes clauses[optseq] new-line
- #pragma omp begin declare target clauses[optseq] new-line */
+ #pragma omp begin declare target clauses[optseq] new-line
+
+ #pragma omp begin declare variant (match context-selector) new-line */
#define OMP_BEGIN_DECLARE_TARGET_CLAUSE_MASK \
( (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DEVICE_TYPE) \
@@ -27684,11 +29490,75 @@ c_parser_omp_begin (c_parser *parser)
indirect };
vec_safe_push (current_omp_declare_target_attribute, attr);
}
- else
+ else if (strcmp (p, "variant") == 0)
{
- c_parser_error (parser, "expected %<target%>");
+ c_parser_consume_token (parser);
+ const char *clause = "";
+ matching_parens parens;
+ location_t match_loc = c_parser_peek_token (parser)->location;
+ if (c_parser_next_token_is (parser, CPP_NAME))
+ {
+ tree id = c_parser_peek_token (parser)->value;
+ clause = IDENTIFIER_POINTER (id);
+ }
+ if (strcmp (clause, "match") != 0)
+ {
+ c_parser_error (parser, "expected %<match%>");
+ c_parser_skip_to_pragma_eol (parser);
+ return;
+ }
+
+ c_parser_consume_token (parser);
+
+ if (!parens.require_open (parser))
+ {
+ c_parser_skip_to_pragma_eol (parser, false);
+ return;
+ }
+
+ tree ctx =
+ c_parser_omp_context_selector_specification (parser, NULL_TREE);
+ if (ctx != error_mark_node)
+ ctx = omp_check_context_selector (match_loc, ctx,
+ OMP_CTX_BEGIN_DECLARE_VARIANT);
+
+ if (ctx != error_mark_node
+ && !vec_safe_is_empty (current_omp_declare_variant_attribute))
+ {
+ c_omp_declare_variant_attr a
+ = current_omp_declare_variant_attribute->last ();
+ tree outer_ctx = a.selector;
+ ctx = omp_merge_context_selectors (match_loc, outer_ctx, ctx,
+ OMP_CTX_BEGIN_DECLARE_VARIANT);
+ }
+
+ if (ctx == error_mark_node
+ || !omp_context_selector_matches (ctx, NULL_TREE, false, true))
+ {
+ /* The context is either invalid or cannot possibly match.
+ In the latter case the spec says all code in the begin/end
+ sequence will be elided. In the former case we'll get bogus
+ errors from trying to parse it without a valid context to
+ use for name-mangling, so elide that too. */
+ c_parser_skip_to_pragma_eol (parser, false);
+ c_parser_skip_to_pragma_omp_end_declare_variant (parser);
+ return;
+ }
+ else
+ {
+ bool attr_syntax = parser->in_omp_attribute_pragma != NULL;
+ c_omp_declare_variant_attr a = { attr_syntax, ctx };
+ vec_safe_push (current_omp_declare_variant_attribute, a);
+ }
+
+ parens.require_close (parser);
c_parser_skip_to_pragma_eol (parser);
}
+ else
+ {
+ c_parser_error (parser, "expected %<target%> or %<variant%>");
+ c_parser_skip_to_pragma_eol (parser, false);
+ }
}
else if (strcmp (p, "assumes") == 0)
{
@@ -27700,7 +29570,8 @@ c_parser_omp_begin (c_parser *parser)
}
else
{
- c_parser_error (parser, "expected %<declare target%> or %<assumes%>");
+ c_parser_error (parser, "expected %<declare target%>, "
+ "%<declare variant%>, or %<assumes%>");
c_parser_skip_to_pragma_eol (parser);
}
}
@@ -27709,7 +29580,8 @@ c_parser_omp_begin (c_parser *parser)
#pragma omp end declare target
OpenMP 5.1
- #pragma omp end assumes */
+ #pragma omp end assumes
+ #pragma omp end declare variant new-line */
static void
c_parser_omp_end (c_parser *parser)
@@ -27722,44 +29594,74 @@ c_parser_omp_end (c_parser *parser)
if (strcmp (p, "declare") == 0)
{
c_parser_consume_token (parser);
- if (c_parser_next_token_is (parser, CPP_NAME)
- && strcmp (IDENTIFIER_POINTER (c_parser_peek_token (parser)->value),
- "target") == 0)
- c_parser_consume_token (parser);
- else
+ p = "";
+ if (c_parser_next_token_is (parser, CPP_NAME))
+ p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+ if (strcmp (p, "target") == 0)
{
- c_parser_error (parser, "expected %<target%>");
+ c_parser_consume_token (parser);
+ bool attr_syntax = parser->in_omp_attribute_pragma != NULL;
c_parser_skip_to_pragma_eol (parser);
- return;
+ if (!vec_safe_length (current_omp_declare_target_attribute))
+ error_at (loc, "%<#pragma omp end declare target%> without "
+ "corresponding %<#pragma omp declare target%> or "
+ "%<#pragma omp begin declare target%>");
+ else
+ {
+ c_omp_declare_target_attr
+ a = current_omp_declare_target_attribute->pop ();
+ if (a.attr_syntax != attr_syntax)
+ {
+ if (a.attr_syntax)
+ error_at (loc,
+ "%qs in attribute syntax terminated "
+ "with %qs in pragma syntax",
+ a.device_type >= 0 ? "begin declare target"
+ : "declare target",
+ "end declare target");
+ else
+ error_at (loc,
+ "%qs in pragma syntax terminated "
+ "with %qs in attribute syntax",
+ a.device_type >= 0 ? "begin declare target"
+ : "declare target",
+ "end declare target");
+ }
+ }
}
- bool attr_syntax = parser->in_omp_attribute_pragma != NULL;
- c_parser_skip_to_pragma_eol (parser);
- if (!vec_safe_length (current_omp_declare_target_attribute))
- error_at (loc, "%<#pragma omp end declare target%> without "
- "corresponding %<#pragma omp declare target%> or "
- "%<#pragma omp begin declare target%>");
- else
+ else if (strcmp (p, "variant") == 0)
{
- c_omp_declare_target_attr
- a = current_omp_declare_target_attribute->pop ();
- if (a.attr_syntax != attr_syntax)
+ c_parser_consume_token (parser);
+ bool attr_syntax = parser->in_omp_attribute_pragma != NULL;
+ c_parser_skip_to_pragma_eol (parser);
+ if (!vec_safe_length (current_omp_declare_variant_attribute))
+ error_at (loc, "%<#pragma omp end declare variant%> without "
+ "corresponding %<#pragma omp begin declare variant%>");
+ else
{
- if (a.attr_syntax)
- error_at (loc,
- "%qs in attribute syntax terminated "
- "with %qs in pragma syntax",
- a.device_type >= 0 ? "begin declare target"
- : "declare target",
- "end declare target");
- else
- error_at (loc,
- "%qs in pragma syntax terminated "
- "with %qs in attribute syntax",
- a.device_type >= 0 ? "begin declare target"
- : "declare target",
- "end declare target");
+ c_omp_declare_variant_attr
+ a = current_omp_declare_variant_attribute->pop ();
+ if (a.attr_syntax != attr_syntax)
+ {
+ if (a.attr_syntax)
+ error_at (loc,
+ "%<begin declare variant%> in attribute syntax "
+ "terminated with "
+ "%<end declare variant%> in pragma syntax");
+ else
+ error_at (loc,
+ "%<begin declare variant%> in pragma syntax "
+ "terminated with "
+ "%<end declare variant%> in attribute syntax");
+ }
}
}
+ else
+ {
+ c_parser_error (parser, "expected %<target%> or %<variant%>");
+ c_parser_skip_to_pragma_eol (parser);
+ return;
+ }
}
else if (strcmp (p, "assumes") == 0)
{
@@ -27795,6 +29697,151 @@ c_parser_omp_end (c_parser *parser)
}
}
+/* OpenMP 5.0
+ #pragma omp declare mapper ([mapper-identifier :] type var) \
+ [clause [ [,] clause ] ... ] new-line */
+
+static void
+c_parser_omp_declare_mapper (c_parser *parser, enum pragma_context context)
+{
+ tree type, mapper_name = NULL_TREE, var = NULL_TREE, stmt, stmtlist;
+ tree maplist = NULL_TREE, mapper_id, mapper_decl, t;
+ c_token *token;
+
+ if (context == pragma_struct || context == pragma_param)
+ {
+ error ("%<#pragma omp declare reduction%> not at file or block scope");
+ goto fail;
+ }
+
+ if (!c_parser_require (parser, CPP_OPEN_PAREN, "expected %<(%>"))
+ goto fail;
+
+ token = c_parser_peek_token (parser);
+
+ if (c_parser_peek_2nd_token (parser)->type == CPP_COLON)
+ {
+ switch (token->type)
+ {
+ case CPP_NAME:
+ mapper_name = token->value;
+ c_parser_consume_token (parser);
+ break;
+ case CPP_KEYWORD:
+ if (token->keyword == RID_DEFAULT)
+ {
+ mapper_name = NULL_TREE;
+ c_parser_consume_token (parser);
+ break;
+ }
+ /* Fallthrough. */
+ default:
+ error_at (token->location, "expected identifier or %<default%>");
+ c_parser_skip_to_pragma_eol (parser, false);
+ return;
+ }
+
+ if (!c_parser_require (parser, CPP_COLON, "expected %<:%>"))
+ goto fail;
+ }
+
+ mapper_id = c_omp_mapper_id (mapper_name);
+ mapper_decl = c_omp_mapper_decl (mapper_id);
+
+ {
+ location_t loc = c_parser_peek_token (parser)->location;
+ struct c_type_name *ctype = c_parser_type_name (parser);
+ type = groktypename (ctype, NULL, NULL);
+ if (type == error_mark_node)
+ goto fail;
+ if (TREE_CODE (type) != RECORD_TYPE
+ && TREE_CODE (type) != UNION_TYPE)
+ {
+ error_at (loc, "%qT is not a struct or union type in "
+ "%<#pragma omp declare mapper%>", type);
+ c_parser_skip_to_pragma_eol (parser, false);
+ return;
+ }
+ for (tree t = DECL_INITIAL (mapper_decl); t; t = TREE_CHAIN (t))
+ if (comptypes (TREE_PURPOSE (t), type))
+ {
+ error_at (loc, "redeclaration of %qs %<#pragma omp declare "
+ "mapper%> for type %qT", IDENTIFIER_POINTER (mapper_id)
+ + sizeof ("omp declare mapper ") - 1,
+ type);
+ tree prevmapper = TREE_VALUE (t);
+ /* Hmm, this location might not be very accurate. */
+ location_t ploc
+ = DECL_SOURCE_LOCATION (OMP_DECLARE_MAPPER_DECL (prevmapper));
+ error_at (ploc, "previous %<#pragma omp declare mapper%>");
+ c_parser_skip_to_pragma_eol (parser, false);
+ return;
+ }
+ }
+
+ token = c_parser_peek_token (parser);
+ if (token->type == CPP_NAME)
+ {
+ var = build_decl (token->location, VAR_DECL, token->value, type);
+ c_parser_consume_token (parser);
+ DECL_ARTIFICIAL (var) = 1;
+ }
+ else
+ {
+ error_at (token->location, "expected identifier");
+ goto fail;
+ }
+
+ if (!c_parser_require (parser, CPP_CLOSE_PAREN, "expected %<)%>"))
+ goto fail;
+
+ push_scope ();
+ stmtlist = push_stmt_list ();
+ pushdecl (var);
+ DECL_CONTEXT (var) = current_function_decl;
+
+ while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
+ {
+ location_t here;
+ pragma_omp_clause c_kind;
+ here = c_parser_peek_token (parser)->location;
+ c_kind = c_parser_omp_clause_name (parser);
+ if (c_kind != PRAGMA_OMP_CLAUSE_MAP)
+ {
+ error_at (here, "unexpected clause");
+ goto fail;
+ }
+ maplist = c_parser_omp_clause_map (parser, maplist, GOMP_MAP_UNSET);
+ }
+
+ if (maplist == NULL_TREE)
+ {
+ error_at (input_location, "missing %<map%> clause");
+ goto fail;
+ }
+
+ stmt = make_node (OMP_DECLARE_MAPPER);
+ TREE_TYPE (stmt) = type;
+ OMP_DECLARE_MAPPER_ID (stmt) = mapper_name;
+ OMP_DECLARE_MAPPER_DECL (stmt) = var;
+ OMP_DECLARE_MAPPER_CLAUSES (stmt) = maplist;
+
+ add_stmt (stmt);
+
+ pop_stmt_list (stmtlist);
+ pop_scope ();
+
+ c_parser_skip_to_pragma_eol (parser);
+
+ t = tree_cons (type, stmt, DECL_INITIAL (mapper_decl));
+ DECL_INITIAL (mapper_decl) = t;
+
+ return;
+
+ fail:
+ c_parser_skip_to_pragma_eol (parser);
+}
+
/* OpenMP 4.0
#pragma omp declare reduction (reduction-id : typename-list : expression) \
initializer-clause[opt] new-line
@@ -28186,6 +30233,12 @@ c_parser_omp_declare (c_parser *parser, enum pragma_context context)
c_parser_omp_declare_reduction (parser, context);
return false;
}
+ if (strcmp (p, "mapper") == 0)
+ {
+ c_parser_consume_token (parser);
+ c_parser_omp_declare_mapper (parser, context);
+ return false;
+ }
if (!flag_openmp) /* flag_openmp_simd */
{
c_parser_skip_to_pragma_eol (parser, false);
diff --git a/gcc/c/c-tree.h b/gcc/c/c-tree.h
index 2098120..3d2d174 100644
--- a/gcc/c/c-tree.h
+++ b/gcc/c/c-tree.h
@@ -768,6 +768,8 @@ extern int in_sizeof;
extern int in_typeof;
extern bool c_in_omp_for;
extern bool c_omp_array_section_p;
+extern bool c_omp_array_shaping_op_p;
+extern bool c_omp_has_array_shape_p;
extern tree c_last_sizeof_arg;
extern location_t c_last_sizeof_loc;
@@ -822,7 +824,9 @@ extern tree build_component_ref (location_t, tree, tree, location_t,
location_t, bool = true);
extern tree handle_counted_by_for_component_ref (location_t, tree);
extern tree build_array_ref (location_t, tree, tree);
-extern tree build_omp_array_section (location_t, tree, tree, tree);
+extern tree build_omp_array_section (location_t, tree, tree, tree, tree);
+extern tree create_omp_arrayshape_type (tree expr,
+ vec<tree> *omp_shape_dims);
extern tree build_external_ref (location_t, tree, bool, tree *);
extern void pop_maybe_used (bool);
extern struct c_expr c_expr_sizeof_expr (location_t, struct c_expr);
@@ -884,6 +888,10 @@ extern tree c_finish_omp_task (location_t, tree, tree);
extern void c_finish_omp_cancel (location_t, tree);
extern void c_finish_omp_cancellation_point (location_t, tree);
extern tree c_finish_omp_clauses (tree, enum c_omp_region_type);
+extern tree c_omp_finish_mapper_clauses (tree);
+extern tree c_omp_mapper_lookup (tree, tree);
+extern tree c_omp_extract_mapper_directive (tree);
+extern tree c_omp_map_array_section (location_t, tree);
extern tree c_build_va_arg (location_t, tree, location_t, tree);
extern tree c_finish_transaction (location_t, tree, int);
extern bool c_tree_equal (tree, tree);
@@ -942,6 +950,9 @@ extern tree c_omp_reduction_id (enum tree_code, tree);
extern tree c_omp_reduction_decl (tree);
extern tree c_omp_reduction_lookup (tree, tree);
extern tree c_check_omp_declare_reduction_r (tree *, int *, void *);
+extern tree c_omp_mapper_id (tree);
+extern tree c_omp_mapper_decl (tree);
+extern void c_omp_scan_mapper_bindings (location_t, tree *, tree);
extern bool c_check_in_current_scope (tree);
extern void c_pushtag (location_t, tree, tree);
extern void c_bind (location_t, tree, bool);
diff --git a/gcc/c/c-typeck.cc b/gcc/c/c-typeck.cc
index ea83451..18e9b71 100644
--- a/gcc/c/c-typeck.cc
+++ b/gcc/c/c-typeck.cc
@@ -81,6 +81,13 @@ bool c_in_omp_for;
/* True when parsing OpenMP map clause. */
bool c_omp_array_section_p;
+/* True when parsing OpenMP to/from clause. */
+bool c_omp_array_shaping_op_p;
+
+/* True if we have an OpenMP array-shaping "cast" expression. This adjusts
+ the parsed representation for e.g. array refs. */
+bool c_omp_has_array_shape_p;
+
/* The argument of last parsed sizeof expression, only to be tested
if expr.original_code == SIZEOF_EXPR. */
tree c_last_sizeof_arg;
@@ -2380,6 +2387,8 @@ mark_exp_read (tree exp)
mark_exp_read (TREE_OPERAND (exp, 1));
if (TREE_OPERAND (exp, 2))
mark_exp_read (TREE_OPERAND (exp, 2));
+ if (TREE_OPERAND (exp, 3))
+ mark_exp_read (TREE_OPERAND (exp, 3));
break;
default:
break;
@@ -3441,7 +3450,8 @@ build_array_ref (location_t loc, tree array, tree index)
instead. */
tree
-build_omp_array_section (location_t loc, tree array, tree index, tree length)
+build_omp_array_section (location_t loc, tree array, tree index, tree length,
+ tree stride)
{
tree type = TREE_TYPE (array);
gcc_assert (type);
@@ -3478,7 +3488,48 @@ build_omp_array_section (location_t loc, tree array, tree index, tree length)
sectype = c_build_array_type (eltype, idxtype);
}
- return build3_loc (loc, OMP_ARRAY_SECTION, sectype, array, index, length);
+ return build4_loc (loc, OMP_ARRAY_SECTION, sectype, array, index, length,
+ stride);
+}
+
+/* Build an array type whose dimensions are given by OMP_SHAPE_DIMS and whose
+ elements are of the type pointed to by the "base" node of EXPR with outer
+ OMP_ARRAY_SECTIONs and ARRAY_REFs stripped off, e.g. the type of "*myptr"
+ in "myptr[0:2:3][4][5:6]". */
+
+tree
+create_omp_arrayshape_type (tree expr, vec<tree> *omp_shape_dims)
+{
+ tree strip_sections = expr;
+
+ while (TREE_CODE (strip_sections) == OMP_ARRAY_SECTION
+ || TREE_CODE (strip_sections) == ARRAY_REF)
+ strip_sections = TREE_OPERAND (strip_sections, 0);
+
+ tree type = TREE_TYPE (strip_sections);
+
+ if (TREE_CODE (type) == REFERENCE_TYPE)
+ type = TREE_TYPE (type);
+
+ if (TREE_CODE (type) != POINTER_TYPE)
+ {
+ error ("OpenMP array shaping operator with non-pointer argument");
+ return error_mark_node;
+ }
+
+ type = TREE_TYPE (type);
+
+ int i;
+ tree dim;
+ FOR_EACH_VEC_ELT_REVERSE (*omp_shape_dims, i, dim)
+ {
+ tree maxidx = fold_convert (sizetype, dim);
+ maxidx = size_binop (MINUS_EXPR, maxidx, size_one_node);
+ tree index = build_index_type (maxidx);
+ type = build_array_type (type, index);
+ }
+
+ return type;
}
@@ -15172,14 +15223,16 @@ c_finish_omp_cancellation_point (location_t loc, tree clauses)
<= FIRST_NON_ONE we diagnose non-contiguous arrays if low bound isn't
0 or length isn't the array domain max + 1, for > FIRST_NON_ONE we
can if MAYBE_ZERO_LEN is false. MAYBE_ZERO_LEN will be true in the above
- case though, as some lengths could be zero. */
+ case though, as some lengths could be zero.
+ NON_CONTIGUOUS will be true if this is an OpenACC non-contiguous array
+ section. */
static tree
handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
bool &maybe_zero_len, unsigned int &first_non_one,
- enum c_omp_region_type ort)
+ bool &non_contiguous, enum c_omp_region_type ort, int *discontiguous)
{
- tree ret, low_bound, length, type;
+ tree ret, low_bound, length, stride, type;
bool openacc = (ort & C_ORT_ACC) != 0;
if (TREE_CODE (t) != OMP_ARRAY_SECTION)
{
@@ -15257,15 +15310,23 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
ret = handle_omp_array_sections_1 (c, TREE_OPERAND (t, 0), types,
- maybe_zero_len, first_non_one, ort);
+ maybe_zero_len, first_non_one,
+ non_contiguous, ort,
+ discontiguous);
if (ret == error_mark_node || ret == NULL_TREE)
return ret;
- type = TREE_TYPE (ret);
+ if (TREE_CODE (ret) == OMP_ARRAY_SECTION)
+ type = TREE_TYPE (TREE_TYPE (TREE_OPERAND (ret, 0)));
+ else
+ type = TREE_TYPE (ret);
low_bound = TREE_OPERAND (t, 1);
length = TREE_OPERAND (t, 2);
+ stride = TREE_OPERAND (t, 3);
- if (low_bound == error_mark_node || length == error_mark_node)
+ if (low_bound == error_mark_node
+ || length == error_mark_node
+ || stride == error_mark_node)
return error_mark_node;
if (low_bound && !INTEGRAL_TYPE_P (TREE_TYPE (low_bound)))
@@ -15282,6 +15343,13 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
length);
return error_mark_node;
}
+ if (stride && !INTEGRAL_TYPE_P (TREE_TYPE (stride)))
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "stride %qE of array section does not have integral type",
+ stride);
+ return error_mark_node;
+ }
if (low_bound
&& TREE_CODE (low_bound) == INTEGER_CST
&& TYPE_PRECISION (TREE_TYPE (low_bound))
@@ -15292,8 +15360,15 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
&& TYPE_PRECISION (TREE_TYPE (length))
> TYPE_PRECISION (sizetype))
length = fold_convert (sizetype, length);
+ if (stride
+ && TREE_CODE (stride) == INTEGER_CST
+ && TYPE_PRECISION (TREE_TYPE (stride))
+ > TYPE_PRECISION (sizetype))
+ stride = fold_convert (sizetype, stride);
if (low_bound == NULL_TREE)
low_bound = integer_zero_node;
+ if (stride == NULL_TREE)
+ stride = size_one_node;
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
&& (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH
|| OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_DETACH))
@@ -15412,12 +15487,29 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
if (length && TREE_CODE (length) == INTEGER_CST)
{
- if (tree_int_cst_lt (size, length))
+ tree slength = length;
+ if (stride && TREE_CODE (stride) == INTEGER_CST)
{
- error_at (OMP_CLAUSE_LOCATION (c),
- "length %qE above array section size "
- "in %qs clause", length,
- omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ slength = size_binop (MULT_EXPR,
+ fold_convert (sizetype, length),
+ fold_convert (sizetype, stride));
+ slength = size_binop (MINUS_EXPR,
+ slength,
+ fold_convert (sizetype, stride));
+ slength = size_binop (PLUS_EXPR, slength, size_one_node);
+ }
+ if (tree_int_cst_lt (size, slength))
+ {
+ if (stride && !integer_onep (stride))
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "length %qE with stride %qE above array "
+ "section size in %qs clause", length, stride,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ else
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "length %qE above array section size "
+ "in %qs clause", length,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
return error_mark_node;
}
if (TREE_CODE (low_bound) == INTEGER_CST)
@@ -15425,7 +15517,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
tree lbpluslen
= size_binop (PLUS_EXPR,
fold_convert (sizetype, low_bound),
- fold_convert (sizetype, length));
+ fold_convert (sizetype, slength));
if (TREE_CODE (lbpluslen) == INTEGER_CST
&& tree_int_cst_lt (size, lbpluslen))
{
@@ -15484,7 +15576,9 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
return error_mark_node;
}
/* If there is a pointer type anywhere but in the very first
- array-section-subscript, the array section could be non-contiguous. */
+ array-section-subscript, the array section could be non-contiguous.
+ Note that OpenACC does accept these kinds of non-contiguous pointer
+ based arrays. */
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
&& TREE_CODE (TREE_OPERAND (t, 0)) == OMP_ARRAY_SECTION)
@@ -15496,12 +15590,37 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
d = TREE_OPERAND (d, 0))
{
tree d_length = TREE_OPERAND (d, 2);
- if (d_length == NULL_TREE || !integer_onep (d_length))
+ tree d_stride = TREE_OPERAND (d, 3);
+ if (d_length == NULL_TREE || !integer_onep (d_length)
+ || (d_stride && !integer_onep (d_stride)))
{
- error_at (OMP_CLAUSE_LOCATION (c),
- "array section is not contiguous in %qs clause",
- omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
- return error_mark_node;
+ if (openacc && OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP)
+ {
+ while (TREE_CODE (d) == OMP_ARRAY_SECTION)
+ d = TREE_OPERAND (d, 0);
+ if (DECL_P (d))
+ {
+ /* Note that OpenACC does accept these kinds of
+ non-contiguous pointer based arrays. */
+ non_contiguous = true;
+ break;
+ }
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "base-pointer expression in %qs clause not "
+ "supported for non-contiguous arrays",
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ return error_mark_node;
+ }
+
+ if (discontiguous && *discontiguous)
+ *discontiguous = 2;
+ else
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "array section is not contiguous in %qs clause",
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ return error_mark_node;
+ }
}
}
}
@@ -15513,7 +15632,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
return error_mark_node;
}
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND)
- types.safe_push (TREE_TYPE (ret));
+ types.safe_push (type);
/* We will need to evaluate lb more than once. */
tree lb = save_expr (low_bound);
if (lb != low_bound)
@@ -15521,28 +15640,56 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
TREE_OPERAND (t, 1) = lb;
low_bound = lb;
}
- ret = build_array_ref (OMP_CLAUSE_LOCATION (c), ret, low_bound);
+ /* NOTE: Stride/length are discarded for affinity/depend here. */
+ if (discontiguous
+ && *discontiguous
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND)
+ ret = build_omp_array_section (OMP_CLAUSE_LOCATION (c), ret, low_bound,
+ length, stride);
+ else
+ ret = build_array_ref (OMP_CLAUSE_LOCATION (c), ret, low_bound);
return ret;
}
-/* Handle array sections for clause C. */
+/* We built a reference to an array section, but it turns out we only need a
+ set of ARRAY_REFs to the lower bound. Rewrite the node. */
+
+static tree
+omp_array_section_low_bound (location_t loc, tree node)
+{
+ if (TREE_CODE (node) == OMP_ARRAY_SECTION)
+ {
+ tree low_bound = TREE_OPERAND (node, 1);
+ tree ret = omp_array_section_low_bound (loc, TREE_OPERAND (node, 0));
+ return build_array_ref (loc, ret, low_bound);
+ }
+
+ return node;
+}
+
+/* Handle array sections for clause C. On entry *DISCONTIGUOUS is 0 if array
+ section must be contiguous, 1 if it can be discontiguous, and in the latter
+ case it is set to 2 on exit if it is determined to be discontiguous during
+ the function's execution. */
static bool
-handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
+handle_omp_array_sections (tree *pc, tree **pnext, enum c_omp_region_type ort,
+ int *discontiguous, bool *strided = NULL)
{
+ tree c = *pc;
bool maybe_zero_len = false;
unsigned int first_non_one = 0;
+ bool non_contiguous = false;
auto_vec<tree, 10> types;
tree *tp = &OMP_CLAUSE_DECL (c);
if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
- && TREE_CODE (*tp) == TREE_LIST
- && TREE_PURPOSE (*tp)
- && TREE_CODE (TREE_PURPOSE (*tp)) == TREE_VEC)
+ && OMP_ITERATOR_DECL_P (*tp))
tp = &TREE_VALUE (*tp);
tree first = handle_omp_array_sections_1 (c, *tp, types,
maybe_zero_len, first_non_one,
- ort);
+ non_contiguous, ort, discontiguous);
if (first == error_mark_node)
return true;
if (first == NULL_TREE)
@@ -15576,15 +15723,19 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
unsigned int num = types.length (), i;
tree t, side_effects = NULL_TREE, size = NULL_TREE;
tree condition = NULL_TREE;
+ tree ncarray_dims = NULL_TREE;
if (int_size_in_bytes (TREE_TYPE (first)) <= 0)
maybe_zero_len = true;
+ bool higher_discontiguous = false;
+
for (i = num, t = OMP_CLAUSE_DECL (c); i > 0;
t = TREE_OPERAND (t, 0))
{
tree low_bound = TREE_OPERAND (t, 1);
tree length = TREE_OPERAND (t, 2);
+ tree stride = TREE_OPERAND (t, 3);
i--;
if (low_bound
@@ -15597,12 +15748,65 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
&& TYPE_PRECISION (TREE_TYPE (length))
> TYPE_PRECISION (sizetype))
length = fold_convert (sizetype, length);
+ if (stride
+ && TREE_CODE (stride) == INTEGER_CST
+ && TYPE_PRECISION (TREE_TYPE (stride))
+ > TYPE_PRECISION (sizetype))
+ stride = fold_convert (sizetype, stride);
if (low_bound == NULL_TREE)
low_bound = integer_zero_node;
+
+ if (non_contiguous)
+ {
+ ncarray_dims = tree_cons (low_bound, length, ncarray_dims);
+ continue;
+ }
+
+ if (stride == NULL_TREE)
+ stride = size_one_node;
+ if (strided && !integer_onep (stride))
+ *strided = true;
+ if (discontiguous && *discontiguous)
+ {
+ /* This condition is similar to the error check below, but
+ whereas that checks for a definitely-discontiguous array
+ section in order to report an error (where such a section is
+ illegal), here we instead need to know if the array section
+ *may be* discontiguous so we can handle that case
+ appropriately (i.e. for rectangular "target update"
+ operations). */
+ bool full_span = false;
+ if (length != NULL_TREE
+ && TREE_CODE (length) == INTEGER_CST
+ && TREE_CODE (types[i]) == ARRAY_TYPE
+ && TYPE_DOMAIN (types[i])
+ && TYPE_MAX_VALUE (TYPE_DOMAIN (types[i]))
+ && TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (types[i])))
+ == INTEGER_CST)
+ {
+ tree size;
+ size = size_binop (PLUS_EXPR,
+ TYPE_MAX_VALUE (TYPE_DOMAIN (types[i])),
+ size_one_node);
+ if (tree_int_cst_equal (length, size))
+ full_span = true;
+ }
+
+ if (!integer_onep (stride)
+ || (higher_discontiguous
+ && (!integer_zerop (low_bound)
+ || !full_span)))
+ *discontiguous = 2;
+
+ if (!integer_onep (stride)
+ || !integer_zerop (low_bound)
+ || !full_span)
+ higher_discontiguous = true;
+ }
if (!maybe_zero_len && i > first_non_one)
{
if (integer_nonzerop (low_bound))
- goto do_warn_noncontiguous;
+ goto is_noncontiguous;
if (length != NULL_TREE
&& TREE_CODE (length) == INTEGER_CST
&& TYPE_DOMAIN (types[i])
@@ -15616,12 +15820,17 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
size_one_node);
if (!tree_int_cst_equal (length, size))
{
- do_warn_noncontiguous:
- error_at (OMP_CLAUSE_LOCATION (c),
- "array section is not contiguous in %qs "
- "clause",
- omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
- return true;
+ is_noncontiguous:
+ if (discontiguous && *discontiguous)
+ *discontiguous = 2;
+ else
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "array section is not contiguous in %qs "
+ "clause",
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ return true;
+ }
}
}
if (length != NULL_TREE
@@ -15695,6 +15904,14 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
size = size_binop (MULT_EXPR, size, l);
}
}
+ if (non_contiguous)
+ {
+ int kind = OMP_CLAUSE_MAP_KIND (c);
+ OMP_CLAUSE_SET_MAP_KIND (c, kind | GOMP_MAP_NONCONTIG_ARRAY);
+ OMP_CLAUSE_DECL (c) = t;
+ OMP_CLAUSE_SIZE (c) = ncarray_dims;
+ return false;
+ }
if (side_effects)
size = build2 (COMPOUND_EXPR, sizetype, side_effects, size);
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
@@ -15733,6 +15950,8 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
OMP_CLAUSE_DECL (c) = t;
return false;
}
+ if (discontiguous && *discontiguous != 2)
+ first = omp_array_section_low_bound (OMP_CLAUSE_LOCATION (c), first);
first = c_fully_fold (first, false, NULL);
OMP_CLAUSE_DECL (c) = first;
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR)
@@ -15748,7 +15967,8 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
OMP_CLAUSE_SIZE (c) = size;
}
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP
+ && !(discontiguous && *discontiguous == 2))
return false;
auto_vec<omp_addr_token *, 10> addr_tokens;
@@ -15758,23 +15978,28 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
c_omp_address_inspector ai (OMP_CLAUSE_LOCATION (c), t);
- tree nc = ai.expand_map_clause (c, first, addr_tokens, ort);
- if (nc != error_mark_node)
+ tree *npc = ai.expand_map_clause (pc, first, addr_tokens, ort);
+ if (npc != NULL)
{
using namespace omp_addr_tokenizer;
- if (ai.maybe_zero_length_array_section (c))
+ c = *pc;
+
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && ai.maybe_zero_length_array_section (c))
OMP_CLAUSE_MAP_MAYBE_ZERO_LENGTH_ARRAY_SECTION (c) = 1;
/* !!! If we're accessing a base decl via chained access
methods (e.g. multiple indirections), duplicate clause
detection won't work properly. Skip it in that case. */
- if ((addr_tokens[0]->type == STRUCTURE_BASE
- || addr_tokens[0]->type == ARRAY_BASE)
+ if (pnext
+ && (addr_tokens[0]->type == STRUCTURE_BASE
+ || addr_tokens[0]->type == ARRAY_BASE)
&& addr_tokens[0]->u.structure_base_kind == BASE_DECL
&& addr_tokens[1]->type == ACCESS_METHOD
&& omp_access_chain_p (addr_tokens, 1))
- c = nc;
+ /* NPC points to the last node in the new sequence. */
+ *pnext = npc;
return false;
}
@@ -15871,10 +16096,10 @@ c_omp_finish_iterators (tree iter)
bool ret = false;
for (tree it = iter; it; it = TREE_CHAIN (it))
{
- tree var = TREE_VEC_ELT (it, 0);
- tree begin = TREE_VEC_ELT (it, 1);
- tree end = TREE_VEC_ELT (it, 2);
- tree step = TREE_VEC_ELT (it, 3);
+ tree var = OMP_ITERATORS_VAR (it);
+ tree begin = OMP_ITERATORS_BEGIN (it);
+ tree end = OMP_ITERATORS_END (it);
+ tree step = OMP_ITERATORS_STEP (it);
tree orig_step;
tree type = TREE_TYPE (var);
location_t loc = DECL_SOURCE_LOCATION (var);
@@ -15948,10 +16173,10 @@ c_omp_finish_iterators (tree iter)
tree it2;
for (it2 = TREE_CHAIN (it); it2; it2 = TREE_CHAIN (it2))
{
- tree var2 = TREE_VEC_ELT (it2, 0);
- tree begin2 = TREE_VEC_ELT (it2, 1);
- tree end2 = TREE_VEC_ELT (it2, 2);
- tree step2 = TREE_VEC_ELT (it2, 3);
+ tree var2 = OMP_ITERATORS_VAR (it2);
+ tree begin2 = OMP_ITERATORS_BEGIN (it2);
+ tree end2 = OMP_ITERATORS_END (it2);
+ tree step2 = OMP_ITERATORS_STEP (it2);
tree type2 = TREE_TYPE (var2);
location_t loc2 = DECL_SOURCE_LOCATION (var2);
struct c_find_omp_var_s data = { var, &pset };
@@ -15986,10 +16211,10 @@ c_omp_finish_iterators (tree iter)
ret = true;
continue;
}
- TREE_VEC_ELT (it, 1) = begin;
- TREE_VEC_ELT (it, 2) = end;
- TREE_VEC_ELT (it, 3) = step;
- TREE_VEC_ELT (it, 4) = orig_step;
+ OMP_ITERATORS_BEGIN (it) = begin;
+ OMP_ITERATORS_END (it) = end;
+ OMP_ITERATORS_STEP (it) = step;
+ OMP_ITERATORS_ORIG_STEP (it) = orig_step;
}
return ret;
}
@@ -16023,6 +16248,68 @@ c_oacc_check_attachments (tree c)
return false;
}
+static bool
+c_oacc_reduction_defined_type_p (enum tree_code reduction_code, tree t)
+{
+ if (TREE_CODE (t) == INTEGER_TYPE)
+ return true;
+
+ if (FLOAT_TYPE_P (t) || TREE_CODE (t) == COMPLEX_TYPE)
+ switch (reduction_code)
+ {
+ case PLUS_EXPR:
+ case MULT_EXPR:
+ case MINUS_EXPR:
+ case TRUTH_ANDIF_EXPR:
+ case TRUTH_ORIF_EXPR:
+ return true;
+ case MIN_EXPR:
+ case MAX_EXPR:
+ return TREE_CODE (t) != COMPLEX_TYPE;
+ case BIT_AND_EXPR:
+ case BIT_XOR_EXPR:
+ case BIT_IOR_EXPR:
+ return false;
+ default:
+ gcc_unreachable ();
+ }
+
+ if (TREE_CODE (t) == ARRAY_TYPE)
+ return c_oacc_reduction_defined_type_p (reduction_code, TREE_TYPE (t));
+
+ if (TREE_CODE (t) == RECORD_TYPE)
+ {
+ for (tree fld = TYPE_FIELDS (t); fld; fld = TREE_CHAIN (fld))
+ if (TREE_CODE (fld) == FIELD_DECL
+ && !c_oacc_reduction_defined_type_p (reduction_code,
+ TREE_TYPE (fld)))
+ return false;
+ return true;
+ }
+
+ return false;
+}
+
+static const char *
+c_oacc_reduction_code_name (enum tree_code reduction_code)
+{
+ switch (reduction_code)
+ {
+ case PLUS_EXPR: return "+";
+ case MULT_EXPR: return "*";
+ case MINUS_EXPR: return "-";
+ case TRUTH_ANDIF_EXPR: return "&&";
+ case TRUTH_ORIF_EXPR: return "||";
+ case MIN_EXPR: return "min";
+ case MAX_EXPR: return "max";
+ case BIT_AND_EXPR: return "&";
+ case BIT_XOR_EXPR: return "^";
+ case BIT_IOR_EXPR: return "|";
+ default:
+ gcc_unreachable ();
+ }
+}
+
/* For all elements of CLAUSES, validate them against their constraints.
Remove any elements from the list that are invalid. */
@@ -16096,7 +16383,14 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
/* We've reached the end of a list of expanded nodes. Reset the group
start pointer. */
if (c == grp_sentinel)
- grp_start_p = NULL;
+ {
+ if (grp_start_p
+ && OMP_CLAUSE_HAS_ITERATORS (*grp_start_p))
+ for (tree gc = *grp_start_p; gc != grp_sentinel;
+ gc = OMP_CLAUSE_CHAIN (gc))
+ OMP_CLAUSE_ITERATORS (gc) = OMP_CLAUSE_ITERATORS (*grp_start_p);
+ grp_start_p = NULL;
+ }
switch (OMP_CLAUSE_CODE (c))
{
@@ -16128,12 +16422,13 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
t = OMP_CLAUSE_DECL (c);
if (TREE_CODE (t) == OMP_ARRAY_SECTION)
{
- if (handle_omp_array_sections (c, ort))
+ if (handle_omp_array_sections (pc, NULL, ort, NULL))
{
remove = true;
break;
}
+ c = *pc;
t = OMP_CLAUSE_DECL (c);
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_REDUCTION_INSCAN (c))
@@ -16221,9 +16516,22 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
break;
}
}
- if (OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) == NULL_TREE
- && (FLOAT_TYPE_P (type)
- || TREE_CODE (type) == COMPLEX_TYPE))
+ if (ort == C_ORT_ACC)
+ {
+ enum tree_code r_code = OMP_CLAUSE_REDUCTION_CODE (c);
+ if (!c_oacc_reduction_defined_type_p (r_code, TREE_TYPE (t)))
+ {
+ const char *r_name = c_oacc_reduction_code_name (r_code);
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "%qE has invalid type for %<reduction(%s)%>",
+ t, r_name);
+ remove = true;
+ break;
+ }
+ }
+ else if (OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) == NULL_TREE
+ && (FLOAT_TYPE_P (type)
+ || TREE_CODE (type) == COMPLEX_TYPE))
{
enum tree_code r_code = OMP_CLAUSE_REDUCTION_CODE (c);
const char *r_name = NULL;
@@ -16267,8 +16575,11 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
}
else if (OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) == error_mark_node)
{
- error_at (OMP_CLAUSE_LOCATION (c),
- "user defined reduction not found for %qE", t);
+ /* There are no user-defined reductions in OpenACC (as of
+ 2.6). */
+ if (ort & C_ORT_OMP)
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "user defined reduction not found for %qE", t);
remove = true;
break;
}
@@ -16730,14 +17041,117 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
break;
}
gcc_unreachable ();
+
+ case OMP_CLAUSE_USES_ALLOCATORS:
+ t = OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c);
+ if ((VAR_P (t) || TREE_CODE (t) == PARM_DECL)
+ && (bitmap_bit_p (&generic_head, DECL_UID (t))
+ || bitmap_bit_p (&map_head, DECL_UID (t))
+ || bitmap_bit_p (&firstprivate_head, DECL_UID (t))
+ || bitmap_bit_p (&lastprivate_head, DECL_UID (t))))
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "%qE appears more than once in data clauses", t);
+ remove = true;
+ break;
+ }
+ else
+ bitmap_set_bit (&generic_head, DECL_UID (t));
+ if (TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE
+ || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (TREE_TYPE (t))),
+ "omp_allocator_handle_t") != 0)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "allocator must be of %<omp_allocator_handle_t%> type");
+ remove = true;
+ break;
+ }
+ if (TREE_CODE (t) == CONST_DECL)
+ {
+ /* Currently for pre-defined allocators in libgomp, we do not
+ require additional init/fini inside target regions, so discard
+ such clauses. */
+ remove = true;
+
+ if (strcmp (IDENTIFIER_POINTER (DECL_NAME (t)),
+ "omp_null_allocator") == 0)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "%<omp_null_allocator%> cannot be used in "
+ "%<uses_allocators%> clause");
+ break;
+ }
+
+ if (OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c)
+ || OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c))
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "modifiers cannot be used with pre-defined "
+ "allocators");
+ break;
+ }
+ }
+ t = OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c);
+ if (t != NULL_TREE
+ && (TREE_CODE (t) != CONST_DECL
+ || TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE
+ || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (TREE_TYPE (t))),
+ "omp_memspace_handle_t") != 0))
+ {
+ error_at (OMP_CLAUSE_LOCATION (c), "memspace modifier must be "
+ "constant enum of %<omp_memspace_handle_t%> type");
+ remove = true;
+ break;
+ }
+ t = OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c);
+ if (t != NULL_TREE)
+ {
+ bool type_err = false;
+
+ if (TREE_CODE (TREE_TYPE (t)) != ARRAY_TYPE
+ || DECL_SIZE (t) == NULL_TREE)
+ type_err = true;
+ else
+ {
+ tree elem_t = TREE_TYPE (TREE_TYPE (t));
+ if (TREE_CODE (elem_t) != RECORD_TYPE
+ || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (elem_t)),
+ "omp_alloctrait_t") != 0
+ || !TYPE_READONLY (elem_t))
+ type_err = true;
+ }
+ if (type_err)
+ {
+ if (TREE_CODE (t) != ERROR_MARK)
+ error_at (OMP_CLAUSE_LOCATION (c), "traits array %qE must "
+ "be of %<const omp_alloctrait_t []%> type", t);
+ else
+ error_at (OMP_CLAUSE_LOCATION (c), "traits array must "
+ "be of %<const omp_alloctrait_t []%> type");
+ remove = true;
+ }
+ else
+ {
+ tree cst_val = decl_constant_value_1 (t, true);
+ if (cst_val == t)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c), "traits array must be "
+ "of constant values");
+
+ remove = true;
+ }
+ }
+ }
+ if (remove)
+ break;
+ pc = &OMP_CLAUSE_CHAIN (c);
+ continue;
case OMP_CLAUSE_DEPEND:
depend_clause = c;
/* FALLTHRU */
case OMP_CLAUSE_AFFINITY:
t = OMP_CLAUSE_DECL (c);
- if (TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (t))
{
if (TREE_PURPOSE (t) != last_iterators)
last_iterators_remove
@@ -16751,10 +17165,12 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
last_iterators = NULL_TREE;
if (TREE_CODE (t) == OMP_ARRAY_SECTION)
{
- if (handle_omp_array_sections (c, ort))
+ if (handle_omp_array_sections (pc, NULL, ort, NULL))
remove = true;
- else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
- && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if ((c = *pc)
+ && OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && (OMP_CLAUSE_DEPEND_KIND (c)
+ == OMP_CLAUSE_DEPEND_DEPOBJ))
{
error_at (OMP_CLAUSE_LOCATION (c),
"%<depend%> clause with %<depobj%> dependence "
@@ -16837,10 +17253,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
break;
}
}
- if (TREE_CODE (OMP_CLAUSE_DECL (c)) == TREE_LIST
- && TREE_PURPOSE (OMP_CLAUSE_DECL (c))
- && (TREE_CODE (TREE_PURPOSE (OMP_CLAUSE_DECL (c)))
- == TREE_VEC))
+ if (OMP_ITERATOR_DECL_P (OMP_CLAUSE_DECL (c)))
TREE_VALUE (OMP_CLAUSE_DECL (c)) = t;
else
OMP_CLAUSE_DECL (c) = t;
@@ -16850,9 +17263,25 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
case OMP_CLAUSE_MAP:
if (OMP_CLAUSE_MAP_IMPLICIT (c) && !implicit_moved)
goto move_implicit;
+ if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_PUSH_MAPPER_NAME
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POP_MAPPER_NAME)
+ {
+ remove = true;
+ break;
+ }
+ if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_GRID_DIM
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_GRID_STRIDE)
+ break;
/* FALLTHRU */
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
+ if (OMP_CLAUSE_ITERATORS (c)
+ && c_omp_finish_iterators (OMP_CLAUSE_ITERATORS (c)))
+ {
+ t = error_mark_node;
+ break;
+ }
+ /* FALLTHRU */
case OMP_CLAUSE__CACHE_:
{
using namespace omp_addr_tokenizer;
@@ -16864,10 +17293,24 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
grp_start_p = pc;
grp_sentinel = OMP_CLAUSE_CHAIN (c);
- if (handle_omp_array_sections (c, ort))
+ tree *pnext = NULL;
+ /* FIXME: Strided target updates not supported together with
+ iterators yet. */
+ int discontiguous
+ = (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM)
+ && !OMP_CLAUSE_ITERATORS (c);
+ bool strided = false;
+ if (handle_omp_array_sections (pc, &pnext, ort, &discontiguous,
+ &strided))
remove = true;
else
{
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM)
+ && OMP_CLAUSE_ITERATORS (c) && strided)
+ sorry ("strided target updates with iterators");
+ c = *pc;
t = OMP_CLAUSE_DECL (c);
if (!omp_mappable_type (TREE_TYPE (t)))
{
@@ -16963,6 +17406,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
clauses, reset the OMP_CLAUSE_SIZE (representing a bias)
to zero here. */
OMP_CLAUSE_SIZE (c) = size_zero_node;
+ if (pnext)
+ c = *pnext;
break;
}
else if (!omp_parse_expr (addr_tokens, t))
@@ -17104,7 +17549,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
}
else if (bitmap_bit_p (&map_head, DECL_UID (t))
&& !bitmap_bit_p (&map_field_head, DECL_UID (t))
- && ort != C_ORT_OMP
+ && ort != C_ORT_OMP && ort != C_ORT_OMP_TARGET
&& ort != C_ORT_OMP_EXIT_DATA)
{
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
@@ -17161,10 +17606,10 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
grp_start_p = pc;
grp_sentinel = OMP_CLAUSE_CHAIN (c);
- tree nc = ai.expand_map_clause (c, OMP_CLAUSE_DECL (c),
- addr_tokens, ort);
- if (nc != error_mark_node)
- c = nc;
+ tree *npc = ai.expand_map_clause (pc, OMP_CLAUSE_DECL (c),
+ addr_tokens, ort);
+ if (npc != NULL)
+ c = *npc;
}
}
break;
@@ -17264,10 +17709,11 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
t = OMP_CLAUSE_DECL (c);
if (TREE_CODE (t) == OMP_ARRAY_SECTION)
{
- if (handle_omp_array_sections (c, ort))
+ if (handle_omp_array_sections (pc, NULL, ort, NULL))
remove = true;
else
{
+ c = *pc;
t = OMP_CLAUSE_DECL (c);
while (TREE_CODE (t) == ARRAY_REF)
t = TREE_OPERAND (t, 0);
@@ -17581,6 +18027,11 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
pc = &OMP_CLAUSE_CHAIN (c);
}
+ if (grp_start_p
+ && OMP_CLAUSE_HAS_ITERATORS (*grp_start_p))
+ for (tree gc = *grp_start_p; gc; gc = OMP_CLAUSE_CHAIN (gc))
+ OMP_CLAUSE_ITERATORS (gc) = OMP_CLAUSE_ITERATORS (*grp_start_p);
+
if (simdlen
&& safelen
&& tree_int_cst_lt (OMP_CLAUSE_SAFELEN_EXPR (safelen),
@@ -17790,6 +18241,15 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
return clauses;
}
+/* Do processing necessary to make CLAUSES well-formed, where CLAUSES result
+ from implicit instantiation of user-defined mappers (in gimplify.cc). */
+
+tree
+c_omp_finish_mapper_clauses (tree clauses)
+{
+ return c_finish_omp_clauses (clauses, C_ORT_OMP);
+}
+
/* Return code to initialize DST with a copy constructor from SRC.
C doesn't have copy constructors nor assignment operators, only for
_Atomic vars we need to perform __atomic_load from src into a temporary
diff --git a/gcc/cgraphunit.cc b/gcc/cgraphunit.cc
index fa54a59..33ee89b 100644
--- a/gcc/cgraphunit.cc
+++ b/gcc/cgraphunit.cc
@@ -990,6 +990,10 @@ varpool_node::finalize_decl (tree decl)
tree attr = lookup_attribute ("omp allocate", DECL_ATTRIBUTES (decl));
if (attr)
{
+ /* The var loc, wrapped in a nop_expr, is stored here by
+ cp_parser_omp_allocate, finish_omp_allocate finalizes it,
+ we should never reach here before that happens. */
+ gcc_assert (TREE_CODE (TREE_VALUE (attr)) != NOP_EXPR);
tree align = TREE_VALUE (TREE_VALUE (attr));
if (align)
SET_DECL_ALIGN (decl, MAX (tree_to_uhwi (align) * BITS_PER_UNIT,
@@ -1198,7 +1202,12 @@ analyze_functions (bool first_time)
build_type_inheritance_graph ();
if (flag_openmp && first_time)
- omp_discover_implicit_declare_target ();
+ {
+ omp_discover_implicit_declare_target ();
+
+ if(flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ omp_ompacc_attribute_tagging ();
+ }
/* Analysis adds static variables that in turn adds references to new functions.
So we need to iterate the process until it stabilize. */
diff --git a/gcc/common.opt b/gcc/common.opt
index e3fa0da..5bc253b 100644
--- a/gcc/common.opt
+++ b/gcc/common.opt
@@ -2423,6 +2423,22 @@ foffload-abi-host-opts=
Common Joined MissingArgError(option missing after %qs)
-foffload-abi-host-opts=<options> Specify host ABI options.
+foffload-memory=
+Common Joined RejectNegative Enum(offload_memory) Var(flag_offload_memory) Init(OFFLOAD_MEMORY_NONE)
+-foffload-memory=[none|unified|pinned] Use an offload memory optimization.
+
+Enum
+Name(offload_memory) Type(enum offload_memory) UnknownError(Unknown offload memory option %qs)
+
+EnumValue
+Enum(offload_memory) String(none) Value(OFFLOAD_MEMORY_NONE)
+
+EnumValue
+Enum(offload_memory) String(unified) Value(OFFLOAD_MEMORY_UNIFIED)
+
+EnumValue
+Enum(offload_memory) String(pinned) Value(OFFLOAD_MEMORY_PINNED)
+
fomit-frame-pointer
Common Var(flag_omit_frame_pointer) Optimization
When possible do not generate stack frames.
@@ -2449,6 +2465,19 @@ Enum(target_simd_clone_device) String(nohost) Value(OMP_TARGET_SIMD_CLONE_NOHOST
EnumValue
Enum(target_simd_clone_device) String(any) Value(OMP_TARGET_SIMD_CLONE_ANY)
+fopenmp-target=
+Common Joined RejectNegative Enum(openmp_target) Var(flag_openmp_target) Init(OMP_TARGET_MODE_DEFAULT)
+Execution model used for OpenMP target regions.
+
+Enum
+Name(openmp_target) Type(int)
+
+EnumValue
+Enum(openmp_target) String(default) Value(OMP_TARGET_MODE_DEFAULT)
+
+EnumValue
+Enum(openmp_target) String(acc) Value(OMP_TARGET_MODE_OMPACC)
+
fopt-info
Common Var(flag_opt_info) Optimization
Enable all optimization info dumps on stderr.
diff --git a/gcc/config/gcn/gcn-tree.cc b/gcc/config/gcn/gcn-tree.cc
index 4ae29bd..c3349d6 100644
--- a/gcc/config/gcn/gcn-tree.cc
+++ b/gcc/config/gcn/gcn-tree.cc
@@ -35,6 +35,7 @@
#include "varasm.h"
#include "omp-low.h"
#include "omp-general.h"
+#include "omp-offload.h"
#include "internal-fn.h"
#include "tree-vrp.h"
#include "tree-ssanames.h"
@@ -44,6 +45,7 @@
#include "cgraph.h"
#include "targhooks.h"
#include "langhooks-def.h"
+#include "memmodel.h"
/* }}} */
/* {{{ OpenACC reductions. */
@@ -78,6 +80,9 @@ gcn_global_lock_addr ()
return build_fold_addr_expr (v);
}
+/* Pointer variables for array reduction buffers used. */
+static vec<tree> gcn_array_reduction_buffers;
+
/* Helper function for gcn_reduction_update.
Insert code to locklessly update *PTR with *PTR OP VAR just before
@@ -259,7 +264,8 @@ gcn_lockfull_update (location_t loc, gimple_stmt_iterator *gsi,
/* Build and insert the reduction calculation. */
gimple_seq red_seq = NULL;
tree acc_in = make_ssa_name (var_type);
- tree ref_in = build_simple_mem_ref (ptr);
+ tree ref_in
+ = build_simple_mem_ref (fold_convert (build_pointer_type (var_type), ptr));
TREE_THIS_VOLATILE (ref_in) = 1;
gimplify_assign (acc_in, ref_in, &red_seq);
@@ -267,7 +273,8 @@ gcn_lockfull_update (location_t loc, gimple_stmt_iterator *gsi,
tree update_expr = fold_build2 (op, var_type, ref_in, var);
gimplify_assign (acc_out, update_expr, &red_seq);
- tree ref_out = build_simple_mem_ref (ptr);
+ tree ref_out
+ = build_simple_mem_ref (fold_convert (build_pointer_type (var_type), ptr));
TREE_THIS_VOLATILE (ref_out) = 1;
gimplify_assign (ref_out, acc_out, &red_seq);
@@ -291,11 +298,144 @@ gcn_lockfull_update (location_t loc, gimple_stmt_iterator *gsi,
static tree
gcn_reduction_update (location_t loc, gimple_stmt_iterator *gsi,
- tree ptr, tree var, tree_code op)
+ tree ptr, tree var, tree_code op,
+ tree array_max_idx = NULL_TREE)
{
tree type = TREE_TYPE (var);
tree size = TYPE_SIZE (type);
+ if (!VAR_P (ptr))
+ {
+ tree t = make_ssa_name (TREE_TYPE (ptr));
+ gimple_seq seq = NULL;
+ gimplify_assign (t, ptr, &seq);
+ gsi_insert_seq_before (gsi, seq, GSI_SAME_STMT);
+ ptr = t;
+ }
+
+ if (TREE_CODE (type) == ARRAY_TYPE
+ || TREE_CODE (type) == POINTER_TYPE)
+ {
+ tree array_type;
+ if (TREE_CODE (type) == ARRAY_TYPE)
+ {
+ array_type = TREE_TYPE (var);
+ }
+ else if (TREE_CODE (type) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
+ {
+ array_type = TREE_TYPE (TREE_TYPE (var));
+ }
+ else if (TREE_CODE (type) == POINTER_TYPE)
+ {
+ array_type = TREE_TYPE (var);
+ }
+ else
+ gcc_unreachable ();
+
+ tree array_elem_type = TREE_TYPE (array_type);
+
+ gimple *g;
+ gimple_seq seq = NULL;
+ tree max_index = array_max_idx;
+ gcc_assert (array_max_idx);
+
+ tree init_index = make_ssa_name (TREE_TYPE (max_index));
+ tree loop_index = make_ssa_name (TREE_TYPE (max_index));
+ tree update_index = make_ssa_name (TREE_TYPE (max_index));
+
+ g = gimple_build_assign (init_index,
+ build_int_cst (TREE_TYPE (init_index), 0));
+ gimple_seq_add_stmt (&seq, g);
+ gimple *init_end = gimple_seq_last (seq);
+ gsi_insert_seq_before (gsi, seq, GSI_SAME_STMT);
+
+ basic_block init_bb = gsi_bb (*gsi);
+ edge init_edge = split_block (init_bb, init_end);
+ basic_block loop_bb = init_edge->dest;
+ /* Reset the iterator. */
+ *gsi = gsi_for_stmt (gsi_stmt (*gsi));
+
+ seq = NULL;
+ g = gimple_build_assign (update_index, PLUS_EXPR, loop_index,
+ build_int_cst (TREE_TYPE (loop_index), 1));
+ gimple_seq_add_stmt (&seq, g);
+
+ g = gimple_build_cond (LE_EXPR, update_index, max_index, NULL, NULL);
+ gimple_seq_add_stmt (&seq, g);
+ gsi_insert_seq_before (gsi, seq, GSI_SAME_STMT);
+
+ edge post_edge = split_block (loop_bb, g);
+ basic_block post_bb = post_edge->dest;
+ loop_bb = post_edge->src;
+ /* Reset the iterator. */
+ *gsi = gsi_for_stmt (gsi_stmt (*gsi));
+
+ /* Place where we insert reduction code below. */
+ gimple_stmt_iterator reduction_code_gsi = gsi_start_bb (loop_bb);
+
+ post_edge->flags ^= EDGE_FALSE_VALUE | EDGE_FALLTHRU;
+ post_edge->probability = profile_probability::even ();
+ edge loop_edge = make_edge (loop_bb, loop_bb, EDGE_TRUE_VALUE);
+ loop_edge->probability = profile_probability::even ();
+ set_immediate_dominator (CDI_DOMINATORS, loop_bb, init_bb);
+ set_immediate_dominator (CDI_DOMINATORS, post_bb, loop_bb);
+ class loop *new_loop = alloc_loop ();
+ new_loop->header = loop_bb;
+ new_loop->latch = loop_bb;
+ add_loop (new_loop, loop_bb->loop_father);
+
+ gphi *phi = create_phi_node (loop_index, loop_bb);
+ add_phi_arg (phi, init_index, init_edge, loc);
+ add_phi_arg (phi, update_index, loop_edge, loc);
+
+ tree var_ptr = fold_convert (build_pointer_type (array_elem_type),
+ var);
+ tree idx = fold_build2 (MULT_EXPR, sizetype,
+ fold_convert (sizetype, loop_index),
+ TYPE_SIZE_UNIT (array_elem_type));
+ var_ptr = build2 (POINTER_PLUS_EXPR, TREE_TYPE (var_ptr), var_ptr, idx);
+ tree var_aref = build_simple_mem_ref (var_ptr);
+ ptr = build2 (POINTER_PLUS_EXPR, TREE_TYPE (ptr), ptr, idx);
+
+ gcn_reduction_update (loc, &reduction_code_gsi,
+ ptr, var_aref, op);
+
+ return build_simple_mem_ref (ptr);
+ }
+ else if (TREE_CODE (type) == RECORD_TYPE)
+ {
+ for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
+ if (TREE_CODE (fld) == FIELD_DECL)
+ {
+ tree var_fld_ref = build3 (COMPONENT_REF, TREE_TYPE (fld),
+ var, fld, NULL);
+ tree ptr_ref = build_simple_mem_ref (ptr);
+ tree ptr_fld_type
+ = build_qualified_type (TREE_TYPE (fld),
+ TYPE_QUALS (TREE_TYPE (ptr_ref)));
+ tree ptr_fld_ref = build3 (COMPONENT_REF, ptr_fld_type,
+ ptr_ref, fld, NULL);
+
+ if (TREE_CODE (TREE_TYPE (fld)) == ARRAY_TYPE)
+ {
+ tree array_elem_ptr_type
+ = build_pointer_type (TREE_TYPE (TREE_TYPE (fld)));
+ gcn_reduction_update
+ (loc, gsi,
+ fold_convert (array_elem_ptr_type,
+ build_fold_addr_expr (ptr_fld_ref)),
+ build_fold_addr_expr (var_fld_ref), op,
+ TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (fld))));
+ }
+ else
+ gcn_reduction_update (loc, gsi,
+ build_fold_addr_expr (ptr_fld_ref),
+ var_fld_ref, op);
+ }
+ return build_simple_mem_ref (ptr);
+ }
+
if (size == TYPE_SIZE (unsigned_type_node)
|| size == TYPE_SIZE (long_long_unsigned_type_node))
return gcn_lockless_update (loc, gsi, ptr, var, op);
@@ -306,7 +446,7 @@ gcn_reduction_update (location_t loc, gimple_stmt_iterator *gsi,
/* Return a temporary variable decl to use for an OpenACC worker reduction. */
static tree
-gcn_goacc_get_worker_red_decl (tree type, unsigned offset)
+gcn_goacc_get_worker_red_decl (tree type, tree offset_expr)
{
machine_function *machfun = cfun->machine;
@@ -317,15 +457,165 @@ gcn_goacc_get_worker_red_decl (tree type, unsigned offset)
= build_qualified_type (type,
(TYPE_QUALS (type)
| ENCODE_QUAL_ADDR_SPACE (ADDR_SPACE_LDS)));
-
- gcc_assert (offset
- < (machfun->reduction_limit - machfun->reduction_base));
- tree ptr_type = build_pointer_type (var_type);
- tree addr = build_int_cst (ptr_type, machfun->reduction_base + offset);
+ tree addr;
+ if (TREE_CONSTANT (offset_expr))
+ {
+ unsigned offset = TREE_INT_CST_LOW (offset_expr);
+ gcc_assert (offset
+ < (machfun->reduction_limit - machfun->reduction_base));
+ tree ptr_type = build_pointer_type (var_type);
+ addr = build_int_cst (ptr_type, machfun->reduction_base + offset);
+ }
+ else
+ {
+ tree ptr_type = build_pointer_type (var_type);
+ tree red_base = build_int_cst (ptr_type, machfun->reduction_base);
+ addr = build2 (POINTER_PLUS_EXPR, ptr_type,
+ red_base, fold_convert (size_type_node, offset_expr));
+ }
return build_simple_mem_ref (addr);
}
+static tree
+gcn_goacc_get_worker_array_reduction_buffer (tree array_type,
+ tree array_max_idx,
+ gimple_seq *seq)
+{
+ gcc_assert (!gcn_array_reduction_buffers.is_empty ());
+ tree red_buf_ptr = gcn_array_reduction_buffers.last ();
+
+ tree ptr = make_ssa_name (ptr_type_node);
+ gimplify_assign (ptr, red_buf_ptr, seq);
+
+ tree whole_block_ptr;
+ if (TREE_CODE (array_type) == ARRAY_TYPE)
+ whole_block_ptr = fold_convert (build_pointer_type (array_type), ptr);
+ else
+ whole_block_ptr = array_type;
+
+ tree arg = build_int_cst (unsigned_type_node, GOMP_DIM_GANG);
+ tree gang_id = make_ssa_name (integer_type_node);
+ gimple *gang_id_call = gimple_build_call_internal (IFN_GOACC_DIM_POS, 1, arg);
+ gimple_call_set_lhs (gang_id_call, gang_id);
+ gimple_seq_add_stmt (seq, gang_id_call);
+
+ tree len = fold_build2 (PLUS_EXPR, size_type_node, array_max_idx,
+ size_int (1));
+ tree elem_size = TYPE_SIZE_UNIT (TREE_TYPE (array_type));
+ tree array_size_expr = build2 (MULT_EXPR, size_type_node, len, elem_size);
+ tree type_size = make_ssa_name (size_type_node);
+ gimplify_assign (type_size, array_size_expr, seq);
+
+ tree idx = make_ssa_name (size_type_node);
+ gimplify_assign (idx, build2 (MULT_EXPR, size_type_node, type_size,
+ fold_convert (size_type_node, gang_id)), seq);
+
+ tree addr = fold_convert (ptr_type_node, whole_block_ptr);;
+ addr = build2 (POINTER_PLUS_EXPR, ptr_type_node, addr, idx);
+ addr = fold_convert (build_pointer_type (array_type), addr);
+
+ tree addr_reg = make_ssa_name (build_pointer_type (array_type));
+ gimplify_assign (addr_reg, addr, seq);
+
+ return build_simple_mem_ref (addr_reg);
+}
+
+static void
+gcn_create_if_else_seq (gimple_stmt_iterator *gsi_p, gimple *split_stmt,
+ gimple_seq *then_seq, gimple_seq *else_seq)
+{
+ basic_block init_bb = gsi_bb (*gsi_p);
+
+ edge fallthru_edge = split_block (init_bb, split_stmt);
+ basic_block then_bb = fallthru_edge->dest;
+
+ /* Reset the iterator. */
+ *gsi_p = gsi_for_stmt (gsi_stmt (*gsi_p));
+
+ gimple *then_seq_end = gimple_seq_last (*then_seq);
+ gsi_insert_seq_before (gsi_p, *then_seq, GSI_SAME_STMT);
+
+ basic_block last_bb = then_bb;
+ gimple *last_seq_end = then_seq_end;
+
+ basic_block else_bb = NULL;
+ edge then_else_fallthru_edge = NULL;
+ if (else_seq)
+ {
+ then_else_fallthru_edge = split_block (then_bb, then_seq_end);
+ else_bb = then_else_fallthru_edge->dest;
+
+ /* Reset the iterator. */
+ *gsi_p = gsi_for_stmt (gsi_stmt (*gsi_p));
+
+ gimple *else_seq_end = gimple_seq_last (*else_seq);
+ gsi_insert_seq_before (gsi_p, *else_seq, GSI_SAME_STMT);
+
+ last_bb = else_bb;
+ last_seq_end = else_seq_end;
+ }
+
+ edge post_edge = split_block (last_bb, last_seq_end);
+ basic_block post_bb = post_edge->dest;
+
+ /* Reset the iterator. */
+ *gsi_p = gsi_for_stmt (gsi_stmt (*gsi_p));
+
+ edge if_true_edge = make_edge (init_bb, (else_seq ? else_bb : post_bb),
+ EDGE_TRUE_VALUE);
+ if_true_edge->probability = profile_probability::even ();
+ fallthru_edge->flags = EDGE_FALSE_VALUE;
+ fallthru_edge->probability = profile_probability::even ();
+
+ post_edge->flags = EDGE_FALLTHRU;
+ post_edge->probability = profile_probability::always ();
+
+ set_immediate_dominator (CDI_DOMINATORS, then_bb, init_bb);
+ set_immediate_dominator (CDI_DOMINATORS, post_bb, init_bb);
+
+ if (else_seq)
+ {
+ redirect_edge_and_branch (then_else_fallthru_edge, post_bb);
+ set_immediate_dominator (CDI_DOMINATORS, else_bb, init_bb);
+ }
+}
+
+static void
+gcn_create_do_while_loop_seq (gimple_stmt_iterator *gsi_p,
+ gimple_seq *body_seq, int edge_flags)
+{
+ gimple *g = NULL;
+ basic_block init_bb = gsi_bb (*gsi_p);
+ edge init_edge = split_block (init_bb, g);
+ basic_block loop_bb = init_edge->dest;
+ init_bb = init_edge->src;
+
+ /* Reset the iterator. */
+ *gsi_p = gsi_for_stmt (gsi_stmt (*gsi_p));
+
+ gimple_stmt_iterator loop_gsi = gsi_start_bb (loop_bb);
+
+ gimple *body_seq_end = gimple_seq_last (*body_seq);
+ gsi_insert_seq_before (&loop_gsi, *body_seq, GSI_SAME_STMT);
+
+ edge post_edge = split_block (loop_bb, body_seq_end);
+ basic_block post_bb = post_edge->dest;
+
+ /* Reset the iterator. */
+ *gsi_p = gsi_for_stmt (gsi_stmt (*gsi_p));
+
+ make_edge (loop_bb, loop_bb, edge_flags);
+ post_edge->flags = EDGE_FALSE_VALUE;
+ set_immediate_dominator (CDI_DOMINATORS, loop_bb, init_bb);
+ set_immediate_dominator (CDI_DOMINATORS, post_bb, loop_bb);
+
+ loop *loop = alloc_loop ();
+ loop->header = loop_bb;
+ loop->latch = loop_bb;
+ add_loop (loop, loop_bb->loop_father);
+}
+
/* Expand IFN_GOACC_REDUCTION_SETUP. */
static void
@@ -335,35 +625,156 @@ gcn_goacc_reduction_setup (gcall *call)
tree lhs = gimple_call_lhs (call);
tree var = gimple_call_arg (call, 2);
int level = TREE_INT_CST_LOW (gimple_call_arg (call, 3));
+
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+ bool array_p = !integer_zerop (array_addr);
+
+ tree array_type = NULL_TREE;
+ if (array_p)
+ array_type
+ = (TREE_CODE (TREE_TYPE (array_addr)) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (array_addr))) == ARRAY_TYPE
+ ? TREE_TYPE (TREE_TYPE (array_addr))
+ : TREE_TYPE (array_addr));
+
gimple_seq seq = NULL;
push_gimplify_context (true);
+ /* Copy the receiver object. */
+ tree ref_to_res = gimple_call_arg (call, 1);
+
if (level != GOMP_DIM_GANG)
{
- /* Copy the receiver object. */
- tree ref_to_res = gimple_call_arg (call, 1);
-
if (!integer_zerop (ref_to_res))
- var = build_simple_mem_ref (ref_to_res);
+ {
+ if (!array_p)
+ var = build_simple_mem_ref (ref_to_res);
+ }
+ }
+
+ if (array_p && !integer_zerop (ref_to_res))
+ {
+ gimple_seq condseq = NULL;
+
+ /* Create global variable to store pointer to array reduction buffer. */
+ tree reduction_buffer_ptr_type
+ = build_qualified_type (ptr_type_node, TYPE_QUAL_VOLATILE);
+ tree reduction_buffer_ptr
+ = build_decl (UNKNOWN_LOCATION, VAR_DECL,
+ create_tmp_var_name ("gcn_array_reduction_buf"),
+ reduction_buffer_ptr_type);
+ TREE_STATIC (reduction_buffer_ptr) = 1;
+ TREE_PUBLIC (reduction_buffer_ptr) = 0;
+ DECL_INITIAL (reduction_buffer_ptr) = 0;
+ DECL_EXTERNAL (reduction_buffer_ptr) = 0;
+
+ varpool_node::add (reduction_buffer_ptr);
+
+ tree reduction_buffer_ptr_addr = make_ssa_name (ptr_type_node);
+ gimplify_assign (reduction_buffer_ptr_addr,
+ build_fold_addr_expr (reduction_buffer_ptr), &condseq);
+
+ tree gang_dim_arg = build_int_cst (unsigned_type_node, GOMP_DIM_GANG);
+ tree gang_pos = make_ssa_name (integer_type_node);
+ gimple *gang_pos_call = gimple_build_call_internal (IFN_GOACC_DIM_POS,
+ 1, gang_dim_arg);
+ gimple_call_set_lhs (gang_pos_call, gang_pos);
+ gimple_seq_add_stmt (&condseq, gang_pos_call);
+ gimple *cond = gimple_build_cond (NE_EXPR, gang_pos, integer_zero_node,
+ NULL, NULL);
+ gimple_seq_add_stmt (&condseq, cond);
+ gimple *cond_end = gimple_seq_last (condseq);
+ gsi_insert_seq_before (&gsi, condseq, GSI_SAME_STMT);
+
+ gimple_seq malloc_seq = NULL;
+ tree gang_num = make_ssa_name (integer_type_node);
+ gimple *gang_num_call = gimple_build_call_internal (IFN_GOACC_DIM_SIZE,
+ 1, gang_dim_arg);
+ gimple_call_set_lhs (gang_num_call, gang_num);
+ gimple_seq_add_stmt (&malloc_seq, gang_num_call);
+
+ tree len = fold_build2 (PLUS_EXPR, size_type_node, array_max_idx,
+ size_int (1));
+ tree elem_size = TYPE_SIZE_UNIT (TREE_TYPE (array_type));
+ tree malloc_size_expr = build2 (MULT_EXPR, size_type_node, len,
+ elem_size);
+ malloc_size_expr = build2 (MULT_EXPR, size_type_node, malloc_size_expr,
+ fold_convert (size_type_node, gang_num));
+ tree malloc_size = make_ssa_name (size_type_node);
+ gimplify_assign (malloc_size, malloc_size_expr, &malloc_seq);
+
+ tree ptr = make_ssa_name (ptr_type_node);
+ tree malloc_decl = builtin_decl_explicit (BUILT_IN_MALLOC);
+ gcall *stmt = gimple_build_call (malloc_decl, 1, malloc_size);
+ gimple_call_set_lhs (stmt, ptr);
+ gimple_seq_add_stmt (&malloc_seq, stmt);
+
+ tree atomic_store_decl = builtin_decl_explicit (BUILT_IN_ATOMIC_STORE_8);
+ gcall *atomic_store
+ = gimple_build_call (atomic_store_decl, 3, reduction_buffer_ptr_addr,
+ ptr, build_int_cst (integer_type_node,
+ MEMMODEL_RELEASE));
+ gimple_seq_add_stmt (&malloc_seq, atomic_store);
+
+ gimple_seq wait_seq = NULL;
+ gimple *nop = gimple_build_nop ();
+ gimple_seq_add_stmt (&wait_seq, nop);
+
+ gcn_create_if_else_seq (&gsi, cond_end, &malloc_seq, &wait_seq);
+
+ /* Create cmp-swap loop for other gangs to wait for
+ gcn_array_reduction_buf.* to be properly set by gang zero. */
+ gimple_stmt_iterator ngsi = gsi_for_stmt (nop);
+
+ gimple_seq atomic_load_seq = NULL;
+ tree loadval = make_ssa_name (size_type_node);
+ tree atomic_load_decl = builtin_decl_explicit (BUILT_IN_ATOMIC_LOAD_8);
+ gcall *atomic_load
+ = gimple_build_call (atomic_load_decl, 2, reduction_buffer_ptr_addr,
+ build_int_cst (integer_type_node,
+ MEMMODEL_ACQUIRE));
+ gimple_call_set_lhs (atomic_load, loadval);
+ gimple_seq_add_stmt (&atomic_load_seq, atomic_load);
+ cond = gimple_build_cond (EQ_EXPR, loadval, size_zero_node,
+ NULL_TREE, NULL_TREE);
+ gimple_seq_add_stmt (&atomic_load_seq, cond);
+
+ gcn_create_do_while_loop_seq (&ngsi, &atomic_load_seq, EDGE_TRUE_VALUE);
+ gcn_array_reduction_buffers.safe_push (reduction_buffer_ptr);
}
if (level == GOMP_DIM_WORKER)
{
- tree var_type = TREE_TYPE (var);
- /* Store incoming value to worker reduction buffer. */
tree offset = gimple_call_arg (call, 5);
- tree decl
- = gcn_goacc_get_worker_red_decl (var_type, TREE_INT_CST_LOW (offset));
-
- gimplify_assign (decl, var, &seq);
+ if (array_p)
+ {
+ tree copy_src = !integer_zerop (ref_to_res) ? ref_to_res : array_addr;
+ tree decl = gcn_goacc_get_worker_array_reduction_buffer
+ (array_type, array_max_idx, &seq);
+ tree ptr = make_ssa_name (TREE_TYPE (array_addr));
+ gimplify_assign (ptr, build_fold_addr_expr (decl), &seq);
+
+ /* Store incoming value to worker reduction buffer. */
+ oacc_build_array_copy (ptr, copy_src, array_max_idx, &seq);
+ }
+ else
+ {
+ tree var_type = TREE_TYPE (var);
+ /* Store incoming value to worker reduction buffer. */
+ tree decl = gcn_goacc_get_worker_red_decl (var_type, offset);
+ gimplify_assign (decl, var, &seq);
+ }
}
if (lhs)
- gimplify_assign (lhs, var, &seq);
+ gimplify_assign (lhs, unshare_expr (var), &seq);
pop_gimplify_context (NULL);
- gsi_replace_with_seq (&gsi, seq, true);
+
+ gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
+ gsi_remove (&gsi, true);
}
/* Expand IFN_GOACC_REDUCTION_INIT. */
@@ -377,12 +788,55 @@ gcn_goacc_reduction_init (gcall *call)
int level = TREE_INT_CST_LOW (gimple_call_arg (call, 3));
enum tree_code rcode
= (enum tree_code) TREE_INT_CST_LOW (gimple_call_arg (call, 4));
- tree init = omp_reduction_init_op (gimple_location (call), rcode,
- TREE_TYPE (var));
+
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+ bool array_p = !integer_zerop (array_addr);
+
+ tree array_type = NULL_TREE;
+ if (array_p)
+ array_type
+ = (TREE_CODE (TREE_TYPE (array_addr)) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (array_addr))) == ARRAY_TYPE
+ ? TREE_TYPE (TREE_TYPE (array_addr))
+ : TREE_TYPE (array_addr));
+
+ tree init = NULL_TREE;
gimple_seq seq = NULL;
push_gimplify_context (true);
+ if (array_p)
+ {
+ tree loop_index;
+ gimple_stmt_iterator loop_body_gsi;
+ oacc_build_indexed_ssa_loop (gimple_location (call), array_max_idx, &gsi,
+ &loop_index, &loop_body_gsi);
+
+ tree init_type = TREE_TYPE (array_type);
+ init = omp_reduction_init_op (gimple_location (call), rcode,
+ init_type);
+ gimple_seq seq = NULL;
+
+ tree ptr = fold_convert (ptr_type_node, array_addr);
+ tree offset = build2 (MULT_EXPR, sizetype,
+ fold_convert (sizetype, loop_index),
+ TYPE_SIZE_UNIT (init_type));
+
+ tree addr = build2 (POINTER_PLUS_EXPR, build_pointer_type (init_type),
+ ptr, offset);
+ tree ref = build_simple_mem_ref (addr);
+
+ push_gimplify_context (true);
+ gimplify_assign (ref, init, &seq);
+ pop_gimplify_context (NULL);
+ gsi_insert_seq_before (&loop_body_gsi, seq, GSI_SAME_STMT);
+ init = var;
+ }
+ else
+ init = omp_reduction_init_op (gimple_location (call), rcode,
+ TREE_TYPE (var));
+
if (level == GOMP_DIM_GANG)
{
/* If there's no receiver object, propagate the incoming VAR. */
@@ -395,7 +849,9 @@ gcn_goacc_reduction_init (gcall *call)
gimplify_assign (lhs, init, &seq);
pop_gimplify_context (NULL);
- gsi_replace_with_seq (&gsi, seq, true);
+
+ gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
+ gsi_remove (&gsi, true);
}
/* Expand IFN_GOACC_REDUCTION_FINI. */
@@ -410,8 +866,13 @@ gcn_goacc_reduction_fini (gcall *call)
int level = TREE_INT_CST_LOW (gimple_call_arg (call, 3));
enum tree_code op
= (enum tree_code) TREE_INT_CST_LOW (gimple_call_arg (call, 4));
+
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+ bool array_p = !integer_zerop (array_addr);
+
gimple_seq seq = NULL;
- tree r = NULL_TREE;;
+ tree r = NULL_TREE;
push_gimplify_context (true);
@@ -419,11 +880,19 @@ gcn_goacc_reduction_fini (gcall *call)
if (level == GOMP_DIM_WORKER)
{
- tree var_type = TREE_TYPE (var);
tree offset = gimple_call_arg (call, 5);
- tree decl
- = gcn_goacc_get_worker_red_decl (var_type, TREE_INT_CST_LOW (offset));
-
+ tree decl;
+ if (array_p)
+ {
+ tree array_type = TREE_TYPE (TREE_TYPE (array_addr));
+ decl = gcn_goacc_get_worker_array_reduction_buffer
+ (array_type, array_max_idx, &seq);
+ }
+ else
+ {
+ tree var_type = TREE_TYPE (var);
+ decl = gcn_goacc_get_worker_red_decl (var_type, offset);
+ }
accum = build_fold_addr_expr (decl);
}
else if (integer_zerop (ref_to_res))
@@ -436,14 +905,22 @@ gcn_goacc_reduction_fini (gcall *call)
/* UPDATE the accumulator. */
gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
seq = NULL;
- r = gcn_reduction_update (gimple_location (call), &gsi, accum, var, op);
+ if (array_p)
+ {
+ gcn_reduction_update (gimple_location (call), &gsi, accum,
+ array_addr, op, array_max_idx);
+ r = var;
+ }
+ else
+ r = gcn_reduction_update (gimple_location (call), &gsi, accum, var, op);
}
if (lhs)
gimplify_assign (lhs, r, &seq);
pop_gimplify_context (NULL);
- gsi_replace_with_seq (&gsi, seq, true);
+ gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
+ gsi_remove (&gsi, true);
}
/* Expand IFN_GOACC_REDUCTION_TEARDOWN. */
@@ -455,28 +932,90 @@ gcn_goacc_reduction_teardown (gcall *call)
tree lhs = gimple_call_lhs (call);
tree var = gimple_call_arg (call, 2);
int level = TREE_INT_CST_LOW (gimple_call_arg (call, 3));
+
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+ bool array_p = !integer_zerop (array_addr);
+
+ tree array_accum = NULL_TREE;
+
gimple_seq seq = NULL;
push_gimplify_context (true);
if (level == GOMP_DIM_WORKER)
{
- tree var_type = TREE_TYPE (var);
-
- /* Read the worker reduction buffer. */
tree offset = gimple_call_arg (call, 5);
- tree decl
- = gcn_goacc_get_worker_red_decl (var_type, TREE_INT_CST_LOW (offset));
- var = decl;
+ if (array_p)
+ {
+ tree array_type = TREE_TYPE (TREE_TYPE (array_addr));
+ array_accum = gcn_goacc_get_worker_array_reduction_buffer
+ (array_type, array_max_idx, &seq);
+ }
+ else
+ {
+ tree var_type = TREE_TYPE (var);
+
+ /* Read the worker reduction buffer. */
+ tree decl = gcn_goacc_get_worker_red_decl (var_type, offset);
+ var = decl;
+ }
}
+ /* Write to the receiver object. */
+ tree ref_to_res = gimple_call_arg (call, 1);
if (level != GOMP_DIM_GANG)
{
- /* Write to the receiver object. */
- tree ref_to_res = gimple_call_arg (call, 1);
-
if (!integer_zerop (ref_to_res))
- gimplify_assign (build_simple_mem_ref (ref_to_res), var, &seq);
+ {
+ if (array_p)
+ {
+ tree ptr
+ = make_ssa_name (build_pointer_type (TREE_TYPE (array_addr)));
+ gimplify_assign (ptr, build_fold_addr_expr (array_accum), &seq);
+ oacc_build_array_copy (ref_to_res, ptr, array_max_idx, &seq);
+ }
+ else
+ gimplify_assign (build_simple_mem_ref (ref_to_res), var, &seq);
+ }
+ else if (array_p)
+ {
+ tree ptr
+ = make_ssa_name (build_pointer_type (TREE_TYPE (array_accum)));
+ gimplify_assign (ptr, build_fold_addr_expr (array_accum), &seq);
+ oacc_build_array_copy (array_addr, ptr, array_max_idx, &seq);
+ }
+ }
+
+ if (array_p && !integer_zerop (ref_to_res))
+ {
+ gimple_seq condseq = NULL;
+ tree gang_dim_arg = build_int_cst (unsigned_type_node, GOMP_DIM_GANG);
+ tree gang_pos = make_ssa_name (integer_type_node);
+ gimple *gang_pos_call = gimple_build_call_internal (IFN_GOACC_DIM_POS,
+ 1, gang_dim_arg);
+ gimple_call_set_lhs (gang_pos_call, gang_pos);
+ gimple_seq_add_stmt (&condseq, gang_pos_call);
+ gimple *cond = gimple_build_cond (NE_EXPR, gang_pos, integer_zero_node,
+ NULL, NULL);
+ gimple_seq_add_stmt (&condseq, cond);
+ gimple *cond_end = gimple_seq_last (condseq);
+ gsi_insert_seq_before (&gsi, condseq, GSI_SAME_STMT);
+
+ gimple_seq free_seq = NULL;
+ gcc_assert (!gcn_array_reduction_buffers.is_empty ());
+ tree red_buf_ptr = gcn_array_reduction_buffers.last ();
+
+ tree ptr = make_ssa_name (ptr_type_node);
+ gimplify_assign (ptr, red_buf_ptr, &free_seq);
+
+ gcn_array_reduction_buffers.pop ();
+
+ tree free_decl = builtin_decl_explicit (BUILT_IN_FREE);
+ gcall *stmt = gimple_build_call (free_decl, 1, ptr);
+ gimple_seq_add_stmt (&free_seq, stmt);
+
+ gcn_create_if_else_seq (&gsi, cond_end, &free_seq, NULL);
}
if (lhs)
@@ -484,7 +1023,8 @@ gcn_goacc_reduction_teardown (gcall *call)
pop_gimplify_context (NULL);
- gsi_replace_with_seq (&gsi, seq, true);
+ gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
+ gsi_remove (&gsi, true);
}
/* Implement TARGET_GOACC_REDUCTION.
diff --git a/gcc/config/gcn/gcn.cc b/gcc/config/gcn/gcn.cc
index d59e87b..91ce801 100644
--- a/gcc/config/gcn/gcn.cc
+++ b/gcc/config/gcn/gcn.cc
@@ -6587,8 +6587,8 @@ gcn_hsa_declare_function_name (FILE *file, const char *name,
if (avgpr % vgpr_block_size)
avgpr += vgpr_block_size - (avgpr % vgpr_block_size);
- fputs ("\t.rodata\n"
- "\t.p2align\t6\n"
+ switch_to_section (readonly_data_section);
+ fputs ("\t.p2align\t6\n"
"\t.amdhsa_kernel\t", file);
assemble_name (file, name);
fputs ("\n", file);
@@ -6707,7 +6707,7 @@ gcn_hsa_declare_function_name (FILE *file, const char *name,
fputs (" .end_amdgpu_metadata\n", file);
#endif
- fputs ("\t.text\n", file);
+ switch_to_section (current_function_section ());
fputs ("\t.align\t256\n", file);
fputs ("\t.type\t", file);
assemble_name (file, name);
diff --git a/gcc/config/nvptx/mkoffload.cc b/gcc/config/nvptx/mkoffload.cc
index e7ec0ef..205bc2d 100644
--- a/gcc/config/nvptx/mkoffload.cc
+++ b/gcc/config/nvptx/mkoffload.cc
@@ -698,6 +698,7 @@ main (int argc, char **argv)
/* Scan the argument vector. */
bool fopenmp = false;
+ bool fopenmp_target = false;
bool fopenacc = false;
bool fPIC = false;
bool fpic = false;
@@ -726,6 +727,9 @@ main (int argc, char **argv)
}
else if (strcmp (argv[i], "-fopenmp") == 0)
fopenmp = true;
+ else if (strncmp (argv[i], "-fopenmp-target=",
+ strlen ("-fopenmp-target=")) == 0)
+ fopenmp_target = true;
else if (strcmp (argv[i], "-fopenacc") == 0)
fopenacc = true;
else if (strcmp (argv[i], "-fPIC") == 0)
@@ -756,6 +760,15 @@ main (int argc, char **argv)
if (!(fopenacc ^ fopenmp))
fatal_error (input_location, "either %<-fopenacc%> or %<-fopenmp%> "
"must be set");
+ if (fopenmp_target)
+ {
+ if (fopenacc)
+ fatal_error (input_location, "%<-fopenacc%> not compatible with "
+ "%<-fopenmp-target=%>");
+ if (!fopenmp)
+ fatal_error (input_location, "%<-fopenmp-target=%> requires "
+ "%<-fopenmp%>");
+ }
struct obstack argv_obstack;
obstack_init (&argv_obstack);
diff --git a/gcc/config/nvptx/nvptx-protos.h b/gcc/config/nvptx/nvptx-protos.h
index ca1fed6..dce4146 100644
--- a/gcc/config/nvptx/nvptx-protos.h
+++ b/gcc/config/nvptx/nvptx-protos.h
@@ -50,6 +50,7 @@ extern unsigned int ptx_version_to_number (enum ptx_version, bool);
extern void nvptx_expand_oacc_fork (unsigned);
extern void nvptx_expand_oacc_join (unsigned);
extern void nvptx_expand_call (rtx, rtx);
+extern void nvptx_expand_omp_get_num_threads (rtx);
extern rtx nvptx_gen_shuffle (rtx, rtx, rtx, nvptx_shuffle_kind);
extern rtx nvptx_expand_compare (rtx);
extern const char *nvptx_ptx_type_from_mode (machine_mode, bool);
@@ -64,5 +65,6 @@ extern const char *nvptx_output_red_partition (rtx, rtx);
extern const char *nvptx_output_atomic_insn (const char *, rtx *, int, int);
extern bool nvptx_mem_local_p (rtx);
extern bool nvptx_mem_maybe_shared_p (const_rtx);
+extern bool nvptx_mem_shared_p (const_rtx);
#endif
#endif
diff --git a/gcc/config/nvptx/nvptx.cc b/gcc/config/nvptx/nvptx.cc
index f893971..115d34f 100644
--- a/gcc/config/nvptx/nvptx.cc
+++ b/gcc/config/nvptx/nvptx.cc
@@ -175,6 +175,9 @@ static unsigned gang_private_shared_align;
static GTY(()) rtx gang_private_shared_sym;
static hash_map<tree_decl_hash, unsigned int> gang_private_shared_hmap;
+static GTY(()) rtx omp_num_threads_sym;
+static unsigned omp_num_threads_align;
+
/* Global lock variable, needed for 128bit worker & gang reductions. */
static GTY(()) tree global_lock_var;
@@ -184,6 +187,9 @@ static bool need_softstack_decl;
/* True if any function references __nvptx_uni. */
static bool need_unisimt_decl;
+/* True if any function references __nvptx_omp_num_threads. */
+static bool need_omp_num_threads;
+
static int nvptx_mach_max_workers ();
/* Allocate a new, cleared machine_function structure. */
@@ -410,6 +416,10 @@ nvptx_option_override (void)
SET_SYMBOL_DATA_AREA (gang_private_shared_sym, DATA_AREA_SHARED);
gang_private_shared_align = GET_MODE_ALIGNMENT (SImode) / BITS_PER_UNIT;
+ omp_num_threads_sym = gen_rtx_SYMBOL_REF (Pmode, "__nvptx_omp_num_threads");
+ SET_SYMBOL_DATA_AREA (omp_num_threads_sym, DATA_AREA_SHARED);
+ omp_num_threads_align = GET_MODE_ALIGNMENT (SImode) / BITS_PER_UNIT;
+
diagnose_openacc_conflict (TARGET_GOMP, "-mgomp");
diagnose_openacc_conflict (TARGET_SOFT_STACK, "-msoft-stack");
diagnose_openacc_conflict (TARGET_UNIFORM_SIMT, "-muniform-simt");
@@ -976,7 +986,8 @@ write_as_kernel (tree attrs)
{
return (lookup_attribute ("kernel", attrs) != NULL_TREE
|| (lookup_attribute ("omp target entrypoint", attrs) != NULL_TREE
- && lookup_attribute ("oacc function", attrs) != NULL_TREE));
+ && (lookup_attribute ("oacc function", attrs) != NULL_TREE
+ || lookup_attribute ("ompacc", attrs) != NULL_TREE)));
/* For OpenMP target regions, the corresponding kernel entry is emitted from
write_omp_entry as a separate function. */
}
@@ -1509,6 +1520,7 @@ nvptx_declare_function_name (FILE *file, const char *name, const_tree decl)
DECL_ATTRIBUTES (decl)))
force_public = true;
if (lookup_attribute ("omp target entrypoint", DECL_ATTRIBUTES (decl))
+ && !lookup_attribute ("ompacc", DECL_ATTRIBUTES (decl))
&& !lookup_attribute ("oacc function", DECL_ATTRIBUTES (decl)))
{
char *buf = (char *) alloca (strlen (name) + sizeof ("$impl"));
@@ -1562,7 +1574,7 @@ nvptx_declare_function_name (FILE *file, const char *name, const_tree decl)
HOST_WIDE_INT sz = get_frame_size ();
bool need_frameptr = sz || cfun->machine->has_chain;
int alignment = crtl->stack_alignment_needed / BITS_PER_UNIT;
- if (!TARGET_SOFT_STACK)
+ if (!TARGET_SOFT_STACK || lookup_attribute ("ompacc", DECL_ATTRIBUTES (decl)))
{
/* Declare a local var for outgoing varargs. */
if (cfun->machine->has_variadic)
@@ -1633,6 +1645,45 @@ nvptx_declare_function_name (FILE *file, const char *name, const_tree decl)
nvptx_init_unisimt_predicate (file);
if (cfun->machine->bcast_partition || cfun->machine->sync_bar)
nvptx_init_oacc_workers (file);
+
+ if (offloading_function_p ((tree) decl)
+ && lookup_attribute ("ompacc", DECL_ATTRIBUTES (decl))
+ && !lookup_attribute ("ompacc seq", DECL_ATTRIBUTES (decl)))
+ {
+ int nthr_regno = REGNO (cfun->machine->omp_fn_entry_num_threads_reg);
+ if (lookup_attribute ("omp target entrypoint", DECL_ATTRIBUTES (decl)))
+ {
+ fprintf (file, "\t{\n");
+ if (cfun->machine->omp_parallel_predicate)
+ {
+ /* Borrow num-threads regno as temp register. */
+ fprintf (file, "\t\tmov.u32 %%r%d, %%tid.x;\n", nthr_regno);
+ fprintf (file, "\t\tsetp.ne.u32 %%r%d, %%r%d, 0;\n",
+ REGNO (cfun->machine->omp_parallel_predicate), nthr_regno);
+ }
+ fprintf (file, "\t\tmov.u32 %%r%d, 1;\n", nthr_regno);
+ fprintf (file, "\t\tst.shared.u32 [__nvptx_omp_num_threads], %%r%d;\n", nthr_regno);
+ fprintf (file, "\t}\n");
+ need_omp_num_threads = true;
+ }
+ else
+ {
+ fprintf (file, "\t\tld.shared.u32 %%r%d, [__nvptx_omp_num_threads];\n", nthr_regno);
+ if (cfun->machine->omp_parallel_predicate)
+ {
+ fprintf (file, "\t{\n");
+ fprintf (file, "\t\t.reg.u32 %%tmp1;\n");
+ fprintf (file, "\t\t.reg.pred %%not_parallel_mode, %%v1_lane;\n");
+ fprintf (file, "\t\tsetp.eq.u32 %%not_parallel_mode, %%r%d, 1;\n", nthr_regno);
+ fprintf (file, "\t\tmov.u32 %%tmp1, %%tid.x;\n");
+ fprintf (file, "\t\tsetp.ne.u32 %%v1_lane, %%tmp1, 0;\n");
+ fprintf (file, "\t\tand.pred %%r%d, %%not_parallel_mode, %%v1_lane;\n",
+ REGNO (cfun->machine->omp_parallel_predicate));
+ fprintf (file, "\t}\n");
+ need_omp_num_threads = true;
+ }
+ }
+ }
}
/* Output code for switching uniform-simt state. ENTERING indicates whether
@@ -1750,6 +1801,10 @@ nvptx_output_simt_exit (rtx src)
const char *
nvptx_output_set_softstack (unsigned src_regno)
{
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && lookup_attribute ("ompacc",
+ DECL_ATTRIBUTES (current_function_decl)))
+ return "";
if (cfun->machine->has_softstack && !crtl->is_leaf)
{
fprintf (asm_out_file, "\tst.shared.u%d\t[%s], ",
@@ -1889,20 +1944,29 @@ nvptx_expand_call (rtx retval, rtx address)
if (DECL_STATIC_CHAIN (decl))
cfun->machine->has_chain = true;
- tree attr = oacc_get_fn_attrib (decl);
- if (attr)
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC)
{
- tree dims = TREE_VALUE (attr);
-
- parallel = GOMP_DIM_MASK (GOMP_DIM_MAX) - 1;
- for (int ix = 0; ix != GOMP_DIM_MAX; ix++)
+ if (lookup_attribute ("ompacc", DECL_ATTRIBUTES (decl))
+ && !lookup_attribute ("ompacc seq", DECL_ATTRIBUTES (decl)))
+ parallel = GOMP_DIM_MASK (GOMP_DIM_VECTOR);
+ }
+ else
+ {
+ tree attr = oacc_get_fn_attrib (decl);
+ if (attr)
{
- if (TREE_PURPOSE (dims)
- && !integer_zerop (TREE_PURPOSE (dims)))
- break;
- /* Not on this axis. */
- parallel ^= GOMP_DIM_MASK (ix);
- dims = TREE_CHAIN (dims);
+ tree dims = TREE_VALUE (attr);
+
+ parallel = GOMP_DIM_MASK (GOMP_DIM_MAX) - 1;
+ for (int ix = 0; ix != GOMP_DIM_MAX; ix++)
+ {
+ if (TREE_PURPOSE (dims)
+ && !integer_zerop (TREE_PURPOSE (dims)))
+ break;
+ /* Not on this axis. */
+ parallel ^= GOMP_DIM_MASK (ix);
+ dims = TREE_CHAIN (dims);
+ }
}
}
}
@@ -1965,15 +2029,27 @@ nvptx_expand_compare (rtx compare)
void
nvptx_expand_oacc_fork (unsigned mode)
{
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ mode = GOMP_DIM_VECTOR;
nvptx_emit_forking (GOMP_DIM_MASK (mode), false);
}
void
nvptx_expand_oacc_join (unsigned mode)
{
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ mode = GOMP_DIM_VECTOR;
nvptx_emit_joining (GOMP_DIM_MASK (mode), false);
}
+void
+nvptx_expand_omp_get_num_threads (rtx target)
+{
+ rtx mem = gen_rtx_MEM (SImode, omp_num_threads_sym);
+ emit_insn (gen_rtx_SET (target, mem));
+ need_omp_num_threads = true;
+}
+
/* Generate instruction(s) to unpack a 64 bit object into 2 32 bit
objects. */
@@ -2066,19 +2142,15 @@ nvptx_gen_shuffle (rtx dst, rtx src, rtx idx, nvptx_shuffle_kind kind)
break;
case E_V2SImode:
{
- rtx src0 = gen_rtx_SUBREG (SImode, src, 0);
- rtx src1 = gen_rtx_SUBREG (SImode, src, 4);
- rtx dst0 = gen_rtx_SUBREG (SImode, dst, 0);
- rtx dst1 = gen_rtx_SUBREG (SImode, dst, 4);
rtx tmp0 = gen_reg_rtx (SImode);
rtx tmp1 = gen_reg_rtx (SImode);
start_sequence ();
- emit_insn (gen_movsi (tmp0, src0));
- emit_insn (gen_movsi (tmp1, src1));
+ emit_insn (gen_vec_extractv2sisi (tmp0, src, GEN_INT (0)));
+ emit_insn (gen_vec_extractv2sisi (tmp1, src, GEN_INT (1)));
emit_insn (nvptx_gen_shuffle (tmp0, tmp0, idx, kind));
emit_insn (nvptx_gen_shuffle (tmp1, tmp1, idx, kind));
- emit_insn (gen_movsi (dst0, tmp0));
- emit_insn (gen_movsi (dst1, tmp1));
+ emit_insn (gen_vec_setv2si (dst, tmp0, GEN_INT (0)));
+ emit_insn (gen_vec_setv2si (dst, tmp1, GEN_INT (1)));
res = get_insns ();
end_sequence ();
}
@@ -2964,6 +3036,13 @@ nvptx_mem_maybe_shared_p (const_rtx x)
return area == DATA_AREA_SHARED || area == DATA_AREA_GENERIC;
}
+bool
+nvptx_mem_shared_p (const_rtx x)
+{
+ nvptx_data_area area = nvptx_mem_data_area (x);
+ return area == DATA_AREA_SHARED;
+}
+
/* Print an operand, X, to FILE, with an optional modifier in CODE.
Meaning of CODE:
@@ -3568,6 +3647,11 @@ init_axis_dim (void)
static int ATTRIBUTE_UNUSED
nvptx_mach_max_workers ()
{
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && lookup_attribute ("ompacc",
+ DECL_ATTRIBUTES (current_function_decl)))
+ return 1;
+
if (!cfun->machine->axis_dim_init_p)
init_axis_dim ();
return cfun->machine->axis_dim[MACH_MAX_WORKERS];
@@ -3576,11 +3660,62 @@ nvptx_mach_max_workers ()
static int ATTRIBUTE_UNUSED
nvptx_mach_vector_length ()
{
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && lookup_attribute ("ompacc",
+ DECL_ATTRIBUTES (current_function_decl)))
+ return 32;
+
if (!cfun->machine->axis_dim_init_p)
init_axis_dim ();
return cfun->machine->axis_dim[MACH_VECTOR_LENGTH];
}
+/* UNIFIED is a cond_uni insn. Find the branch insn it affects, and
+ mark that as unified. We expect to be in a single block. */
+
+static void
+nvptx_propagate_unified (rtx_insn *unified)
+{
+ rtx_insn *probe = unified;
+ rtx cond_reg = SET_DEST (PATTERN (unified));
+ rtx pat = NULL_RTX;
+
+ /* Find the comparison. (We could skip this and simply scan to he
+ blocks' terminating branch, if we didn't care for self
+ checking.) */
+ for (;;)
+ {
+ probe = next_real_insn (probe);
+ if (!probe)
+ break;
+ pat = PATTERN (probe);
+
+ if (GET_CODE (pat) == SET
+ && GET_RTX_CLASS (GET_CODE (SET_SRC (pat))) == RTX_COMPARE
+ && XEXP (SET_SRC (pat), 0) == cond_reg)
+ break;
+ gcc_assert (NONJUMP_INSN_P (probe));
+ }
+ gcc_assert (pat);
+ rtx pred_reg = SET_DEST (pat);
+
+ /* Find the branch. */
+ do
+ probe = NEXT_INSN (probe);
+ while (!JUMP_P (probe));
+
+ pat = PATTERN (probe);
+ rtx itec = XEXP (SET_SRC (pat), 0);
+ gcc_assert (XEXP (itec, 0) == pred_reg);
+
+ /* Mark the branch's condition as unified. */
+ rtx unspec = gen_rtx_UNSPEC (BImode, gen_rtvec (1, pred_reg),
+ UNSPEC_BR_UNIFIED);
+ bool ok = validate_change (probe, &XEXP (itec, 0), unspec, false);
+
+ gcc_assert (ok);
+}
+
/* Loop structure of the function. The entire function is described as
a NULL loop. */
/* See also 'gcc/omp-oacc-neuter-broadcast.cc:struct parallel_g'. */
@@ -3684,6 +3819,9 @@ nvptx_split_blocks (bb_insn_map_t *map)
continue;
switch (recog_memoized (insn))
{
+ case CODE_FOR_cond_uni:
+ nvptx_propagate_unified (insn);
+ /* FALLTHROUGH */
default:
seen_insn = true;
continue;
@@ -4909,11 +5047,27 @@ nvptx_single (unsigned mask, basic_block from, basic_block to)
rtx_insn *tail = BB_END (to);
unsigned skip_mask = mask;
+ rtx_insn *join = NULL;
+ rtx_insn *fork = NULL;
+
while (true)
{
/* Find first insn of from block. */
- while (head != BB_END (from) && !needs_neutering_p (head))
- head = NEXT_INSN (head);
+ while (true)
+ {
+ if (INSN_P (head)
+ && recog_memoized (head) == CODE_FOR_nvptx_join)
+ {
+ /* Record join if we see it. */
+ gcc_assert (!join);
+ join = head;
+ }
+
+ if (head != BB_END (from) && !needs_neutering_p (head))
+ head = NEXT_INSN (head);
+ else
+ break;
+ }
if (from == to)
break;
@@ -4931,8 +5085,46 @@ nvptx_single (unsigned mask, basic_block from, basic_block to)
/* Find last insn of to block */
rtx_insn *limit = from == to ? head : BB_HEAD (to);
- while (tail != limit && !INSN_P (tail) && !LABEL_P (tail))
- tail = PREV_INSN (tail);
+ while (true)
+ {
+ if (INSN_P (tail)
+ && recog_memoized (tail) == CODE_FOR_nvptx_fork)
+ {
+ /* Record join if we see it. */
+ gcc_assert (!fork);
+ fork = tail;
+ }
+
+ if (tail != limit && !INSN_P (tail) && !LABEL_P (tail))
+ tail = PREV_INSN (tail);
+ else
+ break;
+ }
+
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ {
+ if (join
+ /* We do not set/restore parallel state across function calls. */
+ && !(INTVAL (XVECEXP (PATTERN (join), 0, 0)) & (1 << GOMP_DIM_MAX)))
+ {
+ rtx reg = cfun->machine->omp_fn_entry_num_threads_reg;
+ rtx mem = gen_rtx_MEM (SImode, omp_num_threads_sym);
+ emit_insn_before (gen_nvptx_omp_parallel_join (mem, reg), head);
+ need_omp_num_threads = true;
+ head = PREV_INSN (head);
+ }
+
+ if (fork
+ /* We do not set/restore parallel state across function calls. */
+ && !(INTVAL (XVECEXP (PATTERN (fork), 0, 0)) & (1 << GOMP_DIM_MAX)))
+ {
+ rtx reg = gen_reg_rtx (SImode);
+ rtx mem = gen_rtx_MEM (SImode, omp_num_threads_sym);
+ emit_insn_before (gen_get_ntid (reg), tail);
+ emit_insn_before (gen_nvptx_omp_parallel_fork (mem, reg), tail);
+ need_omp_num_threads = true;
+ }
+ }
/* Detect if tail is a branch. */
rtx tail_branch = NULL_RTX;
@@ -4979,16 +5171,31 @@ nvptx_single (unsigned mask, basic_block from, basic_block to)
if (GOMP_DIM_MASK (mode) & skip_mask)
{
rtx_code_label *label = gen_label_rtx ();
- rtx pred = cfun->machine->axis_predicate[mode - GOMP_DIM_WORKER];
rtx_insn **mode_jump
= mode == GOMP_DIM_VECTOR ? &vector_jump : &worker_jump;
rtx_insn **mode_label
= mode == GOMP_DIM_VECTOR ? &vector_label : &worker_label;
- if (!pred)
+ rtx pred;
+
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && mode == GOMP_DIM_VECTOR)
+ {
+ pred = cfun->machine->omp_parallel_predicate;
+ if (!pred)
+ {
+ pred = gen_reg_rtx (BImode);
+ cfun->machine->omp_parallel_predicate = pred;
+ }
+ }
+ else
{
- pred = gen_reg_rtx (BImode);
- cfun->machine->axis_predicate[mode - GOMP_DIM_WORKER] = pred;
+ pred = cfun->machine->axis_predicate[mode - GOMP_DIM_WORKER];
+ if (!pred)
+ {
+ pred = gen_reg_rtx (BImode);
+ cfun->machine->axis_predicate[mode - GOMP_DIM_WORKER] = pred;
+ }
}
rtx br;
@@ -5103,7 +5310,38 @@ nvptx_single (unsigned mask, basic_block from, basic_block to)
rtx tmp = gen_reg_rtx (BImode);
emit_insn_before (gen_movbi (tmp, const0_rtx),
bb_first_real_insn (from));
- emit_insn_before (gen_rtx_SET (tmp, pvar), label);
+
+ if(flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ {
+ rtx nthr = cfun->machine->omp_fn_entry_num_threads_reg;
+ rtx single_p = gen_reg_rtx (BImode);
+
+ rtx_code_label *lbl_copy_tmp_pvar = gen_label_rtx ();
+ LABEL_NUSES (lbl_copy_tmp_pvar) = 1;
+
+ rtx_insn *lbl_fallthru = NEXT_INSN (tail);
+ gcc_assert (lbl_fallthru);
+ if (!LABEL_P (lbl_fallthru))
+ {
+ rtx_code_label *nlbl = gen_label_rtx ();
+ LABEL_NUSES (nlbl) = 1;
+ emit_label_before (nlbl, lbl_fallthru);
+ lbl_fallthru = nlbl;
+ }
+ emit_insn_before
+ (gen_rtx_SET (single_p,
+ gen_rtx_EQ (BImode, nthr, GEN_INT (1))),
+ label);
+ emit_insn_before
+ (gen_br_true (single_p, lbl_copy_tmp_pvar), label);
+ emit_jump_insn_before (copy_rtx (tail_branch), label);
+ emit_insn_before (gen_jump (lbl_fallthru), label);
+ emit_label_before (lbl_copy_tmp_pvar, label);
+ emit_insn_before (gen_rtx_SET (tmp, pvar), label);
+ }
+ else
+ emit_insn_before (gen_rtx_SET (tmp, pvar), label);
+
emit_insn_before (gen_rtx_SET (pvar, tmp), tail);
#endif
emit_insn_before (nvptx_gen_warp_bcast (pvar), tail);
@@ -5862,10 +6100,29 @@ nvptx_reorg (void)
delete pars;
}
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && offloading_function_p (current_function_decl)
+ && lookup_attribute ("ompacc",
+ DECL_ATTRIBUTES (current_function_decl))
+ && !lookup_attribute ("ompacc seq",
+ DECL_ATTRIBUTES (current_function_decl)))
+ {
+ cfun->machine->omp_fn_entry_num_threads_reg = gen_reg_rtx (SImode);
+
+ /* Discover & process partitioned regions. */
+ parallel *pars = nvptx_discover_pars (&bb_insn_map);
+ nvptx_process_pars (pars);
+ nvptx_neuter_pars (pars, GOMP_DIM_MASK (GOMP_DIM_VECTOR), 0);
+ delete pars;
+ }
+
/* Replace subregs. */
nvptx_reorg_subreg ();
- if (TARGET_UNIFORM_SIMT)
+ if (TARGET_UNIFORM_SIMT
+ && (flag_openmp_target != OMP_TARGET_MODE_OMPACC
+ || !lookup_attribute ("ompacc",
+ DECL_ATTRIBUTES (current_function_decl))))
nvptx_reorg_uniform_simt ();
#if WORKAROUND_PTXJIT_BUG_2
@@ -6163,6 +6420,12 @@ nvptx_file_end (void)
write_var_marker (asm_out_file, false, true, "__nvptx_uni");
fprintf (asm_out_file, ".extern .shared .u32 __nvptx_uni[32];\n");
}
+ if (need_omp_num_threads)
+ {
+ write_var_marker (asm_out_file, false, true, "__nvptx_omp_num_threads");
+ fprintf (asm_out_file,
+ ".extern .shared .u32 __nvptx_omp_num_threads;\n");
+ }
}
/* Expander for the shuffle builtins. */
@@ -6245,9 +6508,18 @@ nvptx_expand_shared_addr (tree exp, rtx target,
unsigned align = TREE_INT_CST_LOW (CALL_EXPR_ARG (exp, 2));
unsigned offset = TREE_INT_CST_LOW (CALL_EXPR_ARG (exp, 0));
- unsigned size = TREE_INT_CST_LOW (CALL_EXPR_ARG (exp, 1));
+ unsigned size = 0;
+
+ tree size_expr = CALL_EXPR_ARG (exp, 1);
rtx addr = worker_red_sym;
+ if (TREE_CONSTANT (size_expr))
+ size = TREE_INT_CST_LOW (size_expr);
+
+ /* Default size for unknown size expression. */
+ if (size == 0)
+ size = 256;
+
if (vector)
{
offload_attrs oa;
@@ -6269,7 +6541,8 @@ nvptx_expand_shared_addr (tree exp, rtx target,
else
{
worker_red_align = MAX (worker_red_align, align);
- worker_red_size = MAX (worker_red_size, size + offset);
+ if (size)
+ worker_red_size = MAX (worker_red_size, size + offset);
if (offset)
{
@@ -6319,6 +6592,20 @@ nvptx_expand_cmp_swap (tree exp, rtx target,
return target;
}
+/* Expander for the compare unified builtin. */
+
+static rtx
+nvptx_expand_cond_uni (tree exp, rtx target, machine_mode mode, int ignore)
+{
+ if (ignore)
+ return target;
+
+ rtx src = expand_expr (CALL_EXPR_ARG (exp, 0), NULL_RTX, mode, EXPAND_NORMAL);
+
+ emit_insn (gen_cond_uni (target, src));
+
+ return target;
+}
/* Codes for all the NVPTX builtins. */
enum nvptx_builtins
@@ -6334,8 +6621,10 @@ enum nvptx_builtins
NVPTX_BUILTIN_BAR_RED_AND,
NVPTX_BUILTIN_BAR_RED_OR,
NVPTX_BUILTIN_BAR_RED_POPC,
+ NVPTX_BUILTIN_BAR_WARPSYNC,
NVPTX_BUILTIN_BREV,
NVPTX_BUILTIN_BREVLL,
+ NVPTX_BUILTIN_COND_UNI,
NVPTX_BUILTIN_MAX
};
@@ -6456,6 +6745,7 @@ nvptx_init_builtins (void)
DEF (CMP_SWAPLL, "cmp_swapll", (LLUINT, PTRVOID, LLUINT, LLUINT, NULL_TREE));
DEF (MEMBAR_GL, "membar_gl", (VOID, VOID, NULL_TREE));
DEF (MEMBAR_CTA, "membar_cta", (VOID, VOID, NULL_TREE));
+ DEF (COND_UNI, "cond_uni", (integer_type_node, integer_type_node, NULL_TREE));
DEF (BAR_RED_AND, "bar_red_and",
(UINT, UINT, UINT, UINT, UINT, NULL_TREE));
@@ -6464,6 +6754,8 @@ nvptx_init_builtins (void)
DEF (BAR_RED_POPC, "bar_red_popc",
(UINT, UINT, UINT, UINT, UINT, NULL_TREE));
+ DEF (BAR_WARPSYNC, "bar_warpsync", (VOID, VOID, NULL_TREE));
+
DEF (BREV, "brev", (UINT, UINT, NULL_TREE));
DEF (BREVLL, "brevll", (LLUINT, LLUINT, NULL_TREE));
@@ -6514,10 +6806,17 @@ nvptx_expand_builtin (tree exp, rtx target, rtx ARG_UNUSED (subtarget),
case NVPTX_BUILTIN_BAR_RED_POPC:
return nvptx_expand_bar_red (exp, target, mode, ignore);
+ case NVPTX_BUILTIN_BAR_WARPSYNC:
+ emit_insn (gen_nvptx_warpsync ());
+ return NULL_RTX;
+
case NVPTX_BUILTIN_BREV:
case NVPTX_BUILTIN_BREVLL:
return nvptx_expand_brev (exp, target, mode, ignore);
+ case NVPTX_BUILTIN_COND_UNI:
+ return nvptx_expand_cond_uni (exp, target, mode, ignore);
+
default: gcc_unreachable ();
}
}
@@ -6831,6 +7130,9 @@ nvptx_goacc_fork_join (gcall *call, const int dims[],
tree arg = gimple_call_arg (call, 2);
unsigned axis = TREE_INT_CST_LOW (arg);
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ return true;
+
/* We only care about worker and vector partitioning. */
if (axis < GOMP_DIM_WORKER)
return false;
@@ -6852,22 +7154,38 @@ nvptx_get_shared_red_addr (tree type, tree offset, bool vector)
enum nvptx_builtins addr_dim = NVPTX_BUILTIN_WORKER_ADDR;
if (vector)
addr_dim = NVPTX_BUILTIN_VECTOR_ADDR;
- machine_mode mode = TYPE_MODE (type);
tree fndecl = nvptx_builtin_decl (addr_dim, true);
- tree size = build_int_cst (unsigned_type_node, GET_MODE_SIZE (mode));
- tree align = build_int_cst (unsigned_type_node,
- GET_MODE_ALIGNMENT (mode) / BITS_PER_UNIT);
+ tree size = TYPE_SIZE_UNIT (type);
+ tree align = build_int_cst (unsigned_type_node, TYPE_ALIGN_UNIT (type));
tree call = build_call_expr (fndecl, 3, offset, size, align);
return fold_convert (build_pointer_type (type), call);
}
+static tree
+nvptx_get_shared_red_addr (tree array_elem_type, tree array_max_idx,
+ tree offset, bool vector)
+{
+ tree fndecl = nvptx_builtin_decl ((vector
+ ? NVPTX_BUILTIN_VECTOR_ADDR
+ : NVPTX_BUILTIN_WORKER_ADDR),
+ true);
+ tree align = build_int_cst (unsigned_type_node,
+ TYPE_ALIGN_UNIT (array_elem_type));
+ tree array_length = fold_build2 (PLUS_EXPR, sizetype, array_max_idx,
+ build_int_cst (sizetype, 1));
+ tree size = fold_build2 (MULT_EXPR, sizetype,
+ TYPE_SIZE_UNIT (array_elem_type), array_length);
+ tree call = build_call_expr (fndecl, 3, offset, size, align);
+ return fold_convert (build_pointer_type (array_elem_type), call);
+}
+
/* Emit a SHFL.DOWN using index SHFL of VAR into DEST_VAR. This function
will cast the variable if necessary. */
static void
nvptx_generate_vector_shuffle (location_t loc,
- tree dest_var, tree var, unsigned shift,
+ tree dest_var, tree var, tree bits,
gimple_seq *seq)
{
unsigned fn = NVPTX_BUILTIN_SHUFFLE;
@@ -6890,7 +7208,6 @@ nvptx_generate_vector_shuffle (location_t loc,
}
tree call = nvptx_builtin_decl (fn, true);
- tree bits = build_int_cst (unsigned_type_node, shift);
tree kind = build_int_cst (unsigned_type_node, SHUFFLE_DOWN);
tree expr;
@@ -7168,11 +7485,144 @@ nvptx_lockfull_update (location_t loc, gimple_stmt_iterator *gsi,
static tree
nvptx_reduction_update (location_t loc, gimple_stmt_iterator *gsi,
- tree ptr, tree var, tree_code op, int level)
+ tree ptr, tree var, tree_code op, int level,
+ tree array_max_idx = NULL_TREE)
{
tree type = TREE_TYPE (var);
tree size = TYPE_SIZE (type);
+ if (!VAR_P (ptr))
+ {
+ tree t = make_ssa_name (TREE_TYPE (ptr));
+ gimple_seq seq = NULL;
+ gimplify_assign (t, ptr, &seq);
+ gsi_insert_seq_before (gsi, seq, GSI_SAME_STMT);
+ ptr = t;
+ }
+
+ if (TREE_CODE (type) == ARRAY_TYPE
+ || TREE_CODE (type) == POINTER_TYPE)
+ {
+ tree array_type;
+ if (TREE_CODE (type) == ARRAY_TYPE)
+ {
+ array_type = TREE_TYPE (var);
+ }
+ else if (TREE_CODE (type) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
+ {
+ array_type = TREE_TYPE (TREE_TYPE (var));
+ }
+ else if (TREE_CODE (type) == POINTER_TYPE)
+ {
+ array_type = TREE_TYPE (var);
+ }
+ else
+ gcc_unreachable ();
+
+ tree array_elem_type = TREE_TYPE (array_type);
+
+ gimple *g;
+ gimple_seq seq = NULL;
+ tree max_index = array_max_idx;
+ gcc_assert (array_max_idx);
+
+ tree init_index = make_ssa_name (TREE_TYPE (max_index));
+ tree loop_index = make_ssa_name (TREE_TYPE (max_index));
+ tree update_index = make_ssa_name (TREE_TYPE (max_index));
+
+ g = gimple_build_assign (init_index,
+ build_int_cst (TREE_TYPE (init_index), 0));
+ gimple_seq_add_stmt (&seq, g);
+ gimple *init_end = gimple_seq_last (seq);
+ gsi_insert_seq_before (gsi, seq, GSI_SAME_STMT);
+
+ basic_block init_bb = gsi_bb (*gsi);
+ edge init_edge = split_block (init_bb, init_end);
+ basic_block loop_bb = init_edge->dest;
+ /* Reset the iterator. */
+ *gsi = gsi_for_stmt (gsi_stmt (*gsi));
+
+ seq = NULL;
+ g = gimple_build_assign (update_index, PLUS_EXPR, loop_index,
+ build_int_cst (TREE_TYPE (loop_index), 1));
+ gimple_seq_add_stmt (&seq, g);
+
+ g = gimple_build_cond (LE_EXPR, update_index, max_index, NULL, NULL);
+ gimple_seq_add_stmt (&seq, g);
+ gsi_insert_seq_before (gsi, seq, GSI_SAME_STMT);
+
+ edge post_edge = split_block (loop_bb, g);
+ basic_block post_bb = post_edge->dest;
+ loop_bb = post_edge->src;
+ /* Reset the iterator. */
+ *gsi = gsi_for_stmt (gsi_stmt (*gsi));
+
+ /* Place where we insert reduction code below. */
+ gimple_stmt_iterator reduction_code_gsi = gsi_start_bb (loop_bb);
+
+ post_edge->flags ^= EDGE_FALSE_VALUE | EDGE_FALLTHRU;
+ post_edge->probability = profile_probability::even ();
+ edge loop_edge = make_edge (loop_bb, loop_bb, EDGE_TRUE_VALUE);
+ loop_edge->probability = profile_probability::even ();
+ set_immediate_dominator (CDI_DOMINATORS, loop_bb, init_bb);
+ set_immediate_dominator (CDI_DOMINATORS, post_bb, loop_bb);
+ class loop *new_loop = alloc_loop ();
+ new_loop->header = loop_bb;
+ new_loop->latch = loop_bb;
+ add_loop (new_loop, loop_bb->loop_father);
+
+ gphi *phi = create_phi_node (loop_index, loop_bb);
+ add_phi_arg (phi, init_index, init_edge, loc);
+ add_phi_arg (phi, update_index, loop_edge, loc);
+
+ tree var_ptr = fold_convert (build_pointer_type (array_elem_type),
+ var);
+ tree idx = fold_build2 (MULT_EXPR, sizetype,
+ fold_convert (sizetype, loop_index),
+ TYPE_SIZE_UNIT (array_elem_type));
+ var_ptr = build2 (POINTER_PLUS_EXPR, TREE_TYPE (var_ptr), var_ptr, idx);
+ tree var_aref = build_simple_mem_ref (var_ptr);
+ ptr = build2 (POINTER_PLUS_EXPR, TREE_TYPE (ptr),ptr, idx);
+
+ nvptx_reduction_update (loc, &reduction_code_gsi,
+ ptr, var_aref, op, level);
+
+ return build_simple_mem_ref (ptr);
+ }
+ else if (TREE_CODE (type) == RECORD_TYPE)
+ {
+ for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
+ if (TREE_CODE (fld) == FIELD_DECL)
+ {
+ tree var_fld_ref = build3 (COMPONENT_REF, TREE_TYPE (fld),
+ var, fld, NULL);
+ tree ptr_ref = build_simple_mem_ref (ptr);
+ tree ptr_fld_type
+ = build_qualified_type (TREE_TYPE (fld),
+ TYPE_QUALS (TREE_TYPE (ptr_ref)));
+ tree ptr_fld_ref = build3 (COMPONENT_REF, ptr_fld_type,
+ ptr_ref, fld, NULL);
+
+ if (TREE_CODE (TREE_TYPE (fld)) == ARRAY_TYPE)
+ {
+ tree array_elem_ptr_type
+ = build_pointer_type (TREE_TYPE (TREE_TYPE (fld)));
+ nvptx_reduction_update
+ (loc, gsi,
+ fold_convert (array_elem_ptr_type,
+ build_fold_addr_expr (ptr_fld_ref)),
+ build_fold_addr_expr (var_fld_ref), op, level,
+ TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (fld))));
+ }
+ else
+ nvptx_reduction_update (loc, gsi,
+ build_fold_addr_expr (ptr_fld_ref),
+ var_fld_ref, op, level);
+ }
+ return build_simple_mem_ref (ptr);
+ }
+
if (size == TYPE_SIZE (unsigned_type_node)
|| size == TYPE_SIZE (long_long_unsigned_type_node))
return nvptx_lockless_update (loc, gsi, ptr, var, op);
@@ -7180,6 +7630,131 @@ nvptx_reduction_update (location_t loc, gimple_stmt_iterator *gsi,
return nvptx_lockfull_update (loc, gsi, ptr, var, op, level);
}
+/* Emit a vector-level reduction loop. OLD_VAR is the incoming
+ variable to reduce (valid in each vector), OP is the reduction
+ operator. Return the reduced value (an SSA var).
+
+ The code we generate looks like:
+ unsigned old_shift = DIM_SIZE(VECTOR);
+ do
+ {
+ shift = PHI (old_shift, new_shift);
+ var = PHI (old_var, new_var);
+ new_shift = shift >> 1;
+ other_var = VSHUFFLE (var, new_shift);
+ new_var = var OP other_var;
+ cond_var = builtin_cond_uni (new_shift);
+ }
+ while (cond_var > 1);
+
+ The builtin_cond_ini expands to a cond_uni instruction, which is
+ processed in nvpts_split_blocks to mark the loop's terminating
+ branch instruction. */
+
+static tree
+nvptx_vector_reduction (location_t loc, gimple_stmt_iterator *gsi,
+ tree old_var, tree_code op)
+{
+ tree var_type = TREE_TYPE (old_var);
+
+ /* Emit old_shift = DIM_SIZE(VECTOR) */
+ tree old_shift = make_ssa_name (integer_type_node);
+ tree dim = build_int_cst (integer_type_node, GOMP_DIM_VECTOR);
+ gcall *call = gimple_build_call_internal (IFN_GOACC_DIM_SIZE, 1, dim);
+ gimple_set_lhs (call, old_shift);
+ gimple_set_location (call, loc);
+ gsi_insert_before (gsi, call, GSI_SAME_STMT);
+
+ /* Split the block just after the init stmts. */
+ basic_block pre_bb = gsi_bb (*gsi);
+ edge pre_edge = split_block (pre_bb, call);
+ pre_edge->probability = profile_probability::even ();
+ basic_block loop_bb = pre_edge->dest;
+ pre_bb = pre_edge->src;
+ /* Reset the iterator. */
+ *gsi = gsi_for_stmt (gsi_stmt (*gsi));
+
+ tree shift = make_ssa_name (integer_type_node);
+ // Avoid segfault in gimple_stmt_nonnegative_warnv_p during simplification
+ SSA_NAME_DEF_STMT (shift) = gimple_build_nop ();
+ tree new_shift = make_ssa_name (integer_type_node);
+ tree var = make_ssa_name (var_type);
+ tree other_var = make_ssa_name (var_type);
+ tree new_var = make_ssa_name (var_type);
+
+ /* Build and insert the loop body. */
+ gimple_seq loop_seq = NULL;
+
+ /* new_shift = shift >> 1 */
+ tree shift_expr = fold_build2 (RSHIFT_EXPR, integer_type_node,
+ shift, integer_one_node);
+ gimplify_assign (new_shift, shift_expr, &loop_seq);
+
+ /* other_var = shuffle (var, shift) */
+ nvptx_generate_vector_shuffle (loc, other_var, var, new_shift, &loop_seq);
+ /* new_var = var OP other_var */
+ tree red_expr = fold_build2 (op, var_type, var, other_var);
+ gimplify_assign (new_var, red_expr, &loop_seq);
+
+ /* Mark the iterator variable as unified. */
+ tree cond_var = make_ssa_name (integer_type_node);
+ tree uni_fn = nvptx_builtin_decl (NVPTX_BUILTIN_COND_UNI, true);
+ tree uni_expr = build_call_expr_loc (loc, uni_fn, 1, new_shift);
+ gimplify_assign (cond_var, uni_expr, &loop_seq);
+
+ gcond *cond = gimple_build_cond (LE_EXPR, cond_var, integer_one_node,
+ NULL_TREE, NULL_TREE);
+ gimple_seq_add_stmt (&loop_seq, cond);
+
+ gsi_insert_seq_before (gsi, loop_seq, GSI_SAME_STMT);
+
+ /* Split the block just after the loop stmts. */
+ edge post_edge = split_block (loop_bb, cond);
+ post_edge->probability = profile_probability::even ();
+ basic_block post_bb = post_edge->dest;
+ loop_bb = post_edge->src;
+ *gsi = gsi_for_stmt (gsi_stmt (*gsi));
+
+ /* Create the loop. */
+ post_edge->flags ^= EDGE_TRUE_VALUE | EDGE_FALLTHRU;
+ edge loop_edge = make_edge (loop_bb, loop_bb, EDGE_FALSE_VALUE);
+ loop_edge->probability = profile_probability::even ();
+ set_immediate_dominator (CDI_DOMINATORS, loop_bb, pre_bb);
+ set_immediate_dominator (CDI_DOMINATORS, post_bb, loop_bb);
+
+ gphi *shift_phi = create_phi_node (shift, loop_bb);
+ add_phi_arg (shift_phi, old_shift, pre_edge, loc);
+ add_phi_arg (shift_phi, new_shift, loop_edge, loc);
+
+ gphi *var_phi = create_phi_node (var, loop_bb);
+ add_phi_arg (var_phi, old_var, pre_edge, loc);
+ add_phi_arg (var_phi, new_var, loop_edge, loc);
+
+ loop *loop = alloc_loop ();
+ loop->header = loop_bb;
+ loop->latch = loop_bb;
+ add_loop (loop, loop_bb->loop_father);
+
+ return new_var;
+}
+
+/* Dummy reduction vars that have GOMP_MAP_FIRSTPRIVATE_POINTER data
+ mappings gets retyped to (void *). Adjust the type of VAR to TYPE
+ as appropriate. */
+
+static tree
+nvptx_adjust_reduction_type (tree var, tree type, gimple_seq *seq)
+{
+ if (TREE_TYPE (TREE_TYPE (var)) == type)
+ return var;
+
+ tree ptype = build_pointer_type (type);
+ tree t = make_ssa_name (ptype);
+ tree expr = fold_build1 (NOP_EXPR, ptype, var);
+ gimple_seq_add_stmt (seq, gimple_build_assign (t, expr));
+ return t;
+}
+
/* NVPTX implementation of GOACC_REDUCTION_SETUP. */
static void
@@ -7189,39 +7764,75 @@ nvptx_goacc_reduction_setup (gcall *call, offload_attrs *oa)
tree lhs = gimple_call_lhs (call);
tree var = gimple_call_arg (call, 2);
int level = TREE_INT_CST_LOW (gimple_call_arg (call, 3));
+
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+ bool array_p = !integer_zerop (array_addr);
+
+ tree array_type = NULL_TREE;
+ if (array_p)
+ array_type
+ = (TREE_CODE (TREE_TYPE (array_addr)) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (array_addr))) == ARRAY_TYPE
+ ? TREE_TYPE (TREE_TYPE (array_addr))
+ : TREE_TYPE (array_addr));
+
gimple_seq seq = NULL;
push_gimplify_context (true);
+ /* Copy the receiver object. */
+ tree ref_to_res = gimple_call_arg (call, 1);
+
if (level != GOMP_DIM_GANG)
{
- /* Copy the receiver object. */
- tree ref_to_res = gimple_call_arg (call, 1);
-
- if (!integer_zerop (ref_to_res))
- var = build_simple_mem_ref (ref_to_res);
+ if (!integer_zerop (ref_to_res) && !array_p)
+ {
+ ref_to_res = nvptx_adjust_reduction_type (ref_to_res,
+ TREE_TYPE (var), &seq);
+ var = build_simple_mem_ref (ref_to_res);
+ }
}
if (level == GOMP_DIM_WORKER
- || (level == GOMP_DIM_VECTOR && oa->vector_length > PTX_WARP_SIZE))
+ || (level == GOMP_DIM_VECTOR
+ && (oa->vector_length > PTX_WARP_SIZE
+ || array_p
+ || TREE_CODE (TREE_TYPE (var)) == RECORD_TYPE)))
{
/* Store incoming value to worker reduction buffer. */
tree offset = gimple_call_arg (call, 5);
- tree call = nvptx_get_shared_red_addr (TREE_TYPE (var), offset,
- level == GOMP_DIM_VECTOR);
- tree ptr = make_ssa_name (TREE_TYPE (call));
-
- gimplify_assign (ptr, call, &seq);
- tree ref = build_simple_mem_ref (ptr);
- TREE_THIS_VOLATILE (ref) = 1;
- gimplify_assign (ref, var, &seq);
+ tree call, ptr;
+ if (array_p)
+ {
+ tree copy_src = !integer_zerop (ref_to_res) ? ref_to_res : array_addr;
+ tree array_elem_type = TREE_TYPE (array_type);
+ call = nvptx_get_shared_red_addr (array_elem_type, array_max_idx,
+ offset, level == GOMP_DIM_VECTOR);
+ ptr = make_ssa_name (TREE_TYPE (call));
+ gimplify_assign (ptr, call, &seq);
+ oacc_build_array_copy (fold_convert (TREE_TYPE (array_addr), ptr),
+ copy_src, array_max_idx, &seq);
+ }
+ else
+ {
+ call = nvptx_get_shared_red_addr (TREE_TYPE (var), offset,
+ level == GOMP_DIM_VECTOR);
+ ptr = make_ssa_name (TREE_TYPE (call));
+ gimplify_assign (ptr, call, &seq);
+ tree ref = build_simple_mem_ref (ptr);
+ TREE_THIS_VOLATILE (ref) = 1;
+ gimplify_assign (ref, var, &seq);
+ }
}
if (lhs)
- gimplify_assign (lhs, var, &seq);
+ gimplify_assign (lhs, unshare_expr (var), &seq);
pop_gimplify_context (NULL);
- gsi_replace_with_seq (&gsi, seq, true);
+
+ gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
+ gsi_remove (&gsi, true);
}
/* NVPTX implementation of GOACC_REDUCTION_INIT. */
@@ -7235,13 +7846,55 @@ nvptx_goacc_reduction_init (gcall *call, offload_attrs *oa)
int level = TREE_INT_CST_LOW (gimple_call_arg (call, 3));
enum tree_code rcode
= (enum tree_code)TREE_INT_CST_LOW (gimple_call_arg (call, 4));
- tree init = omp_reduction_init_op (gimple_location (call), rcode,
- TREE_TYPE (var));
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+ bool array_p = !integer_zerop (array_addr);
+
+ tree array_type = NULL_TREE;
+ if (array_p)
+ array_type
+ = (TREE_CODE (TREE_TYPE (array_addr)) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (array_addr))) == ARRAY_TYPE
+ ? TREE_TYPE (TREE_TYPE (array_addr))
+ : TREE_TYPE (array_addr));
+
+ tree init = NULL_TREE;
gimple_seq seq = NULL;
push_gimplify_context (true);
+ if (array_p)
+ {
+ tree loop_index;
+ gimple_stmt_iterator loop_body_gsi;
+ oacc_build_indexed_ssa_loop (gimple_location (call), array_max_idx, &gsi,
+ &loop_index, &loop_body_gsi);
+
+ tree init_type = TREE_TYPE (array_type);
+ init = omp_reduction_init_op (gimple_location (call), rcode,
+ init_type);
+ gimple_seq seq = NULL;
+
+ tree ptr = fold_convert (ptr_type_node, array_addr);
+ tree offset = build2 (MULT_EXPR, sizetype,
+ fold_convert (sizetype, loop_index),
+ TYPE_SIZE_UNIT (init_type));
+ tree addr = build2 (POINTER_PLUS_EXPR, build_pointer_type (init_type),
+ ptr, offset);
+ tree ref = build_simple_mem_ref (addr);
+
+ push_gimplify_context (true);
+ gimplify_assign (ref, init, &seq);
+ pop_gimplify_context (NULL);
+ gsi_insert_seq_before (&loop_body_gsi, seq, GSI_SAME_STMT);
+ init = var;
+ }
+ else
+ init = omp_reduction_init_op (gimple_location (call), rcode,
+ TREE_TYPE (var));
- if (level == GOMP_DIM_VECTOR && oa->vector_length == PTX_WARP_SIZE)
+ if (level == GOMP_DIM_VECTOR && oa->vector_length == PTX_WARP_SIZE
+ && !array_p
+ && TREE_CODE (TREE_TYPE (var)) != RECORD_TYPE)
{
/* Initialize vector-non-zeroes to INIT_VAL (OP). */
tree tid = make_ssa_name (integer_type_node);
@@ -7306,7 +7959,9 @@ nvptx_goacc_reduction_init (gcall *call, offload_attrs *oa)
}
pop_gimplify_context (NULL);
- gsi_replace_with_seq (&gsi, seq, true);
+
+ gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
+ gsi_remove (&gsi, true);
}
/* NVPTX implementation of GOACC_REDUCTION_FINI. */
@@ -7321,55 +7976,84 @@ nvptx_goacc_reduction_fini (gcall *call, offload_attrs *oa)
int level = TREE_INT_CST_LOW (gimple_call_arg (call, 3));
enum tree_code op
= (enum tree_code)TREE_INT_CST_LOW (gimple_call_arg (call, 4));
+
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+ bool array_p = !integer_zerop (array_addr);
+
+ tree array_type = NULL_TREE;
+ if (array_p)
+ array_type
+ = (TREE_CODE (TREE_TYPE (array_addr)) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (array_addr))) == ARRAY_TYPE
+ ? TREE_TYPE (TREE_TYPE (array_addr))
+ : TREE_TYPE (array_addr));
+
gimple_seq seq = NULL;
tree r = NULL_TREE;
push_gimplify_context (true);
- if (level == GOMP_DIM_VECTOR && oa->vector_length == PTX_WARP_SIZE)
- {
- /* Emit binary shuffle tree. TODO. Emit this as an actual loop,
- but that requires a method of emitting a unified jump at the
- gimple level. */
- for (int shfl = PTX_WARP_SIZE / 2; shfl > 0; shfl = shfl >> 1)
- {
- tree other_var = make_ssa_name (TREE_TYPE (var));
- nvptx_generate_vector_shuffle (gimple_location (call),
- other_var, var, shfl, &seq);
-
- r = make_ssa_name (TREE_TYPE (var));
- gimplify_assign (r, fold_build2 (op, TREE_TYPE (var),
- var, other_var), &seq);
- var = r;
- }
- }
+ if (level == GOMP_DIM_VECTOR && oa->vector_length == PTX_WARP_SIZE
+ && !array_p
+ && TREE_CODE (TREE_TYPE (var)) != RECORD_TYPE)
+ r = nvptx_vector_reduction (gimple_location (call), &gsi, var, op);
else
{
tree accum = NULL_TREE;
+ tree ptr = NULL_TREE;
if (level == GOMP_DIM_WORKER || level == GOMP_DIM_VECTOR)
{
/* Get reduction buffer address. */
tree offset = gimple_call_arg (call, 5);
- tree call = nvptx_get_shared_red_addr (TREE_TYPE (var), offset,
- level == GOMP_DIM_VECTOR);
- tree ptr = make_ssa_name (TREE_TYPE (call));
-
+ tree call;
+ if (array_p)
+ {
+ tree array_elem_type = TREE_TYPE (array_type);
+ call = nvptx_get_shared_red_addr (array_elem_type, array_max_idx,
+ offset,
+ level == GOMP_DIM_VECTOR);
+ }
+ else
+ call = nvptx_get_shared_red_addr (TREE_TYPE (var), offset,
+ level == GOMP_DIM_VECTOR);
+ ptr = make_ssa_name (TREE_TYPE (call));
gimplify_assign (ptr, call, &seq);
accum = ptr;
}
else if (integer_zerop (ref_to_res))
r = var;
else
- accum = ref_to_res;
+ {
+ ref_to_res = nvptx_adjust_reduction_type (ref_to_res, TREE_TYPE (var),
+ &seq);
+ accum = ref_to_res;
+ }
if (accum)
{
/* UPDATE the accumulator. */
gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
seq = NULL;
- r = nvptx_reduction_update (gimple_location (call), &gsi,
- accum, var, op, level);
+ if (array_p)
+ {
+ nvptx_reduction_update (gimple_location (call), &gsi,
+ accum, array_addr, op, level,
+ array_max_idx);
+ r = var;
+ }
+ else
+ r = nvptx_reduction_update (gimple_location (call), &gsi,
+ accum, var, op, level);
+
+ if (TARGET_SM70 && level == GOMP_DIM_VECTOR)
+ {
+ /* After SM70, with Independent Thread Scheduling introduced,
+ place a warpsync after vector-mode update of accum buffer. */
+ tree fn = nvptx_builtin_decl (NVPTX_BUILTIN_BAR_WARPSYNC, true);
+ gimple_seq_add_stmt (&seq, gimple_build_call (fn, 0));
+ }
}
}
@@ -7377,7 +8061,8 @@ nvptx_goacc_reduction_fini (gcall *call, offload_attrs *oa)
gimplify_assign (lhs, r, &seq);
pop_gimplify_context (NULL);
- gsi_replace_with_seq (&gsi, seq, true);
+ gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
+ gsi_remove (&gsi, true);
}
/* NVPTX implementation of GOACC_REDUCTION_TEARDOWN. */
@@ -7389,21 +8074,47 @@ nvptx_goacc_reduction_teardown (gcall *call, offload_attrs *oa)
tree lhs = gimple_call_lhs (call);
tree var = gimple_call_arg (call, 2);
int level = TREE_INT_CST_LOW (gimple_call_arg (call, 3));
+
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+ bool array_p = !integer_zerop (array_addr);
+
+ tree array_type = NULL_TREE;
+ if (array_p)
+ array_type
+ = (TREE_CODE (TREE_TYPE (array_addr)) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (array_addr))) == ARRAY_TYPE
+ ? TREE_TYPE (TREE_TYPE (array_addr))
+ : TREE_TYPE (array_addr));
+
+ tree ptr = NULL_TREE;
gimple_seq seq = NULL;
push_gimplify_context (true);
if (level == GOMP_DIM_WORKER
- || (level == GOMP_DIM_VECTOR && oa->vector_length > PTX_WARP_SIZE))
+ || (level == GOMP_DIM_VECTOR && (oa->vector_length > PTX_WARP_SIZE
+ || array_p)))
{
/* Read the worker reduction buffer. */
tree offset = gimple_call_arg (call, 5);
- tree call = nvptx_get_shared_red_addr (TREE_TYPE (var), offset,
- level == GOMP_DIM_VECTOR);
- tree ptr = make_ssa_name (TREE_TYPE (call));
-
- gimplify_assign (ptr, call, &seq);
- var = build_simple_mem_ref (ptr);
- TREE_THIS_VOLATILE (var) = 1;
+ if (array_p)
+ {
+ tree array_elem_type = TREE_TYPE (array_type);
+ tree call
+ = nvptx_get_shared_red_addr (array_elem_type, array_max_idx,
+ offset, level == GOMP_DIM_VECTOR);
+ ptr = make_ssa_name (TREE_TYPE (call));
+ gimplify_assign (ptr, call, &seq);
+ }
+ else
+ {
+ tree call = nvptx_get_shared_red_addr (TREE_TYPE (var), offset,
+ level == GOMP_DIM_VECTOR);
+ ptr = make_ssa_name (TREE_TYPE (call));
+ gimplify_assign (ptr, call, &seq);
+ var = build_simple_mem_ref (ptr);
+ TREE_THIS_VOLATILE (var) = 1;
+ }
}
if (level != GOMP_DIM_GANG)
@@ -7412,15 +8123,29 @@ nvptx_goacc_reduction_teardown (gcall *call, offload_attrs *oa)
tree ref_to_res = gimple_call_arg (call, 1);
if (!integer_zerop (ref_to_res))
- gimplify_assign (build_simple_mem_ref (ref_to_res), var, &seq);
+ {
+ if (array_p)
+ oacc_build_array_copy (ref_to_res, ptr, array_max_idx, &seq);
+ else
+ {
+ ref_to_res = nvptx_adjust_reduction_type (ref_to_res,
+ TREE_TYPE (var), &seq);
+ gimplify_assign (build_simple_mem_ref (ref_to_res), var, &seq);
+ }
+ }
+ else if (array_p)
+ {
+ oacc_build_array_copy (array_addr, ptr, array_max_idx, &seq);
+ }
}
if (lhs)
- gimplify_assign (lhs, var, &seq);
+ gimplify_assign (lhs, unshare_expr (var), &seq);
pop_gimplify_context (NULL);
- gsi_replace_with_seq (&gsi, seq, true);
+ gsi_insert_seq_before (&gsi, seq, GSI_SAME_STMT);
+ gsi_remove (&gsi, true);
}
/* NVPTX reduction expander. */
diff --git a/gcc/config/nvptx/nvptx.h b/gcc/config/nvptx/nvptx.h
index 35ef4bd..0c544d3 100644
--- a/gcc/config/nvptx/nvptx.h
+++ b/gcc/config/nvptx/nvptx.h
@@ -247,6 +247,9 @@ struct GTY(()) machine_function
for per-lane storage in OpenMP SIMD regions. */
unsigned HOST_WIDE_INT simt_stack_size;
unsigned HOST_WIDE_INT simt_stack_align;
+
+ rtx omp_parallel_predicate;
+ rtx omp_fn_entry_num_threads_reg;
};
#endif
diff --git a/gcc/config/nvptx/nvptx.md b/gcc/config/nvptx/nvptx.md
index 7c3bd69..9d45c49 100644
--- a/gcc/config/nvptx/nvptx.md
+++ b/gcc/config/nvptx/nvptx.md
@@ -79,6 +79,14 @@
UNSPECV_SIMT_EXIT
UNSPECV_RED_PART
+
+ UNSPECV_GET_TID
+ UNSPECV_GET_NTID
+ UNSPECV_GET_CTAID
+ UNSPECV_GET_NCTAID
+
+ UNSPECV_OMP_PARALLEL_FORK
+ UNSPECV_OMP_PARALLEL_JOIN
])
(define_attr "subregs_ok" "false,true"
@@ -122,6 +130,12 @@
: immediate_operand (op, mode));
})
+(define_predicate "nvptx_shared_mem_operand"
+ (match_code "mem")
+{
+ return nvptx_mem_shared_p (op);
+})
+
(define_predicate "const0_operand"
(and (match_code "const_int")
(match_test "op == const0_rtx")))
@@ -950,6 +964,13 @@
"%J0\\tbra.uni\\t%l1;"
[(set_attr "predicable" "no")])
+(define_insn "cond_uni"
+ [(set (match_operand:SI 0 "nvptx_register_operand" "=R")
+ (unspec:SI [(match_operand:SI 1 "nvptx_nonmemory_operand" "R")]
+ UNSPEC_BR_UNIFIED))]
+ ""
+ "%.\\tmov%t0\\t%0, %1; // unified")
+
(define_expand "cbranch<mode>4"
[(set (pc)
(if_then_else (match_operator 0 "nvptx_comparison_operator"
@@ -1875,6 +1896,60 @@
return asms[INTVAL (operands[1])];
})
+(define_expand "gomp_barrier"
+ [(const_int 1)]
+ "flag_openmp_target == OMP_TARGET_MODE_OMPACC"
+{
+ emit_insn (gen_nvptx_barsync (GEN_INT (0), GEN_INT (0)));
+ DONE;
+})
+
+(define_expand "omp_get_num_threads"
+ [(match_operand 0 "nvptx_register_operand" "=R")]
+ "flag_openmp_target == OMP_TARGET_MODE_OMPACC"
+{
+ nvptx_expand_omp_get_num_threads (operands[0]);
+ DONE;
+})
+
+(define_insn "omp_get_num_teams"
+ [(set (match_operand:SI 0 "nvptx_register_operand" "=R")
+ (unspec_volatile:SI [(const_int 0)] UNSPECV_GET_NCTAID))]
+ "flag_openmp_target == OMP_TARGET_MODE_OMPACC"
+ "%.\\tmov.u32\\t%0, %%nctaid.x;")
+
+(define_insn "omp_get_thread_num"
+ [(set (match_operand:SI 0 "nvptx_register_operand" "=R")
+ (unspec_volatile:SI [(const_int 0)] UNSPECV_GET_TID))]
+ "flag_openmp_target == OMP_TARGET_MODE_OMPACC"
+ "%.\\tmov.u32\\t%0, %%tid.x;")
+
+(define_insn "omp_get_team_num"
+ [(set (match_operand:SI 0 "nvptx_register_operand" "=R")
+ (unspec_volatile:SI [(const_int 0)] UNSPECV_GET_CTAID))]
+ "flag_openmp_target == OMP_TARGET_MODE_OMPACC"
+ "%.\\tmov.u32\\t%0, %%ctaid.x;")
+
+(define_insn "get_ntid"
+ [(set (match_operand:SI 0 "nvptx_register_operand" "=R")
+ (unspec_volatile:SI [(const_int 0)] UNSPECV_GET_NTID))]
+ "flag_openmp_target == OMP_TARGET_MODE_OMPACC"
+ "%.\\tmov.u32\\t%0, %%ntid.x;")
+
+(define_insn "nvptx_omp_parallel_fork"
+ [(set (match_operand:SI 0 "nvptx_shared_mem_operand" "=m")
+ (unspec_volatile:SI [(match_operand:SI 1 "nvptx_register_operand" "R")]
+ UNSPECV_OMP_PARALLEL_FORK))]
+ "flag_openmp_target == OMP_TARGET_MODE_OMPACC"
+ "%.\\tst.shared.u32\\t%0, %1; //omp parallel fork")
+
+(define_insn "nvptx_omp_parallel_join"
+ [(set (match_operand:SI 0 "nvptx_shared_mem_operand" "=m")
+ (unspec_volatile:SI [(match_operand:SI 1 "nvptx_register_operand" "R")]
+ UNSPECV_OMP_PARALLEL_JOIN))]
+ "flag_openmp_target == OMP_TARGET_MODE_OMPACC"
+ "%.\\tst.shared.u32\\t%0, %1; //omp parallel join")
+
(define_insn "nvptx_fork"
[(unspec_volatile:SI [(match_operand:SI 0 "const_int_operand" "")]
UNSPECV_FORK)]
diff --git a/gcc/coretypes.h b/gcc/coretypes.h
index a11ebd1..3d483a5 100644
--- a/gcc/coretypes.h
+++ b/gcc/coretypes.h
@@ -228,6 +228,13 @@ enum offload_abi {
OFFLOAD_ABI_ILP32
};
+/* Types of memory optimization for an offload device. */
+enum offload_memory {
+ OFFLOAD_MEMORY_NONE,
+ OFFLOAD_MEMORY_UNIFIED,
+ OFFLOAD_MEMORY_PINNED
+};
+
/* Types of profile update methods. */
enum profile_update {
PROFILE_UPDATE_SINGLE,
diff --git a/gcc/cp/ChangeLog.omp b/gcc/cp/ChangeLog.omp
new file mode 100644
index 0000000..3f2574a
--- /dev/null
+++ b/gcc/cp/ChangeLog.omp
@@ -0,0 +1,332 @@
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ * parser.cc (cp_finish_omp_declare_variant): Adjust error messages.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+
+ PR c++/119659
+ PR c++/118859
+ PR c++/119601
+ PR c++/119602
+ PR c++/119775
+ PR c++/119659
+ PR c++/118859
+ PR c++/119601
+ PR c++/119602
+ PR c++/119775
+ * cp-tree.h (finish_omp_parm_list): New declaration.
+ (finish_omp_adjust_args): New declaration.
+ * decl.cc (omp_declare_variant_finalize_one): Refactor and change
+ attribute unpacking, use finish_omp_parm_list and
+ finish_omp_adjust_args, refactor append_args diagnostics, add
+ nbase_parms to append_args attribute, remove special handling for
+ member functions.
+ * parser.cc (cp_parser_direct_declarator): Don't pass parms.
+ (cp_parser_late_return_type_opt): Remove parms parameter.
+ (cp_parser_omp_parm_list): New function.
+ (cp_finish_omp_declare_variant): Remove parms parameter.
+ Add NULL_TREE instead of nbase_args to append_args_tree. Refactor,
+ use cp_parser_omp_parm_list not cp_parser_omp_var_list_no_open,
+ handle "need_device_addr" and remove handling and diagnostics of
+ parm list arguments that are done too early. Change format of
+ unnamed variant attribute.
+ (cp_parser_late_parsing_omp_declare_simd): Remove parms parameter.
+ * pt.cc (tsubst_attribute): Copy "omp declare variant base" nodes,
+ substitute parm list numeric range bounds.
+ * semantics.cc (finish_omp_parm_list): New function.
+ (finish_omp_adjust_args): New function.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * parser.cc (cp_parser_omp_clause_map): Apply iterator to push and
+ pop mapper clauses.
+ * semantics.cc (cxx_omp_map_array_section): Allow array types for
+ base type of array sections.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * parser.cc (cp_parser_omp_iterators): Use macros for accessing
+ iterator elements.
+ (cp_parser_omp_clause_affinity): Likewise.
+ (cp_parser_omp_clause_depend): Likewise.
+ (cp_parser_omp_clause_from_to): Likewise.
+ (cp_parser_omp_clause_map): Likewise.
+ * semantics.cc (cp_omp_finish_iterators): Likewise.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * semantics.cc (handle_omp_array_sections): Add extra argument. Set
+ argument to true if array section has a stride that is not one.
+ (finish_omp_clauses): Disable strided updates when iterators are
+ used in the clause. Emit sorry if strided.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * parser.cc (cp_parser_omp_clause_from_to): Parse 'iterator' modifier.
+ * semantics.cc (finish_omp_clauses): Finish iterators for to/from
+ clauses.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * parser.cc (cp_parser_omp_clause_map): Parse 'iterator' modifier.
+ * semantics.cc (finish_omp_clauses): Finish iterators. Apply
+ iterators to generated clauses.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * pt.cc (tsubst_omp_clause_decl): Use OMP_ITERATOR_DECL_P.
+ * semantics.cc (handle_omp_array_sections): Likewise.
+ (finish_omp_clauses): Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * parser.cc (cp_parser_omp_var_list_no_open): Adjust parsing of opening
+ square bracket.
+ (cp_parser_omp_clause_reduction): Adjustments for
+ OpenACC-specific cases.
+ * semantics.cc (cp_oacc_reduction_defined_type_p): New function.
+ (cp_oacc_reduction_code_name): Likewise.
+ (finish_omp_reduction_clause): Handle OpenACC cases using new
+ functions.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Julian Brown <julian@codesourcery.com>
+ waffl3x <waffl3x@baylibre.com>
+
+ * cp-tree.h (struct cp_omp_declare_variant_attr): New.
+ (struct saved_scope): Add omp_declare_variant_attribute field.
+ * decl.cc (omp_declare_variant_finalize_one): Add logic to inject
+ "this" parameter for method calls.
+ * parser.cc (cp_parser_skip_to_pragma_omp_end_declare_variant): New.
+ (omp_start_variant_function): New.
+ (omp_finish_variant_function): New.
+ (cp_parser_init_declarator): Handle variant functions.
+ (cp_parser_class_specifier): Handle deferred lookup of base functions
+ when the entire class has been seen.
+ (cp_parser_member_declaration): Handle variant functions.
+ (cp_finish_omp_declare_variant): Merge context selectors if in
+ a "begin declare variant" block.
+ (cp_parser_omp_begin): Match "omp begin declare variant". Adjust
+ error messages.
+ (cp_parser_omp_end): Match "omp end declare variant".
+ * parser.h (struct cp_parser): Add omp_unregistered_variants field.
+ * semantics.cc (finish_translation_unit): Detect unmatched
+ "omp begin declare variant".
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+ Tobias Burnus <tobias@codesourcery.com>
+
+ * constexpr.cc (potential_constant_expression_1): Handle
+ OMP_ALLOCATE.
+ * cp-tree.def (OMP_ALLOCATE): New tree code.
+ * cp-tree.h (OMP_ALLOCATE_LOCATION): Define.
+ (OMP_ALLOCATE_VARS): Define.
+ (OMP_ALLOCATE_ALLOCATOR): Define.
+ (OMP_ALLOCATE_ALIGN): Define.
+ (finish_omp_allocate): New function declaration.
+ * decl.cc (make_rtl_for_nonlocal_decl): Work around ICE with
+ implicit constexpr functions.
+ * parser.cc (cp_parser_omp_allocate): Use OMP_CLAUSE_ERROR,
+ add diagnostics for args, call finish_omp_allocate.
+ (cp_parser_omp_construct): Don't handle PRAGMA_OMP_ALLOCATE.
+ (cp_parser_pragma): Comment.
+ * pt.cc (tsubst_stmt): Handle OMP_ALLOCATE, call
+ finish_omp_allocate.
+ * semantics.cc (finish_omp_allocate): New function.
+ * typeck.cc (can_do_nrvo_p): Don't do NRVO for omp allocate vars.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Andrew Stubbs <ams@baylibre.com>
+ Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * parser.cc (cp_parser_omp_var_list_no_open): Support array-shaping
+ operator in 'declare mapper' definitions.
+ (cp_parser_omp_clause_from_to): Add parsing for mapper modifier.
+ (cp_parser_omp_clause_map): Pass C_ORT_OMP_DECLARE_MAPPER to
+ cp_parser_omp_var_list_no_open in mapper definitions.
+ (cp_parser_omp_target_update): Instantiate mappers.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * cp-objcp-common.cc (cp_common_init_ts): Add array-shape cast
+ support.
+ * cp-tree.def (OMP_ARRAYSHAPE_CAST_EXPR): Add tree code.
+ * cp-tree.h (DECLTYPE_FOR_OMP_ARRAYSHAPE_CAST): Add flag.
+ (cp_omp_create_arrayshape_type, cp_build_omp_arrayshape_cast): Add
+ prototypes.
+ (grok_omp_array_section, build_omp_array_section): Add stride
+ parameters.
+ * decl.cc (create_anon_array_type): New function.
+ (cp_omp_create_arrayshape_type): New function.
+ * decl2.cc (grok_omp_array_section): Add stride parameter.
+ (min_vis_expr_r): Add OMP_ARRAYSHAPE_CAST_EXPR support.
+ * error.cc (dump_expr): Add stride support for OMP_ARRAY_SECTION.
+ * mangle.cc (write_expression): Add OMP_ARRAYSHAPE_CAST_EXPR support.
+ * operators.def (OMP_ARRAYSHAPE_CAST_EXPR): Add.
+ * parser.cc (cp_parser_new): Initialise omp_array_shaping_op_p and
+ omp_has_array_shape_p fields.
+ (cp_parser_statement_expr): Don't allow array shaping op in statement
+ exprs.
+ (cp_parser_postfix_open_square_expression): Add stride parsing for
+ array sections. Use array section code to represent array refs if we
+ have an array-shaping operator.
+ (cp_parser_parenthesized_expression_list): Don't allow array-shaping
+ op here.
+ (cp_parser_cast_expression): Add array-shaping operator parsing.
+ (cp_parser_lambda_expression): Don't allow array-shaping op in lambda
+ body.
+ (cp_parser_braced_list): Don't allow array-shaping op in braced list.
+ (struct omp_dim): Add stride field.
+ (cp_parser_var_list_no_open): Add stride/array shape support.
+ (cp_parser_omp_target_update): Handle noncontiguous updates.
+ * parser.h (cp_parser): Add omp_array_shaping_op_p and
+ omp_has_array_shape_p fields.
+ * pt.cc (tsubst): Add array-shape cast support.
+ (tsubst_copy, tsubst_copy_and_build): Likewise. Add stride support for
+ OMP_ARRAY_SECTION.
+ (tsubst_omp_clause_decl): Add stride support for OMP_ARRAY_SECTION.
+ * semantics.cc (handle_omp_array_sections_1): Add DISCONTIGUOUS
+ parameter and stride support.
+ (omp_array_section_low_bound): New function.
+ (handle_omp_array_sections): Add DISCONTIGUOUS parameter and stride
+ support.
+ (finish_omp_clauses): Update calls to handle_omp_array_sections, and
+ add noncontiguous array update support.
+ (cp_build_omp_arrayshape_cast): New function.
+ * typeck.cc (structural_comptypes): Add array-shape cast support.
+ (build_omp_array_section): Add stride parameter.
+ (check_for_casting_away_constness): Add OMP_ARRAYSHAPE_CAST_EXPR
+ support.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * semantics.cc (handle_omp_array_sections): Pass pointer to clause
+ instead of clause. Add PNEXT return parameter for next clause in list
+ to process.
+ (finish_omp_clauses): Update calls to handle_omp_array_sections.
+ Handle cases where initial clause might be replaced.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * parser.cc (cp_parser_omp_target_data): Instantiate mappers for 'omp
+ target data'.
+ (cp_parser_omp_target_enter_data): Instantiate mappers for 'omp target
+ enter data'.
+ (cp_parser_omp_target_exit_data): Instantiate mappers for 'omp target
+ exit data'.
+ (cp_parser_omp_target): Add c_omp_region_type argument to
+ c_omp_instantiate_mappers call.
+ * pt.cc (tsubst_omp_clauses): Instantiate mappers for OMP regions other
+ than just C_ORT_OMP_TARGET.
+ (tsubst_expr): Update call to tsubst_omp_clauses for OMP_TARGET_UPDATE,
+ OMP_TARGET_ENTER_DATA, OMP_TARGET_EXIT_DATA stanza.
+ * semantics.cc (cxx_omp_map_array_section): Avoid calling
+ build_array_ref for non-array/non-pointer bases (error reported
+ already).
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * constexpr.cc (reduced_constant_expression_p): Add OMP_DECLARE_MAPPER
+ case.
+ (cxx_eval_constant_expression, potential_constant_expression_1):
+ Likewise.
+ * cp-gimplify.cc (cxx_omp_finish_mapper_clauses): New function.
+ * cp-objcp-common.h (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES,
+ LANG_HOOKS_OMP_MAPPER_LOOKUP, LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE,
+ LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define langhooks.
+ * cp-tree.h (lang_decl_base): Add omp_declare_mapper_p field. Recount
+ spare bits comment.
+ (DECL_OMP_DECLARE_MAPPER_P): New macro.
+ (omp_mapper_id): Add prototype.
+ (cp_check_omp_declare_mapper): Add prototype.
+ (omp_instantiate_mappers): Add prototype.
+ (cxx_omp_finish_mapper_clauses): Add prototype.
+ (cxx_omp_mapper_lookup): Add prototype.
+ (cxx_omp_extract_mapper_directive): Add prototype.
+ (cxx_omp_map_array_section): Add prototype.
+ * decl.cc (check_initializer): Add OpenMP declare mapper support.
+ (cp_finish_decl): Set DECL_INITIAL for OpenMP declare mapper var decls
+ as appropriate.
+ * decl2.cc (mark_used): Instantiate OpenMP "declare mapper" magic var
+ decls.
+ * error.cc (dump_omp_declare_mapper): New function.
+ (dump_simple_decl): Use above.
+ * parser.cc (cp_parser_omp_clause_map): Add KIND parameter. Support
+ "mapper" modifier.
+ (cp_parser_omp_all_clauses): Add KIND argument to
+ cp_parser_omp_clause_map call.
+ (cp_parser_omp_target): Call omp_instantiate_mappers before
+ finish_omp_clauses.
+ (cp_parser_omp_declare_mapper): New function.
+ (cp_parser_omp_declare): Add "declare mapper" support.
+ * pt.cc (tsubst_decl): Adjust name of "declare mapper" magic var decls
+ once we know their type.
+ (tsubst_omp_clauses): Call omp_instantiate_mappers before
+ finish_omp_clauses, for target regions.
+ (tsubst_expr): Support OMP_DECLARE_MAPPER nodes.
+ (instantiate_decl): Instantiate initialiser (i.e definition) for OpenMP
+ declare mappers.
+ * semantics.cc (gimplify.h): Include.
+ (omp_mapper_id, omp_mapper_lookup, omp_extract_mapper_directive,
+ cxx_omp_map_array_section, cp_check_omp_declare_mapper): New functions.
+ (finish_omp_clauses): Delete GOMP_MAP_PUSH_MAPPER_NAME and
+ GOMP_MAP_POP_MAPPER_NAME artificial clauses.
+ (omp_target_walk_data): Add MAPPERS field.
+ (finish_omp_target_clauses_r): Scan for uses of struct/union/class type
+ variables.
+ (finish_omp_target_clauses): Create artificial mapper binding clauses
+ for used structs/unions/classes in offload region.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * parser.cc (cp_parser_omp_clause_uses_allocators): New.
+ (cp_parser_omp_clause_name, cp_parser_omp_all_clauses,
+ OMP_TARGET_CLAUSE_MASK): Handle uses_allocators.
+ * semantics.cc (finish_omp_clauses): Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * semantics.cc (finish_omp_clauses): Adjust to allow duplicate
+ mapped variables for OpenMP.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+ Nathan Sidwell <nathan@acm.org>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+
+ * parser.cc (cp_parser_omp_var_list_no_open): New c_omp_region_type
+ argument. Use it to specialize handling of OMP_CLAUSE_REDUCTION for
+ OpenACC.
+ (cp_parser_omp_var_list): Add c_omp_region_type argument. Update call
+ to cp_parser_omp_var_list_no_open.
+ (cp_parser_oacc_data_clause): Update call to
+ cp_parser_omp_var_list_no_open.
+ (cp_parser_omp_clause_reduction): Change is_omp boolean parameter to
+ c_omp_region_type. Update call to cp_parser_omp_var_list_no_open.
+ (cp_parser_omp_clause_from_to): Update call to
+ cp_parser_omp_clause_var_list_no_open.
+ (cp_parser_omp_clause_map): Likewise.
+ (cp_parser_omp_clause_init): Likewise.
+ (cp_parser_oacc_all_clauses): Update call to
+ cp_parser_omp_clause_reduction.
+ (cp_parser_omp_all_clauses): Likewise.
+ * semantics.cc (finish_omp_reduction_clause): Add c_omp_region_type
+ argument. Suppress user-defined reduction error for OpenACC.
+ (finish_omp_clauses): Update call to finish_omp_reduction_clause.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ PR other/76739
+ * semantics.cc (handle_omp_array_sections_1): Add 'bool &non_contiguous'
+ parameter, adjust recursive call site, add cases for allowing
+ pointer based multi-dimensional arrays for OpenACC. Reject
+ non-DECL base-pointer cases as unsupported.
+ (handle_omp_array_sections): Adjust handle_omp_array_sections_1 call,
+ handle non-contiguous case to create dynamic array map. \ No newline at end of file
diff --git a/gcc/cp/constexpr.cc b/gcc/cp/constexpr.cc
index d647a09..48327fb 100644
--- a/gcc/cp/constexpr.cc
+++ b/gcc/cp/constexpr.cc
@@ -3540,6 +3540,9 @@ reduced_constant_expression_p (tree t)
/* Even if we can't lower this yet, it's constant. */
return true;
+ case OMP_DECLARE_MAPPER:
+ return true;
+
case CONSTRUCTOR:
/* And we need to handle PTRMEM_CST wrapped in a CONSTRUCTOR. */
tree field;
@@ -7849,6 +7852,7 @@ cxx_eval_constant_expression (const constexpr_ctx *ctx, tree t,
case LABEL_EXPR:
case CASE_LABEL_EXPR:
case PREDICT_EXPR:
+ case OMP_DECLARE_MAPPER:
return t;
case PARM_DECL:
@@ -10536,6 +10540,11 @@ potential_constant_expression_1 (tree t, bool want_rval, bool strict, bool now,
"expression", t);
return false;
+ case OMP_DECLARE_MAPPER:
+ /* This can be used to initialize VAR_DECLs: it's treated as a magic
+ constant. */
+ return true;
+
case ASM_EXPR:
if (flags & tf_error)
inline_asm_in_constexpr_error (loc, fundef_p);
@@ -11033,6 +11042,22 @@ potential_constant_expression_1 (tree t, bool want_rval, bool strict, bool now,
return true;
}
+ /* We technically should never encounter this, but handling a generic
+ lambda checks the function body before instantiation to see if it can be
+ declared constexpr. This is currently fairly buggy and not respected
+ by other parts of the code though. */
+ case OMP_ALLOCATE:
+ /* This is the only case I observed this, we want to know if other cases
+ suddenly manifest. */
+ gcc_assert (cxx_dialect >= cxx17
+ && processing_template_decl
+ && LAMBDA_FUNCTION_P (current_function_decl));
+ /* OpenMP does not currently allow directives in constexpr functions.
+ However as hinted at above, returning false here doesn't actually stop
+ lambdas from being called in constant expressions.
+ We still return false in case that changes in the future. */
+ return false;
+
default:
if (objc_non_constant_expr_p (t))
return false;
diff --git a/gcc/cp/cp-gimplify.cc b/gcc/cp/cp-gimplify.cc
index d2423fd..a4f3eaa 100644
--- a/gcc/cp/cp-gimplify.cc
+++ b/gcc/cp/cp-gimplify.cc
@@ -2809,6 +2809,12 @@ cxx_omp_finish_clause (tree c, gimple_seq *, bool /* openacc */)
}
}
+tree
+cxx_omp_finish_mapper_clauses (tree clauses)
+{
+ return finish_omp_clauses (clauses, C_ORT_OMP);
+}
+
/* Return true if DECL's DECL_VALUE_EXPR (if any) should be
disregarded in OpenMP construct, because it is going to be
remapped during OpenMP lowering. SHARED is true if DECL
diff --git a/gcc/cp/cp-objcp-common.cc b/gcc/cp/cp-objcp-common.cc
index 8336d0b..f56541e 100644
--- a/gcc/cp/cp-objcp-common.cc
+++ b/gcc/cp/cp-objcp-common.cc
@@ -685,6 +685,7 @@ cp_common_init_ts (void)
MARK_TS_EXP (OFFSET_REF);
MARK_TS_EXP (PSEUDO_DTOR_EXPR);
MARK_TS_EXP (REINTERPRET_CAST_EXPR);
+ MARK_TS_EXP (OMP_ARRAYSHAPE_CAST_EXPR);
MARK_TS_EXP (SCOPE_REF);
MARK_TS_EXP (STATIC_CAST_EXPR);
MARK_TS_EXP (STMT_EXPR);
diff --git a/gcc/cp/cp-objcp-common.h b/gcc/cp/cp-objcp-common.h
index 13fb80c..ff35428 100644
--- a/gcc/cp/cp-objcp-common.h
+++ b/gcc/cp/cp-objcp-common.h
@@ -190,6 +190,15 @@ static const scoped_attribute_specs *const cp_objcp_attribute_table[] =
#define LANG_HOOKS_OMP_CLAUSE_DTOR cxx_omp_clause_dtor
#undef LANG_HOOKS_OMP_FINISH_CLAUSE
#define LANG_HOOKS_OMP_FINISH_CLAUSE cxx_omp_finish_clause
+#undef LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES
+#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES cxx_omp_finish_mapper_clauses
+#undef LANG_HOOKS_OMP_MAPPER_LOOKUP
+#define LANG_HOOKS_OMP_MAPPER_LOOKUP cxx_omp_mapper_lookup
+#undef LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE
+#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE \
+ cxx_omp_extract_mapper_directive
+#undef LANG_HOOKS_OMP_MAP_ARRAY_SECTION
+#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION cxx_omp_map_array_section
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE cxx_omp_privatize_by_reference
#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
diff --git a/gcc/cp/cp-tree.def b/gcc/cp/cp-tree.def
index bb5aaf9..2182141 100644
--- a/gcc/cp/cp-tree.def
+++ b/gcc/cp/cp-tree.def
@@ -257,6 +257,7 @@ DEFTREECODE (REINTERPRET_CAST_EXPR, "reinterpret_cast_expr", tcc_unary, 1)
DEFTREECODE (CONST_CAST_EXPR, "const_cast_expr", tcc_unary, 1)
DEFTREECODE (STATIC_CAST_EXPR, "static_cast_expr", tcc_unary, 1)
DEFTREECODE (DYNAMIC_CAST_EXPR, "dynamic_cast_expr", tcc_unary, 1)
+DEFTREECODE (OMP_ARRAYSHAPE_CAST_EXPR, "omp_arrayshape_cast_expr", tcc_unary, 1)
DEFTREECODE (IMPLICIT_CONV_EXPR, "implicit_conv_expr", tcc_unary, 1)
DEFTREECODE (DOTSTAR_EXPR, "dotstar_expr", tcc_expression, 2)
DEFTREECODE (TYPEID_EXPR, "typeid_expr", tcc_expression, 1)
@@ -490,6 +491,17 @@ DEFTREECODE (TEMPLATE_INFO, "template_info", tcc_exceptional, 0)
Operand 1: OMP_DEPOBJ_CLAUSES: List of clauses. */
DEFTREECODE (OMP_DEPOBJ, "omp_depobj", tcc_statement, 2)
+/* OpenMP - #pragma omp allocate
+ Underlying node type is tree_exp, used to represent the directive as a
+ statement in a function. Only used for template instantiation.
+ Operand 0: OMP_ALLOCATE_VARS: tree_list containing each var_decl passed to
+ the directive as an args, purpose contains the
+ var_decl, value contains a expr that holds the
+ location where the var was passed in.
+ Operand 1: OMP_ALLOCATE_ALLOCATOR: Expr of the allocator clause.
+ Operand 2: OMP_ALLOCATE_ALIGN: Expr of the align clause. */
+DEFTREECODE (OMP_ALLOCATE, "omp_allocate", tcc_statement, 3)
+
/* Extensions for Concepts. */
/* Used to represent information associated with constrained declarations. */
diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index eb32ec0..f984940 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -515,6 +515,7 @@ extern GTY(()) tree cp_global_trees[CPTI_MAX];
LOOKUP_FOUND_P (in RECORD_TYPE, UNION_TYPE, ENUMERAL_TYPE, NAMESPACE_DECL)
FNDECL_MANIFESTLY_CONST_EVALUATED (in FUNCTION_DECL)
TARGET_EXPR_INTERNAL_P (in TARGET_EXPR)
+ DECLTYPE_FOR_OMP_ARRAYSHAPE_CAST (in DECLTYPE_TYPE)
5: IDENTIFIER_VIRTUAL_P (in IDENTIFIER_NODE)
FUNCTION_RVALUE_QUALIFIED (in FUNCTION_TYPE, METHOD_TYPE)
CALL_EXPR_REVERSE_ARGS (in CALL_EXPR, AGGR_INIT_EXPR)
@@ -1923,6 +1924,11 @@ struct GTY(()) cp_omp_begin_assumes_data {
bool attr_syntax;
};
+struct GTY(()) cp_omp_declare_variant_attr {
+ bool attr_syntax;
+ tree selector;
+};
+
/* Global state. */
struct GTY(()) saved_scope {
@@ -1973,6 +1979,7 @@ struct GTY(()) saved_scope {
hash_map<tree, tree> *GTY((skip)) x_local_specializations;
vec<cp_omp_declare_target_attr, va_gc> *omp_declare_target_attribute;
vec<cp_omp_begin_assumes_data, va_gc> *omp_begin_assumes;
+ vec<cp_omp_declare_variant_attr, va_gc> *omp_declare_variant_attribute;
struct saved_scope *prev;
};
@@ -2975,7 +2982,10 @@ struct GTY(()) lang_decl_base {
unsigned module_keyed_decls_p : 1; /* has keys, applies to all decls */
- /* 11 spare bits. */
+ /* VAR_DECL being used to represent an OpenMP declared mapper. */
+ unsigned omp_declare_mapper_p : 1;
+
+ /* 10 spare bits. */
};
/* True for DECL codes which have template info and access. */
@@ -4530,6 +4540,11 @@ get_vec_init_expr (tree t)
#define DECL_OMP_DECLARE_REDUCTION_P(NODE) \
(LANG_DECL_FN_CHECK (DECL_COMMON_CHECK (NODE))->omp_declare_reduction_p)
+/* Nonzero if NODE is an artificial FUNCTION_DECL for
+ #pragma omp declare mapper. */
+#define DECL_OMP_DECLARE_MAPPER_P(NODE) \
+ (DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))->u.base.omp_declare_mapper_p)
+
/* Nonzero if DECL has been declared threadprivate by
#pragma omp threadprivate. */
#define CP_DECL_THREADPRIVATE_P(DECL) \
@@ -5050,6 +5065,8 @@ get_vec_init_expr (tree t)
TREE_LANG_FLAG_2 (DECLTYPE_TYPE_CHECK (NODE))
#define DECLTYPE_FOR_REF_CAPTURE(NODE) \
TREE_LANG_FLAG_3 (DECLTYPE_TYPE_CHECK (NODE))
+#define DECLTYPE_FOR_OMP_ARRAYSHAPE_CAST(NODE) \
+ TREE_LANG_FLAG_4 (DECLTYPE_TYPE_CHECK (NODE))
/* Nonzero for VAR_DECL and FUNCTION_DECL node means that `extern' was
specified in its declaration. This can also be set for an
@@ -5670,6 +5687,23 @@ target_expr_needs_replace (tree t)
#define OMP_DEPOBJ_DEPOBJ(NODE) TREE_OPERAND (OMP_DEPOBJ_CHECK (NODE), 0)
#define OMP_DEPOBJ_CLAUSES(NODE) TREE_OPERAND (OMP_DEPOBJ_CHECK (NODE), 1)
+/* OMP_ALLOCATE accessors.
+ #pragma omp allocate(var1, var2) allocator(Expr) align(Expr) */
+/* Location of the OMP_ALLOCATE directive. */
+#define OMP_ALLOCATE_LOCATION(NODE) (OMP_ALLOCATE_CHECK (NODE)->exp.locus)
+/* Contains a tree_list containing each variable passed as an argument to the
+ allocate directive. The purpose holds the var_decl, the value holds an expr
+ containing the location the var was passed as an argument. */
+#define OMP_ALLOCATE_VARS(NODE) (TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0))
+/* Contains the expression passed in the allocator clause, may be
+ error_mark_node if errors occurred. */
+#define OMP_ALLOCATE_ALLOCATOR(NODE) \
+ (TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 1))
+/* Contains the expression passed in the align clause, may be error_mark_node
+ if errors occurred. */
+#define OMP_ALLOCATE_ALIGN(NODE) \
+ (TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 2))
+
/* An enumeration of the kind of tags that C++ accepts. */
enum tag_types {
none_type = 0, /* Not a tag type. */
@@ -7221,6 +7255,8 @@ extern tree cxx_comdat_group (tree);
extern bool cp_missing_noreturn_ok_p (tree);
extern bool is_direct_enum_init (tree, tree);
extern void initialize_artificial_var (tree, vec<constructor_elt, va_gc> *);
+extern tree cp_omp_create_arrayshape_type (location_t, tree,
+ vec<cp_expr> *);
extern tree check_var_type (tree, tree, location_t);
extern tree reshape_init (tree, tree, tsubst_flags_t);
extern tree next_aggregate_field (tree);
@@ -7255,7 +7291,8 @@ extern void grokclassfn (tree, tree,
enum overload_flags);
extern tree grok_array_decl (location_t, tree, tree,
vec<tree, va_gc> **, tsubst_flags_t);
-extern tree grok_omp_array_section (location_t, tree, tree, tree);
+extern tree grok_omp_array_section (location_t, tree, tree, tree,
+ tree);
extern tree delete_sanity (location_t, tree, tree, bool,
int, tsubst_flags_t);
extern tree check_classfn (tree, tree, tree);
@@ -8062,11 +8099,16 @@ extern tree finish_qualified_id_expr (tree, tree, bool, bool,
extern void simplify_aggr_init_expr (tree *);
extern void finalize_nrv (tree, tree);
extern tree omp_reduction_id (enum tree_code, tree, tree);
+extern tree omp_mapper_id (tree, tree);
extern tree cp_remove_omp_priv_cleanup_stmt (tree *, int *, void *);
extern bool cp_check_omp_declare_reduction (tree);
+extern bool cp_check_omp_declare_mapper (tree);
extern void finish_omp_declare_simd_methods (tree);
extern tree cp_finish_omp_init_prefer_type (tree);
+extern tree finish_omp_parm_list (tree, const_tree, int);
+extern tree finish_omp_adjust_args (tree, const_tree, int);
extern tree finish_omp_clauses (tree, enum c_omp_region_type);
+extern tree omp_instantiate_mappers (tree);
extern tree push_omp_privatization_clauses (bool);
extern void pop_omp_privatization_clauses (tree);
extern void save_omp_privatization_clauses (vec<tree> &);
@@ -8085,6 +8127,7 @@ extern tree finish_omp_for (location_t, enum tree_code,
tree, tree, tree, tree, tree,
tree, tree, vec<tree> *, tree);
extern tree finish_omp_for_block (tree, tree);
+extern void finish_omp_allocate (location_t, tree, tree, tree);
extern void finish_omp_atomic (location_t, enum tree_code,
enum tree_code, tree, tree,
tree, tree, tree, tree, tree,
@@ -8148,6 +8191,8 @@ extern tree cp_build_vec_convert (tree, location_t, tree,
tsubst_flags_t);
extern tree cp_build_bit_cast (location_t, tree, tree,
tsubst_flags_t);
+extern tree cp_build_omp_arrayshape_cast (location_t, tree, tree,
+ tsubst_flags_t);
extern void start_lambda_scope (tree decl);
extern void finish_lambda_scope (void);
extern void record_lambda_scope (tree lambda);
@@ -8406,7 +8451,8 @@ inline tree build_x_binary_op (const op_location_t &loc,
}
extern tree build_x_array_ref (location_t, tree, tree,
tsubst_flags_t);
-extern tree build_omp_array_section (location_t, tree, tree, tree);
+extern tree build_omp_array_section (location_t, tree, tree, tree,
+ tree);
extern tree build_x_unary_op (location_t,
enum tree_code, cp_expr,
tree, tsubst_flags_t);
@@ -8662,6 +8708,10 @@ extern tree cxx_omp_clause_copy_ctor (tree, tree, tree);
extern tree cxx_omp_clause_assign_op (tree, tree, tree);
extern tree cxx_omp_clause_dtor (tree, tree);
extern void cxx_omp_finish_clause (tree, gimple_seq *, bool);
+extern tree cxx_omp_finish_mapper_clauses (tree);
+extern tree cxx_omp_mapper_lookup (tree, tree);
+extern tree cxx_omp_extract_mapper_directive (tree);
+extern tree cxx_omp_map_array_section (location_t, tree);
extern bool cxx_omp_privatize_by_reference (const_tree);
extern bool cxx_omp_disregard_value_expr (tree, bool);
extern void cp_fold_function (tree);
diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc
index 4e97093..9db508f 100644
--- a/gcc/cp/decl.cc
+++ b/gcc/cp/decl.cc
@@ -7871,6 +7871,12 @@ check_initializer (tree decl, tree init, int flags, vec<tree, va_gc> **cleanups)
}
else if (!init && DECL_REALLY_EXTERN (decl))
;
+ else if (flag_openmp
+ && VAR_P (decl)
+ && DECL_LANG_SPECIFIC (decl)
+ && DECL_OMP_DECLARE_MAPPER_P (decl)
+ && TREE_CODE (init) == OMP_DECLARE_MAPPER)
+ return NULL_TREE;
else if (init || type_build_ctor_call (type)
|| TYPE_REF_P (type))
{
@@ -8165,6 +8171,17 @@ make_rtl_for_nonlocal_decl (tree decl, tree init, const char* asmspec)
&& !var_in_maybe_constexpr_fn (decl))
|| DECL_VIRTUAL_P (decl));
+ /* See testsuite/g++.dg/gomp/allocate-15.C
+ This is a band-aid to fix an ICE with implicit constexpr functions, it
+ does not fix the non-template case in allocate-15.C though. We currently
+ sorry on all cases where this is relevant so it shouldn't be necessary.
+ The above needs to be changed but it makes more sense to defer it to
+ another patch as it relates to some other bugs too and has slightly wider
+ implications than just within the scope of OpenMP. */
+ if (!defer_p && flag_openmp
+ && lookup_attribute ("omp allocate", DECL_ATTRIBUTES (decl)))
+ defer_p = 1;
+
/* Defer template instantiations. */
if (DECL_LANG_SPECIFIC (decl)
&& DECL_IMPLICIT_INSTANTIATION (decl))
@@ -8465,15 +8482,29 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
parm = DECL_CHAIN (parm);
for (; parm; parm = DECL_CHAIN (parm))
vec_safe_push (args, forward_parm (parm));
-
+ /* The layout of these nodes are a mess, this function is generally very hard
+ to reason about because of it, this needs to be fixed. */
+ const tree adjust_args_idxs = [&] ()
+ {
+ const tree omp_variant_clauses_temp = TREE_CHAIN (TREE_CHAIN (chain));
+ gcc_checking_assert (!omp_variant_clauses_temp
+ || TREE_PURPOSE (omp_variant_clauses_temp)
+ == get_identifier ("omp variant clauses temp"));
+ const tree adjust_args_idxs = omp_variant_clauses_temp
+ ? TREE_VALUE (omp_variant_clauses_temp)
+ : NULL_TREE;
+ gcc_checking_assert (!adjust_args_idxs
+ || TREE_PURPOSE (adjust_args_idxs)
+ == get_identifier ("omp adjust args idxs"));
+ return adjust_args_idxs;
+ } (); /* IILE. */
unsigned nappend_args = 0;
- tree append_args_list = TREE_CHAIN (TREE_CHAIN (chain));
+ const tree append_args_list
+ = adjust_args_idxs && TREE_CHAIN (adjust_args_idxs)
+ ? TREE_VALUE (TREE_CHAIN (adjust_args_idxs))
+ : NULL_TREE;;
if (append_args_list)
{
- append_args_list = TREE_VALUE (append_args_list);
- append_args_list = (append_args_list && TREE_CHAIN (append_args_list)
- ? TREE_VALUE (TREE_CHAIN (append_args_list))
- : NULL_TREE);
for (tree t = append_args_list; t; t = TREE_CHAIN (t))
nappend_args++;
if (nappend_args)
@@ -8504,6 +8535,55 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
vec_safe_push (args, build_stub_object (TREE_TYPE (type)));
}
}
+ /* We assume the this parameter is included in the declaration, if it isn't
+ our parm count will be wrong. */
+ gcc_assert (!DECL_IOBJ_MEMBER_FUNCTION_P (decl)
+ || is_this_parameter (DECL_ARGUMENTS (decl)));
+ struct bundled_parm_info
+ {
+ int count;
+ bool unexpanded_pack;
+ bool variadic;
+ };
+ const bundled_parm_info parm_info = [&] ()
+ {
+ bool pack = false;
+ int cnt = 0;
+ tree parm_t = TYPE_ARG_TYPES (TREE_TYPE (decl));
+ while (parm_t && parm_t != void_list_node)
+ {
+ /* We can't tell how many parameters there are until all parameter
+ packs have been expanded. */
+ if (PACK_EXPANSION_P (TREE_VALUE (parm_t)))
+ pack = true;
+ parm_t = TREE_CHAIN (parm_t);
+ ++cnt;
+ }
+ return bundled_parm_info{!pack ? cnt : 0, pack, parm_t == NULL_TREE};
+ } (); /* IILE. */
+ tree adjust_args_list = adjust_args_idxs ? TREE_VALUE (adjust_args_idxs)
+ : NULL_TREE;
+ if (adjust_args_list)
+ {
+ /* We currently treat a parm count of 0 as variadic. */
+ adjust_args_list
+ = finish_omp_parm_list (adjust_args_list,
+ decl,
+ parm_info.variadic ? 0 : parm_info.count);
+ if (adjust_args_list != error_mark_node)
+ adjust_args_list
+ = finish_omp_adjust_args (adjust_args_list,
+ decl,
+ parm_info.variadic ? 0 : parm_info.count);
+ if (adjust_args_list == error_mark_node)
+ adjust_args_list = NULL_TREE;
+ }
+ /* This will also clear the adjust_args_list if there was an error. */
+ if (adjust_args_idxs)
+ TREE_VALUE (adjust_args_idxs) = adjust_args_list;
+
+ /* Maybe we should just return at this point if an unexpanded pack was
+ encountered, there isn't much else that we can do if there is. */
bool koenig_p = false;
if (idk == CP_ID_KIND_UNQUALIFIED || idk == CP_ID_KIND_TEMPLATE_ID)
@@ -8543,6 +8623,21 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
if (idk == CP_ID_KIND_QUALIFIED)
variant = finish_call_expr (variant, &args, /*disallow_virtual=*/true,
koenig_p, tf_warning_or_error);
+ else if (idk == CP_ID_KIND_NONE
+ && TREE_CODE (variant) == FUNCTION_DECL
+ && DECL_IOBJ_MEMBER_FUNCTION_P (variant)
+ && CLASS_TYPE_P (DECL_CONTEXT (decl)))
+ {
+ tree saved_ccp = current_class_ptr;
+ tree saved_ccr = current_class_ref;
+ current_class_ptr = NULL_TREE;
+ current_class_ref = NULL_TREE;
+ inject_this_parameter (DECL_CONTEXT (decl), TYPE_UNQUALIFIED);
+ variant = finish_call_expr (variant, &args, /*disallow_virtual=*/false,
+ koenig_p, tf_warning_or_error);
+ current_class_ptr = saved_ccp;
+ current_class_ref = saved_ccr;
+ }
else
variant = finish_call_expr (variant, &args, /*disallow_virtual=*/false,
koenig_p, tf_warning_or_error);
@@ -8555,120 +8650,119 @@ omp_declare_variant_finalize_one (tree decl, tree attr)
variant = cp_get_callee_fndecl_nofold (STRIP_REFERENCE_REF (variant));
input_location = save_loc;
- if (variant)
+ if (!variant)
{
- bool fail;
- const char *varname = IDENTIFIER_POINTER (DECL_NAME (variant));
- if (!nappend_args)
- fail = !comptypes (TREE_TYPE (decl), TREE_TYPE (variant),
- COMPARE_STRICT);
- else
- {
- unsigned nbase_args = 0;
- for (tree t = TYPE_ARG_TYPES (TREE_TYPE (decl));
- t && TREE_VALUE (t) != void_type_node; t = TREE_CHAIN (t))
- nbase_args++;
- tree vargs, varg;
- vargs = varg = TYPE_ARG_TYPES (TREE_TYPE (variant));
- for (unsigned i = 0; i < nbase_args && varg;
- i++, varg = TREE_CHAIN (varg))
- vargs = varg;
- for (unsigned i = 0; i < nappend_args && varg; i++)
- varg = TREE_CHAIN (varg);
- tree saved_vargs;
- if (nbase_args)
- {
- saved_vargs = TREE_CHAIN (vargs);
- TREE_CHAIN (vargs) = varg;
- }
- else
- {
- saved_vargs = vargs;
- TYPE_ARG_TYPES (TREE_TYPE (variant)) = varg;
- }
- /* Skip assert check that TYPE_CANONICAL is the same. */
- fail = !comptypes (TREE_TYPE (decl), TREE_TYPE (variant),
- COMPARE_STRUCTURAL);
- if (nbase_args)
- TREE_CHAIN (vargs) = saved_vargs;
- else
- TYPE_ARG_TYPES (TREE_TYPE (variant)) = saved_vargs;
- varg = saved_vargs;
- if (!fail && !processing_template_decl)
- for (unsigned i = 0; i < nappend_args;
- i++, varg = TREE_CHAIN (varg))
- if (!varg || !c_omp_interop_t_p (TREE_VALUE (varg)))
- {
- error_at (DECL_SOURCE_LOCATION (variant),
- "argument %d of %qD must be of %<omp_interop_t%>",
- nbase_args + i + 1, variant);
- inform (EXPR_LOCATION (TREE_PURPOSE (append_args_list)),
- "%<append_args%> specified here");
- break;
- }
- }
+ /* Don't error unless we are fully instantiated. */
+ if (processing_template_decl)
+ return false;
+ error_at (varid_loc, "could not find variant declaration");
+ return true;
+ }
+
+ /* We should probably just error and return here if the two functions are not
+ both member functions or both free functions, but I don't want to move
+ the later error that checks for builtins ip right now. */
+ auto emit_variant_type_error = [&] ()
+ {
+ error_at (varid_loc, "variant %qD and base %qD have incompatible "
+ "types", variant, decl);
+ };
+ /* Unlike below, COMPARE_STRICT is fine here. */
+ if (!nappend_args
+ && !comptypes (TREE_TYPE (decl), TREE_TYPE (variant), COMPARE_STRICT))
+ {
+ error_at (varid_loc, "variant %qD and base %qD have incompatible "
+ "types", variant, decl);
+ return true;
+ }
+ if (nappend_args)
+ {
+ const unsigned nbase_parms = parm_info.count;
+ {
+ tree t = TREE_CHAIN (TREE_CHAIN (chain));
+ tree append_args_node = TREE_CHAIN (TREE_VALUE (t));
+ /* Add the number of parameters once we know how many there are, for
+ now just wait until we are fully instantiated to keep it simple. */
+ if (append_args_node && !processing_template_decl)
+ TREE_PURPOSE (append_args_node)
+ = build_int_cst (integer_type_node, nbase_parms);
+ }
+ /* This is where appended interop parms start, we need to remove them
+ temporarily to compare the function types. */
+ tree *const last_regular_parm_chain = [&] ()
+ {
+ if (!nbase_parms)
+ return &TYPE_ARG_TYPES (TREE_TYPE (variant));
+ /* Return a pointer to the last regular parm's chain, subtract 1 from
+ nbase_parms so we don't iterate past it. */
+ tree last_regular_parm
+ = chain_index (nbase_parms - 1,
+ TYPE_ARG_TYPES (TREE_TYPE (variant)));
+ return &TREE_CHAIN (last_regular_parm);
+ } (); /* IILE. */
+
+ /* Go past the added interop parms to find the first hidden parm, or the
+ end of the list of parms, this can be NULL_TREE or void_list_node. */
+ tree first_hidden_parm = chain_index (nappend_args,
+ *last_regular_parm_chain);
+ tree interop_parms_start = *last_regular_parm_chain;
+ *last_regular_parm_chain = first_hidden_parm;
+ /* Skip assert check that TYPE_CANONICAL is the same, use
+ COMPARE_STRUCTURAL, not COMPARE_STRICT. */
+ const bool fail = !comptypes (TREE_TYPE (decl), TREE_TYPE (variant),
+ COMPARE_STRUCTURAL);
+ /* Return the variant back to normal, even if the comparison failed. */
+ *last_regular_parm_chain = interop_parms_start;
+
if (fail)
{
- error_at (varid_loc, "variant %qD and base %qD have incompatible "
- "types", variant, decl);
- return true;
- }
- if (fndecl_built_in_p (variant)
- && (startswith (varname, "__builtin_")
- || startswith (varname, "__sync_")
- || startswith (varname, "__atomic_")))
- {
- error_at (varid_loc, "variant %qD is a built-in", variant);
+ emit_variant_type_error ();
return true;
}
- else
- {
- tree construct
- = omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
- omp_mark_declare_variant (match_loc, variant, construct);
- if (!omp_context_selector_matches (ctx, NULL_TREE, false))
- return true;
- TREE_PURPOSE (TREE_VALUE (attr)) = variant;
-
- // Prepend adjust_args list to variant attributes
- tree adjust_args_list = TREE_CHAIN (TREE_CHAIN (chain));
- if (adjust_args_list != NULL_TREE)
- {
- if (DECL_NONSTATIC_MEMBER_P (variant)
- && TREE_VALUE (adjust_args_list))
- {
- /* Shift arg position for the added 'this' pointer. */
- /* Handle need_device_ptr */
- for (tree t = TREE_PURPOSE (TREE_VALUE (adjust_args_list));
- t; t = TREE_CHAIN (t))
- TREE_VALUE (t)
- = build_int_cst (TREE_TYPE (t),
- tree_to_uhwi (TREE_VALUE (t)) + 1);
- }
- if (DECL_NONSTATIC_MEMBER_P (variant) && append_args_list)
- {
- /* Shift likewise the number of args after which the
- interop object should be added. */
- tree nargs = TREE_CHAIN (TREE_VALUE (adjust_args_list));
- TREE_PURPOSE (nargs)
- = build_int_cst (TREE_TYPE (nargs),
- tree_to_uhwi (TREE_PURPOSE (nargs)) + 1);
- }
- for (tree t = append_args_list; t; t = TREE_CHAIN (t))
- TREE_VALUE (t)
- = cp_finish_omp_init_prefer_type (TREE_VALUE (t));
- DECL_ATTRIBUTES (variant) = tree_cons (
- get_identifier ("omp declare variant variant args"),
- TREE_VALUE (adjust_args_list), DECL_ATTRIBUTES (variant));
- }
- }
+ tree interop_parm = interop_parms_start;
+ if (!processing_template_decl)
+ for (unsigned i = 0; i < nappend_args; i++)
+ {
+ if (!interop_parm
+ || !c_omp_interop_t_p (TREE_VALUE (interop_parm)))
+ {
+ error_at (DECL_SOURCE_LOCATION (variant),
+ "argument %d of %qD must be of %<omp_interop_t%>",
+ nbase_parms + i + 1, variant);
+ inform (EXPR_LOCATION (TREE_PURPOSE (append_args_list)),
+ "%<append_args%> specified here");
+ break;
+ }
+ interop_parm = TREE_CHAIN (interop_parm);
+ }
}
- else if (!processing_template_decl)
+ const char *varname = IDENTIFIER_POINTER (DECL_NAME (variant));
+ if (fndecl_built_in_p (variant)
+ && (startswith (varname, "__builtin_")
+ || startswith (varname, "__sync_")
+ || startswith (varname, "__atomic_")))
{
- error_at (varid_loc, "could not find variant declaration");
+ error_at (varid_loc, "variant %qD is a built-in", variant);
return true;
}
+ tree construct
+ = omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
+ omp_mark_declare_variant (match_loc, variant, construct);
+ if (!omp_context_selector_matches (ctx, NULL_TREE, false))
+ return true;
+ TREE_PURPOSE (TREE_VALUE (attr)) = variant;
+
+ // Prepend adjust_args list to variant attributes
+ if (adjust_args_idxs != NULL_TREE)
+ {
+ for (tree t = append_args_list; t; t = TREE_CHAIN (t))
+ TREE_VALUE (t) = cp_finish_omp_init_prefer_type (TREE_VALUE (t));
+ DECL_ATTRIBUTES (variant)
+ = tree_cons (get_identifier ("omp declare variant variant args"),
+ adjust_args_idxs, DECL_ATTRIBUTES (variant));
+ }
+
return false;
}
@@ -9188,14 +9282,23 @@ cp_finish_decl (tree decl, tree init, bool init_const_expr_p,
varpool_node::get_create (decl);
}
+ if (flag_openmp
+ && VAR_P (decl)
+ && DECL_LANG_SPECIFIC (decl)
+ && DECL_OMP_DECLARE_MAPPER_P (decl)
+ && init)
+ {
+ gcc_assert (TREE_CODE (init) == OMP_DECLARE_MAPPER);
+ DECL_INITIAL (decl) = init;
+ }
/* Convert the initializer to the type of DECL, if we have not
already initialized DECL. */
- if (!DECL_INITIALIZED_P (decl)
- /* If !DECL_EXTERNAL then DECL is being defined. In the
- case of a static data member initialized inside the
- class-specifier, there can be an initializer even if DECL
- is *not* defined. */
- && (!DECL_EXTERNAL (decl) || init))
+ else if (!DECL_INITIALIZED_P (decl)
+ /* If !DECL_EXTERNAL then DECL is being defined. In the
+ case of a static data member initialized inside the
+ class-specifier, there can be an initializer even if DECL
+ is *not* defined. */
+ && (!DECL_EXTERNAL (decl) || init))
{
cleanups = make_tree_vector ();
init = check_initializer (decl, init, flags, &cleanups);
@@ -12400,6 +12503,81 @@ create_array_type_for_decl (tree name, tree type, tree size, location_t loc)
return build_cplus_array_type (type, itype);
}
+/* Build an anonymous array of SIZE elements of ELTYPE. */
+
+static tree
+create_anon_array_type (location_t loc, tree eltype, tree size)
+{
+ if (eltype == error_mark_node || size == error_mark_node)
+ return error_mark_node;
+
+ tree itype = compute_array_index_type_loc (loc, NULL_TREE, size,
+ tf_warning_or_error);
+
+ if (type_uses_auto (eltype)
+ && variably_modified_type_p (itype, /*fn=*/NULL_TREE))
+ {
+ sorry_at (loc, "variable-length array of %<auto%>");
+ return error_mark_node;
+ }
+
+ return build_cplus_array_type (eltype, itype);
+}
+
+/* Derive an array type for an OpenMP array-shaping operator given EXPR, which
+ is an expression that might have array refs or array sections postfixed
+ (e.g. "ptr[0:3:2][3:4]"), and OMP_SHAPE_DIMS, a vector of dimensions. */
+
+tree
+cp_omp_create_arrayshape_type (location_t loc, tree expr,
+ vec<cp_expr> *omp_shape_dims)
+{
+ tree type, strip_sections = expr;
+
+ while (TREE_CODE (strip_sections) == OMP_ARRAY_SECTION
+ || TREE_CODE (strip_sections) == ARRAY_REF)
+ strip_sections = TREE_OPERAND (strip_sections, 0);
+
+ /* Determine the element type, either directly or by using
+ "decltype" of an expression representing an element to
+ figure it out later during template instantiation. */
+ if (type_dependent_expression_p (expr))
+ {
+ type = cxx_make_type (DECLTYPE_TYPE);
+
+ DECLTYPE_TYPE_EXPR (type)
+ = build_min_nt_loc (loc, INDIRECT_REF, strip_sections);
+ DECLTYPE_FOR_OMP_ARRAYSHAPE_CAST (type) = true;
+ SET_TYPE_STRUCTURAL_EQUALITY (type);
+ }
+ else
+ {
+ type = TREE_TYPE (strip_sections);
+
+ if (TREE_CODE (type) == REFERENCE_TYPE)
+ type = TREE_TYPE (type);
+
+ if (TREE_CODE (type) != POINTER_TYPE)
+ {
+ error ("OpenMP array shaping operator with non-pointer argument");
+ return error_mark_node;
+ }
+
+ type = TREE_TYPE (type);
+ }
+
+ int i;
+ cp_expr dim;
+ FOR_EACH_VEC_ELT_REVERSE (*omp_shape_dims, i, dim)
+ {
+ if (!type_dependent_expression_p (dim))
+ dim = fold_convert (sizetype, dim);
+ type = create_anon_array_type (loc, type, dim);
+ }
+
+ return type;
+}
+
/* Returns the smallest location that is not UNKNOWN_LOCATION. */
static location_t
diff --git a/gcc/cp/decl2.cc b/gcc/cp/decl2.cc
index a137e88..d019d4d 100644
--- a/gcc/cp/decl2.cc
+++ b/gcc/cp/decl2.cc
@@ -622,35 +622,39 @@ grok_array_decl (location_t loc, tree array_expr, tree index_exp,
tree
grok_omp_array_section (location_t loc, tree array_expr, tree index,
- tree length)
+ tree length, tree stride)
{
tree orig_array_expr = array_expr;
tree orig_index = index;
tree orig_length = length;
+ tree orig_stride = stride;
if (error_operand_p (array_expr)
|| error_operand_p (index)
- || error_operand_p (length))
+ || error_operand_p (length)
+ || error_operand_p (stride))
return error_mark_node;
if (processing_template_decl
&& (type_dependent_expression_p (array_expr)
|| type_dependent_expression_p (index)
- || type_dependent_expression_p (length)))
- return build_min_nt_loc (loc, OMP_ARRAY_SECTION, array_expr, index, length);
+ || type_dependent_expression_p (length)
+ || type_dependent_expression_p (stride)))
+ return build_min_nt_loc (loc, OMP_ARRAY_SECTION, array_expr, index, length, stride);
index = fold_non_dependent_expr (index);
length = fold_non_dependent_expr (length);
+ stride = fold_non_dependent_expr (stride);
/* NOTE: We can pass through invalidly-typed index/length fields
here (e.g. if the user tries to use a floating-point index/length).
This is diagnosed later in semantics.cc:handle_omp_array_sections_1. */
- tree expr = build_omp_array_section (loc, array_expr, index, length);
+ tree expr = build_omp_array_section (loc, array_expr, index, length, stride);
if (processing_template_decl)
expr = build_min_non_dep (OMP_ARRAY_SECTION, expr, orig_array_expr,
- orig_index, orig_length);
+ orig_index, orig_length, orig_stride);
return expr;
}
@@ -2834,6 +2838,7 @@ min_vis_expr_r (tree *tp, int */*walk_subtrees*/, void *data)
case REINTERPRET_CAST_EXPR:
case CONST_CAST_EXPR:
case DYNAMIC_CAST_EXPR:
+ case OMP_ARRAYSHAPE_CAST_EXPR:
case NEW_EXPR:
case CONSTRUCTOR:
case LAMBDA_EXPR:
@@ -6405,12 +6410,17 @@ mark_used (tree decl, tsubst_flags_t complain /* = tf_warning_or_error */)
/* If DECL has a deduced return type, we need to instantiate it now to
find out its type. For OpenMP user defined reductions, we need them
- instantiated for reduction clauses which inline them by hand directly. */
+ instantiated for reduction clauses which inline them by hand directly.
+ OpenMP declared mappers are used implicitly so must be instantiated
+ before they can be detected. */
if (undeduced_auto_decl (decl)
|| (VAR_P (decl)
&& VAR_HAD_UNKNOWN_BOUND (decl))
|| (TREE_CODE (decl) == FUNCTION_DECL
- && DECL_OMP_DECLARE_REDUCTION_P (decl)))
+ && DECL_OMP_DECLARE_REDUCTION_P (decl))
+ || (TREE_CODE (decl) == VAR_DECL
+ && DECL_LANG_SPECIFIC (decl)
+ && DECL_OMP_DECLARE_MAPPER_P (decl)))
maybe_instantiate_decl (decl);
if (!decl_dependent_p (decl)
diff --git a/gcc/cp/error.cc b/gcc/cp/error.cc
index 499eb1b..f9af2be 100644
--- a/gcc/cp/error.cc
+++ b/gcc/cp/error.cc
@@ -1255,12 +1255,37 @@ dump_global_iord (cxx_pretty_printer *pp, tree t)
pp_printf (pp, p, DECL_SOURCE_FILE (t));
}
+/* Write a representation of OpenMP "declare mapper" T to PP in a manner
+ suitable for error messages. */
+
+static void
+dump_omp_declare_mapper (cxx_pretty_printer *pp, tree t, int flags)
+{
+ pp_string (pp, "#pragma omp declare mapper");
+ if (t == NULL_TREE || t == error_mark_node)
+ return;
+ pp_space (pp);
+ pp_cxx_left_paren (pp);
+ if (OMP_DECLARE_MAPPER_ID (t))
+ {
+ pp_cxx_tree_identifier (pp, OMP_DECLARE_MAPPER_ID (t));
+ pp_colon (pp);
+ }
+ dump_type (pp, TREE_TYPE (t), flags);
+ pp_cxx_right_paren (pp);
+}
+
static void
dump_simple_decl (cxx_pretty_printer *pp, tree t, tree type, int flags)
{
if (VAR_P (t) && DECL_NTTP_OBJECT_P (t))
return dump_expr (pp, DECL_INITIAL (t), flags);
+ if (TREE_CODE (t) == VAR_DECL
+ && DECL_LANG_SPECIFIC (t)
+ && DECL_OMP_DECLARE_MAPPER_P (t))
+ return dump_omp_declare_mapper (pp, DECL_INITIAL (t), flags);
+
if (flags & TFF_DECL_SPECIFIERS)
{
if (concept_definition_p (t))
@@ -2594,6 +2619,11 @@ dump_expr (cxx_pretty_printer *pp, tree t, int flags)
dump_expr (pp, TREE_OPERAND (t, 1), flags);
pp_colon (pp);
dump_expr (pp, TREE_OPERAND (t, 2), flags);
+ if (TREE_OPERAND (t, 3))
+ {
+ pp_colon (pp);
+ dump_expr (pp, TREE_OPERAND (t, 3), flags);
+ }
pp_cxx_right_bracket (pp);
break;
diff --git a/gcc/cp/mangle.cc b/gcc/cp/mangle.cc
index 3d5e96b..6d0ce22 100644
--- a/gcc/cp/mangle.cc
+++ b/gcc/cp/mangle.cc
@@ -3944,6 +3944,7 @@ write_expression (tree expr)
case REINTERPRET_CAST_EXPR:
case STATIC_CAST_EXPR:
case CONST_CAST_EXPR:
+ case OMP_ARRAYSHAPE_CAST_EXPR:
write_type (TREE_TYPE (expr));
write_expression (TREE_OPERAND (expr, 0));
break;
diff --git a/gcc/cp/operators.def b/gcc/cp/operators.def
index 17601d3..e24714b 100644
--- a/gcc/cp/operators.def
+++ b/gcc/cp/operators.def
@@ -134,6 +134,7 @@ DEF_OPERATOR (NULL, DYNAMIC_CAST_EXPR, "dc", OVL_OP_FLAG_UNARY)
DEF_OPERATOR (NULL, REINTERPRET_CAST_EXPR, "rc", OVL_OP_FLAG_UNARY)
DEF_OPERATOR (NULL, CONST_CAST_EXPR, "cc", OVL_OP_FLAG_UNARY)
DEF_OPERATOR (NULL, STATIC_CAST_EXPR, "sc", OVL_OP_FLAG_UNARY)
+DEF_OPERATOR (NULL, OMP_ARRAYSHAPE_CAST_EXPR, "oc", OVL_OP_FLAG_UNARY)
DEF_OPERATOR (NULL, SCOPE_REF, "sr", OVL_OP_FLAG_NONE)
DEF_OPERATOR (NULL, EXPR_PACK_EXPANSION, "sp", OVL_OP_FLAG_NONE)
DEF_OPERATOR (NULL, UNARY_LEFT_FOLD_EXPR, "fl", OVL_OP_FLAG_NONE)
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index 3628cfe..be86252 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -2705,7 +2705,7 @@ static cp_ref_qualifier cp_parser_ref_qualifier_opt
static tree cp_parser_tx_qualifier_opt
(cp_parser *);
static tree cp_parser_late_return_type_opt
- (cp_parser *, cp_declarator *, tree &, tree);
+ (cp_parser *, cp_declarator *, tree &);
static tree cp_parser_declarator_id
(cp_parser *, bool);
static tree cp_parser_type_id
@@ -2740,7 +2740,7 @@ static void cp_parser_ctor_initializer_opt_and_function_body
(cp_parser *, bool);
static tree cp_parser_late_parsing_omp_declare_simd
- (cp_parser *, tree, tree);
+ (cp_parser *, tree);
static tree cp_parser_late_parsing_oacc_routine
(cp_parser *, tree);
@@ -4524,6 +4524,54 @@ cp_parser_require_pragma_eol (cp_parser *parser, cp_token *pragma_tok)
}
}
+/* Skip tokens up to and including "#pragma omp end declare variant".
+ Properly handle nested "#pragma omp begin declare variant" pragmas. */
+static void
+cp_parser_skip_to_pragma_omp_end_declare_variant (cp_parser *parser)
+{
+ for (int depth = 0; depth >= 0; )
+ {
+ cp_token *token = cp_lexer_peek_token (parser->lexer);
+
+ switch (token->type)
+ {
+ case CPP_PRAGMA_EOL:
+ if (!parser->lexer->in_pragma)
+ break;
+ /* FALLTHRU */
+ case CPP_EOF:
+ /* If we've run out of tokens, stop. */
+ return;
+
+ case CPP_PRAGMA:
+ if ((cp_parser_pragma_kind (token) == PRAGMA_OMP_BEGIN
+ || cp_parser_pragma_kind (token) == PRAGMA_OMP_END)
+ && cp_lexer_nth_token_is (parser->lexer, 2, CPP_NAME)
+ && cp_lexer_nth_token_is (parser->lexer, 3, CPP_NAME))
+ {
+ tree id1 = cp_lexer_peek_nth_token (parser->lexer, 2)->u.value;
+ tree id2 = cp_lexer_peek_nth_token (parser->lexer, 3)->u.value;
+ if (strcmp (IDENTIFIER_POINTER (id1), "declare") == 0
+ && strcmp (IDENTIFIER_POINTER (id2), "variant") == 0)
+ {
+ if (cp_parser_pragma_kind (token) == PRAGMA_OMP_BEGIN)
+ depth++;
+ else
+ depth--;
+ }
+ }
+ cp_parser_skip_to_pragma_eol (parser, token);
+ continue;
+
+ default:
+ break;
+ }
+
+ /* Consume the token. */
+ cp_lexer_consume_token (parser->lexer);
+ }
+}
+
/* This is a simple wrapper around make_typename_type. When the id is
an unresolved identifier node, we can provide a superior diagnostic
using cp_parser_diagnose_invalid_type_name. */
@@ -4652,6 +4700,12 @@ cp_parser_new (cp_lexer *lexer)
/* Disallow OpenMP array sections in expressions. */
parser->omp_array_section_p = false;
+ /* Disallow OpenMP array-shaping operator in expressions. */
+ parser->omp_array_shaping_op_p = false;
+
+ /* We don't have an OpenMP array shape here. */
+ parser->omp_has_array_shape_p = false;
+
/* Not declaring an implicit function template. */
parser->auto_is_implicit_function_template_parm_p = false;
parser->fully_implicit_function_template_p = false;
@@ -5659,6 +5713,7 @@ cp_parser_statement_expr (cp_parser *parser)
{
cp_token_position start = cp_parser_start_tentative_firewall (parser);
auto oas = make_temp_override (parser->omp_array_section_p, false);
+ auto aso = make_temp_override (parser->omp_array_shaping_op_p, false);
/* Consume the '('. */
location_t start_loc = cp_lexer_peek_token (parser->lexer)->location;
@@ -8722,7 +8777,7 @@ cp_parser_postfix_open_square_expression (cp_parser *parser,
&& cp_lexer_next_token_is (parser->lexer, CPP_COLON))
{
cp_lexer_consume_token (parser->lexer);
- tree length = NULL_TREE;
+ tree length = NULL_TREE, stride = NULL_TREE;
if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_SQUARE))
{
if (cxx_dialect >= cxx23)
@@ -8755,9 +8810,23 @@ cp_parser_postfix_open_square_expression (cp_parser *parser,
/*warn_comma_p=*/warn_comma_subscript);
}
+ if (cp_lexer_next_token_is (parser->lexer, CPP_COLON))
+ {
+ cp_lexer_consume_token (parser->lexer);
+ /* We could check for C++-23 multidimensional/comma-separated
+ subscripts here, or not bother. */
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_SQUARE))
+ stride
+ = cp_parser_expression (parser, NULL, /*cast_p=*/false,
+ /*decltype_p=*/false,
+ /*warn_comma_p=*/warn_comma_subscript);
+ }
+
parser->colon_corrects_to_scope_p = saved_colon_corrects_to_scope_p;
- if (index == error_mark_node || length == error_mark_node)
+ if (index == error_mark_node
+ || length == error_mark_node
+ || stride == error_mark_node)
{
cp_parser_skip_to_closing_square_bracket (parser);
return error_mark_node;
@@ -8766,7 +8835,7 @@ cp_parser_postfix_open_square_expression (cp_parser *parser,
cp_parser_require (parser, CPP_CLOSE_SQUARE, RT_CLOSE_SQUARE);
return grok_omp_array_section (input_location, postfix_expression, index,
- length);
+ length, stride);
}
parser->colon_corrects_to_scope_p = saved_colon_corrects_to_scope_p;
@@ -8774,11 +8843,23 @@ cp_parser_postfix_open_square_expression (cp_parser *parser,
/* Look for the closing `]'. */
cp_parser_require (parser, CPP_CLOSE_SQUARE, RT_CLOSE_SQUARE);
- /* Build the ARRAY_REF. */
- postfix_expression = grok_array_decl (loc, postfix_expression,
- index, &expression_list,
- tf_warning_or_error
- | (decltype_p ? tf_decltype : 0));
+ if (parser->omp_has_array_shape_p
+ && (expression_list.get () == NULL
+ || vec_safe_length (expression_list) == 1))
+ /* If we have an array-shaping operator, we may not be able to represent
+ a well-formed ARRAY_REF here, because we are coercing the type of the
+ innermost array base and the original type may not be compatible. Use
+ the OMP_ARRAY_SECTION code instead. We also want to explicitly avoid
+ creating INDIRECT_REFs for pointer bases, because that can lead to
+ parsing ambiguities (see cp_parser_omp_var_list_no_open). */
+ return grok_omp_array_section (loc, postfix_expression, index,
+ size_one_node, NULL_TREE);
+ else
+ /* Build the ARRAY_REF. */
+ postfix_expression = grok_array_decl (loc, postfix_expression,
+ index, &expression_list,
+ tf_warning_or_error
+ | (decltype_p ? tf_decltype : 0));
/* When not doing offsetof, array references are not permitted in
constant-expressions. */
@@ -9101,6 +9182,7 @@ cp_parser_parenthesized_expression_list (cp_parser* parser,
vec<tree, va_gc> *expression_list;
bool saved_greater_than_is_operator_p;
bool saved_omp_array_section_p;
+ bool saved_omp_array_shaping_op_p;
/* Assume all the expressions will be constant. */
if (non_constant_p)
@@ -9119,7 +9201,9 @@ cp_parser_parenthesized_expression_list (cp_parser* parser,
parser->greater_than_is_operator_p = true;
saved_omp_array_section_p = parser->omp_array_section_p;
+ saved_omp_array_shaping_op_p = parser->omp_array_shaping_op_p;
parser->omp_array_section_p = false;
+ parser->omp_array_shaping_op_p = false;
cp_expr expr (NULL_TREE);
@@ -9203,6 +9287,7 @@ cp_parser_parenthesized_expression_list (cp_parser* parser,
parser->greater_than_is_operator_p
= saved_greater_than_is_operator_p;
parser->omp_array_section_p = saved_omp_array_section_p;
+ parser->omp_array_shaping_op_p = saved_omp_array_shaping_op_p;
return NULL;
}
}
@@ -9210,6 +9295,7 @@ cp_parser_parenthesized_expression_list (cp_parser* parser,
parser->greater_than_is_operator_p
= saved_greater_than_is_operator_p;
parser->omp_array_section_p = saved_omp_array_section_p;
+ parser->omp_array_shaping_op_p = saved_omp_array_shaping_op_p;
return expression_list;
}
@@ -10505,6 +10591,8 @@ cp_parser_cast_expression (cp_parser *parser, bool address_p, bool cast_p,
cp_expr expr (NULL_TREE);
int cast_expression = 0;
const char *saved_message;
+ auto_vec<cp_expr, 4> omp_shape_dims;
+ bool omp_array_shape_p = false;
/* There's no way to know yet whether or not this is a cast.
For example, `(int (3))' is a unary-expression, while `(int)
@@ -10574,6 +10662,28 @@ cp_parser_cast_expression (cp_parser *parser, bool address_p, bool cast_p,
that the call to cp_parser_error_occurred below returns true. */
if (!cast_expression)
cp_parser_simulate_error (parser);
+ else if (parser->omp_array_shaping_op_p
+ && cp_lexer_next_token_is (parser->lexer, CPP_OPEN_SQUARE))
+ {
+ auto oas = make_temp_override (parser->omp_array_section_p, false);
+ auto aso = make_temp_override (parser->omp_array_shaping_op_p, false);
+
+ while (cp_lexer_next_token_is (parser->lexer, CPP_OPEN_SQUARE))
+ {
+ cp_lexer_consume_token (parser->lexer);
+ cp_expr e = cp_parser_expression (parser);
+ if (e.get_value () == error_mark_node)
+ break;
+ omp_shape_dims.safe_push (e);
+ if (!cp_parser_require (parser, CPP_CLOSE_SQUARE,
+ RT_CLOSE_SQUARE))
+ break;
+ }
+ cp_token *close_paren = parens.require_close (parser);
+ if (close_paren)
+ close_paren_loc = close_paren->location;
+ omp_array_shape_p = true;
+ }
else
{
type_id_in_expr_sentinel s (parser);
@@ -10593,6 +10703,10 @@ cp_parser_cast_expression (cp_parser *parser, bool address_p, bool cast_p,
function returning T. */
if (!cp_parser_error_occurred (parser))
{
+ auto aso = make_temp_override (parser->omp_array_shaping_op_p, false);
+ auto as = make_temp_override (parser->omp_has_array_shape_p,
+ omp_array_shape_p);
+
/* Only commit if the cast-expression doesn't start with
'++', '--', or '[' in C++11. */
if (cast_expression > 0)
@@ -10606,6 +10720,24 @@ cp_parser_cast_expression (cp_parser *parser, bool address_p, bool cast_p,
if (cp_parser_parse_definitely (parser))
{
+ if (omp_array_shape_p)
+ {
+ location_t cast_loc = make_location (open_paren_loc,
+ open_paren_loc,
+ expr.get_finish ());
+
+ type = cp_omp_create_arrayshape_type (cast_loc, expr,
+ &omp_shape_dims);
+
+ /* Things rapidly get worse below if we carry on from here
+ with an erroneous type... */
+ if (error_operand_p (type))
+ return error_mark_node;
+
+ return cp_build_omp_arrayshape_cast (cast_loc, type, expr,
+ tf_warning_or_error);
+ }
+
/* Warn about old-style casts, if so requested. */
if (warn_old_style_cast
&& !in_system_header_at (input_location)
@@ -11776,6 +11908,7 @@ cp_parser_lambda_expression (cp_parser* parser)
bool auto_is_implicit_function_template_parm_p
= parser->auto_is_implicit_function_template_parm_p;
bool saved_omp_array_section_p = parser->omp_array_section_p;
+ bool saved_omp_array_shaping_op_p = parser->omp_array_shaping_op_p;
parser->num_template_parameter_lists = 0;
parser->in_statement = 0;
@@ -11785,6 +11918,7 @@ cp_parser_lambda_expression (cp_parser* parser)
parser->implicit_template_scope = 0;
parser->auto_is_implicit_function_template_parm_p = false;
parser->omp_array_section_p = false;
+ parser->omp_array_shaping_op_p = false;
/* Inside the lambda, outside unevaluated context do not apply. */
cp_evaluated ev;
@@ -11839,6 +11973,7 @@ cp_parser_lambda_expression (cp_parser* parser)
parser->auto_is_implicit_function_template_parm_p
= auto_is_implicit_function_template_parm_p;
parser->omp_array_section_p = saved_omp_array_section_p;
+ parser->omp_array_shaping_op_p = saved_omp_array_shaping_op_p;
}
/* This lambda shouldn't have any proxies left at this point. */
@@ -23781,6 +23916,226 @@ cp_parser_maybe_adjust_declarator_for_dguide (cp_parser *parser,
}
}
+/* Helper function for OpenMP "begin declare variant" directives.
+ Function definitions inside the construct need to have their names
+ mangled according to the context selector CTX. The DECLARATOR is
+ modified in place to point to a new identifier; the original name of
+ the function is returned. */
+static tree
+omp_start_variant_function (cp_declarator *declarator, tree ctx)
+{
+ cp_declarator *id = get_id_declarator (declarator);
+ tree name = id->u.id.unqualified_name;
+ tree scope = id->u.id.qualifying_scope;
+ enum special_function_kind sfk = id->u.id.sfk;
+
+ /* There seems to be no reasonable interpretation of what the behavior
+ should be if the name is qualified. You cannot add the variant function
+ to a class or namespace from outside of that scope. */
+ if (scope)
+ {
+ sorry_at (id->id_loc,
+ "cannot handle qualified name for variant function");
+ return NULL_TREE;
+ }
+
+ /* Catch disallowed constructors and destructors now. We can't mangle
+ destructor names (which are not IDENTIFIER_NODEs) in any case. */
+ if (sfk == sfk_constructor)
+ {
+ error_at (id->id_loc,
+ "declare variant directives are not allowed on constructors");
+ return NULL_TREE;
+ }
+ if (sfk == sfk_destructor)
+ {
+ error_at (id->id_loc,
+ "declare variant directives are not allowed on destructors");
+ return NULL_TREE;
+ }
+ if (TREE_CODE (name) != IDENTIFIER_NODE)
+ {
+ sorry_at (id->id_loc,
+ "cannot handle %s identifier name",
+ get_tree_code_name (TREE_CODE (name)));
+ return NULL_TREE;
+ }
+
+ /* Mangle the name in the declarator. */
+ id->u.id.unqualified_name
+ = omp_mangle_variant_name (name, ctx, JOIN_STR);
+
+ return name;
+}
+
+/* Helper function for OpenMP "begin declare variant" directives. Now
+ that we have a DECL for the variant function, and BASE_NAME for the
+ base function, look up the decl for BASE_NAME in the same scope as
+ DECL, add an "omp declare variant base" attribute pointing at CTX
+ to the base decl, and an "omp declare variant variant" attribute to
+ the variant DECL. */
+static void
+omp_finish_variant_function (cp_parser *parser, tree decl, tree base_name,
+ tree ctx)
+{
+ tree match = NULL_TREE;
+ bool is_template = false;
+ tree decl_context = CP_DECL_CONTEXT (decl);
+
+ /* First find the base_decl. */
+ tree base_decl = cp_parser_lookup_name_simple (parser, base_name,
+ DECL_SOURCE_LOCATION (decl));
+
+ if (base_decl == error_mark_node)
+ base_decl = NULL_TREE;
+ if (!base_decl)
+ {
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "no previous declaration of base function in this scope");
+ return;
+ }
+
+ /* Find the right overloaded function. */
+ if (TREE_CODE (base_decl) == OVERLOAD)
+ {
+ for (ovl_iterator iter (base_decl); iter; ++iter)
+ {
+ tree bb = *iter;
+ if (decls_match (decl, bb))
+ {
+ match = bb;
+ break;
+ }
+ else if (TREE_CODE (bb) == TEMPLATE_DECL
+ && TREE_CODE (decl) == FUNCTION_DECL
+ && DECL_TEMPLATE_INFO (decl))
+ {
+ tree decl_template = DECL_TI_TEMPLATE (decl);
+ if (decl_template
+ && PRIMARY_TEMPLATE_P (decl_template)
+ && decls_match (bb, decl_template))
+ {
+ /* We want to put the attributes on the function rather
+ than on the TEMPLATE_DECL that points to it. */
+ match = DECL_TEMPLATE_RESULT (bb);
+ is_template = true;
+ break;
+ }
+ }
+ }
+ }
+ else if (decls_match (decl, base_decl))
+ match = base_decl;
+ else if (TREE_CODE (base_decl) == TEMPLATE_DECL)
+ /* Per comment in cp-tree.h, TEMPLATE_DECLs are always wrapped in an
+ OVERLOAD, so we should never see them here. */
+ gcc_unreachable ();
+ else if (TREE_CODE (base_decl) == TREE_LIST)
+ {
+ error_at (DECL_SOURCE_LOCATION (decl), "base function is ambiguous");
+ return;
+ }
+ else if (TREE_CODE (base_decl) == SCOPE_REF)
+ {
+ /* This shows up in some cases involving templates; it's apparently a
+ placeholder for names that can't be matched to a declaration
+ until template instantiation. */
+ sorry_at (DECL_SOURCE_LOCATION (decl),
+ "base function cannot be resolved");
+ return;
+ }
+
+ if (!match)
+ {
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "variant function definition does not match previous "
+ "declaration of %qE", base_decl);
+ return;
+ }
+ else if (CP_DECL_CONTEXT (match) != decl_context)
+ {
+ /* Reject inherited or using decls. */
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "variant function must be in the same scope as the "
+ "base function %qE", match);
+ return;
+ }
+ else if (DECL_VIRTUAL_P (decl) || DECL_VIRTUAL_P (match))
+ {
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "declare variant directives are not allowed on "
+ "virtual functions");
+ return;
+ }
+ else if (DECL_DEFAULTED_FN (decl) || DECL_DEFAULTED_FN (match))
+ {
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "declare variant directives are not allowed on "
+ "defaulted functions");
+ return;
+ }
+ else if (DECL_DELETED_FN (decl) || DECL_DELETED_FN (match))
+ {
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "declare variant directives are not allowed on "
+ "deleted functions");
+ return;
+ }
+ else if (DECL_IMMEDIATE_FUNCTION_P (decl)
+ || DECL_IMMEDIATE_FUNCTION_P (match))
+ {
+ error_at (DECL_SOURCE_LOCATION (decl),
+ "declare variant directives are not allowed on "
+ "immediate functions");
+ return;
+ }
+
+ /* Inside a template, make the "omp declare variant base" attribute
+ point to the name of DECL rather than DECL itself. During template
+ instantiation, omp_declare_variant_finalize_one will handle this
+ using the same logic as for the non-delimited form of "declare variant",
+ causing template instantiation as needed. For the non-template case,
+ there is nothing that will trigger omp_declare_variant_finalize_one;
+ so we create the final form of the attribute here, which points
+ directly to DECL rather than its name. */
+ tree decl_or_name = decl;
+ cp_id_kind idk = CP_ID_KIND_NONE;
+ if (processing_template_decl && is_template)
+ {
+ decl_or_name = DECL_NAME (decl);
+ idk = CP_ID_KIND_TEMPLATE_ID;
+ }
+
+ omp_check_for_duplicate_variant (DECL_SOURCE_LOCATION (decl),
+ match, ctx);
+ tree construct
+ = omp_get_context_selector_list (ctx, OMP_TRAIT_SET_CONSTRUCT);
+ omp_mark_declare_variant (DECL_SOURCE_LOCATION (decl), decl, construct);
+
+ tree attrs = DECL_ATTRIBUTES (match);
+ tree match_loc_node
+ = maybe_wrap_with_location (integer_zero_node,
+ DECL_SOURCE_LOCATION (match));
+ tree loc_node = tree_cons (match_loc_node,
+ build_int_cst (integer_type_node, idk),
+ build_tree_list (match_loc_node,
+ integer_zero_node));
+ attrs = tree_cons (get_identifier ("omp declare variant base"),
+ tree_cons (decl_or_name, ctx, loc_node), attrs);
+ if (processing_template_decl)
+ ATTR_IS_DEPENDENT (attrs) = 1;
+ DECL_ATTRIBUTES (match) = attrs;
+
+ /* Variant functions are essentially anonymous and cannot be
+ referenced by name, so make them have internal linkage. Note
+ that class methods in C++ normally have external linkage with
+ weak/comdat semantics; this prevents that. */
+ TREE_PUBLIC (decl) = 0;
+ DECL_COMDAT (decl) = 0;
+ DECL_INTERFACE_KNOWN (decl) = 1;
+ DECL_NOT_REALLY_EXTERN (decl) = 1;
+}
+
/* Declarators [gram.dcl.decl] */
/* Parse an init-declarator.
@@ -23997,6 +24352,27 @@ cp_parser_init_declarator (cp_parser* parser,
/* This is a function-definition. */
*function_definition_p = true;
+ /* If we're in an OpenMP "begin declare variant" block, the
+ name in the declarator refers to the base function. We need
+ to save that and modify the declarator to have the mangled
+ name for the variant function instead. */
+ tree dv_base = NULL_TREE;
+ tree dv_ctx = NULL_TREE;
+ vec<cp_omp_declare_variant_attr, va_gc> *dv_state
+ = scope_chain->omp_declare_variant_attribute;
+
+ if (!vec_safe_is_empty (dv_state))
+ {
+ cp_omp_declare_variant_attr a = dv_state->last ();
+ dv_ctx = copy_list (a.selector);
+ dv_base = omp_start_variant_function (declarator, dv_ctx);
+ if (dv_base == NULL_TREE)
+ {
+ cp_parser_skip_to_end_of_statement (parser);
+ return error_mark_node;
+ }
+ }
+
/* Parse the function definition. */
if (member_p)
decl = cp_parser_save_member_function_body (parser,
@@ -24015,6 +24391,11 @@ cp_parser_init_declarator (cp_parser* parser,
= func_brace_location;
}
+ /* If this function was in a "begin declare variant" block,
+ store the pointer back to the base function and fix up
+ the attributes for the middle end. */
+ if (dv_base && decl != error_mark_node)
+ omp_finish_variant_function (parser, decl, dv_base, dv_ctx);
return decl;
}
}
@@ -24092,6 +24473,27 @@ cp_parser_init_declarator (cp_parser* parser,
is_initialized = SD_DEFAULTED;
else if (t2->keyword == RID_DELETE)
is_initialized = SD_DELETED;
+ if (!vec_safe_is_empty (scope_chain->omp_declare_variant_attribute))
+ {
+ /* We're in a "begin declare variant" construct. The parser
+ doesn't go through the normal function definition path for
+ these and hence doesn't invoke omp_finish_variant_function
+ where these errors would otherwise be caught. */
+ if (is_initialized == SD_DEFAULTED)
+ {
+ error_at (declarator->init_loc,
+ "declare variant directives are not allowed on "
+ "defaulted functions");
+ return error_mark_node;
+ }
+ else if (is_initialized == SD_DELETED)
+ {
+ error_at (declarator->init_loc,
+ "declare variant directives are not allowed on "
+ "deleted functions");
+ return error_mark_node;
+ }
+ }
}
}
else
@@ -24664,7 +25066,7 @@ cp_parser_direct_declarator (cp_parser* parser,
tree requires_clause = NULL_TREE;
late_return
= cp_parser_late_return_type_opt (parser, declarator,
- requires_clause, params);
+ requires_clause);
cp_finalize_omp_declare_simd (parser, &odsd);
@@ -25530,7 +25932,7 @@ parsing_function_declarator ()
static tree
cp_parser_late_return_type_opt (cp_parser *parser, cp_declarator *declarator,
- tree &requires_clause, tree parms)
+ tree &requires_clause)
{
cp_token *token;
tree type = NULL_TREE;
@@ -25586,8 +25988,8 @@ cp_parser_late_return_type_opt (cp_parser *parser, cp_declarator *declarator,
if (declare_simd_p)
declarator->attributes
- = cp_parser_late_parsing_omp_declare_simd (parser, declarator->attributes,
- parms);
+ = cp_parser_late_parsing_omp_declare_simd (parser,
+ declarator->attributes);
if (oacc_routine_p)
declarator->attributes
= cp_parser_late_parsing_oacc_routine (parser,
@@ -26892,6 +27294,7 @@ cp_parser_braced_list (cp_parser *parser, bool *non_constant_p /*=nullptr*/)
tree initializer;
location_t start_loc = cp_lexer_peek_token (parser->lexer)->location;
auto oas = make_temp_override (parser->omp_array_section_p, false);
+ auto aso = make_temp_override (parser->omp_array_shaping_op_p, false);
/* Consume the `{' token. */
matching_braces braces;
@@ -27565,6 +27968,10 @@ cp_parser_class_specifier (cp_parser* parser)
tree saved_ccr = current_class_ref;
current_class_ptr = NULL_TREE;
current_class_ref = NULL_TREE;
+ /* Set up for deferred lookup of "omp begin declare variant" base functions
+ in the class. */
+ tree save_unregistered_variants = parser->omp_unregistered_variants;
+ parser->omp_unregistered_variants = NULL_TREE;
/* Start the class. */
if (nested_name_specifier_p)
@@ -27586,6 +27993,19 @@ cp_parser_class_specifier (cp_parser* parser)
/* Parse the member-specification. */
cp_parser_member_specification_opt (parser);
+ /* Register any "begin declare variant" functions in this class, since
+ references to the base function can only be resolved after the
+ entire class is seen. */
+ for (tree bdv = parser->omp_unregistered_variants; bdv;
+ bdv = TREE_CHAIN (bdv))
+ {
+ tree dv_base = TREE_PURPOSE (TREE_PURPOSE (bdv));
+ tree dv_ctx = TREE_VALUE (TREE_PURPOSE (bdv));
+ tree dv_decl = TREE_VALUE (bdv);
+ omp_finish_variant_function (parser, dv_decl, dv_base, dv_ctx);
+ }
+ parser->omp_unregistered_variants = save_unregistered_variants;
+
/* Look for the trailing `}'. */
closing_brace = braces.require_close (parser);
/* Look for trailing attributes to apply to this class. */
@@ -29248,6 +29668,28 @@ cp_parser_member_declaration (cp_parser* parser)
if (initializer && initializer_token_start)
error_at (initializer_token_start->location,
"pure-specifier on function-definition");
+
+ /* If we're in an OpenMP "begin declare variant" block,
+ the name in the declarator refers to the base function.
+ We need to save that and modify the declarator to have
+ the mangled name for the variant function instead. */
+ tree dv_base = NULL_TREE;
+ tree dv_ctx = NULL_TREE;
+ vec<cp_omp_declare_variant_attr, va_gc> *dv_state
+ = scope_chain->omp_declare_variant_attribute;
+ if (!vec_safe_is_empty (dv_state))
+ {
+ cp_omp_declare_variant_attr a = dv_state->last ();
+ dv_ctx = copy_list (a.selector);
+ dv_base = omp_start_variant_function (declarator,
+ dv_ctx);
+ if (dv_base == NULL_TREE)
+ {
+ cp_parser_skip_to_end_of_statement (parser);
+ goto out;
+ }
+ }
+
decl = cp_parser_save_member_function_body (parser,
&decl_specifiers,
declarator,
@@ -29258,6 +29700,19 @@ cp_parser_member_declaration (cp_parser* parser)
/* If the member was not a friend, declare it here. */
if (!friend_p)
finish_member_declaration (decl);
+
+ /* If this function was in a "begin declare variant"
+ block, record the information we need to find the
+ base function and fix it up later. At this point in
+ parsing, we may not have seen the base function yet
+ so we defer looking it up and registering the variant
+ until the class is complete. */
+ if (dv_base && decl != error_mark_node)
+ parser->omp_unregistered_variants
+ = tree_cons (tree_cons (dv_base, dv_ctx, NULL_TREE),
+ decl,
+ parser->omp_unregistered_variants);
+
/* Peek at the next token. */
token = cp_lexer_peek_token (parser->lexer);
/* If the next token is a semicolon, consume it. */
@@ -38927,6 +39382,8 @@ cp_parser_omp_clause_name (cp_parser *parser)
result = PRAGMA_OMP_CLAUSE_USE_DEVICE_ADDR;
else if (!strcmp ("use_device_ptr", p))
result = PRAGMA_OMP_CLAUSE_USE_DEVICE_PTR;
+ else if (!strcmp ("uses_allocators", p))
+ result = PRAGMA_OMP_CLAUSE_USES_ALLOCATORS;
break;
case 'v':
if (!strcmp ("vector", p))
@@ -38983,16 +39440,17 @@ check_no_duplicate_clause (tree clauses, enum omp_clause_code code,
struct omp_dim
{
- tree low_bound, length;
+ tree low_bound, length, stride;
location_t loc;
bool no_colon;
- omp_dim (tree lb, tree len, location_t lo, bool nc)
- : low_bound (lb), length (len), loc (lo), no_colon (nc) {}
+ omp_dim (tree lb, tree len, tree str, location_t lo, bool nc)
+ : low_bound (lb), length (len), stride (str), loc (lo), no_colon (nc) {}
};
static tree
cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
tree list, bool *colon,
+ enum c_omp_region_type ort = C_ORT_OMP,
bool map_lvalue = false)
{
auto_vec<omp_dim> dims;
@@ -39019,10 +39477,23 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
|| kind == OMP_CLAUSE_FROM))
{
auto s = make_temp_override (parser->omp_array_section_p, true);
+ auto o = make_temp_override (parser->omp_array_shaping_op_p,
+ (kind == OMP_CLAUSE_TO
+ || kind == OMP_CLAUSE_FROM
+ || ort == C_ORT_OMP_DECLARE_MAPPER));
+ tree reshaped_to = NULL_TREE;
token = cp_lexer_peek_token (parser->lexer);
location_t loc = token->location;
decl = cp_parser_assignment_expression (parser);
+ if ((TREE_CODE (decl) == VIEW_CONVERT_EXPR
+ && TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
+ || TREE_CODE (decl) == OMP_ARRAYSHAPE_CAST_EXPR)
+ {
+ reshaped_to = TREE_TYPE (decl);
+ decl = TREE_OPERAND (decl, 0);
+ }
+
/* This code rewrites a parsed expression containing various tree
codes used to represent array accesses into a more uniform nest of
OMP_ARRAY_SECTION nodes before it is processed by
@@ -39033,49 +39504,159 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
dims.truncate (0);
if (TREE_CODE (decl) == OMP_ARRAY_SECTION)
{
+ size_t sections = 0;
+ tree orig_decl = decl;
+ bool update_p = (kind == OMP_CLAUSE_TO
+ || kind == OMP_CLAUSE_FROM);
+ bool maybe_ptr_based_noncontig_update = false;
+
+ while (update_p
+ && !reshaped_to
+ && (TREE_CODE (decl) == OMP_ARRAY_SECTION
+ || TREE_CODE (decl) == ARRAY_REF
+ || TREE_CODE (decl) == COMPOUND_EXPR))
+ {
+ if (TREE_CODE (decl) == COMPOUND_EXPR)
+ decl = TREE_OPERAND (decl, 1);
+ else
+ {
+ if (TREE_CODE (decl) == OMP_ARRAY_SECTION)
+ maybe_ptr_based_noncontig_update = true;
+ decl = TREE_OPERAND (decl, 0);
+ sections++;
+ }
+ }
+
+ decl = orig_decl;
+
while (TREE_CODE (decl) == OMP_ARRAY_SECTION)
{
tree low_bound = TREE_OPERAND (decl, 1);
tree length = TREE_OPERAND (decl, 2);
- dims.safe_push (omp_dim (low_bound, length, loc, false));
+ tree stride = TREE_OPERAND (decl, 3);
+ dims.safe_push (omp_dim (low_bound, length, stride, loc,
+ false));
decl = TREE_OPERAND (decl, 0);
+ if (sections > 0)
+ sections--;
}
+ /* The handling of INDIRECT_REF here in the presence of
+ array-shaping operations is a little tricky. We need to
+ avoid treating a pointer dereference as a unit-sized array
+ section when we have an array shaping operation, because we
+ don't want an indirection to consume one of the user's
+ requested array dimensions. E.g. if we have a
+ double-indirect pointer like:
+
+ int **foopp;
+ #pragma omp target update from(([N][N]) (*foopp)[0:X][0:Y])
+
+ We don't want to interpret this as:
+
+ foopp[0:1][0:X][0:Y]
+
+ else the array shape [N][N] won't match. Also we can't match
+ the array sections right-to-left instead, else this:
+
+ #pragma omp target update from(([N][N]) (*foopp)[0:X])
+
+ would not copy the dimensions:
+
+ (*foopp)[0:X][0:N]
+
+ as required. So, avoid descending through INDIRECT_REFs if
+ we have an array-shaping op.
+
+ If we *don't* have an array-shaping op, but we have a
+ multiply-indirected pointer and an array section like this:
+
+ int ***fooppp;
+ #pragma omp target update from((**fooppp)[0:X:S]
+
+ also avoid descending through more indirections than we have
+ array sections, since the noncontiguous update processing code
+ won't understand them (and doesn't need to traverse them
+ anyway). */
+
while (TREE_CODE (decl) == ARRAY_REF
- || TREE_CODE (decl) == INDIRECT_REF
+ || (TREE_CODE (decl) == INDIRECT_REF
+ && !reshaped_to)
|| TREE_CODE (decl) == COMPOUND_EXPR)
{
if (REFERENCE_REF_P (decl))
break;
+ if (maybe_ptr_based_noncontig_update && sections == 0)
+ break;
+
if (TREE_CODE (decl) == COMPOUND_EXPR)
{
decl = TREE_OPERAND (decl, 1);
STRIP_NOPS (decl);
+ continue;
}
- else if (TREE_CODE (decl) == INDIRECT_REF)
+ else if (TREE_CODE (decl) == INDIRECT_REF
+ && !reshaped_to)
{
dims.safe_push (omp_dim (integer_zero_node,
- integer_one_node, loc, true));
+ integer_one_node, NULL_TREE, loc,
+ true));
decl = TREE_OPERAND (decl, 0);
}
else /* ARRAY_REF. */
{
tree index = TREE_OPERAND (decl, 1);
- dims.safe_push (omp_dim (index, integer_one_node, loc,
- true));
+ dims.safe_push (omp_dim (index, integer_one_node,
+ NULL_TREE, loc, true));
decl = TREE_OPERAND (decl, 0);
+ if (sections > 0)
+ sections--;
}
}
+ if (reshaped_to)
+ {
+ unsigned reshaped_dims = 0;
+
+ for (tree t = reshaped_to;
+ TREE_CODE (t) == ARRAY_TYPE;
+ t = TREE_TYPE (t))
+ reshaped_dims++;
+
+ if (dims.length () > reshaped_dims)
+ {
+ error_at (loc, "too many array section specifiers "
+ "for %qT", reshaped_to);
+ decl = error_mark_node;
+ }
+ else
+ {
+ /* We have a pointer DECL whose target should be
+ interpreted as an array with particular dimensions,
+ not "the pointer itself". So, add an indirection
+ here. */
+ if (type_dependent_expression_p (decl))
+ decl = build_min_nt_loc (loc, INDIRECT_REF, decl);
+ else
+ {
+ /* We're interested in the reference target. */
+ decl = convert_from_reference (decl);
+ decl = cp_build_fold_indirect_ref (decl);
+ }
+ decl
+ = cp_build_omp_arrayshape_cast (loc, reshaped_to, decl,
+ tf_warning_or_error);
+ }
+ }
/* Bare references have their own special handling, so remove
the explicit dereference added by convert_from_reference. */
- if (REFERENCE_REF_P (decl))
+ else if (REFERENCE_REF_P (decl))
decl = TREE_OPERAND (decl, 0);
for (int i = dims.length () - 1; i >= 0; i--)
decl = grok_omp_array_section (loc, decl, dims[i].low_bound,
- dims[i].length);
+ dims[i].length, dims[i].stride);
}
else if (TREE_CODE (decl) == INDIRECT_REF)
{
@@ -39091,7 +39672,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
if (!ref_p)
decl = grok_omp_array_section (loc, decl, integer_zero_node,
- integer_one_node);
+ integer_one_node, NULL_TREE);
}
else if (TREE_CODE (decl) == ARRAY_REF)
{
@@ -39100,7 +39681,16 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
decl = TREE_OPERAND (decl, 0);
STRIP_NOPS (decl);
- decl = grok_omp_array_section (loc, decl, idx, integer_one_node);
+ decl = grok_omp_array_section (loc, decl, idx, integer_one_node,
+ NULL_TREE);
+ }
+ else if (reshaped_to)
+ {
+ /* We're copying the whole of a reshaped array, originally a
+ base pointer. Rewrite as an array section. */
+ tree elems = array_type_nelts_total (reshaped_to);
+ decl = grok_omp_array_section (loc, decl, size_zero_node, elems,
+ NULL_TREE);
}
else if (TREE_CODE (decl) == NON_LVALUE_EXPR
|| CONVERT_EXPR_P (decl))
@@ -39264,7 +39854,8 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
goto skip_comma;
}
- dims.safe_push (omp_dim (low_bound, length, loc, no_colon));
+ dims.safe_push (omp_dim (low_bound, length, NULL_TREE, loc,
+ no_colon));
}
if ((kind == OMP_CLAUSE_MAP
@@ -39286,7 +39877,8 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
for (unsigned i = 0; i < dims.length (); i++)
decl = build_omp_array_section (input_location, decl,
dims[i].low_bound,
- dims[i].length);
+ dims[i].length,
+ dims[i].stride);
break;
default:
break;
@@ -39299,6 +39891,8 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
&& cp_parser_simulate_error (parser))
{
depend_lvalue:
+ auto o = make_temp_override (parser->omp_array_shaping_op_p,
+ true);
cp_parser_abort_tentative_parse (parser);
decl = cp_parser_assignment_expression (parser, NULL,
false, false);
@@ -39357,6 +39951,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
static tree
cp_parser_omp_var_list (cp_parser *parser, enum omp_clause_code kind, tree list,
+ enum c_omp_region_type ort = C_ORT_OMP,
bool map_lvalue = false)
{
if (parser->lexer->in_omp_decl_attribute)
@@ -39375,11 +39970,422 @@ cp_parser_omp_var_list (cp_parser *parser, enum omp_clause_code kind, tree list,
}
if (cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
- return cp_parser_omp_var_list_no_open (parser, kind, list, NULL,
+ return cp_parser_omp_var_list_no_open (parser, kind, list, NULL, ort,
map_lvalue);
return list;
}
+/* Parse an OpenMP parameter-list.
+ parameter-list:
+ parameter-list-item[, parameter-list-item [, ...]]
+
+ parameter-list-item:
+ named parameter list item
+ parameter index (1 based)
+ numeric-range
+
+ numeric-range:
+ [bound]:[bound]
+
+ bound:
+ index-expr
+ omp_num_args[±logical_offset]
+
+ A named parameter list item is the name of a parameter. A parameter index
+ is a positive integer literal that is the 1 based index of a parameter.
+ A numeric-range is a pair of bounds of the form lb:ub, the values of each
+ bound form a closed interval of parameter indices. Bounds can be literal or
+ relative. An index-expr is a non-negative integer constant-expression that
+ is the value of a literal bound. The special identifier omp_num_args is
+ equal to the number of arguments passed to the function at the call site,
+ including the number of varargs. Optionally, a plus or minus with a
+ logical_offset may follow omp_num_args, logical_offset is a non-negative
+ integer constant-expression. A bound formed with omp_num_args is a relative
+ bound. If a bound is omitted, a default value is used. The default value
+ of lb is as if 1 were specified, the default value of ub is as if
+ omp_num_args were specified.
+
+ Each parameter-list-item is stored in a TREE_LIST. The PURPOSE is for
+ general use and left NULL_TREE here, and the item is stored in the VALUE.
+ An item is a TREE_LIST, the PURPOSE is an expression with the location of
+ the list item, and the VALUE is a representation of the item.
+ Each parameter-list-item is stored in a TREE_LIST node VALUE. The PURPOSE
+ is unused, and the VALUE is the item-repr.
+
+ Node - PUPOSE: NULL_TREE
+ - VALUE: item-with-location
+ item-with-location - PURPOSE: expr-with-location
+ - VALUE: item-repr
+
+ An item-repr is a PARM_DECL, a NOP_EXPR, or a TREE_LIST. A PARM_DECL is a
+ named parameter list item. A NOP_EXPR is the unadjusted 1-based parameter
+ index. A TREE_LIST is a numeric-range where its PURPOSE is a TREE_LIST
+ representing the lb, and its VALUE is a TREE_LIST representing the ub.
+
+ item-repr
+ PARM_DECL - parameter name
+ NOP_EXPR - parameter index (1 based)
+ TREE_LIST - PURPOSE: TREE_LIST (lb)
+ - VALUE: TREE_LIST (ub)
+
+ lb and ub are a TREE_LIST of the following form;
+ TREE_LIST - PURPOSE: relative bound marker (NULL_TREE if literal)
+ - VALUE: expr-value
+
+ This function strictly handles a parameter-list, it does not parse clause
+ modifiers, or parenthesis other than in the expr of a numeric range.
+
+ If a diagnostic is issued for a list item, it is not appened to the list and
+ parsing continues. Returns NULL_TREE if no valid list items are parsed. */
+
+static tree
+cp_parser_omp_parm_list (cp_parser *parser)
+{
+ tree list = NULL_TREE;
+ auto append_to_list = [chain = &list] (tree arg, location_t loc) mutable
+ {
+ gcc_assert (*chain == NULL_TREE);
+ *chain = build_tree_list (NULL_TREE,
+ build_tree_list (build_empty_stmt (loc), arg));
+ chain = &TREE_CHAIN (*chain);
+ };
+
+ auto tok_terminates_item_p = [] (const cp_token *tok)
+ {
+ return tok->type == CPP_COMMA
+ || tok->type == CPP_CLOSE_PAREN;
+ };
+ /* The first list item is (obviously) not preceded by a comma. */
+ goto first_element;
+ do
+ {
+ /* Consume the comma. */
+ cp_lexer_consume_token (parser->lexer);
+ first_element:
+
+ cp_token *const tok = cp_lexer_peek_token (parser->lexer);
+
+ /* OpenMP 6.0 (162:29-34)
+ A parameter list item can be one of the following:
+ • A named parameter list item;
+ • The position of a parameter in a parameter specification specified
+ by a positive integer, where 1 represents the first parameter; or
+ • A parameter range specified by lb : ub where both lb and ub must
+ be an expression of integer OpenMP type with the constant property
+ and the positive property.
+
+ The spec does not support arbitrary expression outside of a numeric
+ range. In theory they could be supported as a parameter index, but
+ for now we do not support that case. */
+
+ /* If we don't see a comma or close paren this can't be a named parameter
+ list item or a parameter index, it can only be a numeric range. */
+ if (!tok_terminates_item_p (cp_lexer_peek_nth_token (parser->lexer, 2))
+ /* Or this edge case, there is a default lower bound. */
+ || tok->type == CPP_COLON)
+ /* Early exit, numeric range case handled below. */;
+ else if (tok->type == CPP_NAME)
+ {
+ if (strcmp (IDENTIFIER_POINTER (tok->u.value), "omp_num_args") == 0)
+ {
+ error_at (tok->location, "%<omp_num_args%> may only be used at "
+ "the start of a numeric range bound");
+ cp_lexer_consume_token (parser->lexer);
+ continue;
+ }
+ /* This might not be the right way to do this, we might want to use
+ cp_parser_lookup_name_simple instead. */
+ tree parm = lookup_name (tok->u.value,
+ LOOK_where::BLOCK,
+ LOOK_want::NORMAL);
+ if (parm && TREE_CODE (parm) == PARM_DECL)
+ {
+ if (DECL_PACK_P (parm))
+ {
+ /* In theory we could just consider every element of the pack
+ as being specified, the spec does not say what to do
+ though. */
+ sorry_at (tok->location,
+ "parameter packs are not supported as an OpenMP "
+ "named parameter list item");
+ inform (DECL_SOURCE_LOCATION (parm),
+ "declared as a pack here");
+ }
+ else
+ append_to_list (parm, tok->location);
+ }
+ else
+ {
+ /* FIXME: Nice diagnostic, potentially using
+ cp_parser_name_lookup_error. */
+ error_at (tok->location,
+ "%qs is not a function parameter",
+ IDENTIFIER_POINTER (tok->u.value));
+ }
+ cp_lexer_consume_token (parser->lexer);
+ continue;
+ }
+ else if (tok->type == CPP_NUMBER)
+ {
+ if (wi::to_widest (tok->u.value) <= 0)
+ {
+ error_at (tok->location,
+ "parameter indices in an OpenMP "
+ "parameter list must be positive");
+ }
+ else if (wi::to_widest (tok->u.value) > INT_MAX)
+ error_at (tok->location, "parameter index is too big");
+ else
+ {
+ /* Don't adjust here, we can't finalize these until we know if we
+ are in a member function or not. We can probably hack this to
+ find out in here, but it belongs in finish_omp_parm_list, not
+ here.
+ FIXME: We have to come up with a better way of transporting
+ these and marking them as unfinalized. Wrapping in a NOP is
+ really quite bad. */
+ tree cst = build_int_cst (integer_type_node,
+ tree_to_shwi (tok->u.value));
+ append_to_list (build_nop (integer_type_node, cst),
+ tok->location);
+ }
+ cp_lexer_consume_token (parser->lexer);
+ continue;
+ }
+ else
+ {
+ gcc_checking_assert (tok_terminates_item_p
+ (cp_lexer_peek_nth_token (parser->lexer, 2)));
+ cp_parser_error (parser, "expected unqualified-id, "
+ "integer, or expression");
+ cp_lexer_consume_token (parser->lexer);
+ continue;
+ }
+ /* We have a numeric range or something ill formed now, this can be
+ an arbitrary expression. */
+
+ /* Empty bounds are delimited differently for lower and upper bounds,
+ handle them without calling parse_bound. */
+ auto parse_bound = [&] () -> tree
+ {
+ location_t bound_start
+ = cp_lexer_peek_token (parser->lexer)->location;
+ enum omp_num_args
+ {
+ num_args_none,
+ num_args_plus,
+ num_args_minus,
+ num_args_no_offset
+ };
+ /* (OpenMP 6.0, 162:35-37)
+ In both lb and ub, an expression using omp_num_args, that enables
+ identification of parameters relative to the last argument of the
+ call, can be used with the form:
+ omp_num_args [± logical_offset] */
+ const omp_num_args parsed_omp_num_args = [&] ()
+ {
+ cp_token *tok = cp_lexer_peek_token (parser->lexer);
+ if (tok->type == CPP_NAME
+ && strcmp (IDENTIFIER_POINTER (tok->u.value), "omp_num_args")
+ == 0)
+ {
+ /* Consume omp_num_args. */
+ cp_lexer_consume_token (parser->lexer);
+ cp_token *op_tok = cp_lexer_peek_token (parser->lexer);
+ if (op_tok->type == CPP_PLUS)
+ {
+ cp_lexer_consume_token (parser->lexer);
+ return num_args_plus;
+ }
+ else if (op_tok->type == CPP_MINUS)
+ {
+ cp_lexer_consume_token (parser->lexer);
+ return num_args_minus;
+ }
+ return num_args_no_offset;
+ }
+ else
+ return num_args_none;
+ } (); /* IILE. */
+ /* If there was omp_num_args but no operator an expr is not
+ permitted, we are finished with this bound. */
+ if (parsed_omp_num_args == num_args_no_offset)
+ {
+ tree cst = build_zero_cst (integer_type_node);
+ /* I hate this hack. We don't know if we are parsing a lb or ub,
+ so even though we know it's value we have to wait until later
+ to finalize it. */
+ return build_tree_list (get_identifier ("omp num args plus"),
+ build1_loc (bound_start,
+ NOP_EXPR,
+ integer_type_node,
+ cst));
+ }
+ const bool saved_flag = parser->colon_corrects_to_scope_p;
+ /* Disable this diagnostic to parse id:id cases such as
+ 'V:omp_num_args' where V is a constant expression variable. */
+ parser->colon_corrects_to_scope_p = false;
+ /* Function arguments are considered an assignment-expression by the
+ C++ standard, it seems to me that those semantics match what we
+ want from an expr in lb or ub. */
+ cp_expr expr = cp_parser_assignment_expression (parser);
+ parser->colon_corrects_to_scope_p = saved_flag;
+
+ if (!expr || expr == error_mark_node)
+ return error_mark_node;
+
+ auto finish_bound_expr = [&parsed_omp_num_args] (cp_expr expr_in)
+ {
+ const location_t loc = expr_in.get_location ();
+ tree expr = expr_in.get_value ();
+ /* Try to fold early if expr is not dependent. I'm pretty sure
+ this should be manifestly constant-evaluated. We require a
+ constant here, let fold_non_dependent_expr complain, but
+ handle everything else in finish_omp_parm_list. */
+ if (!value_dependent_expression_p (expr))
+ {
+ expr = fold_non_dependent_expr (expr,
+ tf_warning_or_error,
+ true);
+ if (!expr || error_operand_p (expr))
+ {
+ if (parsed_omp_num_args != num_args_none)
+ error_at (loc, "logical offset of a bound must "
+ "be a constant expression");
+ else
+ error_at (loc, "expression of a bound must be a "
+ "constant expression");
+ return error_mark_node;
+ }
+ }
+ /* We need a way to signal that an expr has not been adjusted,
+ the best way I came up with is checking if it is an
+ INTEGER_CST, but if we already have an INTEGER_CST at this
+ point, what now? Wrap it in a nop, that's what. */
+ if (TREE_CODE (expr) == INTEGER_CST)
+ return build1_loc (loc, NOP_EXPR, TREE_TYPE (expr), expr);
+ /* We still need this for things like template parameters. */
+ auto maybe_force_wrap_with_location = [&] ()
+ {
+ if (!expr
+ || error_operand_p (expr)
+ || CAN_HAVE_LOCATION_P (expr))
+ return expr;
+ /* Pulled from maybe_wrap_with_location. */
+ const tree_code code
+ = ((CONSTANT_CLASS_P (expr)
+ && TREE_CODE (expr) != STRING_CST)
+ || (TREE_CODE (expr) == CONST_DECL
+ && !TREE_STATIC (expr)))
+ ? NON_LVALUE_EXPR : VIEW_CONVERT_EXPR;
+ tree wrap = build1_loc (loc, code, TREE_TYPE (expr), expr);
+ EXPR_LOCATION_WRAPPER_P (wrap) = 1;
+ return wrap;
+ };
+ return maybe_force_wrap_with_location ();
+ };
+
+ gcc_assert (parsed_omp_num_args < num_args_no_offset);
+ switch (parsed_omp_num_args)
+ {
+ case num_args_none:
+ /* NULL_TREE represents literal. */
+ return build_tree_list (NULL_TREE,
+ finish_bound_expr (expr));
+ case num_args_plus:
+ return build_tree_list (get_identifier ("omp num args plus"),
+ finish_bound_expr (expr));
+ case num_args_minus:
+ return build_tree_list (get_identifier ("omp num args minus"),
+ finish_bound_expr (expr));
+ case num_args_no_offset:
+ /* Handled above. */
+ default:
+ gcc_unreachable ();
+ }
+ gcc_unreachable ();
+ };
+ /* I'm not happy with the state of diagnostics here, but I'm not sure how
+ to fix it so it's best to wait to see which cases end up giving really
+ unclear errors. */
+ location_t num_range_loc_begin
+ = cp_lexer_peek_token (parser->lexer)->location;
+ /* As stated above, empty bounds are handled here. */
+ tree lower_bound = cp_lexer_next_token_is (parser->lexer, CPP_COLON)
+ ? NULL_TREE : parse_bound ();
+ /* I wish we could error here saying that we expect an unqualified-id,
+ an integer, or an expression. Parsing the expression emits the error
+ right away though. Maybe we can do some tentative parsing? */
+ if (lower_bound && error_operand_p (lower_bound))
+ {
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/true,
+ /*consume_paren=*/false);
+ continue;
+ }
+ /* Tokens get consumed by parse_bound. */
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_COLON))
+ {
+ /* lower_bound can only be null if the next token was a colon. */
+ gcc_assert (lower_bound && !error_operand_p (lower_bound));
+ const cp_token *const next_tok = cp_lexer_peek_token (parser->lexer);
+
+ cp_parser_error (parser, "expected %<:%>");
+ if (tok_terminates_item_p (next_tok))
+ {
+ const location_t loc = make_location (num_range_loc_begin,
+ num_range_loc_begin,
+ input_location);
+ inform (loc, "an expression is only allowed in a numeric range");
+ }
+ /* Do not consume the close paren, this function does not handle
+ that part of the clause. */
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/true,
+ /*consume_paren=*/false);
+ continue;
+ }
+ location_t colon_loc = cp_lexer_consume_token (parser->lexer)->location;
+ tree upper_bound = tok_terminates_item_p
+ (cp_lexer_peek_token (parser->lexer))
+ ? NULL_TREE : parse_bound ();
+
+ /* I think we are supposed to have some sort of diagnostic here, I'm just
+ not sure what it should be. */
+ if (error_operand_p (lower_bound) || error_operand_p (upper_bound))
+ continue;
+
+ location_t num_range_loc_end
+ = upper_bound ? EXPR_LOCATION (TREE_VALUE (upper_bound)) : colon_loc;
+
+ auto build_default_bound = [] (tree num_args_marker, int val)
+ {
+ /* Unfortunately, we can't assume what the final value will be
+ because we don't know if we are in a member function or not. */
+ tree value = build_nop (integer_type_node,
+ build_int_cst (integer_type_node, val));
+ return build_tree_list (num_args_marker, value);
+ };
+ static constexpr int lb_default = 1;
+ /* Internally, 0 + omp_num_args refers to the last arg. */
+ static constexpr int ub_default = 0;
+ if (!lower_bound)
+ lower_bound = build_default_bound (NULL_TREE, lb_default);
+ if (!upper_bound)
+ upper_bound
+ = build_default_bound (get_identifier ("omp num args plus"),
+ ub_default);
+
+ append_to_list (build_tree_list (lower_bound, upper_bound),
+ make_location (num_range_loc_begin,
+ num_range_loc_begin,
+ num_range_loc_end));
+ } while (cp_lexer_next_token_is (parser->lexer, CPP_COMMA));
+ return list;
+}
+
/* OpenACC 2.0:
copy ( variable-list )
copyin ( variable-list )
@@ -39467,7 +40473,7 @@ cp_parser_oacc_data_clause (cp_parser *parser, pragma_omp_clause c_kind,
}
}
nl = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_MAP, list, NULL,
- false);
+ C_ORT_ACC, false);
}
for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
@@ -40831,7 +41837,7 @@ cp_parser_omp_clause_ordered (cp_parser *parser,
static tree
cp_parser_omp_clause_reduction (cp_parser *parser, enum omp_clause_code kind,
- bool is_omp, tree list)
+ enum c_omp_region_type ort, tree list)
{
enum tree_code code = ERROR_MARK;
tree nlist, c, id = NULL_TREE;
@@ -40841,7 +41847,7 @@ cp_parser_omp_clause_reduction (cp_parser *parser, enum omp_clause_code kind,
if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
return list;
- if (kind == OMP_CLAUSE_REDUCTION && is_omp)
+ if (kind == OMP_CLAUSE_REDUCTION && ort == C_ORT_OMP)
{
if (cp_lexer_next_token_is_keyword (parser->lexer, RID_DEFAULT)
&& cp_lexer_nth_token_is (parser->lexer, 2, CPP_COMMA))
@@ -40916,6 +41922,12 @@ cp_parser_omp_clause_reduction (cp_parser *parser, enum omp_clause_code kind,
code = TRUTH_ANDIF_EXPR;
else if (id == ovl_op_identifier (false, TRUTH_ORIF_EXPR))
code = TRUTH_ORIF_EXPR;
+ if (code == ERROR_MARK && ort == C_ORT_ACC)
+ {
+ cp_parser_error (parser, "expected %<+%>, %<*%>, %<-%>, %<&%>, "
+ "%<^%>, %<|%>, %<&&%>, %<||%>, %<min%> or %<max%>");
+ goto resync_fail;
+ }
id = omp_reduction_id (code, id, NULL_TREE);
tree scope = parser->scope;
if (scope)
@@ -40938,11 +41950,14 @@ cp_parser_omp_clause_reduction (cp_parser *parser, enum omp_clause_code kind,
if (!cp_parser_require (parser, CPP_COLON, RT_COLON))
goto resync_fail;
- nlist = cp_parser_omp_var_list_no_open (parser, kind, list,
- NULL);
+ nlist = cp_parser_omp_var_list_no_open (parser, kind, list, NULL, ort);
for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
{
OMP_CLAUSE_REDUCTION_CODE (c) = code;
+ /* OpenACC does not require anything below. */
+ if (ort == C_ORT_ACC)
+ continue;
+
if (task)
OMP_CLAUSE_REDUCTION_TASK (c) = 1;
else if (inscan)
@@ -41479,6 +42494,234 @@ cp_parser_omp_clause_allocate (cp_parser *parser, tree list)
return nlist;
}
+/* OpenMP 5.0:
+ uses_allocators ( allocator-list )
+
+ allocator-list:
+ allocator
+ allocator , allocator-list
+ allocator ( traits-array )
+ allocator ( traits-array ) , allocator-list
+
+ OpenMP 5.2:
+
+ uses_allocators ( modifier : allocator-list )
+ uses_allocators ( modifier , modifier : allocator-list )
+
+ modifier:
+ traits ( traits-array )
+ memspace ( mem-space-handle ) */
+
+static tree
+cp_parser_omp_clause_uses_allocators (cp_parser *parser, tree list)
+{
+ location_t clause_loc
+ = cp_lexer_peek_token (parser->lexer)->location;
+ tree t = NULL_TREE, nl = list;
+ matching_parens parens;
+ if (!parens.require_open (parser))
+ return list;
+
+ tree memspace_expr = NULL_TREE;
+ tree traits_var = NULL_TREE;
+
+ struct item_tok
+ {
+ location_t loc;
+ tree id;
+ item_tok (void) : loc (UNKNOWN_LOCATION), id (NULL_TREE) {}
+ };
+ struct item { item_tok name, arg; };
+ auto_vec<item> *modifiers = NULL, *allocators = NULL;
+ auto_vec<item> *cur_list = new auto_vec<item> (4);
+
+ while (true)
+ {
+ item it;
+
+ if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+ {
+ cp_token *tok = cp_lexer_peek_token (parser->lexer);
+ it.name.id = tok->u.value;
+ it.name.loc = tok->location;
+ cp_lexer_consume_token (parser->lexer);
+
+ if (cp_lexer_next_token_is (parser->lexer, CPP_OPEN_PAREN))
+ {
+ matching_parens parens2;
+ parens2.consume_open (parser);
+
+ if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+ {
+ tok = cp_lexer_peek_token (parser->lexer);
+ it.arg.id = tok->u.value;
+ it.arg.loc = tok->location;
+ cp_lexer_consume_token (parser->lexer);
+ }
+ else
+ {
+ cp_parser_error (parser, "expected identifier");
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ goto end;
+ }
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/false,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ }
+ }
+
+ cur_list->safe_push (it);
+
+ if (cp_lexer_next_token_is (parser->lexer, CPP_COMMA))
+ cp_lexer_consume_token (parser->lexer);
+ else if (cp_lexer_next_token_is (parser->lexer, CPP_COLON))
+ {
+ if (modifiers)
+ {
+ cp_parser_error (parser, "expected %<)%>");
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ goto end;
+ }
+ else
+ {
+ cp_lexer_consume_token (parser->lexer);
+ modifiers = cur_list;
+ cur_list = new auto_vec<item> (4);
+ }
+ }
+ else if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_PAREN))
+ {
+ gcc_assert (allocators == NULL);
+ allocators = cur_list;
+ cur_list = NULL;
+ break;
+ }
+ else
+ {
+ cp_parser_error (parser, "expected %<)%>");
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ goto end;
+ }
+ }
+
+ if (modifiers)
+ for (unsigned i = 0; i < modifiers->length (); i++)
+ {
+ item& it = (*modifiers)[i];
+ const char *p = IDENTIFIER_POINTER (it.name.id);
+ int strcmp_traits = 1, strcmp_memspace = 1;
+
+ if ((strcmp_traits = strcmp ("traits", p)) == 0
+ || (strcmp_memspace = strcmp ("memspace", p)) == 0)
+ {
+ if ((strcmp_traits == 0 && traits_var != NULL_TREE)
+ || (strcmp_memspace == 0 && memspace_expr != NULL_TREE))
+ {
+ error_at (it.name.loc, "duplicate %qs modifier", p);
+ goto end;
+ }
+ t = cp_parser_lookup_name_simple (parser, it.arg.id, it.arg.loc);
+ if (t == error_mark_node)
+ {
+ cp_parser_name_lookup_error (parser, it.arg.id, t, NLE_NULL,
+ it.arg.loc);
+ }
+ else if (strcmp_memspace == 0)
+ memspace_expr = t;
+ else if (strcmp_traits == 0)
+ traits_var = t;
+ else
+ gcc_unreachable ();
+ }
+ else
+ {
+ error_at (it.name.loc, "unknown modifier %qE", it.name.id);
+ goto end;
+ }
+ }
+
+ if (allocators)
+ {
+ if (modifiers)
+ {
+ if (allocators->length () > 1)
+ {
+ error_at ((*allocators)[1].name.loc,
+ "%<uses_allocators%> clause only accepts a single "
+ "allocator when using modifiers");
+ goto end;
+ }
+ else if ((*allocators)[0].arg.id)
+ {
+ error_at ((*allocators)[0].arg.loc,
+ "legacy %<%E(%E)%> traits syntax not allowed in "
+ "%<uses_allocators%> clause when using modifiers",
+ (*allocators)[0].name.id, (*allocators)[0].arg.id);
+ goto end;
+ }
+ }
+
+ for (unsigned i = 0; i < allocators->length (); i++)
+ {
+ item& it = (*allocators)[i];
+ t = cp_parser_lookup_name_simple (parser, it.name.id, it.name.loc);
+ if (t == error_mark_node)
+ {
+ cp_parser_name_lookup_error (parser, it.name.id, t, NLE_NULL,
+ it.name.loc);
+ goto end;
+ }
+ else if (t != error_mark_node)
+ {
+ tree t2 = NULL_TREE;
+ if (it.arg.id)
+ {
+ t2 = cp_parser_lookup_name_simple (parser, it.arg.id,
+ it.arg.loc);
+ if (t2 == error_mark_node)
+ {
+ cp_parser_name_lookup_error (parser, it.arg.id, t2,
+ NLE_NULL, it.arg.loc);
+ goto end;
+ }
+ }
+ else
+ t2 = traits_var;
+
+ tree c = build_omp_clause (clause_loc,
+ OMP_CLAUSE_USES_ALLOCATORS);
+ OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c) = t;
+ OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c) = memspace_expr;
+ OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c) = t2;
+ OMP_CLAUSE_CHAIN (c) = nl;
+ nl = c;
+ }
+ }
+ }
+ end:
+ if (cur_list)
+ delete cur_list;
+ if (modifiers)
+ delete modifiers;
+ if (allocators)
+ delete allocators;
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/false,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ return nl;
+}
+
/* OpenMP 2.5:
lastprivate ( variable-list )
@@ -42030,10 +43273,10 @@ cp_parser_omp_iterators (cp_parser *parser)
pushdecl (iter_var);
*last = make_tree_vec (6);
- TREE_VEC_ELT (*last, 0) = iter_var;
- TREE_VEC_ELT (*last, 1) = begin;
- TREE_VEC_ELT (*last, 2) = end;
- TREE_VEC_ELT (*last, 3) = step;
+ OMP_ITERATORS_VAR (*last) = iter_var;
+ OMP_ITERATORS_BEGIN (*last) = begin;
+ OMP_ITERATORS_END (*last) = end;
+ OMP_ITERATORS_STEP (*last) = step;
last = &TREE_CHAIN (*last);
if (cp_lexer_next_token_is (parser->lexer, CPP_COMMA))
@@ -42107,7 +43350,7 @@ cp_parser_omp_clause_affinity (cp_parser *parser, tree list)
tree block = poplevel (1, 1, 0);
if (iterators != error_mark_node)
{
- TREE_VEC_ELT (iterators, 5) = block;
+ OMP_ITERATORS_BLOCK (iterators) = block;
for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
OMP_CLAUSE_DECL (c) = build_tree_list (iterators,
OMP_CLAUSE_DECL (c));
@@ -42232,7 +43475,7 @@ cp_parser_omp_clause_depend (cp_parser *parser, tree list, location_t loc)
if (iterators == error_mark_node)
iterators = NULL_TREE;
else
- TREE_VEC_ELT (iterators, 5) = block;
+ OMP_ITERATORS_BLOCK (iterators) = block;
}
for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
@@ -42328,8 +43571,11 @@ cp_parser_omp_clause_doacross (cp_parser *parser, tree list, location_t loc)
to ( variable-list )
OpenMP 5.1:
- from ( [present :] variable-list )
- to ( [present :] variable-list ) */
+ from ( [motion-modifier[,] [motion-modifier[,]...]:] variable-list )
+ to ( [motion-modifier[,] [motion-modifier[,]...]:] variable-list )
+
+ motion-modifier:
+ present | iterator (iterators-definition) */
static tree
cp_parser_omp_clause_from_to (cp_parser *parser, enum omp_clause_code kind,
@@ -42338,23 +43584,196 @@ cp_parser_omp_clause_from_to (cp_parser *parser, enum omp_clause_code kind,
if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
return list;
- bool present = false;
- cp_token *token = cp_lexer_peek_token (parser->lexer);
+ int pos = 1;
+ int colon_pos = 0;
+ int iterator_length = 0;
- if (token->type == CPP_NAME
- && strcmp (IDENTIFIER_POINTER (token->u.value), "present") == 0
- && cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON))
+ while (cp_lexer_peek_nth_token (parser->lexer, pos)->type == CPP_NAME)
{
- present = true;
- cp_lexer_consume_token (parser->lexer);
- cp_lexer_consume_token (parser->lexer);
+ const char *identifier =
+ IDENTIFIER_POINTER (cp_lexer_peek_nth_token (parser->lexer,
+ pos)->u.value);
+ if (cp_lexer_nth_token_is (parser->lexer, pos + 1, CPP_OPEN_PAREN))
+ {
+ int n = cp_parser_skip_balanced_tokens (parser, pos + 1);
+ if (n != pos + 1)
+ {
+ if (strcmp (identifier, "iterator") == 0)
+ iterator_length = n - pos;
+ pos = n - 1;
+ }
+ }
+ if (cp_lexer_peek_nth_token (parser->lexer, pos + 1)->type == CPP_COMMA)
+ pos += 2;
+ else
+ pos++;
+ if (cp_lexer_peek_nth_token (parser->lexer, pos)->type == CPP_COLON)
+ {
+ colon_pos = pos;
+ break;
+ }
+ }
+
+ bool present_modifier = false;
+ bool mapper_modifier = false;
+ tree mapper_name = NULL_TREE;
+ tree iterators = NULL_TREE;
+
+ for (int pos = 1; pos < colon_pos; ++pos)
+ {
+ cp_token *tok = cp_lexer_peek_token (parser->lexer);
+ if (tok->type == CPP_COMMA)
+ {
+ cp_lexer_consume_token (parser->lexer);
+ continue;
+ }
+ const char *p = IDENTIFIER_POINTER (tok->u.value);
+ if (strcmp ("present", p) == 0)
+ {
+ if (present_modifier)
+ {
+ cp_parser_error (parser, "too many %<present%> modifiers");
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ return list;
+ }
+ present_modifier = true;
+ cp_lexer_consume_token (parser->lexer);
+ }
+ else if (strcmp ("iterator", p) == 0)
+ {
+ if (iterators)
+ {
+ cp_parser_error (parser, "too many %<iterator%> modifiers");
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ return list;
+ }
+ begin_scope (sk_omp, NULL);
+ iterators = cp_parser_omp_iterators (parser);
+ pos += iterator_length - 1;
+ }
+ else if (strcmp ("mapper", p) == 0)
+ {
+ cp_lexer_consume_token (parser->lexer);
+ matching_parens parens;
+ if (parens.require_open (parser))
+ {
+ if (mapper_modifier)
+ {
+ cp_parser_error (parser, "too many %<mapper%> modifiers");
+ /* Assume it's a well-formed mapper modifier, even if it
+ seems to be in the wrong place. */
+ cp_lexer_consume_token (parser->lexer);
+ parens.require_close (parser);
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/
+ true);
+ return list;
+ }
+ tok = cp_lexer_peek_token (parser->lexer);
+ switch (tok->type)
+ {
+ case CPP_NAME:
+ {
+ cp_expr e = cp_parser_identifier (parser);
+ if (e != error_mark_node)
+ mapper_name = e;
+ else
+ goto err;
+ }
+ break;
+ case CPP_KEYWORD:
+ if (tok->keyword == RID_DEFAULT)
+ {
+ cp_lexer_consume_token (parser->lexer);
+ break;
+ }
+ /* Fallthrough. */
+ default:
+ err:
+ cp_parser_error (parser,
+ "expected identifier or %<default%>");
+ return list;
+ }
+
+ if (!parens.require_close (parser))
+ {
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/
+ true);
+ return list;
+ }
+ mapper_modifier = true;
+ pos += 3;
+ }
+ }
+ else
+ {
+ cp_parser_error (parser, "%<to%> or %<from%> clause with "
+ "modifier other than %<iterator%>, "
+ "%<mapper%> or %<present%>");
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ return list;
+ }
}
- tree nl = cp_parser_omp_var_list_no_open (parser, kind, list, NULL, true);
- if (present)
+ if (colon_pos)
+ cp_parser_require (parser, CPP_COLON, RT_COLON);
+
+ tree nl = cp_parser_omp_var_list_no_open (parser, kind, list, NULL, C_ORT_OMP,
+ true);
+ if (present_modifier)
for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
OMP_CLAUSE_MOTION_PRESENT (c) = 1;
+ if (mapper_name)
+ {
+ tree last_new = NULL_TREE;
+ for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
+ last_new = c;
+
+ tree name = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_PUSH_MAPPER_NAME);
+ OMP_CLAUSE_DECL (name) = mapper_name;
+ OMP_CLAUSE_CHAIN (name) = nl;
+ nl = name;
+
+ gcc_assert (last_new);
+
+ name = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_POP_MAPPER_NAME);
+ OMP_CLAUSE_DECL (name) = null_pointer_node;
+ if (iterators)
+ OMP_CLAUSE_ITERATORS (name) = iterators;
+ OMP_CLAUSE_CHAIN (name) = OMP_CLAUSE_CHAIN (last_new);
+ OMP_CLAUSE_CHAIN (last_new) = name;
+ }
+
+ if (iterators)
+ {
+ tree block = poplevel (1, 1, 0);
+ if (iterators == error_mark_node)
+ iterators = NULL_TREE;
+ else
+ OMP_ITERATORS_BLOCK (iterators) = block;
+ }
+
+ if (iterators)
+ for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_ITERATORS (c) = iterators;
+
return nl;
}
@@ -42375,36 +43794,59 @@ cp_parser_omp_clause_from_to (cp_parser *parser, enum omp_clause_code kind,
map ( [map-type-modifier[,] ...] map-kind: variable-list )
map-type-modifier:
- always | close */
+ always | close | mapper ( mapper-name ) */
static tree
-cp_parser_omp_clause_map (cp_parser *parser, tree list)
+cp_parser_omp_clause_map (cp_parser *parser, tree list, enum gomp_map_kind kind)
{
tree nlist, c;
- enum gomp_map_kind kind = GOMP_MAP_TOFROM;
if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
return list;
int pos = 1;
int map_kind_pos = 0;
- while (cp_lexer_peek_nth_token (parser->lexer, pos)->type == CPP_NAME
- || cp_lexer_peek_nth_token (parser->lexer, pos)->keyword == RID_DELETE)
+ int iterator_length = 0;
+ for (;;)
{
- if (cp_lexer_peek_nth_token (parser->lexer, pos + 1)->type == CPP_COLON)
+ cp_token *tok = cp_lexer_peek_nth_token (parser->lexer, pos);
+ if (!(tok->type == CPP_NAME || tok->keyword == RID_DELETE))
+ break;
+
+ cp_token *next_tok = cp_lexer_peek_nth_token (parser->lexer, pos + 1);
+ if (tok->type == CPP_NAME
+ && strcmp (IDENTIFIER_POINTER (tok->u.value), "iterator") == 0
+ && next_tok->type == CPP_OPEN_PAREN)
+ {
+ int n = cp_parser_skip_balanced_tokens (parser, pos + 1);
+ if (n != pos + 1)
+ {
+ iterator_length = n - pos;
+ pos = n - 1;
+ next_tok = cp_lexer_peek_nth_token (parser->lexer, n);
+ }
+ }
+
+ if (next_tok->type == CPP_COLON)
{
map_kind_pos = pos;
break;
}
- if (cp_lexer_peek_nth_token (parser->lexer, pos + 1)->type == CPP_COMMA)
+ if (next_tok->type == CPP_COMMA)
pos++;
+ else if (cp_lexer_peek_nth_token (parser->lexer, pos + 1)->type
+ == CPP_OPEN_PAREN)
+ pos = cp_parser_skip_balanced_tokens (parser, pos + 1);
pos++;
}
bool always_modifier = false;
bool close_modifier = false;
bool present_modifier = false;
+ bool mapper_modifier = false;
+ tree mapper_name = NULL_TREE;
+ tree iterators = NULL_TREE;
for (int pos = 1; pos < map_kind_pos; ++pos)
{
cp_token *tok = cp_lexer_peek_token (parser->lexer);
@@ -42427,6 +43869,7 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list)
return list;
}
always_modifier = true;
+ cp_lexer_consume_token (parser->lexer);
}
else if (strcmp ("close", p) == 0)
{
@@ -42440,6 +43883,71 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list)
return list;
}
close_modifier = true;
+ cp_lexer_consume_token (parser->lexer);
+ }
+ else if (strcmp ("mapper", p) == 0)
+ {
+ cp_lexer_consume_token (parser->lexer);
+
+ matching_parens parens;
+ if (parens.require_open (parser))
+ {
+ if (mapper_modifier)
+ {
+ cp_parser_error (parser, "too many %<mapper%> modifiers");
+ /* Assume it's a well-formed mapper modifier, even if it
+ seems to be in the wrong place. */
+ cp_lexer_consume_token (parser->lexer);
+ parens.require_close (parser);
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/
+ true);
+ return list;
+ }
+
+ tok = cp_lexer_peek_token (parser->lexer);
+ switch (tok->type)
+ {
+ case CPP_NAME:
+ {
+ cp_expr e = cp_parser_identifier (parser);
+ if (e != error_mark_node)
+ mapper_name = e;
+ else
+ goto err;
+ }
+ break;
+
+ case CPP_KEYWORD:
+ if (tok->keyword == RID_DEFAULT)
+ {
+ cp_lexer_consume_token (parser->lexer);
+ break;
+ }
+ /* Fallthrough. */
+
+ default:
+ err:
+ cp_parser_error (parser,
+ "expected identifier or %<default%>");
+ return list;
+ }
+
+ if (!parens.require_close (parser))
+ {
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/
+ true);
+ return list;
+ }
+
+ mapper_modifier = true;
+ pos += 3;
+ }
}
else if (strcmp ("present", p) == 0)
{
@@ -42453,19 +43961,37 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list)
return list;
}
present_modifier = true;
- }
+ cp_lexer_consume_token (parser->lexer);
+ }
+ else if (strcmp ("iterator", p) == 0
+ && cp_lexer_peek_nth_token (parser->lexer, 2)->type
+ == CPP_OPEN_PAREN)
+ {
+ if (iterators)
+ {
+ cp_parser_error (parser, "too many %<iterator%> modifiers");
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ return list;
+ }
+ begin_scope (sk_omp, NULL);
+ iterators = cp_parser_omp_iterators (parser);
+ pos += iterator_length - 1;
+ continue;
+ }
else
{
- cp_parser_error (parser, "%<map%> clause with map-type modifier other"
- " than %<always%>, %<close%> or %<present%>");
+ cp_parser_error (parser, "%<map%> clause with map-type modifier "
+ "other than %<always%>, %<close%>, "
+ "%<iterator%>, %<mapper%> or %<present%>");
cp_parser_skip_to_closing_parenthesis (parser,
/*recovering=*/true,
/*or_comma=*/false,
/*consume_paren=*/true);
return list;
}
-
- cp_lexer_consume_token (parser->lexer);
}
if (cp_lexer_next_token_is (parser->lexer, CPP_NAME)
@@ -42518,11 +44044,47 @@ cp_parser_omp_clause_map (cp_parser *parser, tree list)
legally. */
begin_scope (sk_omp, NULL);
nlist = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_MAP, list,
- NULL, true);
+ NULL, (kind == GOMP_MAP_UNSET
+ ? C_ORT_OMP_DECLARE_MAPPER
+ : C_ORT_OMP), true);
finish_scope ();
+ tree last_new = NULL_TREE;
+
+ if (iterators)
+ {
+ tree block = poplevel (1, 1, 0);
+ if (iterators == error_mark_node)
+ iterators = NULL_TREE;
+ else
+ OMP_ITERATORS_BLOCK (iterators) = block;
+ }
+
for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
- OMP_CLAUSE_SET_MAP_KIND (c, kind);
+ {
+ OMP_CLAUSE_SET_MAP_KIND (c, kind);
+ OMP_CLAUSE_ITERATORS (c) = iterators;
+ last_new = c;
+ }
+
+ if (mapper_name)
+ {
+ tree name = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_PUSH_MAPPER_NAME);
+ OMP_CLAUSE_DECL (name) = mapper_name;
+ if (iterators)
+ OMP_CLAUSE_ITERATORS (name) = iterators;
+ OMP_CLAUSE_CHAIN (name) = nlist;
+ nlist = name;
+
+ gcc_assert (last_new);
+
+ name = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (name, GOMP_MAP_POP_MAPPER_NAME);
+ OMP_CLAUSE_DECL (name) = null_pointer_node;
+ OMP_CLAUSE_CHAIN (name) = OMP_CLAUSE_CHAIN (last_new);
+ OMP_CLAUSE_CHAIN (last_new) = name;
+ }
return nlist;
}
@@ -43180,7 +44742,7 @@ cp_parser_omp_clause_init (cp_parser *parser, tree list)
"missing required %<target%> and/or %<targetsync%> modifier");
tree nl = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_INIT, list,
- NULL, false);
+ NULL);
for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
{
TREE_ADDRESSABLE (OMP_CLAUSE_DECL (c)) = 1;
@@ -43423,7 +44985,7 @@ cp_parser_oacc_all_clauses (cp_parser *parser, omp_clause_mask mask,
case PRAGMA_OACC_CLAUSE_REDUCTION:
clauses
= cp_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION,
- false, clauses);
+ C_ORT_ACC, clauses);
c_name = "reduction";
break;
case PRAGMA_OACC_CLAUSE_SELF:
@@ -43621,7 +45183,7 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
case PRAGMA_OMP_CLAUSE_IN_REDUCTION:
clauses
= cp_parser_omp_clause_reduction (parser, OMP_CLAUSE_IN_REDUCTION,
- true, clauses);
+ C_ORT_OMP, clauses);
c_name = "in_reduction";
break;
case PRAGMA_OMP_CLAUSE_INDIRECT:
@@ -43676,7 +45238,7 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
case PRAGMA_OMP_CLAUSE_REDUCTION:
clauses
= cp_parser_omp_clause_reduction (parser, OMP_CLAUSE_REDUCTION,
- true, clauses);
+ C_ORT_OMP, clauses);
c_name = "reduction";
break;
case PRAGMA_OMP_CLAUSE_SCHEDULE:
@@ -43693,7 +45255,7 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
clauses
= cp_parser_omp_clause_reduction (parser,
OMP_CLAUSE_TASK_REDUCTION,
- true, clauses);
+ C_ORT_OMP, clauses);
c_name = "task_reduction";
break;
case PRAGMA_OMP_CLAUSE_UNTIED:
@@ -43796,6 +45358,10 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
clauses = cp_parser_omp_clause_allocate (parser, clauses);
c_name = "allocate";
break;
+ case PRAGMA_OMP_CLAUSE_USES_ALLOCATORS:
+ clauses = cp_parser_omp_clause_uses_allocators (parser, clauses);
+ c_name = "uses_allocators";
+ break;
case PRAGMA_OMP_CLAUSE_LINEAR:
{
bool declare_simd = false;
@@ -43850,7 +45416,7 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
c_name = "detach";
break;
case PRAGMA_OMP_CLAUSE_MAP:
- clauses = cp_parser_omp_clause_map (parser, clauses);
+ clauses = cp_parser_omp_clause_map (parser, clauses, GOMP_MAP_TOFROM);
c_name = "map";
break;
case PRAGMA_OMP_CLAUSE_DEVICE:
@@ -44011,11 +45577,149 @@ cp_parser_omp_structured_block (cp_parser *parser, bool *if_p)
static void
cp_parser_omp_allocate (cp_parser *parser, cp_token *pragma_tok)
{
- tree allocator = NULL_TREE;
- tree alignment = NULL_TREE;
- location_t loc = pragma_tok->location;
- tree nl = cp_parser_omp_var_list (parser, OMP_CLAUSE_ALLOCATE, NULL_TREE);
+ /* If there were errors nl might be NULL_TREE, we need to handle this case
+ where necessary to diagnose as much as possible. */
+ tree nl = cp_parser_omp_var_list (parser, OMP_CLAUSE_ERROR, NULL_TREE);
+ /* Reverse the chain so diagnostics are in forward order. */
+ nl = nreverse (nl);
+ /* The var declared first in this function of the variables passed into the
+ allocate directive, this gets assigned in the following loop. We can't
+ assign nl's decl to it, because it might have an error, and nl itself
+ might be NULL_TREE.
+
+ We use this to simplify checking the allocator clause's expr later. */
+ tree f_var = NULL_TREE;
+ {
+ /* The head might have an error and need to be replaced. */
+ tree *chain = &nl;
+ for (tree node = nl; node != NULL_TREE; node = TREE_CHAIN (node))
+ {
+ tree var = TREE_PURPOSE (node);
+ /* Do this before duplicates are diagnosed, parms are never valid so we
+ don't want to diagnose duplicate uses of them. */
+ if (TREE_CODE (var) == PARM_DECL)
+ {
+ auto_diagnostic_group d;
+ error_at (EXPR_LOCATION (TREE_VALUE (node)),
+ "function parameter %qD may not appear as list item in "
+ "an %<allocate%> directive", var);
+ inform (DECL_SOURCE_LOCATION (var),
+ "parameter %qD declared here", var);
+ /* Remove the node. */
+ *chain = TREE_CHAIN (node);
+ /* There is nothing else to diagnose for a parm. */
+ continue;
+ }
+ /* Diagnose duplicate vars passed to the allocate directive.
+ We could generate fixits for a number of these, but adding the
+ comma token to be removed to the fixit seems difficult.
+ This is O(n^2), we'll have to use a hash table if it ever becomes
+ a problem. */
+ {
+ auto_diagnostic_group d;
+ bool duplicate_entry = false;
+ /* Frontmost non duplicate node. */
+ tree node_prev = node;
+ /* The node we are checking as a potential duplicate. */
+ tree node_current = TREE_CHAIN (node);
+ while (node_current != NULL_TREE)
+ {
+ if (TREE_PURPOSE (node) == TREE_PURPOSE (node_current))
+ {
+ /* If we could just get the location of the comma token a
+ fixit hint would be viable here. */
+ error_at (EXPR_LOCATION (TREE_VALUE (node_current)),
+ "%qD already appeared as list item in this "
+ "directive",
+ TREE_PURPOSE (node));
+ duplicate_entry = true;
+ /* The current node is a duplicate of node, remove it. */
+ TREE_CHAIN (node_prev) = TREE_CHAIN (node_current);
+ }
+ else
+ node_prev = node_current;
+ node_current = TREE_CHAIN (node_current);
+ }
+ if (duplicate_entry)
+ inform (EXPR_LOCATION (TREE_VALUE (node)), "appeared first here");
+ /* Dupes of node doesn't mean we remove it, keep going. */
+ }
+ auto var_is_in_current_scope = [] (tree var)
+ {
+ tree v = current_binding_level->names;
+ for (; v != NULL_TREE; v = DECL_CHAIN (v))
+ if (v == var)
+ return true;
+ return false;
+ };
+ /* If we do this before checking if the var was used in another
+ allocate directive the diagnostic should be more clear if the user
+ intended to shadow another variable. */
+ if (!var_is_in_current_scope (var))
+ {
+ auto_diagnostic_group d;
+ error_at (EXPR_LOCATION (TREE_VALUE (node)),
+ "%<allocate%> directive must be in the same scope as "
+ "%qD", var);
+ inform (DECL_SOURCE_LOCATION (var), "declared here");
+ /* Remove the node. */
+ *chain = TREE_CHAIN (node);
+ continue;
+ }
+
+ tree attr = lookup_attribute ("omp allocate",
+ DECL_ATTRIBUTES (var));
+ if (attr)
+ {
+ auto_diagnostic_group d;
+ error_at (EXPR_LOCATION (TREE_VALUE (node)),
+ "%qD already appeared as list item in an "
+ "%<allocate%> directive", var);
+ /* The loc is stored in the chain member of the tree_list when the
+ directive is complete. Currently, it is only possible for a
+ directive to already be finished if we are parsing a
+ non-template. */
+ tree var_loc = TREE_CODE (TREE_VALUE (attr)) == NOP_EXPR
+ ? TREE_VALUE (attr)
+ : TREE_CHAIN (TREE_VALUE (attr));
+ inform (EXPR_LOCATION (var_loc),
+ "%qD previously appeared here", var);
+ /* Remove the node. */
+ *chain = TREE_CHAIN (node);
+ }
+ else
+ {
+ /* Mark the variable so we can diagnose this during parsing,
+ including before a template is instantiated.
+ This is necessary even if we diagnose errors for this directive
+ so we don't miss diagnosing secondary uses of a variable in
+ later allocate directives. Additionally, we take advantage of
+ this to store the loc the variable was used for diagnostics. */
+ DECL_ATTRIBUTES (var) = tree_cons (get_identifier ("omp allocate"),
+ TREE_VALUE (node),
+ DECL_ATTRIBUTES (var));
+ /* Everything is good, we are keeping this node now,
+ update the current chain pointer. */
+ chain = &TREE_CHAIN (node);
+
+ /* Nodes that contain a parm or a var that is not in this scope
+ were don't make it this far, we can to assign f_var now. */
+ if (f_var == NULL_TREE)
+ f_var = var;
+ /* I am not sure of a better way to do this. Maybe it would be
+ better to walk the declarations in the current scope? The
+ chain is backwards so it would probably be worse. */
+ else if (linemap_location_before_p (line_table,
+ DECL_SOURCE_LOCATION (var),
+ DECL_SOURCE_LOCATION (f_var)))
+ f_var = var;
+ }
+ }
+ }
+ /* cp_parser_assignment_expression wraps in a location by default. */
+ cp_expr allocator = NULL_TREE;
+ cp_expr alignment = NULL_TREE;
do
{
if (cp_lexer_next_token_is (parser->lexer, CPP_COMMA)
@@ -44036,70 +45740,202 @@ cp_parser_omp_allocate (cp_parser *parser, cp_token *pragma_tok)
}
if (!parens.require_open (parser))
break;
- tree expr = cp_parser_assignment_expression (parser);
+ cp_expr expr = cp_parser_assignment_expression (parser);
if (p[2] == 'i' && alignment)
{
error_at (cloc, "too many %qs clauses", "align");
break;
}
else if (p[2] == 'i')
- {
- if (expr != error_mark_node)
- alignment = expr;
- /* FIXME: Remove when adding check to semantics.cc; cf FIXME below. */
- if (alignment
- && !type_dependent_expression_p (alignment)
- && !INTEGRAL_TYPE_P (TREE_TYPE (alignment)))
- {
- error_at (cloc, "%<align%> clause argument needs to be "
- "positive constant power of two integer "
- "expression");
- alignment = NULL_TREE;
- }
- else if (alignment)
- {
- alignment = mark_rvalue_use (alignment);
- if (!processing_template_decl)
- {
- alignment = maybe_constant_value (alignment);
- if (TREE_CODE (alignment) != INTEGER_CST
- || !tree_fits_uhwi_p (alignment)
- || !integer_pow2p (alignment))
- {
- error_at (cloc, "%<align%> clause argument needs to be "
- "positive constant power of two integer "
- "expression");
- alignment = NULL_TREE;
- }
- }
- }
- }
+ alignment = expr;
else if (allocator)
{
error_at (cloc, "too many %qs clauses", "allocator");
break;
}
else
- {
- if (expr != error_mark_node)
- allocator = expr;
- }
+ allocator = expr;
parens.require_close (parser);
} while (true);
cp_parser_require_pragma_eol (parser, pragma_tok);
- if (allocator || alignment)
- for (tree c = nl; c != NULL_TREE; c = OMP_CLAUSE_CHAIN (c))
- {
- OMP_CLAUSE_ALLOCATE_ALLOCATOR (c) = allocator;
- OMP_CLAUSE_ALLOCATE_ALIGN (c) = alignment;
- }
+ /* Used to carry information into the below lambda through cp_walk_tree. */
+ struct cp_omp_loc_tree
+ {
+ location_t loc;
+ tree first_arg;
+ tree arg_list;
+ };
+ /* Check whether the expression used in the allocator clause is declared or
+ modified between the variable declaration and its allocate directive.
+
+ We could consider moving everything here to finish_omp_allocate but it's
+ convenient to keep it here until we opt to tackle the issues noted in the
+ comments below. */
+ auto check_omp_allocate_allocator_r = [] (tree *tp, int *, void *data)
+ {
+ /* We bail on the first error we find. Alternatively we could diagnose
+ as much as we can, keeping track of vars we have already diagnosed to
+ prevent duplicates errors, but it doesn't seem worth doing. */
+ tree var_in_expr = *tp;
+ if (!VAR_P (var_in_expr))
+ return NULL_TREE;
+
+ location_t alloc_expr_loc = ((cp_omp_loc_tree *) data)->loc;
+ tree first_declared_arg = ((cp_omp_loc_tree *) data)->first_arg;
+ tree all_args = ((cp_omp_loc_tree *) data)->arg_list;
+
+ /* For obvious reasons, you can't use a var used in an allocate directive
+ as part of the allocator clause's expression. We don't have to check
+ this specifically for each var because usage of a var declared after
+ the first declared var will also be rejected, but this would result in
+ a misleading diagnostic. It doesn't cost use much to do this check
+ explicitly for each arg so do it this way. */
+ for (tree arg = all_args; arg; arg = TREE_CHAIN (arg))
+ if (var_in_expr == TREE_PURPOSE (arg))
+ {
+ tree arg_decl = TREE_PURPOSE (arg);
+ /* It would be nice if there were an easy way to put the caret on
+ the use of the variable, but there doesn't appear to be. */
+ auto_diagnostic_group d;
+ error_at (alloc_expr_loc,
+ "variable %qD used in this %<allocate%> directive must "
+ "not be used in its %<allocator%> clause", arg_decl);
+ inform (DECL_SOURCE_LOCATION (arg_decl), "declared here");
+ inform (EXPR_LOCATION (TREE_VALUE (arg)),
+ "used in allocate directive here");
+ return error_mark_node;
+ }
+ /* We can't rely on locations to determine declaration order because var
+ decls that are implicit lambda captures have their location set to
+ their first use. This is probably a bug but relying on source
+ location for this seems incorrect anyway. */
+ for (tree v = current_binding_level->names; v; v = DECL_CHAIN (v))
+ {
+ /* If we find first_declared_arg before var_in_expr it must have
+ been declared before it. */
+ if (v == first_declared_arg)
+ break;
+ if (v == var_in_expr)
+ {
+ /* Captures don't make it here so we should be able to rely on
+ the DECL_SOURCE_LOCATION for var_in_expr. */
+ auto_diagnostic_group d;
+ error_at (alloc_expr_loc,
+ "variable %qD used in the %<allocator%> clause "
+ "must be declared before %qD",
+ var_in_expr, first_declared_arg);
+ inform (DECL_SOURCE_LOCATION (var_in_expr), "declared here");
+ inform (DECL_SOURCE_LOCATION (first_declared_arg),
+ "to be allocated variable declared here");
+ return error_mark_node;
+ }
+ }
+
+ /* It's super easy to hide mutations to variables used in the alloc
+ clause with our current error checking, the following is not currently
+ diagnosed.
+
+ void f() {
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ int a;
+ int hide_mutation = alloc = omp_large_cap_mem_alloc;
+ #pragma omp allocate(a) allocator(alloc)
+ }
+
+ But this is fairly representative of what we currently have in the C
+ front end, which has the same problem, so a problem for the future.
+
+ Alongside incomplete error diagnostics, there are also cases that
+ can't be diagnosed or warned until template instantiation.
+
+ template<typename T>
+ void f(T arg) {
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ int a;
+ foobar(arg, alloc);
+ #pragma omp allocate(a) allocator(alloc)
+ }
+ It's impossible to know what the signature of foobar is until overload
+ resolution completes. To diagnose (or at least warn) for these edge
+ cases, this section should be moved to finish_omp_allocate instead of
+ here. We can add full diagnostics to mutations of variables in the
+ allocator clause once we do that. */
+ gcc_assert (cur_stmt_list
+ && TREE_CODE (cur_stmt_list) == STATEMENT_LIST);
+ for (tree_stmt_iterator stmt_it = tsi_last (cur_stmt_list);
+ !tsi_end_p (stmt_it);
+ --stmt_it)
+ {
+ tree stmt = *stmt_it;
+ /* Don't check anything preceding first_declared_arg's decl. */
+ if (TREE_CODE (stmt) == DECL_EXPR
+ && DECL_EXPR_DECL (stmt) == first_declared_arg)
+ break;
+ /* Due to differences in the C++ AST, I don't believe this catches
+ any cases right now.*/
+ if (TREE_CODE (stmt) == MODIFY_EXPR
+ && TREE_OPERAND (stmt, 0) == var_in_expr)
+ {
+ auto_diagnostic_group d;
+ error_at (alloc_expr_loc,
+ "variable %qD used in the %<allocator%> clause must "
+ "not be modified between declaration of %qD and its "
+ "%<allocate%> directive",
+ var_in_expr, first_declared_arg);
+ inform (EXPR_LOCATION (stmt), "modified here");
+ inform (DECL_SOURCE_LOCATION (first_declared_arg),
+ "to be allocated variable declared here");
+ return error_mark_node;
+ }
+ }
+ return NULL_TREE;
+ };
+ /* This diagnostic is meaningless if we have no valid args. */
+ if (allocator != NULL_TREE && nl != NULL_TREE)
+ {
+ gcc_assert (f_var != NULL_TREE);
+ /* Declarations and mutations must happen before any of the vars are
+ declared. If this is satisfied for the first declaration, it will be
+ satisfied for all of them, so just check the first. */
+ cp_omp_loc_tree data = {allocator.get_location (), f_var, nl};
+ /* We can't take the address of an rvalue, so we need to do this. */
+ tree a = allocator.get_value ();
+ if (cp_walk_tree (&a, check_omp_allocate_allocator_r, &data, NULL))
+ allocator = cp_expr (error_mark_node, UNKNOWN_LOCATION);
+ }
+ /* I couldn't find a function that already does this, might be best to
+ add it instead of having it here.
+ Some codes, such as template parameters, don't get wrapped despite not
+ being able to carry a location. We need a location to issue correct
+ diagnostics in finish_omp_allocate. */
+ auto maybe_force_wrap_with_location = [](cp_expr expr_with_loc) -> tree
+ {
+ tree expr = expr_with_loc.get_value ();
+ if (!expr || error_operand_p (expr))
+ return expr;
+ /* In most situations, expr will already have been wrapped,
+ we don't need to do anything if that's the case. */
+ if (CAN_HAVE_LOCATION_P (expr))
+ return expr;
- /* FIXME: When implementing properly, delete the align/allocate expr error
- check above and add one in semantics.cc (to properly handle templates).
- Base this on the allocator/align modifiers check for the 'allocate' clause
- in semantics.cc's finish_omp_clauses. */
- sorry_at (loc, "%<#pragma omp allocate%> not yet supported");
+ location_t expr_loc = expr_with_loc.get_location ();
+ /* Copied from tree.cc:maybe_wrap_with_location. */
+ tree_code code
+ = (((CONSTANT_CLASS_P (expr) && TREE_CODE (expr) != STRING_CST)
+ || (TREE_CODE (expr) == CONST_DECL && !TREE_STATIC (expr)))
+ ? NON_LVALUE_EXPR : VIEW_CONVERT_EXPR);
+ tree wrapper = build1_loc (expr_loc, code, TREE_TYPE (expr), expr);
+ /* Mark this node as being a wrapper. */
+ EXPR_LOCATION_WRAPPER_P (wrapper) = 1;
+ return wrapper;
+ };
+ /* We can still diagnose some things about allocator/alignment even if nl
+ is empty. */
+ finish_omp_allocate (pragma_tok->location,
+ nl,
+ maybe_force_wrap_with_location (allocator),
+ maybe_force_wrap_with_location (alignment));
}
/* OpenMP 2.5:
@@ -48332,7 +50168,10 @@ cp_parser_omp_target_data (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
tree clauses
= cp_parser_omp_all_clauses (parser, OMP_TARGET_DATA_CLAUSE_MASK,
- "#pragma omp target data", pragma_tok);
+ "#pragma omp target data", pragma_tok, false);
+ if (!processing_template_decl)
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP);
+ clauses = finish_omp_clauses (clauses, C_ORT_OMP);
c_omp_adjust_map_clauses (clauses, false);
int map_seen = 0;
for (tree *pc = &clauses; *pc;)
@@ -48447,7 +50286,11 @@ cp_parser_omp_target_enter_data (cp_parser *parser, cp_token *pragma_tok,
tree clauses
= cp_parser_omp_all_clauses (parser, OMP_TARGET_ENTER_DATA_CLAUSE_MASK,
- "#pragma omp target enter data", pragma_tok);
+ "#pragma omp target enter data", pragma_tok,
+ false);
+ if (!processing_template_decl)
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP);
+ clauses = finish_omp_clauses (clauses, C_ORT_OMP);
c_omp_adjust_map_clauses (clauses, false);
int map_seen = 0;
for (tree *pc = &clauses; *pc;)
@@ -48564,6 +50407,8 @@ cp_parser_omp_target_exit_data (cp_parser *parser, cp_token *pragma_tok,
= cp_parser_omp_all_clauses (parser, OMP_TARGET_EXIT_DATA_CLAUSE_MASK,
"#pragma omp target exit data", pragma_tok,
false);
+ if (!processing_template_decl)
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_EXIT_DATA);
clauses = finish_omp_clauses (clauses, C_ORT_OMP_EXIT_DATA);
c_omp_adjust_map_clauses (clauses, false);
int map_seen = 0;
@@ -48657,9 +50502,43 @@ cp_parser_omp_target_update (cp_parser *parser, cp_token *pragma_tok,
tree clauses
= cp_parser_omp_all_clauses (parser, OMP_TARGET_UPDATE_CLAUSE_MASK,
- "#pragma omp target update", pragma_tok);
- if (omp_find_clause (clauses, OMP_CLAUSE_TO) == NULL_TREE
- && omp_find_clause (clauses, OMP_CLAUSE_FROM) == NULL_TREE)
+ "#pragma omp target update", pragma_tok,
+ false);
+ if (!processing_template_decl)
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_UPDATE);
+ clauses = finish_omp_clauses (clauses, C_ORT_OMP_UPDATE);
+ bool to_clause = false, from_clause = false;
+ for (tree c = clauses;
+ c && !to_clause && !from_clause;
+ c = OMP_CLAUSE_CHAIN (c))
+ {
+ switch (OMP_CLAUSE_CODE (c))
+ {
+ case OMP_CLAUSE_TO:
+ to_clause = true;
+ break;
+ case OMP_CLAUSE_FROM:
+ from_clause = true;
+ break;
+ case OMP_CLAUSE_MAP:
+ switch (OMP_CLAUSE_MAP_KIND (c))
+ {
+ case GOMP_MAP_TO_GRID:
+ to_clause = true;
+ break;
+ case GOMP_MAP_FROM_GRID:
+ from_clause = true;
+ break;
+ default:
+ ;
+ }
+ break;
+ default:
+ ;
+ }
+ }
+
+ if (!to_clause && !from_clause)
{
error_at (pragma_tok->location,
"%<#pragma omp target update%> must contain at least one "
@@ -48696,7 +50575,8 @@ cp_parser_omp_target_update (cp_parser *parser, cp_token *pragma_tok,
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_THREAD_LIMIT) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IS_DEVICE_PTR)\
- | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_HAS_DEVICE_ADDR))
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_HAS_DEVICE_ADDR)\
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_USES_ALLOCATORS))
static bool
cp_parser_omp_target (cp_parser *parser, cp_token *pragma_tok,
@@ -48856,6 +50736,8 @@ cp_parser_omp_target (cp_parser *parser, cp_token *pragma_tok,
OMP_CLAUSE_CHAIN (nc) = OMP_CLAUSE_CHAIN (c);
OMP_CLAUSE_CHAIN (c) = nc;
}
+ if (!processing_template_decl)
+ clauses = c_omp_instantiate_mappers (clauses, C_ORT_OMP_TARGET);
clauses = finish_omp_clauses (clauses, C_ORT_OMP_TARGET);
c_omp_adjust_map_clauses (clauses, true);
@@ -50332,7 +52214,7 @@ cp_parser_omp_dispatch (cp_parser *parser, cp_token *pragma_tok)
static tree
cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
- tree attrs, tree parms)
+ tree attrs)
{
matching_parens parens;
if (!parens.require_open (parser))
@@ -50392,13 +52274,27 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
tree append_args_tree = NULL_TREE;
tree append_args_last = NULL_TREE;
- vec<tree> adjust_args_list = vNULL;
bool has_match = false, has_adjust_args = false;
location_t adjust_args_loc = UNKNOWN_LOCATION;
location_t append_args_loc = UNKNOWN_LOCATION;
- tree need_device_ptr_list = NULL_TREE;
+
tree ctx = NULL_TREE;
+ tree adjust_args_list = NULL_TREE;
+ auto append_adjust_args
+ = [chain = &adjust_args_list] (tree list, tree clause_modifier) mutable
+ {
+ gcc_assert (chain && *chain == NULL_TREE);
+ *chain = list;
+ /* Just stick them all together in one list and process them all
+ at once later. */
+ for (tree node = list; node; node = TREE_CHAIN (node))
+ {
+ TREE_PURPOSE (node) = clause_modifier;
+ chain = &TREE_CHAIN (node);
+ }
+ };
+
do
{
if (cp_lexer_next_token_is (parser->lexer, CPP_COMMA)
@@ -50452,6 +52348,20 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
goto fail;
ctx = omp_check_context_selector (match_loc, ctx,
OMP_CTX_DECLARE_VARIANT);
+
+ /* The OpenMP spec says the merging rules for enclosing
+ "begin declare variant" contexts apply to "declare variant
+ directives" -- the term it uses to refer to both directive
+ forms. */
+ if (ctx != error_mark_node
+ && !vec_safe_is_empty (scope_chain->omp_declare_variant_attribute))
+ {
+ cp_omp_declare_variant_attr a
+ = scope_chain->omp_declare_variant_attribute->last ();
+ tree outer_ctx = a.selector;
+ ctx = omp_merge_context_selectors (match_loc, outer_ctx, ctx,
+ OMP_CTX_DECLARE_VARIANT);
+ }
if (ctx != error_mark_node && variant != error_mark_node)
{
tree match_loc_node
@@ -50479,78 +52389,49 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
{
const char *p = IDENTIFIER_POINTER (adjust_op_tok->u.value);
if (strcmp (p, "need_device_ptr") == 0
+ || strcmp (p, "need_device_addr") == 0
|| strcmp (p, "nothing") == 0)
{
cp_lexer_consume_token (parser->lexer); // need_device_ptr
cp_lexer_consume_token (parser->lexer); // :
- tree arg;
- tree list
- = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_ERROR,
- NULL_TREE, NULL);
-
- for (tree c = list; c != NULL_TREE; c = TREE_CHAIN (c))
+ tree list = cp_parser_omp_parm_list (parser);
+ if (list && list != error_mark_node)
+ /* It should be fine to just use the identifier node. */
+ append_adjust_args (list, adjust_op_tok->u.value);
+ else
{
- tree decl = TREE_PURPOSE (c);
- location_t arg_loc = EXPR_LOCATION (TREE_VALUE (c));
- int idx;
- for (arg = parms, idx = 0; arg != NULL;
- arg = TREE_CHAIN (arg), idx++)
- if (TREE_VALUE (arg) == decl)
- break;
- if (arg == NULL_TREE)
- {
- error_at (arg_loc, "%qD is not a function argument",
- decl);
- continue;
- }
- arg = TREE_VALUE (arg);
- if (adjust_args_list.contains (arg))
- {
- error_at (arg_loc, "%qD is specified more than once",
- decl);
- continue;
- }
- if (strcmp (p, "need_device_ptr") == 0)
- {
- bool is_ptr_or_template
- = TEMPLATE_PARM_P (TREE_TYPE (arg))
- || POINTER_TYPE_P (TREE_TYPE (arg));
- if (!is_ptr_or_template)
- {
- error_at (arg_loc, "%qD is not a C pointer",
- decl);
- continue;
- }
- }
- adjust_args_list.safe_push (arg);
- if (strcmp (p, "need_device_ptr") == 0)
- {
- need_device_ptr_list = chainon (
- need_device_ptr_list,
- build_tree_list (
- NULL_TREE,
- build_int_cst (
- integer_type_node,
- idx))); // Store 0-based argument index,
- // as in gimplify_call_expr
- }
+ /* Do we need a specific diagnostic here?
+ I don't like failing here, we should be skipping to
+ a close paren and continuing. */
+ goto fail;
}
}
else
{
error_at (adjust_op_tok->location,
- "expected %<nothing%> or %<need_device_ptr%>");
+ "expected %<nothing%>, %<need_device_ptr%> or "
+ "%<need_device_addr%>");
+ /* We should be trying to recover here instead of immediately
+ failing, skipping to close paren and continuing. */
goto fail;
}
}
else
{
+ /* We should be trying to recover here instead of immediately
+ failing, skipping to close paren and continuing. */
error_at (adjust_op_tok->location,
- "expected %<nothing%> or %<need_device_ptr%> followed "
- "by %<:%>");
+ "expected %<nothing%>, %<need_device_ptr%> or "
+ "%<need_device_addr%> followed by %<:%>");
goto fail;
}
+ /* cp_parser_omp_var_list_no_open used to handle this, we don't use
+ it anymore though. */
+ if (!parens.require_close (parser))
+ /* We should be trying to recover here instead of immediately
+ failing, I'm not sure what we skip to though. */
+ goto fail;
}
else if (ccode == append_args)
{
@@ -50614,14 +52495,12 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
cp_lexer_consume_token (parser->lexer); // ','
}
while (true);
- int nbase_args = 0;
- for (tree t = parms;
- t && TREE_VALUE (t) != void_type_node; t = TREE_CHAIN (t))
- nbase_args++;
- /* Store as purpose = arg number after which to append
- and value = list of interop items. */
- append_args_tree = build_tree_list (build_int_cst (integer_type_node,
- nbase_args),
+ /* This is where the number of args used to be inserted, it still
+ gets put here by omp_declare_variant_finalize_one once we know how
+ many parameters there are. Ideally we should refactor the way we
+ pass this data around, once we do that we can remove this bit from
+ here. Until then, leave it be. */
+ append_args_tree = build_tree_list (NULL_TREE,
append_args_tree);
}
} while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL));
@@ -50651,11 +52530,17 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
// We might not have a DECL for the variant yet. So we store the
// need_device_ptr list in the base function attribute, after loc
// nodes.
- tree t = build_tree_list (need_device_ptr_list,
- NULL_TREE /* need_device_addr */);
+ tree debug_idxs_node
+ = CHECKING_P ? get_identifier ("omp adjust args idxs")
+ : NULL_TREE;
+ tree t = build_tree_list (debug_idxs_node,
+ adjust_args_list);
TREE_CHAIN (t) = append_args_tree;
+ tree debug_tail_node
+ = CHECKING_P ? get_identifier ("omp variant clauses temp")
+ : NULL_TREE;
TREE_VALUE (attrs) = chainon (TREE_VALUE (attrs),
- build_tree_list ( NULL_TREE, t));
+ build_tree_list (debug_tail_node, t));
}
}
@@ -50668,8 +52553,7 @@ cp_finish_omp_declare_variant (cp_parser *parser, cp_token *pragma_tok,
been parsed, and put that into "omp declare simd" attribute. */
static tree
-cp_parser_late_parsing_omp_declare_simd (cp_parser *parser, tree attrs,
- tree parms)
+cp_parser_late_parsing_omp_declare_simd (cp_parser *parser, tree attrs)
{
struct cp_token_cache *ce;
cp_omp_declare_simd_data *data = parser->omp_declare_simd;
@@ -50713,7 +52597,7 @@ cp_parser_late_parsing_omp_declare_simd (cp_parser *parser, tree attrs,
{
gcc_assert (strcmp (kind, "variant") == 0);
attrs
- = cp_finish_omp_declare_variant (parser, pragma_tok, attrs, parms);
+ = cp_finish_omp_declare_variant (parser, pragma_tok, attrs);
}
cp_parser_pop_lexer (parser);
}
@@ -50845,7 +52729,7 @@ cp_parser_late_parsing_omp_declare_simd (cp_parser *parser, tree attrs,
{
gcc_assert (strcmp (kind, "variant") == 0);
attrs = cp_finish_omp_declare_variant (parser, pragma_tok,
- attrs, parms);
+ attrs);
}
gcc_assert (parser->lexer != lexer);
vec_safe_truncate (lexer->buffer, 0);
@@ -51113,7 +52997,9 @@ cp_parser_omp_declare_target (cp_parser *parser, cp_token *pragma_tok)
/* OpenMP 5.1
# pragma omp begin assumes clauses[optseq] new-line
- # pragma omp begin declare target clauses[optseq] new-line */
+ # pragma omp begin declare target clauses[optseq] new-line
+
+ # pragma omp begin declare variant (match context-selector) new-line */
#define OMP_BEGIN_DECLARE_TARGET_CLAUSE_MASK \
( (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DEVICE_TYPE) \
@@ -51159,9 +53045,73 @@ cp_parser_omp_begin (cp_parser *parser, cp_token *pragma_tok)
= { in_omp_attribute_pragma, device_type, indirect };
vec_safe_push (scope_chain->omp_declare_target_attribute, a);
}
+ else if (strcmp (p, "variant") == 0)
+ {
+ cp_lexer_consume_token (parser->lexer);
+ const char *clause = "";
+ matching_parens parens;
+ location_t match_loc = cp_lexer_peek_token (parser->lexer)->location;
+ if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+ {
+ tree id = cp_lexer_peek_token (parser->lexer)->u.value;
+ clause = IDENTIFIER_POINTER (id);
+ }
+ if (strcmp (clause, "match") != 0)
+ {
+ cp_parser_error (parser, "expected %<match%>");
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ return;
+ }
+
+ cp_lexer_consume_token (parser->lexer);
+
+ if (!parens.require_open (parser))
+ {
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ return;
+ }
+
+ tree ctx = cp_parser_omp_context_selector_specification (parser,
+ true);
+ if (ctx != error_mark_node)
+ ctx = omp_check_context_selector (match_loc, ctx,
+ OMP_CTX_BEGIN_DECLARE_VARIANT);
+
+ if (ctx != error_mark_node
+ && !vec_safe_is_empty (scope_chain->omp_declare_variant_attribute))
+ {
+ cp_omp_declare_variant_attr a
+ = scope_chain->omp_declare_variant_attribute->last ();
+ tree outer_ctx = a.selector;
+ ctx = omp_merge_context_selectors (match_loc, outer_ctx, ctx,
+ OMP_CTX_BEGIN_DECLARE_VARIANT);
+ }
+
+ if (ctx == error_mark_node
+ || !omp_context_selector_matches (ctx, NULL_TREE, false, true))
+ {
+ /* The context is either invalid or cannot possibly match.
+ In the latter case the spec says all code in the begin/end
+ sequence will be elided. In the former case we'll get bogus
+ errors from trying to parse it without a valid context to
+ use for name-mangling, so elide that too. */
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ cp_parser_skip_to_pragma_omp_end_declare_variant (parser);
+ return;
+ }
+ else
+ {
+ cp_omp_declare_variant_attr a
+ = { parser->lexer->in_omp_attribute_pragma, ctx };
+ vec_safe_push (scope_chain->omp_declare_variant_attribute, a);
+ }
+
+ parens.require_close (parser);
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ }
else
{
- cp_parser_error (parser, "expected %<target%>");
+ cp_parser_error (parser, "expected %<target%> or %<variant%>");
cp_parser_skip_to_pragma_eol (parser, pragma_tok);
}
}
@@ -51174,7 +53124,8 @@ cp_parser_omp_begin (cp_parser *parser, cp_token *pragma_tok)
}
else
{
- cp_parser_error (parser, "expected %<declare target%> or %<assumes%>");
+ cp_parser_error (parser, "expected %<declare target%>, "
+ "%<declare variant%>, or %<assumes%>");
cp_parser_skip_to_pragma_eol (parser, pragma_tok);
}
}
@@ -51183,7 +53134,8 @@ cp_parser_omp_begin (cp_parser *parser, cp_token *pragma_tok)
# pragma omp end declare target new-line
OpenMP 5.1:
- # pragma omp end assumes new-line */
+ # pragma omp end assumes new-line
+ # pragma omp end declare variant new-line */
static void
cp_parser_omp_end (cp_parser *parser, cp_token *pragma_tok)
@@ -51205,41 +53157,70 @@ cp_parser_omp_end (cp_parser *parser, cp_token *pragma_tok)
p = IDENTIFIER_POINTER (id);
}
if (strcmp (p, "target") == 0)
- cp_lexer_consume_token (parser->lexer);
- else
{
- cp_parser_error (parser, "expected %<target%>");
- cp_parser_skip_to_pragma_eol (parser, pragma_tok);
- return;
+ cp_lexer_consume_token (parser->lexer);
+ cp_parser_require_pragma_eol (parser, pragma_tok);
+ if (!vec_safe_length (scope_chain->omp_declare_target_attribute))
+ error_at (pragma_tok->location,
+ "%<#pragma omp end declare target%> without "
+ "corresponding %<#pragma omp declare target%> or "
+ "%<#pragma omp begin declare target%>");
+ else
+ {
+ cp_omp_declare_target_attr
+ a = scope_chain->omp_declare_target_attribute->pop ();
+ if (a.attr_syntax != in_omp_attribute_pragma)
+ {
+ if (a.attr_syntax)
+ error_at (pragma_tok->location,
+ "%qs in attribute syntax terminated "
+ "with %qs in pragma syntax",
+ a.device_type >= 0 ? "begin declare target"
+ : "declare target",
+ "end declare target");
+ else
+ error_at (pragma_tok->location,
+ "%qs in pragma syntax terminated "
+ "with %qs in attribute syntax",
+ a.device_type >= 0 ? "begin declare target"
+ : "declare target",
+ "end declare target");
+ }
+ }
}
- cp_parser_require_pragma_eol (parser, pragma_tok);
- if (!vec_safe_length (scope_chain->omp_declare_target_attribute))
- error_at (pragma_tok->location,
- "%<#pragma omp end declare target%> without corresponding "
- "%<#pragma omp declare target%> or "
- "%<#pragma omp begin declare target%>");
- else
+ else if (strcmp (p, "variant") == 0)
{
- cp_omp_declare_target_attr
- a = scope_chain->omp_declare_target_attribute->pop ();
- if (a.attr_syntax != in_omp_attribute_pragma)
+ cp_lexer_consume_token (parser->lexer);
+ cp_parser_require_pragma_eol (parser, pragma_tok);
+ if (!vec_safe_length (scope_chain->omp_declare_variant_attribute))
+ error_at (pragma_tok->location,
+ "%<#pragma omp end declare variant%> without "
+ "corresponding %<#pragma omp begin declare variant%>");
+ else
{
- if (a.attr_syntax)
- error_at (pragma_tok->location,
- "%qs in attribute syntax terminated "
- "with %qs in pragma syntax",
- a.device_type >= 0 ? "begin declare target"
- : "declare target",
- "end declare target");
- else
- error_at (pragma_tok->location,
- "%qs in pragma syntax terminated "
- "with %qs in attribute syntax",
- a.device_type >= 0 ? "begin declare target"
- : "declare target",
- "end declare target");
+ cp_omp_declare_variant_attr
+ a = scope_chain->omp_declare_variant_attribute->pop ();
+ if (a.attr_syntax != in_omp_attribute_pragma)
+ {
+ if (a.attr_syntax)
+ error_at (pragma_tok->location,
+ "%<begin declare variant%> in attribute syntax "
+ "terminated with %<end declare variant%> in "
+ "pragma syntax");
+ else
+ error_at (pragma_tok->location,
+ "%<begin declare variant%> in pragma syntax "
+ "terminated with %<end declare variant%> in "
+ "attribute syntax");
+ }
}
}
+ else
+ {
+ cp_parser_error (parser, "expected %<target%>");
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ return;
+ }
}
else if (strcmp (p, "assumes") == 0)
{
@@ -52136,6 +54117,172 @@ cp_parser_omp_declare_reduction (cp_parser *parser, cp_token *pragma_tok,
obstack_free (&declarator_obstack, p);
}
+/* OpenMP 5.0
+ #pragma omp declare mapper([mapper-identifier:]type var) \
+ [clause[[,] clause] ... ] new-line */
+
+static void
+cp_parser_omp_declare_mapper (cp_parser *parser, cp_token *pragma_tok,
+ enum pragma_context)
+{
+ cp_token *token = NULL;
+ tree type = NULL_TREE, vardecl = NULL_TREE, block = NULL_TREE;
+ bool block_scope = false;
+ /* Don't create location wrapper nodes within "declare mapper"
+ directives. */
+ auto_suppress_location_wrappers sentinel;
+ tree mapper_name = NULL_TREE;
+ tree mapper_id, id, placeholder, mapper, maplist = NULL_TREE;
+
+ if (!cp_parser_require (parser, CPP_OPEN_PAREN, RT_OPEN_PAREN))
+ goto fail;
+
+ if (current_function_decl)
+ block_scope = true;
+
+ token = cp_lexer_peek_token (parser->lexer);
+
+ if (cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON))
+ {
+ switch (token->type)
+ {
+ case CPP_NAME:
+ {
+ cp_expr e = cp_parser_identifier (parser);
+ if (e != error_mark_node)
+ mapper_name = e;
+ else
+ goto fail;
+ }
+ break;
+
+ case CPP_KEYWORD:
+ if (token->keyword == RID_DEFAULT)
+ {
+ mapper_name = NULL_TREE;
+ cp_lexer_consume_token (parser->lexer);
+ break;
+ }
+ /* Fallthrough. */
+
+ default:
+ cp_parser_error (parser, "expected identifier or %<default%>");
+ }
+
+ if (!cp_parser_require (parser, CPP_COLON, RT_COLON))
+ goto fail;
+ }
+
+ {
+ const char *saved_message = parser->type_definition_forbidden_message;
+ parser->type_definition_forbidden_message
+ = G_("types may not be defined within %<declare mapper%>");
+ type_id_in_expr_sentinel s (parser);
+ type = cp_parser_type_id (parser);
+ parser->type_definition_forbidden_message = saved_message;
+ }
+
+ if (dependent_type_p (type))
+ mapper_id = omp_mapper_id (mapper_name, NULL_TREE);
+ else
+ mapper_id = omp_mapper_id (mapper_name, type);
+
+ vardecl = build_lang_decl (VAR_DECL, mapper_id, type);
+ DECL_ARTIFICIAL (vardecl) = 1;
+ TREE_STATIC (vardecl) = 1;
+ TREE_PUBLIC (vardecl) = 0;
+ DECL_EXTERNAL (vardecl) = 0;
+ DECL_DECLARED_CONSTEXPR_P (vardecl) = 1;
+ DECL_INITIALIZED_BY_CONSTANT_EXPRESSION_P (vardecl) = 1;
+ DECL_OMP_DECLARE_MAPPER_P (vardecl) = 1;
+
+ keep_next_level (true);
+ block = begin_omp_structured_block ();
+
+ if (block_scope)
+ DECL_CONTEXT (vardecl) = current_function_decl;
+ else if (current_class_type)
+ DECL_CONTEXT (vardecl) = current_class_type;
+ else
+ DECL_CONTEXT (vardecl) = current_namespace;
+
+ if (processing_template_decl)
+ vardecl = push_template_decl (vardecl);
+
+ id = cp_parser_declarator_id (parser, false);
+
+ if (!cp_parser_require (parser, CPP_CLOSE_PAREN, RT_CLOSE_PAREN))
+ {
+ finish_omp_structured_block (block);
+ goto fail;
+ }
+
+ placeholder = build_lang_decl (VAR_DECL, id, type);
+ DECL_CONTEXT (placeholder) = DECL_CONTEXT (vardecl);
+ if (processing_template_decl)
+ placeholder = push_template_decl (placeholder);
+ pushdecl (placeholder);
+ cp_finish_decl (placeholder, NULL_TREE, 0, NULL_TREE, 0);
+ DECL_ARTIFICIAL (placeholder) = 1;
+ TREE_USED (placeholder) = 1;
+
+ while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
+ {
+ pragma_omp_clause c_kind = cp_parser_omp_clause_name (parser);
+ if (c_kind != PRAGMA_OMP_CLAUSE_MAP)
+ {
+ if (c_kind != PRAGMA_OMP_CLAUSE_NONE)
+ cp_parser_error (parser, "unexpected clause");
+ finish_omp_structured_block (block);
+ goto fail;
+ }
+ maplist = cp_parser_omp_clause_map (parser, maplist, GOMP_MAP_UNSET);
+ if (maplist == NULL_TREE)
+ break;
+ }
+
+ if (maplist == NULL_TREE)
+ {
+ cp_parser_error (parser, "missing %<map%> clause");
+ finish_omp_structured_block (block);
+ goto fail;
+ }
+
+ mapper = make_node (OMP_DECLARE_MAPPER);
+ TREE_TYPE (mapper) = type;
+ OMP_DECLARE_MAPPER_ID (mapper) = mapper_name;
+ OMP_DECLARE_MAPPER_DECL (mapper) = placeholder;
+ OMP_DECLARE_MAPPER_CLAUSES (mapper) = maplist;
+
+ finish_omp_structured_block (block);
+
+ DECL_INITIAL (vardecl) = mapper;
+
+ if (current_class_type)
+ {
+ if (processing_template_decl)
+ {
+ retrofit_lang_decl (vardecl);
+ SET_DECL_VAR_DECLARED_INLINE_P (vardecl);
+ }
+ finish_static_data_member_decl (vardecl, mapper,
+ /*init_const_expr_p=*/true, NULL_TREE, 0);
+ finish_member_declaration (vardecl);
+ }
+ else if (processing_template_decl && block_scope)
+ add_decl_expr (vardecl);
+ else
+ pushdecl (vardecl);
+
+ cp_check_omp_declare_mapper (vardecl);
+
+ cp_parser_require_pragma_eol (parser, pragma_tok);
+ return;
+
+fail:
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+}
+
/* OpenMP 4.0
#pragma omp declare simd declare-simd-clauses[optseq] new-line
#pragma omp declare reduction (reduction-id : typename-list : expression) \
@@ -52180,6 +54327,12 @@ cp_parser_omp_declare (cp_parser *parser, cp_token *pragma_tok,
context);
return false;
}
+ if (strcmp (p, "mapper") == 0)
+ {
+ cp_lexer_consume_token (parser->lexer);
+ cp_parser_omp_declare_mapper (parser, pragma_tok, context);
+ return false;
+ }
if (!flag_openmp) /* flag_openmp_simd */
{
cp_parser_skip_to_pragma_eol (parser, pragma_tok);
@@ -52193,7 +54346,7 @@ cp_parser_omp_declare (cp_parser *parser, cp_token *pragma_tok,
}
}
cp_parser_error (parser, "expected %<simd%>, %<reduction%>, "
- "%<target%> or %<variant%>");
+ "%<target%>, %<mapper%> or %<variant%>");
cp_parser_require_pragma_eol (parser, pragma_tok);
return false;
}
@@ -52968,8 +55121,8 @@ cp_parser_omp_construct (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
stmt = cp_parser_oacc_wait (parser, pragma_tok);
break;
case PRAGMA_OMP_ALLOCATE:
- cp_parser_omp_allocate (parser, pragma_tok);
- return;
+ /* This is a declarative directive, not a construct. */
+ gcc_unreachable ();
case PRAGMA_OMP_ATOMIC:
cp_parser_omp_atomic (parser, pragma_tok, false);
return;
@@ -53671,7 +55824,10 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
cp_parser_omp_construct (parser, pragma_tok, if_p);
return true;
case PRAGMA_OMP_ALLOCATE:
+ /* Don't go through cp_parser_omp_construct as this pragma is a
+ declarative directive, not a construct. */
cp_parser_omp_allocate (parser, pragma_tok);
+ /* EOL is handled in cp_parser_omp_allocate. */
return false;
case PRAGMA_OACC_ATOMIC:
case PRAGMA_OACC_CACHE:
diff --git a/gcc/cp/parser.h b/gcc/cp/parser.h
index f9ed801..b8cf763 100644
--- a/gcc/cp/parser.h
+++ b/gcc/cp/parser.h
@@ -419,6 +419,13 @@ struct GTY(()) cp_parser {
/* TRUE if an OpenMP array section is allowed. */
bool omp_array_section_p;
+ /* TRUE if an OpenMP array-shaping operator is allowed. */
+ bool omp_array_shaping_op_p;
+
+ /* TRUE if we are parsing an expression with an OpenMP array-shaping
+ operator. */
+ bool omp_has_array_shape_p;
+
/* Tracks the function's template parameter list when declaring a function
using generic type parameters. This is either a new chain in the case of a
fully implicit function template or an extension of the function's existing
@@ -456,6 +463,11 @@ struct GTY(()) cp_parser {
outside that file. */
struct omp_metadirective_parse_data * GTY((skip))
omp_metadirective_state;
+
+ /* TREE_LIST of "omp begin declare variant" functions when the base
+ function has not been seen "elsewhere" (per the OpenMP spec) yet;
+ used only when these functions are seen in a class definition. */
+ tree omp_unregistered_variants;
};
/* In parser.cc */
diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc
index be9af50..fc2b31f 100644
--- a/gcc/cp/pt.cc
+++ b/gcc/cp/pt.cc
@@ -12151,36 +12151,159 @@ tsubst_attribute (tree t, tree *decl_p, tree args,
++cp_unevaluated_operand;
tree varid = tsubst_expr (TREE_PURPOSE (val), args, complain, in_decl);
--cp_unevaluated_operand;
- tree chain = TREE_CHAIN (val);
+ tree chain = copy_list (TREE_CHAIN (val));
location_t match_loc = cp_expr_loc_or_input_loc (TREE_PURPOSE (chain));
tree ctx = copy_list (TREE_VALUE (val));
- tree append_args_list = TREE_CHAIN (TREE_CHAIN (chain));
- if (append_args_list
- && TREE_VALUE (append_args_list)
- && TREE_CHAIN (TREE_VALUE (append_args_list)))
- {
- append_args_list = TREE_VALUE (append_args_list);
- append_args_list = TREE_VALUE (TREE_CHAIN (append_args_list));
- for (; append_args_list;
- append_args_list = TREE_CHAIN (append_args_list))
- {
- tree pref_list = TREE_VALUE (append_args_list);
- if (pref_list == NULL_TREE || TREE_CODE (pref_list) != TREE_LIST)
+ /* These asserts may seem strange but the layout of this attribute is
+ really difficult to grok and remember. They should be left in until
+ we refactor the layout of the stored nodes. */
+ gcc_assert (TREE_CHAIN (chain));
+ /* These nodes were copied by copy_list above, don't copy it again. */
+ tree omp_variant_clauses = TREE_CHAIN (TREE_CHAIN (chain));
+ gcc_checking_assert (!omp_variant_clauses
+ || TREE_PURPOSE (omp_variant_clauses)
+ == get_identifier ("omp variant clauses temp"));
+ tree adjust_args_idxs = NULL_TREE;
+ if (omp_variant_clauses)
+ {
+ gcc_assert (TREE_VALUE (omp_variant_clauses));
+ adjust_args_idxs = copy_node (TREE_VALUE (omp_variant_clauses));
+ gcc_assert (adjust_args_idxs);
+ gcc_checking_assert (TREE_PURPOSE (adjust_args_idxs)
+ == get_identifier ("omp adjust args idxs"));
+ /* copy_node doesn't copy the CHAIN. */
+ if (adjust_args_idxs)
+ {
+ if (TREE_CHAIN (TREE_VALUE (omp_variant_clauses)))
+ TREE_CHAIN (adjust_args_idxs)
+ = copy_node (TREE_CHAIN (TREE_VALUE (omp_variant_clauses)));
+ TREE_VALUE (omp_variant_clauses) = adjust_args_idxs;
+ }
+ }
+ if (adjust_args_idxs
+ && TREE_CHAIN (adjust_args_idxs))
+ {
+ /* This only needs to be copied if node PURPOSE is NULL_TREE, or if
+ there is a dependent prefer type node. It's hard to determine
+ this though, so don't try to handle it conditionally for now. */
+ tree append_args_node = TREE_CHAIN (adjust_args_idxs);
+ /* PURPOSE holds the count of real args, it doesn't need to be copied
+ because it will just be replaced if it needs to be changed.
+ VALUE holds the list of append_args. */
+ append_args_node = copy_node (append_args_node);
+ /* It's too hard to figure out if we have anything dependent,
+ unconditionally copy this list. */
+ tree append_args_head = copy_list (TREE_VALUE (append_args_node));
+ for (tree n = append_args_head; n != NULL_TREE; n = TREE_CHAIN (n))
+ {
+ tree pref_list = TREE_VALUE (n);
+ if (pref_list == NULL_TREE
+ || TREE_CODE (pref_list) != TREE_LIST)
+ /* Not a pref_list. */
continue;
- tree fr_list = TREE_VALUE (pref_list);
+ tree fr_list = copy_node (TREE_VALUE (pref_list));
int len = TREE_VEC_LENGTH (fr_list);
+ /* Track if substitution occurs.
+ I'm not really sure that this even works the way I hope it
+ does, really I'm pretty sure tsubst_expr will basically always
+ return some sort of copy. The proper solution is probably
+ marking the list as dependent during parsing. */
+ bool substituted = false;
for (int i = 0; i < len; i++)
{
- tree *fr_expr = &TREE_VEC_ELT (fr_list, i);
- /* Preserve NOP_EXPR to have a location. */
- if (*fr_expr && TREE_CODE (*fr_expr) == NOP_EXPR)
- TREE_OPERAND (*fr_expr, 0)
- = tsubst_expr (TREE_OPERAND (*fr_expr, 0), args, complain,
- in_decl);
- else
- *fr_expr = tsubst_expr (*fr_expr, args, complain, in_decl);
+ tree elt = TREE_VEC_ELT (fr_list, i);
+ if (!elt)
+ continue;
+ tree expr = TREE_CODE (elt) == NOP_EXPR
+ ? TREE_OPERAND (elt, 0)
+ : elt;
+ tree new_expr = tsubst_expr (expr, args, complain, in_decl);
+ if (new_expr != expr)
+ {
+ substituted = true;
+ if (TREE_CODE (elt) == NOP_EXPR)
+ {
+ tree copied_nop = copy_node (elt);
+ TREE_OPERAND (copied_nop, 0) = new_expr;
+ TREE_VEC_ELT (fr_list, i) = copied_nop;
+ }
+ else
+ TREE_VEC_ELT (fr_list, i) = new_expr;
+ }
+ }
+ if (substituted)
+ {
+ pref_list = copy_node (pref_list);
+ TREE_VALUE (pref_list) = fr_list;
+ /* This node gets mutated in cp_finish_omp_init_prefer_type
+ if fr_list is dependent, it needs to be copied. */
+ TREE_PURPOSE (pref_list)
+ = copy_node (TREE_PURPOSE (pref_list));
+ TREE_VALUE (n) = pref_list;
}
}
+ TREE_VALUE (append_args_node) = append_args_head;
+ TREE_CHAIN (adjust_args_idxs) = append_args_node;
+ }
+ gcc_assert (TREE_CHAIN (chain));
+
+ tree adjust_args_list = adjust_args_idxs
+ ? TREE_VALUE (adjust_args_idxs)
+ : NULL_TREE;
+
+ if (adjust_args_list && ATTR_IS_DEPENDENT (adjust_args_list))
+ {
+ tree copied = copy_list (adjust_args_list);
+ /* Substitute numeric ranges, we also need to copy ranges with
+ relative bounds, in theory it's possible for them to get expanded
+ while one bound is still dependent. */
+ for (tree n = copied; n; n = TREE_CHAIN (n))
+ {
+ tree item = TREE_VALUE (n);
+ const tree_code code = TREE_CODE (TREE_VALUE (item));
+ gcc_assert (code == PARM_DECL
+ || code == INTEGER_CST
+ || code == TREE_LIST);
+ if (code == TREE_LIST)
+ {
+ tree range = TREE_VALUE (item);
+ gcc_assert (TREE_CODE (range) == TREE_LIST);
+ auto tsubst_bound = [&] (tree bound)
+ {
+ gcc_assert (bound != NULL_TREE);
+ if (bound == error_mark_node
+ || !ATTR_IS_DEPENDENT (bound))
+ {
+ /* As above, copy the bound if it is relative. */
+ if (TREE_PURPOSE (bound) != NULL_TREE)
+ return copy_node (bound);
+ else
+ return bound;
+ }
+ tree expr = TREE_VALUE (bound);
+ tree subst_expr
+ = tsubst_expr (expr, args, complain, in_decl);
+ gcc_assert (subst_expr != expr);
+ tree new_bound = build_tree_list (TREE_PURPOSE (bound),
+ subst_expr);
+ return new_bound;
+ };
+ tree lb = tsubst_bound (TREE_PURPOSE (range));
+ tree ub = tsubst_bound (TREE_VALUE (range));
+ /* Only build a new range if substitution occured. */
+ if (lb != TREE_PURPOSE (range)
+ || ub != TREE_VALUE (range))
+ {
+ tree new_range = build_tree_list (lb, ub);
+ /* We don't need to copy the purpose, it just holds
+ a location. */
+ TREE_VALUE (n) = build_tree_list (TREE_PURPOSE (item),
+ new_range);
+ }
+ }
+ }
+ TREE_VALUE (adjust_args_idxs) = copied;
+ TREE_VALUE (omp_variant_clauses) = adjust_args_idxs;
}
for (tree tss = ctx; tss; tss = TREE_CHAIN (tss))
{
@@ -15904,7 +16027,10 @@ tsubst_decl (tree t, tree args, tsubst_flags_t complain,
= remove_attribute ("visibility", DECL_ATTRIBUTES (r));
}
determine_visibility (r);
- if ((!local_p || TREE_STATIC (t)) && DECL_SECTION_NAME (t))
+ if ((!local_p || TREE_STATIC (t))
+ && !(flag_openmp && DECL_LANG_SPECIFIC (t)
+ && DECL_OMP_DECLARE_MAPPER_P (t))
+ && DECL_SECTION_NAME (t))
set_decl_section_name (r, t);
}
@@ -15956,6 +16082,13 @@ tsubst_decl (tree t, tree args, tsubst_flags_t complain,
SET_TYPE_STRUCTURAL_EQUALITY (TREE_TYPE (r));
}
+ if (flag_openmp
+ && VAR_P (t)
+ && DECL_LANG_SPECIFIC (t)
+ && DECL_OMP_DECLARE_MAPPER_P (t)
+ && strchr (IDENTIFIER_POINTER (DECL_NAME (t)), '~') == NULL)
+ DECL_NAME (r) = omp_mapper_id (DECL_NAME (t), TREE_TYPE (r));
+
layout_decl (r, 0);
}
break;
@@ -17252,6 +17385,10 @@ tsubst (tree t, tree args, tsubst_flags_t complain, tree in_decl)
member access. */
id = false;
type = finish_decltype_type (type, id, complain);
+
+ if (DECLTYPE_FOR_OMP_ARRAYSHAPE_CAST (t)
+ && TYPE_REF_P (type))
+ type = TREE_TYPE (type);
}
return cp_build_qualified_type (type,
cp_type_quals (t)
@@ -17847,9 +17984,7 @@ tsubst_omp_clause_decl (tree decl, tree args, tsubst_flags_t complain,
return decl;
/* Handle OpenMP iterators. */
- if (TREE_CODE (decl) == TREE_LIST
- && TREE_PURPOSE (decl)
- && TREE_CODE (TREE_PURPOSE (decl)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (decl))
{
tree ret;
if (iterator_cache[0] == TREE_PURPOSE (decl))
@@ -17911,14 +18046,17 @@ tsubst_omp_clause_decl (tree decl, tree args, tsubst_flags_t complain,
= tsubst_stmt (TREE_OPERAND (decl, 1), args, complain, in_decl);
tree length = tsubst_stmt (TREE_OPERAND (decl, 2), args, complain,
in_decl);
+ tree stride = tsubst_stmt (TREE_OPERAND (decl, 3), args, complain,
+ in_decl);
tree base = tsubst_omp_clause_decl (TREE_OPERAND (decl, 0), args,
complain, in_decl, NULL);
if (TREE_OPERAND (decl, 0) == base
&& TREE_OPERAND (decl, 1) == low_bound
- && TREE_OPERAND (decl, 2) == length)
+ && TREE_OPERAND (decl, 2) == length
+ && TREE_OPERAND (decl, 3) == stride)
return decl;
- return build3 (OMP_ARRAY_SECTION, TREE_TYPE (base), base, low_bound,
- length);
+ return build4 (OMP_ARRAY_SECTION, TREE_TYPE (base), base, low_bound,
+ length, stride);
}
tree ret = tsubst_stmt (decl, args, complain, in_decl);
/* Undo convert_from_reference tsubst_expr could have called. */
@@ -18220,8 +18358,10 @@ tsubst_omp_clauses (tree clauses, enum c_omp_region_type ort,
}
new_clauses = nreverse (new_clauses);
- if (ort != C_ORT_OMP_DECLARE_SIMD)
+ if (ort != C_ORT_OMP_DECLARE_SIMD && ort != C_ORT_OMP_DECLARE_MAPPER)
{
+ if (ort & C_ORT_OMP)
+ new_clauses = c_omp_instantiate_mappers (new_clauses, ort);
new_clauses = finish_omp_clauses (new_clauses, ort);
if (linear_no_step)
for (nc = new_clauses; nc; nc = OMP_CLAUSE_CHAIN (nc))
@@ -19668,6 +19808,31 @@ tsubst_stmt (tree t, tree args, tsubst_flags_t complain, tree in_decl)
OMP_DEPOBJ_CLAUSES (t));
break;
+ case OMP_ALLOCATE:
+ {
+ gcc_assert (flag_openmp);
+
+ tree alloc
+ = tsubst_expr (OMP_ALLOCATE_ALLOCATOR (t), args, complain, in_decl);
+ tree align
+ = tsubst_expr (OMP_ALLOCATE_ALIGN (t), args, complain, in_decl);
+ tree vars = copy_list (OMP_ALLOCATE_VARS (t));
+ for (tree node = vars; node != NULL_TREE; node = TREE_CHAIN (node))
+ {
+ if (TREE_PURPOSE (node) == error_mark_node)
+ continue;
+ /* The var was already substituted, just look up the new node. */
+ tree var = lookup_name (DECL_NAME (TREE_PURPOSE (node)),
+ LOOK_where::BLOCK, LOOK_want::NORMAL);
+ /* There's a weird edge case where lookup_name returns NULL_TREE,
+ but only for incorrect code. Even so, handle NULL_TREE to avoid
+ segfaulting in those cases. */
+ TREE_PURPOSE (node) = var ? var : error_mark_node;
+ /* Don't copy the attr here, let finish_omp_allocate handle it. */
+ }
+ finish_omp_allocate (OMP_ALLOCATE_LOCATION (t), vars, alloc, align);
+ break;
+ }
case OACC_DATA:
case OMP_TARGET_DATA:
case OMP_TARGET:
@@ -19736,7 +19901,9 @@ tsubst_stmt (tree t, tree args, tsubst_flags_t complain, tree in_decl)
case OMP_TARGET_UPDATE:
case OMP_TARGET_ENTER_DATA:
case OMP_TARGET_EXIT_DATA:
- tmp = tsubst_omp_clauses (OMP_STANDALONE_CLAUSES (t), C_ORT_OMP, args,
+ tmp = tsubst_omp_clauses (OMP_STANDALONE_CLAUSES (t),
+ (TREE_CODE (t) == OMP_TARGET_EXIT_DATA
+ ? C_ORT_OMP_EXIT_DATA : C_ORT_OMP), args,
complain, in_decl);
t = copy_node (t);
OMP_STANDALONE_CLAUSES (t) = tmp;
@@ -19941,6 +20108,22 @@ tsubst_stmt (tree t, tree args, tsubst_flags_t complain, tree in_decl)
break;
}
+ case OMP_DECLARE_MAPPER:
+ {
+ t = copy_node (t);
+
+ tree decl = OMP_DECLARE_MAPPER_DECL (t);
+ decl = tsubst (decl, args, complain, in_decl);
+ tree type = tsubst (TREE_TYPE (t), args, complain, in_decl);
+ tree clauses = OMP_DECLARE_MAPPER_CLAUSES (t);
+ clauses = tsubst_omp_clauses (clauses, C_ORT_OMP_DECLARE_MAPPER, args,
+ complain, in_decl);
+ TREE_TYPE (t) = type;
+ OMP_DECLARE_MAPPER_DECL (t) = decl;
+ OMP_DECLARE_MAPPER_CLAUSES (t) = clauses;
+ RETURN (t);
+ }
+
case TRANSACTION_EXPR:
{
int flags = 0;
@@ -20797,6 +20980,14 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl)
RETURN (cp_build_bit_cast (EXPR_LOCATION (t), type, op0, complain));
}
+ case OMP_ARRAYSHAPE_CAST_EXPR:
+ {
+ tree type = tsubst (TREE_TYPE (t), args, complain, in_decl);
+ tree op0 = RECUR (TREE_OPERAND (t, 0));
+ RETURN (cp_build_omp_arrayshape_cast (EXPR_LOCATION (t), type, op0,
+ complain));
+ }
+
case POSTDECREMENT_EXPR:
case POSTINCREMENT_EXPR:
op1 = tsubst_non_call_postfix_expression (TREE_OPERAND (t, 0),
@@ -20982,7 +21173,7 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl)
case OMP_ARRAY_SECTION:
{
tree op0 = RECUR (TREE_OPERAND (t, 0));
- tree op1 = NULL_TREE, op2 = NULL_TREE;
+ tree op1 = NULL_TREE, op2 = NULL_TREE, op3 = NULL_TREE;
if (op0 == error_mark_node)
RETURN (error_mark_node);
if (TREE_OPERAND (t, 1))
@@ -20997,7 +21188,31 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl)
if (op2 == error_mark_node)
RETURN (error_mark_node);
}
- RETURN (build_omp_array_section (EXPR_LOCATION (t), op0, op1, op2));
+ if (TREE_OPERAND (t, 3))
+ {
+ op3 = RECUR (TREE_OPERAND (t, 3));
+ if (op3 == error_mark_node)
+ RETURN (error_mark_node);
+ }
+ RETURN (build_omp_array_section (EXPR_LOCATION (t), op0, op1, op2,
+ op3));
+ }
+
+ case OMP_DECLARE_MAPPER:
+ {
+ t = copy_node (t);
+
+ tree decl = OMP_DECLARE_MAPPER_DECL (t);
+ DECL_OMP_DECLARE_MAPPER_P (decl) = 1;
+ decl = tsubst (decl, args, complain, in_decl);
+ tree type = tsubst (TREE_TYPE (t), args, complain, in_decl);
+ tree clauses = OMP_DECLARE_MAPPER_CLAUSES (t);
+ clauses = tsubst_omp_clauses (clauses, C_ORT_OMP_DECLARE_MAPPER, args,
+ complain, in_decl);
+ TREE_TYPE (t) = type;
+ OMP_DECLARE_MAPPER_DECL (t) = decl;
+ OMP_DECLARE_MAPPER_CLAUSES (t) = clauses;
+ RETURN (t);
}
case SIZEOF_EXPR:
@@ -27967,7 +28182,9 @@ instantiate_decl (tree d, bool defer_ok, bool expl_inst_class_mem_p)
|| (external_p && VAR_P (d))
/* Handle here a deleted function too, avoid generating
its body (c++/61080). */
- || deleted_p)
+ || deleted_p
+ /* We need the initializer for an OpenMP declare mapper. */
+ || (VAR_P (d) && DECL_LANG_SPECIFIC (d) && DECL_OMP_DECLARE_MAPPER_P (d)))
{
/* The definition of the static data member is now required so
we must substitute the initializer. */
diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc
index a10ef34..32d4511 100644
--- a/gcc/cp/semantics.cc
+++ b/gcc/cp/semantics.cc
@@ -45,6 +45,7 @@ along with GCC; see the file COPYING3. If not see
#include "gomp-constants.h"
#include "predict.h"
#include "memmodel.h"
+#include "gimplify.h"
/* There routines provide a modular interface to perform many parsing
operations. They may therefore be used during actual parsing, or
@@ -4010,6 +4011,13 @@ finish_translation_unit (void)
"#pragma omp end declare target");
vec_safe_truncate (scope_chain->omp_declare_target_attribute, 0);
}
+ if (vec_safe_length (scope_chain->omp_declare_variant_attribute))
+ {
+ if (!errorcount)
+ error ("%<omp begin declare variant%> without corresponding "
+ "%<omp end declare variant%>");
+ vec_safe_truncate (scope_chain->omp_declare_variant_attribute, 0);
+ }
if (vec_safe_length (scope_chain->omp_begin_assumes))
{
if (!errorcount)
@@ -5906,14 +5914,17 @@ public:
<= FIRST_NON_ONE we diagnose non-contiguous arrays if low bound isn't
0 or length isn't the array domain max + 1, for > FIRST_NON_ONE we
can if MAYBE_ZERO_LEN is false. MAYBE_ZERO_LEN will be true in the above
- case though, as some lengths could be zero. */
+ case though, as some lengths could be zero.
+ NON_CONTIGUOUS will be true if this is an OpenACC non-contiguous array
+ section. */
static tree
handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
bool &maybe_zero_len, unsigned int &first_non_one,
- enum c_omp_region_type ort)
+ bool &non_contiguous, enum c_omp_region_type ort,
+ int *discontiguous)
{
- tree ret, low_bound, length, type;
+ tree ret, low_bound, length, stride, type;
bool openacc = (ort & C_ORT_ACC) != 0;
if (TREE_CODE (t) != OMP_ARRAY_SECTION)
{
@@ -5975,18 +5986,26 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
&& TREE_CODE (TREE_OPERAND (t, 0)) == FIELD_DECL)
TREE_OPERAND (t, 0) = omp_privatize_field (TREE_OPERAND (t, 0), false);
ret = handle_omp_array_sections_1 (c, TREE_OPERAND (t, 0), types,
- maybe_zero_len, first_non_one, ort);
+ maybe_zero_len, first_non_one,
+ non_contiguous, ort, discontiguous);
if (ret == error_mark_node || ret == NULL_TREE)
return ret;
- type = TREE_TYPE (ret);
+ if (TREE_CODE (ret) == OMP_ARRAY_SECTION)
+ type = TREE_TYPE (TREE_TYPE (TREE_OPERAND (ret, 0)));
+ else
+ type = TREE_TYPE (ret);
low_bound = TREE_OPERAND (t, 1);
length = TREE_OPERAND (t, 2);
+ stride = TREE_OPERAND (t, 3);
if ((low_bound && type_dependent_expression_p (low_bound))
- || (length && type_dependent_expression_p (length)))
+ || (length && type_dependent_expression_p (length))
+ || (stride && type_dependent_expression_p (stride)))
return NULL_TREE;
- if (low_bound == error_mark_node || length == error_mark_node)
+ if (low_bound == error_mark_node
+ || length == error_mark_node
+ || stride == error_mark_node)
return error_mark_node;
if (low_bound && !INTEGRAL_TYPE_P (TREE_TYPE (low_bound)))
@@ -6003,15 +6022,26 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
length);
return error_mark_node;
}
+ if (stride && !INTEGRAL_TYPE_P (TREE_TYPE (stride)))
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "stride %qE of array section does not have integral type",
+ stride);
+ return error_mark_node;
+ }
if (low_bound)
low_bound = mark_rvalue_use (low_bound);
if (length)
length = mark_rvalue_use (length);
+ if (stride)
+ stride = mark_rvalue_use (stride);
/* We need to reduce to real constant-values for checks below. */
if (length)
length = fold_simple (length);
if (low_bound)
low_bound = fold_simple (low_bound);
+ if (stride)
+ stride = fold_simple (stride);
if (low_bound
&& TREE_CODE (low_bound) == INTEGER_CST
&& TYPE_PRECISION (TREE_TYPE (low_bound))
@@ -6022,9 +6052,15 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
&& TYPE_PRECISION (TREE_TYPE (length))
> TYPE_PRECISION (sizetype))
length = fold_convert (sizetype, length);
+ if (stride
+ && TREE_CODE (stride) == INTEGER_CST
+ && TYPE_PRECISION (TREE_TYPE (stride))
+ > TYPE_PRECISION (sizetype))
+ stride = fold_convert (sizetype, stride);
if (low_bound == NULL_TREE)
low_bound = integer_zero_node;
-
+ if (stride == NULL_TREE)
+ stride = size_one_node;
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
&& (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH
|| OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_DETACH))
@@ -6143,12 +6179,29 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
if (length && TREE_CODE (length) == INTEGER_CST)
{
- if (tree_int_cst_lt (size, length))
+ tree slength = length;
+ if (stride && TREE_CODE (stride) == INTEGER_CST)
{
- error_at (OMP_CLAUSE_LOCATION (c),
- "length %qE above array section size "
- "in %qs clause", length,
- omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ slength = size_binop (MULT_EXPR,
+ fold_convert (sizetype, length),
+ fold_convert (sizetype, stride));
+ slength = size_binop (MINUS_EXPR,
+ slength,
+ fold_convert (sizetype, stride));
+ slength = size_binop (PLUS_EXPR, slength, size_one_node);
+ }
+ if (tree_int_cst_lt (size, slength))
+ {
+ if (stride)
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "length %qE with stride %qE above array "
+ "section size in %qs clause", length, stride,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ else
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "length %qE above array section size "
+ "in %qs clause", length,
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
return error_mark_node;
}
if (TREE_CODE (low_bound) == INTEGER_CST)
@@ -6156,7 +6209,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
tree lbpluslen
= size_binop (PLUS_EXPR,
fold_convert (sizetype, low_bound),
- fold_convert (sizetype, length));
+ fold_convert (sizetype, slength));
if (TREE_CODE (lbpluslen) == INTEGER_CST
&& tree_int_cst_lt (size, lbpluslen))
{
@@ -6226,12 +6279,38 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
d = TREE_OPERAND (d, 0))
{
tree d_length = TREE_OPERAND (d, 2);
- if (d_length == NULL_TREE || !integer_onep (d_length))
+ tree d_stride = TREE_OPERAND (d, 3);
+ if (d_length == NULL_TREE
+ || !integer_onep (d_length)
+ || (d_stride && !integer_onep (d_stride)))
{
- error_at (OMP_CLAUSE_LOCATION (c),
- "array section is not contiguous in %qs clause",
- omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
- return error_mark_node;
+ if (openacc && OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP)
+ {
+ while (TREE_CODE (d) == OMP_ARRAY_SECTION)
+ d = TREE_OPERAND (d, 0);
+ if (DECL_P (d))
+ {
+ /* Note that OpenACC does accept these kinds of
+ non-contiguous pointer based arrays. */
+ non_contiguous = true;
+ break;
+ }
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "base-pointer expression in %qs clause not "
+ "supported for non-contiguous arrays",
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ return error_mark_node;
+ }
+
+ if (discontiguous && *discontiguous)
+ *discontiguous = 2;
+ else
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "array section is not contiguous in %qs clause",
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ return error_mark_node;
+ }
}
}
}
@@ -6243,7 +6322,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
return error_mark_node;
}
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND)
- types.safe_push (TREE_TYPE (ret));
+ types.safe_push (type);
/* We will need to evaluate lb more than once. */
tree lb = cp_save_expr (low_bound);
if (lb != low_bound)
@@ -6262,29 +6341,59 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION);
- ret = grok_array_decl (OMP_CLAUSE_LOCATION (c), ret, low_bound, NULL,
- tf_warning_or_error);
+ /* NOTE: Stride/length are discarded for affinity/depend here. */
+ if (discontiguous
+ && *discontiguous
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND)
+ ret = grok_omp_array_section (OMP_CLAUSE_LOCATION (c), ret, low_bound,
+ length, stride);
+ else
+ ret = grok_array_decl (OMP_CLAUSE_LOCATION (c), ret, low_bound, NULL,
+ tf_warning_or_error);
return ret;
}
-/* Handle array sections for clause C. */
+/* We built a reference to an array section, but it turns out we only need a
+ set of ARRAY_REFs to the lower bound. Rewrite the node. */
+
+static tree
+omp_array_section_low_bound (location_t loc, tree node)
+{
+ if (TREE_CODE (node) == OMP_ARRAY_SECTION)
+ {
+ tree low_bound = TREE_OPERAND (node, 1);
+ tree ret
+ = omp_array_section_low_bound (loc, TREE_OPERAND (node, 0));
+ return grok_array_decl (loc, ret, low_bound, NULL, tf_warning_or_error);
+ }
+
+ return node;
+}
+
+/* Handle array sections for clause C. On entry *DISCONTIGUOUS is 0 if array
+ section must be contiguous, 1 if it can be discontiguous, and in the latter
+ case it is set to 2 on exit if it is determined to be discontiguous during
+ the function's execution. PC points to the clause to be processed, and
+ *PNEXT to the last mapping node created, if passed as non-NULL. */
static bool
-handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
+handle_omp_array_sections (tree *pc, tree **pnext, enum c_omp_region_type ort,
+ int *discontiguous, bool *strided = NULL)
{
+ tree c = *pc;
bool maybe_zero_len = false;
unsigned int first_non_one = 0;
+ bool non_contiguous = false;
auto_vec<tree, 10> types;
tree *tp = &OMP_CLAUSE_DECL (c);
if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
- && TREE_CODE (*tp) == TREE_LIST
- && TREE_PURPOSE (*tp)
- && TREE_CODE (TREE_PURPOSE (*tp)) == TREE_VEC)
+ && OMP_ITERATOR_DECL_P (*tp))
tp = &TREE_VALUE (*tp);
tree first = handle_omp_array_sections_1 (c, *tp, types,
maybe_zero_len, first_non_one,
- ort);
+ non_contiguous, ort, discontiguous);
if (first == error_mark_node)
return true;
if (first == NULL_TREE)
@@ -6319,12 +6428,15 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
unsigned int num = types.length (), i;
tree t, side_effects = NULL_TREE, size = NULL_TREE;
tree condition = NULL_TREE;
+ tree ncarray_dims = NULL_TREE;
if (int_size_in_bytes (TREE_TYPE (first)) <= 0)
maybe_zero_len = true;
if (processing_template_decl && maybe_zero_len)
return false;
+ bool higher_discontiguous = false;
+
for (i = num, t = OMP_CLAUSE_DECL (c); i > 0;
t = TREE_OPERAND (t, 0))
{
@@ -6332,6 +6444,7 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
tree low_bound = TREE_OPERAND (t, 1);
tree length = TREE_OPERAND (t, 2);
+ tree stride = TREE_OPERAND (t, 3);
i--;
if (low_bound
@@ -6344,12 +6457,66 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
&& TYPE_PRECISION (TREE_TYPE (length))
> TYPE_PRECISION (sizetype))
length = fold_convert (sizetype, length);
+ if (stride
+ && TREE_CODE (stride) == INTEGER_CST
+ && TYPE_PRECISION (TREE_TYPE (stride))
+ > TYPE_PRECISION (sizetype))
+ stride = fold_convert (sizetype, stride);
if (low_bound == NULL_TREE)
low_bound = integer_zero_node;
+
+ if (non_contiguous)
+ {
+ ncarray_dims = tree_cons (low_bound, length, ncarray_dims);
+ continue;
+ }
+
+ if (stride == NULL_TREE)
+ stride = size_one_node;
+ if (strided && !integer_onep (stride))
+ *strided = true;
+ if (discontiguous && *discontiguous)
+ {
+ /* This condition is similar to the error check below, but
+ whereas that checks for a definitely-discontiguous array
+ section in order to report an error (where such a section is
+ illegal), here we instead need to know if the array section
+ *may be* discontiguous so we can handle that case
+ appropriately (i.e. for rectangular "target update"
+ operations). */
+ bool full_span = false;
+ if (length != NULL_TREE
+ && TREE_CODE (length) == INTEGER_CST
+ && TREE_CODE (types[i]) == ARRAY_TYPE
+ && TYPE_DOMAIN (types[i])
+ && TYPE_MAX_VALUE (TYPE_DOMAIN (types[i]))
+ && TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (types[i])))
+ == INTEGER_CST)
+ {
+ tree size;
+ size = size_binop (PLUS_EXPR,
+ TYPE_MAX_VALUE (TYPE_DOMAIN (types[i])),
+ size_one_node);
+ if (tree_int_cst_equal (length, size))
+ full_span = true;
+ }
+
+ if (!integer_onep (stride)
+ || (higher_discontiguous
+ && (!integer_zerop (low_bound)
+ || !full_span)))
+ *discontiguous = 2;
+
+ if (!integer_onep (stride)
+ || !integer_zerop (low_bound)
+ || !full_span)
+ higher_discontiguous = true;
+ }
+
if (!maybe_zero_len && i > first_non_one)
{
if (integer_nonzerop (low_bound))
- goto do_warn_noncontiguous;
+ goto is_noncontiguous;
if (length != NULL_TREE
&& TREE_CODE (length) == INTEGER_CST
&& TYPE_DOMAIN (types[i])
@@ -6363,12 +6530,17 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
size_one_node);
if (!tree_int_cst_equal (length, size))
{
- do_warn_noncontiguous:
- error_at (OMP_CLAUSE_LOCATION (c),
- "array section is not contiguous in %qs "
- "clause",
- omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
- return true;
+ is_noncontiguous:
+ if (discontiguous && *discontiguous)
+ *discontiguous = 2;
+ else
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "array section is not contiguous in %qs "
+ "clause",
+ omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
+ return true;
+ }
}
}
if (!processing_template_decl
@@ -6437,6 +6609,14 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
}
if (!processing_template_decl)
{
+ if (non_contiguous)
+ {
+ int kind = OMP_CLAUSE_MAP_KIND (c);
+ OMP_CLAUSE_SET_MAP_KIND (c, kind | GOMP_MAP_NONCONTIG_ARRAY);
+ OMP_CLAUSE_DECL (c) = t;
+ OMP_CLAUSE_SIZE (c) = ncarray_dims;
+ return false;
+ }
if (side_effects)
size = build2 (COMPOUND_EXPR, sizetype, side_effects, size);
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
@@ -6477,6 +6657,9 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
OMP_CLAUSE_DECL (c) = t;
return false;
}
+ if (discontiguous && *discontiguous != 2)
+ first = omp_array_section_low_bound (OMP_CLAUSE_LOCATION (c),
+ first);
OMP_CLAUSE_DECL (c) = first;
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR)
return false;
@@ -6488,9 +6671,6 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
if (TREE_CODE (t) == FIELD_DECL)
t = finish_non_static_data_member (t, NULL_TREE, NULL_TREE);
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
- return false;
-
if (TREE_CODE (first) == INDIRECT_REF)
{
/* Detect and skip adding extra nodes for pointer-to-member
@@ -6517,6 +6697,10 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
}
}
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP
+ && !(discontiguous && *discontiguous == 2))
+ return false;
+
/* FIRST represents the first item of data that we are mapping.
E.g. if we're mapping an array, FIRST might resemble
"foo.bar.myarray[0]". */
@@ -6528,23 +6712,28 @@ handle_omp_array_sections (tree &c, enum c_omp_region_type ort)
cp_omp_address_inspector ai (OMP_CLAUSE_LOCATION (c), t);
- tree nc = ai.expand_map_clause (c, first, addr_tokens, ort);
- if (nc != error_mark_node)
+ tree* npc = ai.expand_map_clause (pc, first, addr_tokens, ort);
+ if (npc != NULL)
{
using namespace omp_addr_tokenizer;
- if (ai.maybe_zero_length_array_section (c))
+ c = *pc;
+
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && ai.maybe_zero_length_array_section (c))
OMP_CLAUSE_MAP_MAYBE_ZERO_LENGTH_ARRAY_SECTION (c) = 1;
/* !!! If we're accessing a base decl via chained access
methods (e.g. multiple indirections), duplicate clause
detection won't work properly. Skip it in that case. */
- if ((addr_tokens[0]->type == STRUCTURE_BASE
+ if (pnext
+ && (addr_tokens[0]->type == STRUCTURE_BASE
|| addr_tokens[0]->type == ARRAY_BASE)
&& addr_tokens[0]->u.structure_base_kind == BASE_DECL
&& addr_tokens[1]->type == ACCESS_METHOD
&& omp_access_chain_p (addr_tokens, 1))
- c = nc;
+ /* NPC points to the last node in the new sequence. */
+ *pnext = npc;
return false;
}
@@ -6723,6 +6912,102 @@ omp_reduction_lookup (location_t loc, tree id, tree type, tree *baselinkp,
return id;
}
+/* Return identifier to look up for omp declare mapper. */
+
+tree
+omp_mapper_id (tree mapper_id, tree type)
+{
+ const char *p = NULL;
+ const char *m = NULL;
+
+ if (mapper_id == NULL_TREE)
+ p = "";
+ else if (TREE_CODE (mapper_id) == IDENTIFIER_NODE)
+ p = IDENTIFIER_POINTER (mapper_id);
+ else
+ return error_mark_node;
+
+ if (type != NULL_TREE)
+ m = mangle_type_string (TYPE_MAIN_VARIANT (type));
+
+ const char prefix[] = "omp declare mapper ";
+ size_t lenp = sizeof (prefix);
+ if (strncmp (p, prefix, lenp - 1) == 0)
+ lenp = 1;
+ size_t len = strlen (p);
+ size_t lenm = m ? strlen (m) + 1 : 0;
+ char *name = XALLOCAVEC (char, lenp + len + lenm);
+ memcpy (name, prefix, lenp - 1);
+ memcpy (name + lenp - 1, p, len + 1);
+ if (m)
+ {
+ name[lenp + len - 1] = '~';
+ memcpy (name + lenp + len, m, lenm);
+ }
+ return get_identifier (name);
+}
+
+tree
+cxx_omp_mapper_lookup (tree id, tree type)
+{
+ if (TREE_CODE (type) != RECORD_TYPE
+ && TREE_CODE (type) != UNION_TYPE)
+ return NULL_TREE;
+ id = omp_mapper_id (id, type);
+ return lookup_name (id);
+}
+
+tree
+cxx_omp_extract_mapper_directive (tree vardecl)
+{
+ gcc_assert (TREE_CODE (vardecl) == VAR_DECL);
+
+ /* Instantiate the decl if we haven't already. */
+ mark_used (vardecl);
+ tree body = DECL_INITIAL (vardecl);
+
+ if (TREE_CODE (body) == STATEMENT_LIST)
+ {
+ tree_stmt_iterator tsi = tsi_start (body);
+ gcc_assert (TREE_CODE (tsi_stmt (tsi)) == DECL_EXPR);
+ tsi_next (&tsi);
+ body = tsi_stmt (tsi);
+ }
+
+ gcc_assert (TREE_CODE (body) == OMP_DECLARE_MAPPER);
+
+ return body;
+}
+
+/* For now we can handle singleton OMP_ARRAY_SECTIONs with custom mappers, but
+ nothing more complicated. */
+
+tree
+cxx_omp_map_array_section (location_t loc, tree t)
+{
+ tree low = TREE_OPERAND (t, 1);
+ tree len = TREE_OPERAND (t, 2);
+
+ if (len && integer_onep (len))
+ {
+ t = TREE_OPERAND (t, 0);
+
+ if (!low)
+ low = integer_zero_node;
+
+ if (TREE_CODE (TREE_TYPE (t)) == REFERENCE_TYPE)
+ t = convert_from_reference (t);
+
+ if (TYPE_PTR_P (TREE_TYPE (t))
+ || TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
+ t = build_array_ref (loc, t, low);
+ else
+ t = error_mark_node;
+ }
+
+ return t;
+}
+
/* Helper function for cp_parser_omp_declare_reduction_exprs
and tsubst_omp_udr.
Remove CLEANUP_STMT for data (omp_priv variable).
@@ -6903,6 +7188,69 @@ cp_check_omp_declare_reduction (tree udr)
return true;
}
+
+static bool
+cp_oacc_reduction_defined_type_p (enum tree_code reduction_code, tree t)
+{
+ if (TREE_CODE (t) == INTEGER_TYPE)
+ return true;
+
+ if (FLOAT_TYPE_P (t) || TREE_CODE (t) == COMPLEX_TYPE)
+ switch (reduction_code)
+ {
+ case PLUS_EXPR:
+ case MULT_EXPR:
+ case MINUS_EXPR:
+ case TRUTH_ANDIF_EXPR:
+ case TRUTH_ORIF_EXPR:
+ return true;
+ case MIN_EXPR:
+ case MAX_EXPR:
+ return TREE_CODE (t) != COMPLEX_TYPE;
+ case BIT_AND_EXPR:
+ case BIT_XOR_EXPR:
+ case BIT_IOR_EXPR:
+ return false;
+ default:
+ gcc_unreachable ();
+ }
+
+ if (TREE_CODE (t) == ARRAY_TYPE)
+ return cp_oacc_reduction_defined_type_p (reduction_code, TREE_TYPE (t));
+
+ if (TREE_CODE (t) == RECORD_TYPE)
+ {
+ for (tree fld = TYPE_FIELDS (t); fld; fld = TREE_CHAIN (fld))
+ if (TREE_CODE (fld) == FIELD_DECL
+ && !cp_oacc_reduction_defined_type_p (reduction_code,
+ TREE_TYPE (fld)))
+ return false;
+ return true;
+ }
+
+ return false;
+}
+
+static const char *
+cp_oacc_reduction_code_name (enum tree_code reduction_code)
+{
+ switch (reduction_code)
+ {
+ case PLUS_EXPR: return "+";
+ case MULT_EXPR: return "*";
+ case MINUS_EXPR: return "-";
+ case TRUTH_ANDIF_EXPR: return "&&";
+ case TRUTH_ORIF_EXPR: return "||";
+ case MIN_EXPR: return "min";
+ case MAX_EXPR: return "max";
+ case BIT_AND_EXPR: return "&";
+ case BIT_XOR_EXPR: return "^";
+ case BIT_IOR_EXPR: return "|";
+ default:
+ gcc_unreachable ();
+ }
+}
+
/* Helper function of finish_omp_clauses. Clone STMT as if we were making
an inline call. But, remap
the OMP_DECL1 VAR_DECL (omp_out resp. omp_orig) to PLACEHOLDER
@@ -6947,7 +7295,8 @@ find_omp_placeholder_r (tree *tp, int *, void *data)
Return true if there is some error and the clause should be removed. */
static bool
-finish_omp_reduction_clause (tree c, bool *need_default_ctor, bool *need_dtor)
+finish_omp_reduction_clause (tree c, enum c_omp_region_type ort,
+ bool *need_default_ctor, bool *need_dtor)
{
tree t = OMP_CLAUSE_DECL (c);
bool predefined = false;
@@ -7048,6 +7397,20 @@ finish_omp_reduction_clause (tree c, bool *need_default_ctor, bool *need_dtor)
return false;
}
+ if (ort == C_ORT_ACC)
+ {
+ enum tree_code r_code = OMP_CLAUSE_REDUCTION_CODE (c);
+ if (!cp_oacc_reduction_defined_type_p (r_code, TREE_TYPE (t)))
+ {
+ const char *r_name = cp_oacc_reduction_code_name (r_code);
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "%qE has invalid type for %<reduction(%s)%>",
+ t, r_name);
+ return true;
+ }
+ return false;
+ }
+
tree id = OMP_CLAUSE_REDUCTION_PLACEHOLDER (c);
type = TYPE_MAIN_VARIANT (type);
@@ -7193,9 +7556,11 @@ finish_omp_reduction_clause (tree c, bool *need_default_ctor, bool *need_dtor)
*need_dtor = true;
else
{
- error_at (OMP_CLAUSE_LOCATION (c),
- "user defined reduction not found for %qE",
- omp_clause_printable_decl (t));
+ /* There are no user-defined reductions for OpenACC (as of 2.6). */
+ if (ort & C_ORT_OMP)
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "user defined reduction not found for %qE",
+ omp_clause_printable_decl (t));
return true;
}
if (TREE_CODE (OMP_CLAUSE_DECL (c)) == MEM_REF)
@@ -7204,6 +7569,29 @@ finish_omp_reduction_clause (tree c, bool *need_default_ctor, bool *need_dtor)
return false;
}
+/* Check an instance of an "omp declare mapper" function. */
+
+bool
+cp_check_omp_declare_mapper (tree udm)
+{
+ tree type = TREE_TYPE (udm);
+ location_t loc = DECL_SOURCE_LOCATION (udm);
+
+ if (type == error_mark_node)
+ return false;
+
+ if (!processing_template_decl
+ && TREE_CODE (type) != RECORD_TYPE
+ && TREE_CODE (type) != UNION_TYPE)
+ {
+ error_at (loc, "%qT is not a struct, union or class type in "
+ "%<#pragma omp declare mapper%>", type);
+ return false;
+ }
+
+ return true;
+}
+
/* Called from finish_struct_1. linear(this) or linear(this:step)
clauses might not be finalized yet because the class has been incomplete
when parsing #pragma omp declare simd methods. Fix those up now. */
@@ -7286,10 +7674,10 @@ cp_omp_finish_iterators (tree iter)
bool ret = false;
for (tree it = iter; it; it = TREE_CHAIN (it))
{
- tree var = TREE_VEC_ELT (it, 0);
- tree begin = TREE_VEC_ELT (it, 1);
- tree end = TREE_VEC_ELT (it, 2);
- tree step = TREE_VEC_ELT (it, 3);
+ tree var = OMP_ITERATORS_VAR (it);
+ tree begin = OMP_ITERATORS_BEGIN (it);
+ tree end = OMP_ITERATORS_END (it);
+ tree step = OMP_ITERATORS_STEP (it);
tree orig_step;
tree type = TREE_TYPE (var);
location_t loc = DECL_SOURCE_LOCATION (var);
@@ -7387,10 +7775,10 @@ cp_omp_finish_iterators (tree iter)
tree it2;
for (it2 = TREE_CHAIN (it); it2; it2 = TREE_CHAIN (it2))
{
- tree var2 = TREE_VEC_ELT (it2, 0);
- tree begin2 = TREE_VEC_ELT (it2, 1);
- tree end2 = TREE_VEC_ELT (it2, 2);
- tree step2 = TREE_VEC_ELT (it2, 3);
+ tree var2 = OMP_ITERATORS_VAR (it2);
+ tree begin2 = OMP_ITERATORS_BEGIN (it2);
+ tree end2 = OMP_ITERATORS_END (it2);
+ tree step2 = OMP_ITERATORS_STEP (it2);
location_t loc2 = DECL_SOURCE_LOCATION (var2);
if (cp_walk_tree (&begin2, find_omp_placeholder_r, var, &pset))
{
@@ -7416,14 +7804,14 @@ cp_omp_finish_iterators (tree iter)
ret = true;
continue;
}
- TREE_VEC_ELT (it, 1) = begin;
- TREE_VEC_ELT (it, 2) = end;
+ OMP_ITERATORS_BEGIN (it) = begin;
+ OMP_ITERATORS_END (it) = end;
if (processing_template_decl)
- TREE_VEC_ELT (it, 3) = orig_step;
+ OMP_ITERATORS_STEP (it) = orig_step;
else
{
- TREE_VEC_ELT (it, 3) = step;
- TREE_VEC_ELT (it, 4) = orig_step;
+ OMP_ITERATORS_STEP (it) = step;
+ OMP_ITERATORS_ORIG_STEP (it) = orig_step;
}
}
return ret;
@@ -7534,6 +7922,731 @@ cp_finish_omp_init_prefer_type (tree pref_type)
}
return t;
}
+/* LIST is a TREE_LIST, its TREE_PURPOSE is not used here, but its (possibly
+ NULL_TREE) value is propegated to any new nodes derived from the node.
+ Its TREE_VALUE is a TREE_LIST representing an OpenMP parameter-list-item.
+ Its TREE_PURPOSE contains an expr storing the location of the item and
+ TREE_VALUE contains the representation of the item. It is a NOP_EXPR,
+ INTEGER_CST, PARM_DECL, or TREE_LIST, this function possibly mutates it, it
+ is not preserved. DECL is the function the clause/clauses that LIST is
+ specified in is applied to. PARM_COUNT is the number of parameters, unless
+ the function has a parameter pack, or if the function is variadic, then
+ PARM_COUNT is 0. Functions with an empty parameter list are not handled
+ here.
+
+ Finalize each element in LIST, diagnose non-unique elements, and mutate
+ the original element appending them to a new list. The finalized parameter
+ indices are 0 based in contrast to OpenMP specifying 1 based parameter
+ indices, that adjustment is done here. NOP_EXPR elements require adjustment
+ from a 1 based index to a 0 based index. INTEGER_CST elements are finalized
+ parameter indices, but are still used for diagnosing duplicate elements.
+ PARM_DECL elements are switched out for their corresponding 0 based index,
+ provided it can be determined. TREE_LIST represents a numeric range. If
+ the number of parameters is known and DECL is non-variadic, relative bounds
+ are folded into literal bounds. If both bounds are non-relative the numeric
+ range is expanded, replacing the TREE_LIST with N INTEGER_CST nodes for each
+ index in the numeric range. If DECL is variadic, numeric ranges with
+ a relative bound are represented the same as in c_parser_omp_parm_list
+ so gimplify.cc:modify_call_for_omp_dispatch can handle them the same way.
+
+ Returns TREE_LIST or error_mark_node if each elt was invalid. */
+
+tree
+finish_omp_parm_list (tree list, const_tree decl, const int parm_count)
+{
+ gcc_assert (list && decl);
+ const tree parms = DECL_ARGUMENTS (decl);
+ /* We assume that the this parameter is included in parms, make sure this is
+ still true. */
+ gcc_assert (!DECL_IOBJ_MEMBER_FUNCTION_P (decl)
+ || is_this_parameter (parms));
+ /* We expect at least one argument, unless the function is variadic, in which
+ case parm_count will be 0. */
+ gcc_assert (parm_count >= 0 && (parms || parm_count == 0));
+
+ hash_map<int_hash<int, -1, -2>, tree> specified_idxs;
+ /* If there are any nodes that were not able to be finalized and/or expanded
+ this gets set to true, this can occur even if we are fully instantiated
+ if the function is a variadic function. */
+ bool dependent = false;
+ tree new_list = NULL_TREE;
+ auto append_to_list = [chain = &new_list] (tree node) mutable
+ {
+ gcc_assert (*chain == NULL_TREE);
+ *chain = node;
+ chain = &TREE_CHAIN (*chain);
+ };
+
+ const int iobj_parm_adjustment = DECL_IOBJ_MEMBER_FUNCTION_P (decl) ? 1 : 0;
+
+ for (tree next, node = list; node; node = next)
+ {
+ /* Nodes are mutated and appended to new_list, retrieve its chain early
+ and remember it. */
+ next = TREE_CHAIN (node);
+ TREE_CHAIN (node) = NULL_TREE;
+ tree parm_list_item = TREE_VALUE (node);
+ switch (TREE_CODE (TREE_VALUE (parm_list_item)))
+ {
+ case NOP_EXPR:
+ {
+ /* cp_parser_omp_parm_list stores parameter index items in a
+ NOP so we know to modify them here. This solution is
+ imperfect, but there isn't time to do it differently. */
+ tree cst = TREE_OPERAND (TREE_VALUE (parm_list_item), 0);
+ /* Adjust the 1 based index to 0 based, potentially adjust for
+ the 'this' parameter. */
+ const int idx = tree_to_shwi (cst) - 1 + iobj_parm_adjustment;
+ TREE_VALUE (parm_list_item)
+ = build_int_cst (integer_type_node, idx);
+ gcc_fallthrough ();
+ }
+ case INTEGER_CST:
+ {
+ /* These are finished, just check for errors and append
+ them to the list.
+ Check everything, we might have new errors if we didn't know
+ how many parameters we had the first time around. */
+ const int idx = tree_to_shwi (TREE_VALUE (parm_list_item));
+ tree *first = specified_idxs.get (idx);
+ if (first)
+ {
+ error_at (EXPR_LOCATION (TREE_PURPOSE (parm_list_item)),
+ "OpenMP parameter list items must specify a "
+ "unique parameter");
+ inform (EXPR_LOCATION (TREE_PURPOSE (*first)),
+ "parameter previously specified here");
+ }
+ else if (parm_count != 0 && idx >= parm_count)
+ {
+ error_at (EXPR_LOCATION (TREE_PURPOSE (parm_list_item)),
+ "parameter list item index is out of range");
+ }
+ else
+ {
+ append_to_list (node);
+ if (specified_idxs.put (idx, parm_list_item))
+ gcc_unreachable ();
+ }
+ break;
+ }
+ case PARM_DECL:
+ {
+ const const_tree parm_to_find = TREE_VALUE (parm_list_item);
+ /* Indices are stored as 0 based, don't adjust for iobj func,
+ the this parameter is present in parms. */
+ int idx = 0;
+ const_tree parm = parms;
+ while (true)
+ {
+ /* We already confirmed that the parameter exists
+ in cp_parser_omp_parm_list, we should never be reaching
+ the end of this list. */
+ gcc_assert (parm);
+ /* Expansion of a parameter pack will change the index of
+ parameters that come after it, we will have to defer this
+ lookup until the fndecl has been substituted. */
+ if (DECL_PACK_P (parm))
+ {
+ gcc_assert (processing_template_decl);
+ /* As explained above, this only happens with a parameter
+ pack in the middle of a function, this slower lookup
+ is fine for such an edge case. */
+ const tree first = [&] ()
+ {
+ for (tree n = new_list; n; n = TREE_CHAIN (n))
+ {
+ tree item = TREE_VALUE (n);
+ if (TREE_CODE (TREE_VALUE (item)) == PARM_DECL
+ /* This comparison works because we make sure
+ to store the original node. */
+ && TREE_VALUE (item) == parm_to_find)
+ return item;
+ }
+ return NULL_TREE;
+ } (); /* IILE. */
+ if (first)
+ {
+ location_t loc
+ = EXPR_LOCATION (TREE_PURPOSE (parm_list_item));
+ error_at (loc,
+ "OpenMP parameter list items must specify "
+ "a unique parameter");
+ inform (EXPR_LOCATION (TREE_PURPOSE (first)),
+ "parameter previously specified here");
+ }
+ else
+ {
+ /* We need to process this again once the pack
+ blocking us has been expanded. */
+ dependent = true;
+ /* Make sure we use the original so the above
+ comparison works when we return here later.
+ This may no longer be required since we are
+ comparing the DECL_NAME of each below, but
+ regardless, use the original. */
+ append_to_list (node);
+ }
+ break;
+ }
+ /* Compare the identifier nodes to so the comparison works
+ even after the node has been substituted. */
+ if (DECL_NAME (parm) == DECL_NAME (parm_to_find))
+ {
+ tree *first = specified_idxs.get (idx);
+ if (first)
+ {
+ location_t loc
+ = EXPR_LOCATION (TREE_PURPOSE (parm_list_item));
+ error_at (loc,
+ "OpenMP parameter list items must specify "
+ "a unique parameter");
+ inform (EXPR_LOCATION (TREE_PURPOSE (*first)),
+ "parameter previously specified here");
+ }
+ else
+ {
+ TREE_VALUE (parm_list_item)
+ = build_int_cst (integer_type_node, idx);
+ append_to_list (node);
+ if (specified_idxs.put (idx, parm_list_item))
+ gcc_unreachable ();
+ }
+ break;
+ }
+ ++idx;
+ parm = DECL_CHAIN (parm);
+ }
+ break;
+ }
+ case TREE_LIST:
+ {
+ /* Mutates bound.
+ This is the final point where indices and ranges are adjusted
+ from OpenMP spec representation (1 based indices, inclusive
+ intervals [lb, ub]) to GCC's internal representation (0 based
+ indices, inclusive lb, exclusive ub [lb, ub)), this is
+ intended to match C++ semantics.
+ Care must be taken to ensure we do not make these adjustments
+ multiple times. */
+ auto do_bound = [&] (tree bound, const int correction)
+ {
+ gcc_assert (-1 <= correction && correction <= 1);
+ if (bound == error_mark_node)
+ return bound;
+
+ tree expr = TREE_VALUE (bound);
+ /* If we already have an integer_cst, the bound has already
+ been converted to a 0 based index. Do not strip location
+ wrappers, they might be a template parameter that got
+ substituted to an INTEGER_CST, but not been finalized
+ yet. */
+ if (TREE_CODE (expr) == INTEGER_CST)
+ return bound;
+
+ const location_t expr_loc = EXPR_LOCATION (expr);
+
+ if (type_dependent_expression_p (expr))
+ {
+ ATTR_IS_DEPENDENT (bound) = true;
+ return bound;
+ }
+ else if (!INTEGRAL_TYPE_P (TREE_TYPE (expr)))
+ {
+ if (TREE_PURPOSE (bound))
+ error_at (expr_loc, "logical offset of a bound must "
+ "be of type %<int%>");
+ else
+ error_at (expr_loc, "expression of a bound must be "
+ "of type %<int%>");
+ return error_mark_node;
+ }
+ else if (value_dependent_expression_p (expr))
+ {
+ ATTR_IS_DEPENDENT (bound) = true;
+ return bound;
+ }
+ /* EXPR is not dependent, get rid of any leftover location
+ wrappers. */
+ expr = tree_strip_any_location_wrapper (expr);
+ /* Unless we want some really good diagnostics, we don't need
+ to wrap expr with a location anymore. Additionally, if we
+ do that we need a new way of differentiating adjusted and
+ unadjusted expressions. */
+
+ /* Do we need to mark this as an rvalue use with
+ mark_rvalue_use as well?
+ We either need to strictly only accept expressions of type
+ int, or warn for conversions.
+ I'm pretty sure this should be manifestly
+ constant-evaluated. We require a constant here,
+ let fold_non_dependent_expr complain. */
+ expr = fold_non_dependent_expr (expr,
+ tf_warning_or_error,
+ true);
+ if (!TREE_CONSTANT (expr))
+ {
+ if (TREE_PURPOSE (bound))
+ error_at (expr_loc, "logical offset of a bound must "
+ "be a constant expression");
+ else
+ error_at (expr_loc, "expression of a bound must be a "
+ "constant expression");
+ return error_mark_node;
+ }
+
+ const int sgn = tree_int_cst_sgn (expr);
+ const int val = tree_to_shwi (expr);
+ /* Technically this can work with omp_num_args+expr but the
+ spec forbids it, we can support it later if we like. */
+ if (sgn < 0)
+ {
+ if (TREE_PURPOSE (bound))
+ error_at (expr_loc, "logical offset of a bound must "
+ "be non negative");
+ else
+ error_at (expr_loc, "expression of a bound must be "
+ "positive");
+ return error_mark_node;
+ }
+
+ const const_tree num_args_marker = TREE_PURPOSE (bound);
+ if (num_args_marker == NULL_TREE)
+ {
+ if (sgn != 1)
+ {
+ error_at (expr_loc, "expression of bound must be "
+ "positive");
+ return error_mark_node;
+ }
+ if (parm_count > 0 && val > parm_count)
+ {
+ /* FIXME: output omp_num_args and parm_count. */
+ error_at (expr_loc, "expression of bound is out "
+ "of range");
+ return error_mark_node;
+ }
+ TREE_VALUE (bound) = build_int_cst (integer_type_node,
+ val + correction);
+ return bound;
+ }
+ else if (num_args_marker
+ == get_identifier ("omp num args plus"))
+ {
+ if (sgn != 0)
+ {
+ error_at (expr_loc,
+ "logical offset must be equal to 0 in a "
+ "bound of the form "
+ "%<omp_num_args+logical-offset%>");
+ return error_mark_node;
+ }
+ TREE_PURPOSE (bound)
+ = get_identifier ("omp relative bound");
+ /* This expresses
+ omp_num_args + correction + logical offset,
+ the only valid value for logical offset is 0. */
+ TREE_VALUE (bound) = build_int_cst (integer_type_node,
+ correction + 0);
+ return bound;
+ }
+ else if (num_args_marker
+ == get_identifier ("omp num args minus"))
+ {
+ gcc_assert (sgn != -1);
+ TREE_PURPOSE (bound)
+ = get_identifier ("omp relative bound");
+ /* Don't invert correction, we are expressing
+ omp_num_args + correction - logical offset. */
+ TREE_VALUE (bound) = build_int_cst (integer_type_node,
+ correction + (-val));
+ return bound;
+ }
+ gcc_unreachable ();
+ };
+ /* Convert both to 0 based indices, upper bound
+ is stored one past the end. */
+ static constexpr int lb_adjustment = -1;
+ static constexpr int ub_adjustment = -1 + 1;
+
+ tree range = TREE_VALUE (parm_list_item);
+ tree lb = do_bound (TREE_PURPOSE (range),
+ lb_adjustment + iobj_parm_adjustment);
+ tree ub = do_bound (TREE_VALUE (range),
+ ub_adjustment + iobj_parm_adjustment);
+ gcc_assert (lb && ub);
+ /* If we know how many params there are for sure we can
+ change this bound to a literal. */
+ auto maybe_fold_relative_bound = [&] (tree bound)
+ {
+ if (bound == error_mark_node
+ || parm_count == 0
+ || !TREE_PURPOSE (bound))
+ return bound;
+ gcc_assert (TREE_PURPOSE (bound)
+ == get_identifier ("omp relative bound"));
+ const int value = tree_to_shwi (TREE_VALUE (bound));
+ gcc_assert (value <= 0 && parm_count >= 1);
+ /* Overflow is impossible. */
+ const int diff = parm_count + value;
+ if (diff < 0)
+ {
+ /* FIXME: output value of omp_num_args. */
+ error_at (EXPR_LOCATION (TREE_CHAIN (bound)),
+ "bound with logical offset evaluates to an "
+ "out of range index");
+ return error_mark_node;
+ }
+ gcc_assert (diff < INT_MAX);
+ TREE_PURPOSE (bound) = NULL_TREE;
+ TREE_VALUE (bound) = build_int_cst (integer_type_node, diff);
+ return bound;
+ };
+ lb = maybe_fold_relative_bound (lb);
+ ub = maybe_fold_relative_bound (ub);
+
+ gcc_assert (lb && ub);
+ const tree range_loc_wrapped = TREE_PURPOSE (parm_list_item);
+
+ auto append_one_idx = [&] (tree purpose, tree loc_expr, int idx)
+ {
+ tree *dupe = specified_idxs.get (idx);
+ gcc_assert (!dupe || *dupe);
+ if (dupe)
+ return *dupe;
+ tree cst = build_int_cst (integer_type_node, idx);
+ tree new_item = build_tree_list (loc_expr, cst);
+ append_to_list (build_tree_list (purpose, new_item));
+ if (specified_idxs.put (idx, parm_list_item))
+ gcc_unreachable ();
+ return NULL_TREE;
+ };
+
+ /* TODO: handle better lol. */
+ if (lb == error_mark_node || ub == error_mark_node)
+ continue;
+ /* Wait until both lb and ub are substituted before trying to
+ process any further, we are also done if both bounds are
+ relative. */
+ if ((TREE_PURPOSE (lb) && TREE_PURPOSE (ub))
+ || value_dependent_expression_p (TREE_VALUE (lb))
+ || value_dependent_expression_p (TREE_VALUE (ub)))
+ {
+ /* If we are instantiating and have unexpanded numeric ranges
+ then this function must be variadic, and thus it doesn't
+ make this parm list dependent.
+ This doesn't really matter since we are high-jacking this
+ flag but it doesn't hurt to be technically correct. */
+ /* Early escape...? */
+ }
+ /* If both bounds are non relative, we can fully expand them. */
+ else if (!TREE_PURPOSE (lb) && !TREE_PURPOSE (ub))
+ {
+ const int lb_val = tree_to_shwi (TREE_VALUE (lb));
+ const int ub_val = tree_to_shwi (TREE_VALUE (ub));
+ /* Empty ranges are not allowed at this point. */
+ if (lb_val >= ub_val)
+ {
+ /* Note that the error message does not match the
+ condition as we altered ub to be one past the end. */
+ error_at (EXPR_LOCATION (range_loc_wrapped),
+ "numeric range lower bound must be less than "
+ "or equal to upper bound");
+ continue;
+ }
+ gcc_assert (lb_val >= 0 && ub_val > 0 && lb_val < ub_val);
+
+ for (int idx = lb_val; idx < ub_val; ++idx)
+ {
+ /* There might be something in PURPOSE that we want to
+ propogate when expanding. */
+ tree dupe = append_one_idx (TREE_PURPOSE (node),
+ range_loc_wrapped,
+ idx);
+ if (dupe)
+ {
+ const int omp_idx = idx + 1;
+ error_at (EXPR_LOCATION (range_loc_wrapped),
+ "expansion of numeric range specifies "
+ "non-unique index %d",
+ omp_idx);
+ inform (EXPR_LOCATION (TREE_PURPOSE (dupe)),
+ "parameter previously specified here");
+ }
+ }
+ /* The range is fully expanded, do not add it back to the
+ list. */
+ TREE_CHAIN (node) = NULL_TREE;
+ continue;
+ }
+ else if (!processing_template_decl)
+ {
+ /* Wait until we are fully instantiated to make this
+ transformation, expanding a bound with omp_num_args after
+ doing this will cause bugs.
+ We also potentially cause bugs if one gets expanded, gets
+ a partial expansion here, and then the other bound gets
+ expanded later. That case is probably fine but we should
+ avoid it anyway. */
+ gcc_assert (!TREE_PURPOSE (lb)
+ || TREE_PURPOSE (lb)
+ == get_identifier ("omp relative bound"));
+ gcc_assert (!TREE_PURPOSE (ub)
+ || TREE_PURPOSE (ub)
+ == get_identifier ("omp relative bound"));
+ /* At least one of lb and ub are NULL_TREE, and the other
+ is omp relative bound. */
+ gcc_assert (TREE_PURPOSE (lb) != TREE_PURPOSE (ub));
+ /* This only adds slight quality of life to diagnostics, it
+ isn't really worth it, but we need parity with the C front
+ end. Alternatively, handling empty numeric ranges could
+ have been removed from modify_call_for_omp_dispatch but
+ it's already there and it isn't that hard to add support
+ here. */
+ if (TREE_PURPOSE (ub))
+ {
+ /* The C front end goes a little further adding all
+ indices between lb and the last real parameter,
+ we aren't going to those efforts here though. */
+ gcc_assert (!TREE_PURPOSE (lb));
+ const int val = tree_to_shwi (TREE_VALUE (lb));
+ gcc_assert (val < INT_MAX);
+ /* We know the index in lb will always be specified. */
+ tree dupe = append_one_idx (TREE_PURPOSE (node),
+ range_loc_wrapped,
+ val);
+ if (dupe)
+ {
+ error_at (EXPR_LOCATION (range_loc_wrapped),
+ "lower bound of numeric range specifies "
+ "non-unique index %d",
+ val);
+ inform (EXPR_LOCATION (TREE_PURPOSE (dupe)),
+ "parameter previously specified here");
+ }
+ /* The value was added above, adjust lb to be ahead by
+ one so it's not added again in
+ modify_call_for_omp_dispatch. */
+ TREE_VALUE (lb) = build_int_cst (integer_type_node,
+ val + 1);
+ }
+ else
+ {
+ gcc_assert (TREE_PURPOSE (lb));
+ const int val = tree_to_shwi (TREE_VALUE (ub));
+ gcc_assert (val > 0);
+ /* We know the index in ub will always be specified. */
+ tree dupe = append_one_idx (TREE_PURPOSE (node),
+ range_loc_wrapped,
+ val);
+ if (dupe)
+ {
+ error_at (EXPR_LOCATION (range_loc_wrapped),
+ "upper bound of numeric range specifies "
+ "non-unique index %d", val);
+ inform (EXPR_LOCATION (TREE_PURPOSE (dupe)),
+ "parameter previously specified here");
+ }
+ /* The value was added above, adjust ub to be behind by
+ one so it's not added again in
+ modify_call_for_omp_dispatch. */
+ TREE_VALUE (ub) = build_int_cst (integer_type_node,
+ val - 1);
+ }
+ /* This is not a full expansion, just a partial, we still
+ to add the numeric range to the final list. */
+ }
+ dependent = processing_template_decl;
+ TREE_PURPOSE (range) = lb;
+ TREE_VALUE (range) = ub;
+ TREE_VALUE (parm_list_item) = range;
+ append_to_list (node);
+ break;
+ }
+ default:
+ gcc_unreachable ();
+ }
+ }
+ if (!new_list)
+ return error_mark_node;
+ /* Kinda a hack, hopefully temporary. */
+ ATTR_IS_DEPENDENT (new_list) = dependent;
+ return new_list;
+}
+
+/* LIST is a TREE_LIST representing an OpenMP parameter-list specified in an
+ adjust_args clause, or multiple concatanated parameter-lists each specified
+ in an adjust_args clause, each of which may have the same clause modifier,
+ or different clause modifiers. The clause modifier of the adjust_args
+ clause the parameter-list-item was specified in is stored in the
+ TREE_PURPOSE of each elt of LIST. DECL is the function decl the clauses
+ are applied to, PARM_COUNT is 0 if the number of parameters is unknown
+ or because the function is variadic, otherwise PARM_COUNT is the number of
+ parameters.
+
+ Check for and diagnose invalid parameter types for each item, remove them
+ from the list so errors are not diagnosed multiple times. Remove items with
+ the "nothing" modifier once everything is done.
+
+ Returns TREE_LIST or NULL_TREE if no items have errors, returns TREE_LIST
+ or error_mark_node if there were errors diagnosed. NULL_TREE is never
+ returned if an error was diagnosed. */
+
+tree
+finish_omp_adjust_args (tree list, const_tree decl, const int parm_count)
+{
+ gcc_assert (list && decl);
+ /* We need to keep track of this so we know whether we can remove items with
+ the "nothing" modifier. */
+ bool has_dependent_list_items = false;
+
+ const const_tree need_device_ptr_id = get_identifier ("need_device_ptr");
+ const const_tree need_device_addr_id = get_identifier ("need_device_addr");
+ const const_tree nothing_id = get_identifier ("nothing");
+ tree *prev_chain = &list;
+ auto keep_node = [&] (tree n) { prev_chain = &TREE_CHAIN (n); };
+ auto remove_node = [&] (tree n) { *prev_chain = TREE_CHAIN (n); };
+ for (tree n = list; n != NULL_TREE; n = TREE_CHAIN (n))
+ {
+ tree parm_list_item = TREE_VALUE (n);
+ if (TREE_CODE (TREE_VALUE (parm_list_item)) == PARM_DECL)
+ {
+ /* We only encounter a PARM_DECL here if a parameter pack comes
+ before it, it will have been replaced by an index by
+ finish_omp_parm_list otherwise. */
+ gcc_assert (processing_template_decl);
+ keep_node (n);
+ has_dependent_list_items = true;
+ continue;
+ }
+ /* Numeric range case. */
+ if (TREE_CODE (TREE_VALUE (parm_list_item)) == TREE_LIST)
+ {
+ /* These will have been expanded by finish_omp_parm_list unless we
+ can't determine the number of parameters. */
+ gcc_assert (processing_template_decl || parm_count == 0);
+ keep_node (n);
+ has_dependent_list_items = true;
+ continue;
+ }
+ gcc_assert (TREE_CODE (TREE_VALUE (parm_list_item)) == INTEGER_CST);
+
+ const const_tree n_modifier = TREE_PURPOSE (n);
+ gcc_assert (n_modifier == nothing_id
+ || n_modifier == need_device_ptr_id
+ || n_modifier == need_device_addr_id);
+ if (n_modifier == nothing_id)
+ {
+ keep_node (n);
+ continue;
+ }
+ const int idx = tree_to_shwi (TREE_VALUE (parm_list_item));
+
+ gcc_assert (idx >= 0 && (parm_count == 0 || idx < parm_count));
+ const const_tree parm_decl = [&] () -> const_tree
+ {
+ const const_tree parms = DECL_ARGUMENTS (decl);
+ gcc_assert (parms != NULL_TREE || parm_count == 0);
+ if (parms == NULL_TREE
+ || (parm_count != 0 && idx >= parm_count))
+ return NULL_TREE;
+
+ int cur_idx = 0;
+ for (const_tree p = parms; p != NULL_TREE; p = DECL_CHAIN (p))
+ {
+ /* This kind of sucks, we really should be building a vec instead
+ of traversing the list of parms each time. */
+ gcc_assert (parm_count == 0 || cur_idx < parm_count);
+ if (DECL_PACK_P (p))
+ return NULL_TREE;
+ if (cur_idx == idx)
+ return p;
+ ++cur_idx;
+ }
+ return NULL_TREE;
+ } (); /* IILE. */
+ /* cp_parser_omp_parm_list handles out of range indices. */
+ gcc_assert (parm_count == 0 || parm_decl);
+
+ if (!parm_decl)
+ has_dependent_list_items = true;
+ else if (n_modifier == need_device_ptr_id)
+ {
+ /* OpenMP 6.0 (332:28-30)
+ If the need_device_ptr adjust-op modifier is present, each list
+ item that appears in the clause that refers to a specific named
+ argument in the declaration of the function variant must be of
+ pointer type or reference to pointer type. */
+ tree parm_type = TREE_TYPE (parm_decl);
+ if (WILDCARD_TYPE_P (parm_type))
+ /* Do nothing for now, it might become a pointer. */;
+ else if (TYPE_REF_P (parm_type)
+ && WILDCARD_TYPE_P (TREE_TYPE (parm_type)))
+ /* It might become a reference to a pointer. */;
+ else if (!TYPE_PTR_P (parm_type))
+ {
+ if (TYPE_REF_P (parm_type)
+ && TYPE_PTR_P (TREE_TYPE (parm_type)))
+ /* The semantics for this are unclear, instead of supporting
+ it incorrectly, just sorry. */
+ sorry_at (DECL_SOURCE_LOCATION (parm_decl),
+ "parameter with type reference to pointer in an "
+ "%<adjust_args%> with the %<need_device_ptr%> "
+ "modifier is not currently supported");
+ else
+ error_at (DECL_SOURCE_LOCATION (parm_decl),
+ "parameter specified in an %<adjust_args%> clause "
+ "with the %<need_device_ptr%> modifier must be of "
+ "pointer type");
+ inform (EXPR_LOCATION (TREE_PURPOSE (parm_list_item)),
+ "parameter specified here");
+ remove_node (n);
+ continue;
+ }
+ }
+ else if (n_modifier == need_device_addr_id)
+ {
+ /* OpenMP 6.0 (332:31-33)
+ If the need_device_addr adjust-op modifier is present, each list
+ item that appears in the clause must refer to an argument in the
+ declaration of the function variant that has a reference type. */
+ tree parm_type = TREE_TYPE (parm_decl);
+ if (WILDCARD_TYPE_P (parm_type))
+ /* Do nothing for now, it might become a ref. */;
+ else if (!TYPE_REF_P (parm_type))
+ {
+ error_at (DECL_SOURCE_LOCATION (parm_decl),
+ "parameter specified in an %<adjust_args%> clause "
+ "with the %<need_device_addr%> modifier must be of "
+ "reference type");
+ inform (EXPR_LOCATION (TREE_PURPOSE (parm_list_item)),
+ "parameter specified here");
+ remove_node (n);
+ continue;
+ }
+ }
+ /* If we get here there were no errors. */
+ keep_node (n);
+ }
+
+ /* All items were removed due to errors. */
+ if (!list)
+ return error_mark_node;
+ if (has_dependent_list_items)
+ return list;
+ /* We no longer need to keep items with the "nothing" modifier. */
+ prev_chain = &list;
+ for (tree n = list; n != NULL_TREE; n = TREE_CHAIN (n))
+ {
+ if (TREE_PURPOSE (n) == nothing_id)
+ remove_node (n);
+ else
+ keep_node (n);
+ }
+ /* If all items had the "nothing" modifier, we might have NULL_TREE here,
+ but that isn't a problem. */
+ return list;
+}
/* For all elements of CLAUSES, validate them vs OpenMP constraints.
Remove any elements from the list that are invalid. */
@@ -7603,7 +8716,14 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
/* We've reached the end of a list of expanded nodes. Reset the group
start pointer. */
if (c == grp_sentinel)
- grp_start_p = NULL;
+ {
+ if (grp_start_p
+ && OMP_CLAUSE_HAS_ITERATORS (*grp_start_p))
+ for (tree gc = *grp_start_p; gc != grp_sentinel;
+ gc = OMP_CLAUSE_CHAIN (gc))
+ OMP_CLAUSE_ITERATORS (gc) = OMP_CLAUSE_ITERATORS (*grp_start_p);
+ grp_start_p = NULL;
+ }
switch (OMP_CLAUSE_CODE (c))
{
@@ -7632,7 +8752,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
t = OMP_CLAUSE_DECL (c);
if (TREE_CODE (t) == OMP_ARRAY_SECTION)
{
- if (handle_omp_array_sections (c, ort))
+ if (handle_omp_array_sections (pc, NULL, ort, NULL))
{
remove = true;
break;
@@ -8677,14 +9797,107 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
break;
}
gcc_unreachable ();
+ case OMP_CLAUSE_USES_ALLOCATORS:
+ t = OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c);
+ if (TREE_CODE (t) == FIELD_DECL)
+ {
+ sorry_at (OMP_CLAUSE_LOCATION (c), "class members not yet "
+ "supported in %<uses_allocators%> clause");
+ remove = true;
+ break;
+ }
+ t = convert_from_reference (t);
+ if (TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE
+ || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (TREE_TYPE (t))),
+ "omp_allocator_handle_t") != 0)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "allocator must be of %<omp_allocator_handle_t%> type");
+ remove = true;
+ break;
+ }
+ if (TREE_CODE (t) == CONST_DECL)
+ {
+ /* Currently for pre-defined allocators in libgomp, we do not
+ require additional init/fini inside target regions, so discard
+ such clauses. */
+ remove = true;
+
+ if (strcmp (IDENTIFIER_POINTER (DECL_NAME (t)),
+ "omp_null_allocator") == 0)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "%<omp_null_allocator%> cannot be used in "
+ "%<uses_allocators%> clause");
+ break;
+ }
+
+ if (OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c)
+ || OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c))
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "modifiers cannot be used with pre-defined "
+ "allocators");
+ break;
+ }
+ }
+ t = OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c);
+ if (t != NULL_TREE
+ && (TREE_CODE (t) != CONST_DECL
+ || TREE_CODE (TREE_TYPE (t)) != ENUMERAL_TYPE
+ || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (TREE_TYPE (t))),
+ "omp_memspace_handle_t") != 0))
+ {
+ error_at (OMP_CLAUSE_LOCATION (c), "memspace modifier must be "
+ "constant enum of %<omp_memspace_handle_t%> type");
+ remove = true;
+ break;
+ }
+ t = OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c);
+ if (t != NULL_TREE)
+ {
+ bool type_err = false;
+
+ if (TREE_CODE (TREE_TYPE (t)) != ARRAY_TYPE
+ || DECL_SIZE (t) == NULL_TREE)
+ type_err = true;
+ else
+ {
+ tree elem_t = TREE_TYPE (TREE_TYPE (t));
+ if (TREE_CODE (elem_t) != RECORD_TYPE
+ || strcmp (IDENTIFIER_POINTER (TYPE_IDENTIFIER (elem_t)),
+ "omp_alloctrait_t") != 0
+ || !TYPE_READONLY (elem_t))
+ type_err = true;
+ }
+ if (type_err)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c), "traits array %qE must be of "
+ "%<const omp_alloctrait_t []%> type", t);
+ remove = true;
+ }
+ else
+ {
+ tree cst_val = decl_constant_value (t);
+ if (cst_val == t)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c), "traits array must be "
+ "of constant values");
+
+ remove = true;
+ }
+ }
+ }
+ if (remove)
+ break;
+ pc = &OMP_CLAUSE_CHAIN (c);
+ continue;
case OMP_CLAUSE_DEPEND:
depend_clause = c;
/* FALLTHRU */
case OMP_CLAUSE_AFFINITY:
t = OMP_CLAUSE_DECL (c);
- if (TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (t))
{
if (TREE_PURPOSE (t) != last_iterators)
last_iterators_remove
@@ -8699,7 +9912,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
if (TREE_CODE (t) == OMP_ARRAY_SECTION)
{
- if (handle_omp_array_sections (c, ort))
+ int discontiguous = 1;
+ if (handle_omp_array_sections (pc, NULL, ort, &discontiguous))
remove = true;
else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
&& (OMP_CLAUSE_DEPEND_KIND (c)
@@ -8848,9 +10062,25 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
case OMP_CLAUSE_MAP:
if (OMP_CLAUSE_MAP_IMPLICIT (c) && !implicit_moved)
goto move_implicit;
+ if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_PUSH_MAPPER_NAME
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POP_MAPPER_NAME)
+ {
+ remove = true;
+ break;
+ }
+ if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_GRID_DIM
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_GRID_STRIDE)
+ break;
/* FALLTHRU */
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
+ if (OMP_CLAUSE_ITERATORS (c)
+ && cp_omp_finish_iterators (OMP_CLAUSE_ITERATORS (c)))
+ {
+ t = error_mark_node;
+ break;
+ }
+ /* FALLTHRU */
case OMP_CLAUSE__CACHE_:
{
using namespace omp_addr_tokenizer;
@@ -8861,11 +10091,25 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
grp_start_p = pc;
grp_sentinel = OMP_CLAUSE_CHAIN (c);
-
- if (handle_omp_array_sections (c, ort))
+ /* FIXME: Strided target updates not supported together with
+ iterators yet. */
+ int discontiguous
+ = (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM)
+ && !OMP_CLAUSE_ITERATORS (c);
+ bool strided = false;
+ tree *pnext = NULL;
+ if (handle_omp_array_sections (pc, &pnext, ort, &discontiguous,
+ &strided))
remove = true;
else
{
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM)
+ && OMP_CLAUSE_ITERATORS (c) && strided)
+ sorry ("strided target updates with iterators");
+ /* We might have replaced the clause, so refresh C. */
+ c = *pc;
t = OMP_CLAUSE_DECL (c);
if (TREE_CODE (t) != OMP_ARRAY_SECTION
&& !type_dependent_expression_p (t)
@@ -8965,6 +10209,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
clauses, reset the OMP_CLAUSE_SIZE (representing a bias)
to zero here. */
OMP_CLAUSE_SIZE (c) = size_zero_node;
+ if (pnext)
+ c = *pnext;
break;
}
else if (type_dependent_expression_p (t))
@@ -9148,7 +10394,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
bitmap_set_bit (&map_firstprivate_head, DECL_UID (t));
else if (bitmap_bit_p (&map_head, DECL_UID (t))
&& !bitmap_bit_p (&map_field_head, DECL_UID (t))
- && ort != C_ORT_OMP
+ && ort != C_ORT_OMP && ort != C_ORT_OMP_TARGET
&& ort != C_ORT_OMP_EXIT_DATA)
{
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
@@ -9213,10 +10459,10 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
grp_start_p = pc;
grp_sentinel = OMP_CLAUSE_CHAIN (c);
- tree nc = ai.expand_map_clause (c, OMP_CLAUSE_DECL (c),
- addr_tokens, ort);
- if (nc != error_mark_node)
- c = nc;
+ tree *npc = ai.expand_map_clause (pc, OMP_CLAUSE_DECL (c),
+ addr_tokens, ort);
+ if (npc != NULL)
+ c = *npc;
}
}
break;
@@ -9454,10 +10700,11 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
t = OMP_CLAUSE_DECL (c);
if (TREE_CODE (t) == OMP_ARRAY_SECTION)
{
- if (handle_omp_array_sections (c, ort))
+ if (handle_omp_array_sections (pc, NULL, ort, NULL))
remove = true;
else
{
+ c = *pc;
t = OMP_CLAUSE_DECL (c);
while (TREE_CODE (t) == OMP_ARRAY_SECTION)
t = TREE_OPERAND (t, 0);
@@ -9754,6 +11001,11 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
pc = &OMP_CLAUSE_CHAIN (c);
}
+ if (grp_start_p
+ && OMP_CLAUSE_HAS_ITERATORS (*grp_start_p))
+ for (tree gc = *grp_start_p; gc; gc = OMP_CLAUSE_CHAIN (gc))
+ OMP_CLAUSE_ITERATORS (gc) = OMP_CLAUSE_ITERATORS (*grp_start_p);
+
if (reduction_seen < 0 && (ordered_seen || schedule_seen))
reduction_seen = -2;
@@ -9994,7 +11246,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
if (processing_template_decl
&& !VAR_P (t) && TREE_CODE (t) != PARM_DECL)
break;
- if (finish_omp_reduction_clause (c, &need_default_ctor,
+ if (finish_omp_reduction_clause (c, ort, &need_default_ctor,
&need_dtor))
remove = true;
else
@@ -10467,6 +11719,8 @@ struct omp_target_walk_data
/* Local variables declared inside a BIND_EXPR, used to filter out such
variables when recording lambda_objects_accessed. */
hash_set<tree> local_decls;
+
+ omp_mapper_list<tree> *mappers;
};
/* Helper function of finish_omp_target_clauses, called via
@@ -10480,6 +11734,7 @@ finish_omp_target_clauses_r (tree *tp, int *walk_subtrees, void *ptr)
struct omp_target_walk_data *data = (struct omp_target_walk_data *) ptr;
tree current_object = data->current_object;
tree current_closure = data->current_closure;
+ omp_mapper_list<tree> *mlist = data->mappers;
/* References inside of these expression codes shouldn't incur any
form of mapping, so return early. */
@@ -10493,6 +11748,27 @@ finish_omp_target_clauses_r (tree *tp, int *walk_subtrees, void *ptr)
if (TREE_CODE (t) == OMP_CLAUSE)
return NULL_TREE;
+ if (!processing_template_decl)
+ {
+ tree aggr_type = NULL_TREE;
+
+ if (TREE_CODE (t) == COMPONENT_REF
+ && AGGREGATE_TYPE_P (TREE_TYPE (TREE_OPERAND (t, 0))))
+ aggr_type = TREE_TYPE (TREE_OPERAND (t, 0));
+ else if ((TREE_CODE (t) == VAR_DECL
+ || TREE_CODE (t) == PARM_DECL
+ || TREE_CODE (t) == RESULT_DECL)
+ && AGGREGATE_TYPE_P (TREE_TYPE (t)))
+ aggr_type = TREE_TYPE (t);
+
+ if (aggr_type)
+ {
+ tree mapper_fn = cxx_omp_mapper_lookup (NULL_TREE, aggr_type);
+ if (mapper_fn)
+ mlist->add_mapper (NULL_TREE, aggr_type, mapper_fn);
+ }
+ }
+
if (current_object)
{
tree this_expr = TREE_OPERAND (current_object, 0);
@@ -10595,10 +11871,48 @@ finish_omp_target_clauses (location_t loc, tree body, tree *clauses_ptr)
else
data.current_closure = NULL_TREE;
- cp_walk_tree_without_duplicates (&body, finish_omp_target_clauses_r, &data);
-
auto_vec<tree, 16> new_clauses;
+ if (!processing_template_decl)
+ {
+ hash_set<omp_name_type<tree> > seen_types;
+ auto_vec<tree> mapper_fns;
+ omp_mapper_list<tree> mlist (&seen_types, &mapper_fns);
+ data.mappers = &mlist;
+
+ cp_walk_tree_without_duplicates (&body, finish_omp_target_clauses_r,
+ &data);
+
+ unsigned int i;
+ tree mapper_fn;
+ FOR_EACH_VEC_ELT (mapper_fns, i, mapper_fn)
+ c_omp_find_nested_mappers (&mlist, mapper_fn);
+
+ FOR_EACH_VEC_ELT (mapper_fns, i, mapper_fn)
+ {
+ tree mapper = cxx_omp_extract_mapper_directive (mapper_fn);
+ if (mapper == error_mark_node)
+ continue;
+ tree mapper_name = OMP_DECLARE_MAPPER_ID (mapper);
+ tree decl = OMP_DECLARE_MAPPER_DECL (mapper);
+ if (BASELINK_P (mapper_fn))
+ mapper_fn = BASELINK_FUNCTIONS (mapper_fn);
+
+ tree c = build_omp_clause (loc, OMP_CLAUSE__MAPPER_BINDING_);
+ OMP_CLAUSE__MAPPER_BINDING__ID (c) = mapper_name;
+ OMP_CLAUSE__MAPPER_BINDING__DECL (c) = decl;
+ OMP_CLAUSE__MAPPER_BINDING__MAPPER (c) = mapper_fn;
+
+ new_clauses.safe_push (c);
+ }
+ }
+ else
+ {
+ data.mappers = NULL;
+ cp_walk_tree_without_duplicates (&body, finish_omp_target_clauses_r,
+ &data);
+ }
+
tree omp_target_this_expr = NULL_TREE;
tree *explicit_this_deref_map = NULL;
if (data.this_expr_accessed)
@@ -11847,6 +13161,299 @@ finish_omp_for_block (tree bind, tree omp_for)
return bind;
}
+/* Validate an OpenMP allocate directive, then add the ALLOC and ALIGN exprs to
+ the "omp allocate" attr of each decl found in VARS. The value of attr is
+ a TREE_LIST with ALLOC stored in its purpose member and ALIGN stored in its
+ value member. ALLOC and ALIGN are exprs passed as arguments to the
+ allocator and align clauses of the directive. VARS may be NULL_TREE if
+ there were errors during parsing.
+ #pragma omp allocate(VARS) allocator(ALLOC) align(ALIGN)
+
+ If processing_template_decl, a stmt of tree_code OMP_ALLOCATE is added to
+ the function instead. LOC is used to initialize the nodes location member,
+ this information is currently unused. */
+
+void
+finish_omp_allocate (location_t loc, tree var_list, tree alloc, tree align)
+{
+ /* Common routine for modifying the "omp allocate" attribute. This should
+ only be called once for each var, either after a diagnostic, or when we
+ are finished with the directive. */
+ auto finalize_allocate_attr = [] (tree var, tree alloc, tree align)
+ {
+ gcc_assert (var != NULL_TREE && var != error_mark_node);
+
+ /* The attr was added in cp_parser_omp_allocate. */
+ tree attr = lookup_attribute ("omp allocate", DECL_ATTRIBUTES (var));
+ gcc_assert (attr != NULL_TREE);
+
+ /* cp_parser_omp_allocate adds the location where the var was used as an
+ arg for diagnostics, it should still be untouched at this point. */
+ tree arg_loc = TREE_VALUE (attr);
+ gcc_assert (arg_loc != NULL_TREE && TREE_CODE (arg_loc) == NOP_EXPR);
+
+ /* We still need the location in case parsing hasn't finished yet, we
+ simply smuggle it through the chain member. */
+ tree attr_value = tree_cons (alloc, align, arg_loc);
+ /* We can't modify the old "omp allocate" attr, substitution doesn't know
+ the attr is dependent so it isn't copied when substituting the var.
+ We avoid making unnecessary copies creating the final node here. */
+ DECL_ATTRIBUTES (var)
+ = tree_cons (get_identifier ("omp allocate"),
+ attr_value,
+ remove_attribute ("omp allocate",
+ DECL_ATTRIBUTES (var)));
+ };
+ /* The alloc/align clauses get marked with error_mark_node after an error is
+ reported to prevent duplicate diagnosis. The same is done for the var
+ (TREE_PURPOSE) of any node that has an error, additionally the
+ "omp allocate" attr is marked so the middle end knows to skip it during
+ gimplification. */
+
+
+
+ for (tree vn = var_list; vn != NULL_TREE; vn = TREE_CHAIN (vn))
+ {
+ tree var = TREE_PURPOSE (vn);
+ bool var_has_error = false;
+ if (var == error_mark_node)
+ /* Early escape. */;
+ else if (TYPE_REF_P (TREE_TYPE (var)))
+ {
+ auto_diagnostic_group d;
+ error_at (EXPR_LOCATION (TREE_VALUE (vn)),
+ "variable %qD with reference type may not appear as a "
+ "list item in an %<allocate%> directive", var);
+ inform (DECL_SOURCE_LOCATION (var), "%qD declared here", var);
+ var_has_error = true;
+ }
+ else if (TREE_STATIC (var) && var_in_maybe_constexpr_fn (var))
+ {
+ /* Unfortunately, until the first round of band-aids is applied to
+ make_rtl_for_nonlocal_decl we can't support static vars in
+ implicit constexpr functions in non-template contexts at all.
+ Technically, we could support cases inside templates, but it's
+ difficult to differentiate them here, and it would be confusing to
+ only allow the cases in templates. */
+ auto_diagnostic_group d;
+ sorry_at (EXPR_LOCATION (TREE_VALUE (vn)),
+ "static variable %qD is not supported in an %<allocate%> "
+ "directive in an implicit constexpr function", var);
+ inform (DECL_SOURCE_LOCATION (var), "%qD declared here", var);
+ var_has_error = true;
+ }
+
+ if (var_has_error)
+ {
+ /* Mark the node so we don't need to lookup the attribute every
+ time we check if we need to skip a diagnostic. */
+ TREE_PURPOSE (vn) = error_mark_node;
+ /* We won't have access to the var after it's cleared from the node,
+ finalize it early.
+ We avoid needing to handle error_mark_node in
+ varpool_node::finalize_decl if we make align a NULL_TREE. */
+ finalize_allocate_attr (var, error_mark_node, NULL_TREE);
+ }
+ }
+ /* Unfortunately, we can't easily diagnose use of a parameter in the alloc or
+ align expr before instantiation. For a type dependent expr
+ potential_constant_expression must return true even if the expr contains
+ a parameter. The align and alloc clause's exprs must be of type
+ integer/omp_allocator_handle_t respectively, in theory these extra
+ constraints would let us diagnose some cases during parsing of a template
+ declaration. The following case is invalid.
+ void f0(auto p) {
+ int a;
+ #pragma omp allocate(a) align(p)
+ }
+ We know that this can't be valid because expr p must be an integer type,
+ not an empty class type. On the other hand...
+ constexpr int g(auto) { return 32; }
+ void f1(auto p) {
+ int a;
+ #pragma omp allocate(a) align(g (p))
+ }
+ This is valid code if p is an empty class type, so we can't just
+ disqualify an expression because it contains a local var or parameter.
+
+ In short, we don't jump through hoops to try to diagnose cases that are
+ possible to be proven ill-formed, such as with f1 above, we just diagnose
+ it upon instantiation. Perhaps this can be revisited, but it doesn't
+ seem to be worth it. It will complicate the error handling code here,
+ and has a risk of breaking valid code like the f1 case above.
+
+ See PR91953 and r10-6416-g8fda2c274ac66d60c1dfc1349e9efb4e8c2a3580 for
+ more information.
+
+ There are also funny cases like const int that are considered constant
+ expressions which we have to accept for correctness, but that only applies
+ to variables, not parameters. */
+ if (align && align != error_mark_node)
+ {
+ /* (OpenMP 5.1, 181:17-18) alignment is a constant positive integer
+ expression with a value that is a power of two. */
+ location_t align_loc = EXPR_LOCATION (align);
+ if (!type_dependent_expression_p (align))
+ {
+ /* Might we want to support implicitly convertible to int? Is that
+ forbidden by the spec? */
+ if (!INTEGRAL_TYPE_P (TREE_TYPE (align)))
+ {
+ /* Just use the same error as the value checked error, there is
+ little value in fragmenting the wording. */
+ error_at (align_loc,
+ "%<align%> clause argument needs to be positive "
+ "constant power of two integer expression");
+ /* Don't repeat the error again. */
+ align = error_mark_node;
+ }
+ }
+ if (align != error_mark_node && !value_dependent_expression_p (align))
+ {
+ align = fold_non_dependent_expr (align);
+ if (!TREE_CONSTANT (align)
+ || tree_int_cst_sgn (align) != 1
+ || !integer_pow2p (align))
+ {
+ error_at (align_loc,
+ "%<align%> clause argument needs to be positive "
+ "constant power of two integer expression");
+ align = error_mark_node;
+ }
+ }
+ }
+
+ if (alloc == NULL_TREE)
+ {
+ for (tree node = var_list; node != NULL_TREE; node = TREE_CHAIN (node))
+ {
+ tree var = TREE_PURPOSE (node);
+ if (var != error_mark_node && TREE_STATIC (var))
+ {
+ auto_diagnostic_group d;
+ error_at (EXPR_LOCATION (TREE_VALUE (node)),
+ "%<allocator%> clause required for "
+ "static variable %qD", var);
+ inform (DECL_SOURCE_LOCATION (var), "%qD declared here", var);
+ alloc = error_mark_node;
+ }
+ }
+ }
+ else if (alloc != error_mark_node)
+ {
+ location_t alloc_loc = EXPR_LOCATION (alloc);
+ if (!type_dependent_expression_p (alloc))
+ {
+ tree orig_type = TYPE_MAIN_VARIANT (TREE_TYPE (alloc));
+ if (!INTEGRAL_TYPE_P (TREE_TYPE (alloc))
+ || TREE_CODE (orig_type) != ENUMERAL_TYPE
+ || TYPE_NAME (orig_type) == NULL_TREE
+ || (DECL_NAME (TYPE_NAME (orig_type))
+ != get_identifier ("omp_allocator_handle_t")))
+ {
+ error_at (alloc_loc,
+ "%<allocator%> clause expression has type "
+ "%qT rather than %<omp_allocator_handle_t%>",
+ TREE_TYPE (alloc));
+ alloc = error_mark_node;
+ }
+ }
+ if (alloc != error_mark_node && !value_dependent_expression_p (alloc))
+ {
+ /* It is unclear if this is required as fold_non_dependent_expr
+ appears to correctly return the original expr if it can't be
+ folded. Additionally, should we be passing tf_none? */
+ alloc = maybe_fold_non_dependent_expr (alloc);
+ const bool constant_predefined_allocator = [&] ()
+ {
+ if (!TREE_CONSTANT (alloc))
+ return false;
+ wi::tree_to_widest_ref alloc_value = wi::to_widest (alloc);
+ /* MAX is inclusive. */
+ return (alloc_value >= 1
+ && alloc_value <= GOMP_OMP_PREDEF_ALLOC_MAX)
+ || (alloc_value >= GOMP_OMPX_PREDEF_ALLOC_MIN
+ && alloc_value <= GOMP_OMPX_PREDEF_ALLOC_MAX);
+ } (); /* IILE. */
+ if (!constant_predefined_allocator)
+ {
+ for (tree vn = var_list; vn != NULL_TREE; vn = TREE_CHAIN (vn))
+ {
+ tree var = TREE_PURPOSE (vn);
+ if (var != error_mark_node && TREE_STATIC (var))
+ {
+ auto_diagnostic_group d;
+ /* Perhaps we should only report a single error and
+ inform for each static var? */
+ error_at (alloc_loc,
+ "%<allocator%> clause requires a predefined "
+ "allocator as %qD is static", var);
+ inform (DECL_SOURCE_LOCATION (var),
+ "%qD declared here", var);
+ alloc = error_mark_node;
+ }
+ }
+ }
+ }
+ }
+ /* Helper algorithm. */
+ auto any_of_vars = [&var_list] (bool (*predicate)(tree))
+ {
+ for (tree vn = var_list; vn != NULL_TREE; vn = TREE_CHAIN (vn))
+ if (predicate (TREE_PURPOSE (vn)))
+ return true;
+ return false;
+ };
+
+ /* Even if there have been errors we still want to save our progress so we
+ don't miss any potential diagnostics.
+ Technically we don't have to do this if there were errors and alloc,
+ align, and all the vars are substituted, but it's more work to check for
+ that than to just add the stmt. If it were viable to finalize everything
+ before instantiation is complete it might be worth it, but we can't do
+ that because substitution has to eagerly copy nodes. */
+ if (processing_template_decl)
+ {
+ tree allocate_stmt = make_node (OMP_ALLOCATE);
+ /* Pretty sure we don't want side effects on this, it also probably
+ doesn't matter but lets avoid unnecessary noise. */
+ TREE_SIDE_EFFECTS (allocate_stmt) = 0;
+ OMP_ALLOCATE_LOCATION (allocate_stmt) = loc;
+ OMP_ALLOCATE_VARS (allocate_stmt) = var_list;
+ OMP_ALLOCATE_ALLOCATOR (allocate_stmt) = alloc;
+ OMP_ALLOCATE_ALIGN (allocate_stmt) = align;
+ add_stmt (allocate_stmt);
+ return;
+ }
+ else if (alloc == error_mark_node || align == error_mark_node || !var_list
+ || any_of_vars ([] (tree var) { return var == error_mark_node; }))
+ {
+ /* The directive is fully instantiated, however, errors were diagnosed.
+ We can't remove the "omp allocate" attr just in case we are still
+ parsing a function, instead, we mark it. */
+ for (tree vn = var_list; vn != NULL_TREE; vn = TREE_CHAIN (vn))
+ {
+ tree var = TREE_PURPOSE (vn);
+ /* If the var decl is marked, it has already been finalized. */
+ if (var != error_mark_node)
+ /* We avoid needing to handle error_mark_node in
+ varpool_node::finalize_decl if we make align a NULL_TREE. */
+ finalize_allocate_attr (var, error_mark_node, NULL_TREE);
+ }
+ return;
+ }
+
+ /* We have no errors and everything is fully instantiated, we can finally
+ finish the attribute on each var_decl. */
+ gcc_assert (!processing_template_decl
+ && alloc != error_mark_node
+ && align != error_mark_node
+ && var_list != NULL_TREE);
+
+ for (tree vn = var_list; vn != NULL_TREE; vn = TREE_CHAIN (vn))
+ finalize_allocate_attr (TREE_PURPOSE (vn), alloc, align);
+}
+
void
finish_omp_atomic (location_t loc, enum tree_code code, enum tree_code opcode,
tree lhs, tree rhs, tree v, tree lhs1, tree rhs1, tree r,
@@ -14053,6 +15660,45 @@ cp_build_bit_cast (location_t loc, tree type, tree arg,
return ret;
}
+/* Build an OpenMP array-shape cast of ARG to TYPE. */
+
+tree
+cp_build_omp_arrayshape_cast (location_t loc, tree type, tree arg,
+ tsubst_flags_t complain)
+{
+ if (error_operand_p (type))
+ return error_mark_node;
+
+ if (!dependent_type_p (type)
+ && !complete_type_or_maybe_complain (type, NULL_TREE, complain))
+ return error_mark_node;
+
+ if (error_operand_p (arg))
+ return error_mark_node;
+
+ if (!type_dependent_expression_p (arg) && !dependent_type_p (type))
+ {
+ if (!trivially_copyable_p (TREE_TYPE (arg)))
+ {
+ error_at (cp_expr_loc_or_loc (arg, loc),
+ "OpenMP array shape source type %qT "
+ "is not trivially copyable", TREE_TYPE (arg));
+ return error_mark_node;
+ }
+
+ /* A pointer to multi-dimensional array conversion isn't normally
+ allowed, but we force it here for array shape operators by creating
+ the node directly. We also want to avoid any overloaded conversions
+ the user might have defined, not that there are likely to be any. */
+ return build1_loc (loc, VIEW_CONVERT_EXPR, type, arg);
+ }
+
+ tree ret = build_min (OMP_ARRAYSHAPE_CAST_EXPR, type, arg);
+ SET_EXPR_LOCATION (ret, loc);
+
+ return ret;
+}
+
/* Diagnose invalid #pragma GCC unroll argument and adjust
it if needed. */
diff --git a/gcc/cp/typeck.cc b/gcc/cp/typeck.cc
index 88f8f34..46418f9 100644
--- a/gcc/cp/typeck.cc
+++ b/gcc/cp/typeck.cc
@@ -1636,6 +1636,9 @@ structural_comptypes (tree t1, tree t2, int strict)
return false;
if (DECLTYPE_FOR_LAMBDA_PROXY (t1) != DECLTYPE_FOR_LAMBDA_PROXY (t2))
return false;
+ if (DECLTYPE_FOR_OMP_ARRAYSHAPE_CAST (t1)
+ != DECLTYPE_FOR_OMP_ARRAYSHAPE_CAST (t2))
+ return false;
if (!cp_tree_equal (DECLTYPE_TYPE_EXPR (t1), DECLTYPE_TYPE_EXPR (t2)))
return false;
break;
@@ -4865,12 +4868,12 @@ build_x_array_ref (location_t loc, tree arg1, tree arg2,
tree
build_omp_array_section (location_t loc, tree array_expr, tree index,
- tree length)
+ tree length, tree stride)
{
if (TREE_CODE (array_expr) == TYPE_DECL
|| type_dependent_expression_p (array_expr))
- return build3_loc (loc, OMP_ARRAY_SECTION, NULL_TREE, array_expr, index,
- length);
+ return build4_loc (loc, OMP_ARRAY_SECTION, NULL_TREE, array_expr, index,
+ length, stride);
tree type = TREE_TYPE (array_expr);
gcc_assert (type);
@@ -4909,8 +4912,8 @@ build_omp_array_section (location_t loc, tree array_expr, tree index,
sectype = build_array_type (eltype, idxtype);
}
- return build3_loc (loc, OMP_ARRAY_SECTION, sectype, array_expr, index,
- length);
+ return build4_loc (loc, OMP_ARRAY_SECTION, sectype, array_expr, index,
+ length, stride);
}
/* Return whether OP is an expression of enum type cast to integer
@@ -8299,6 +8302,9 @@ check_for_casting_away_constness (location_t loc, tree src_type,
src_type, dest_type);
return true;
+ case OMP_ARRAYSHAPE_CAST_EXPR:
+ return true;
+
default:
gcc_unreachable();
}
@@ -10878,7 +10884,10 @@ can_do_nrvo_p (tree retval, tree functype)
&& same_type_p (TYPE_MAIN_VARIANT (TREE_TYPE (retval)),
TYPE_MAIN_VARIANT (functype))
/* And the returned value must be non-volatile. */
- && !TYPE_VOLATILE (TREE_TYPE (retval)));
+ && !TYPE_VOLATILE (TREE_TYPE (retval))
+ /* And the variable must not be used in an allocate directive. */
+ && (!flag_openmp || !lookup_attribute ("omp allocate",
+ DECL_ATTRIBUTES (retval))));
}
/* True if we would like to perform NRVO, i.e. can_do_nrvo_p is true and we
diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi
index 0978c4c..ec68c85 100644
--- a/gcc/doc/extend.texi
+++ b/gcc/doc/extend.texi
@@ -10695,7 +10695,7 @@ influence run-time behavior.
GCC strives to be compatible with the
@uref{https://www.openacc.org/, OpenACC Application Programming
-Interface v2.6}.
+Interface v2.7}.
To enable the processing of OpenACC directives @samp{#pragma acc}
in C and C++, GCC needs to be invoked with the @option{-fopenacc} option.
diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi
index 617a3d8..3135821 100644
--- a/gcc/doc/invoke.texi
+++ b/gcc/doc/invoke.texi
@@ -302,6 +302,7 @@ Objective-C and Objective-C++ Dialects}.
@item OpenMP and OpenACC Options
@xref{OpenMP and OpenACC Options,,Options Controlling OpenMP and OpenACC}.
@gccoptlist{-foffload=@var{arg} -foffload-options=@var{arg}
+-foffload-memory=@var{arg}
-fopenacc -fopenacc-dim=@var{geom}
-fopenmp -fopenmp-simd -fopenmp-target-simd-clone@r{[}=@var{device-type}@r{]}}
@@ -5235,6 +5236,20 @@ Typical command lines are
-foffload-options=amdgcn-amdhsa=-march=gfx906
@end smallexample
+@opindex foffload-memory
+@cindex OpenMP offloading memory modes
+@item -foffload-memory=none
+@itemx -foffload-memory=unified
+@itemx -foffload-memory=pinned
+Enable a memory optimization mode to use with OpenMP. The default behavior,
+@option{-foffload-memory=none}, is to do nothing special (unless enabled via
+a requires directive in the code). @option{-foffload-memory=unified} is
+equivalent to @code{#pragma omp requires unified_shared_memory}.
+@option{-foffload-memory=pinned} forces all host memory to be pinned (this
+mode may require the user to increase the ulimit setting for locked memory).
+All translation units must select the same setting to avoid undefined
+behavior.
+
@opindex fopenacc
@cindex OpenACC accelerator programming
@item -fopenacc
@@ -5249,7 +5264,11 @@ have support for @option{-pthread}.
Specify default compute dimensions for parallel offload regions that do
not explicitly specify them. The @var{geom} value is a triple of
@samp{:}-separated sizes, in order @var{gang}, @var{worker}, and @var{vector}.
-A size can be omitted, to use a target-specific default value.
+If a size is to be deferred until execution @samp{-} can be used;
+alternatively a size can be omitted to use a target-specific default value.
+When deferring to runtime, the environment variable @env{GOMP_OPENACC_DIM}
+can be set. It has the same format as the option value, except that
+@samp{-} is not permitted.
@opindex fopenmp
@cindex OpenMP parallel
diff --git a/gcc/dwarf2out.cc b/gcc/dwarf2out.cc
index 2437610..b5a7886 100644
--- a/gcc/dwarf2out.cc
+++ b/gcc/dwarf2out.cc
@@ -3466,6 +3466,12 @@ static GTY(()) limbo_die_node *limbo_die_list;
DW_AT_{,MIPS_}linkage_name once their DECL_ASSEMBLER_NAMEs are set. */
static GTY(()) limbo_die_node *deferred_asm_name;
+/* A list of DIEs for which we may have to add a notional code range to the
+ parent DIE. This happens for parents of nested offload kernels, and is
+ necessary because the parents don't exist on the offload target, yet GDB
+ expects parents of real functions to also appear to exist. */
+static GTY(()) limbo_die_node *notional_parents_list;
+
struct dwarf_file_hasher : ggc_ptr_hash<dwarf_file_data>
{
typedef const char *compare_type;
@@ -21024,6 +21030,15 @@ add_location_or_const_value_attribute (dw_die_ref die, tree decl, bool cache_p)
if (list)
{
add_AT_location_description (die, DW_AT_location, list);
+
+ addr_space_t as = TYPE_ADDR_SPACE (TREE_TYPE (decl));
+ if (!ADDR_SPACE_GENERIC_P (as))
+ {
+ int action = targetm.addr_space.debug (as);
+ /* Positive values indicate an address_class. */
+ if (action >= 0)
+ add_AT_unsigned (die, DW_AT_address_class, action);
+ }
return true;
}
/* None of that worked, so it must not really have a location;
@@ -23945,8 +23960,24 @@ gen_subprogram_die (tree decl, dw_die_ref context_die)
if (fde->dw_fde_begin)
{
/* We have already generated the labels. */
- add_AT_low_high_pc (subr_die, fde->dw_fde_begin,
- fde->dw_fde_end, false);
+ add_AT_low_high_pc (subr_die, fde->dw_fde_begin,
+ fde->dw_fde_end, false);
+
+ /* Offload kernel functions are nested within a parent function
+ that doesn't actually exist within the offload object. GDB
+ will ignore the function and everything nested within unless
+ we give the parent a code range. We can't do it here because
+ that breaks the case where the parent actually does exist (as
+ it does on the host-side), so we defer the fixup for later. */
+ if (lookup_attribute ("omp target entrypoint",
+ DECL_ATTRIBUTES (decl)))
+ {
+ limbo_die_node *node = ggc_cleared_alloc<limbo_die_node> ();
+ node->die = subr_die;
+ node->created_for = decl;
+ node->next = notional_parents_list;
+ notional_parents_list = node;
+ }
}
else
{
@@ -32370,6 +32401,37 @@ flush_limbo_die_list (void)
}
}
+/* Add a code range to the notional parent function (which does not actually
+ exist) so that GDB does not ignore all the child functions. The actual
+ values do not matter, but need to be valid labels, so we simply copy those
+ from the child function.
+
+ Typically this occurs when we have an offload kernel, where the parent
+ function only exists in the host-side portion of the code. */
+
+static void
+fixup_notional_parents (void)
+{
+ limbo_die_node *node;
+
+ while ((node = notional_parents_list))
+ {
+ dw_die_ref die = node->die;
+ dw_die_ref parent = die->die_parent;
+ notional_parents_list = node->next;
+
+ if (parent
+ && parent->die_tag == DW_TAG_subprogram
+ && !get_AT_low_pc (parent))
+ {
+ dw_attr_node *low = get_AT (die, DW_AT_low_pc);
+ dw_attr_node *high = get_AT (die, DW_AT_high_pc);
+
+ add_AT_low_high_pc (parent, AT_lbl (low), AT_lbl (high), false);
+ }
+ }
+}
+
/* Reset DIEs so we can output them again. */
static void
@@ -32441,6 +32503,9 @@ dwarf2out_finish (const char *filename)
/* Flush out any latecomers to the limbo party. */
flush_limbo_die_list ();
+ /* Insert an notional parent code ranges. */
+ fixup_notional_parents ();
+
if (inline_entry_data_table)
gcc_assert (inline_entry_data_table->is_empty ());
@@ -33519,6 +33584,7 @@ dwarf2out_cc_finalize (void)
single_comp_unit_die = NULL;
comdat_type_list = NULL;
limbo_die_list = NULL;
+ notional_parents_list = NULL;
file_table = NULL;
decl_die_table = NULL;
common_block_die_table = NULL;
diff --git a/gcc/expr.cc b/gcc/expr.cc
index 3815c56..944081a 100644
--- a/gcc/expr.cc
+++ b/gcc/expr.cc
@@ -11413,7 +11413,8 @@ expand_expr_real_1 (tree exp, rtx target, machine_mode tmode,
/* Allow accel compiler to handle variables that require special
treatment, e.g. if they have been modified in some way earlier in
compilation by the adjust_private_decl OpenACC hook. */
- if (flag_openacc && targetm.goacc.expand_var_decl)
+ if ((flag_openacc || flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ && targetm.goacc.expand_var_decl)
{
temp = targetm.goacc.expand_var_decl (exp);
if (temp)
diff --git a/gcc/flag-types.h b/gcc/flag-types.h
index 9a3cc4a..274307f 100644
--- a/gcc/flag-types.h
+++ b/gcc/flag-types.h
@@ -570,6 +570,12 @@ enum omp_target_simd_clone_device_kind
OMP_TARGET_SIMD_CLONE_ANY = 3
};
+enum omp_target_mode_kind
+{
+ OMP_TARGET_MODE_DEFAULT = 0,
+ OMP_TARGET_MODE_OMPACC = 1
+};
+
#endif
#endif /* ! GCC_FLAG_TYPES_H */
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
new file mode 100644
index 0000000..05c8e3f
--- /dev/null
+++ b/gcc/fortran/ChangeLog.omp
@@ -0,0 +1,448 @@
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ * trans-openmp.cc (gfc_trans_omp_declare_variant): Disallow
+ polymorphic and optional arguments with need_device_addr for now, but
+ don't reject need_device_addr entirely.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+
+ PR c++/119659
+ PR c++/118859
+ PR c++/119601
+ PR c++/119602
+ PR c++/119775
+ * trans-openmp.cc (gfc_trans_omp_declare_variant): Change format of
+ "omp declare variant variant args" attribute.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * trans-openmp.cc (gfc_omp_deep_mapping_map): Add new argument for
+ vector of newly created iterators. Push new iterators onto the
+ vector.
+ (gfc_omp_deep_mapping_comps): Add new argument for vector of new
+ iterators. Pass argument in calls to gfc_omp_deep_mapping_item and
+ gfc_omp_deep_mapping_comps.
+ (gfc_omp_deep_mapping_item): Add new argument for vector of new
+ iterators. Pass argument in calls to gfc_omp_deep_mapping_map and
+ gfc_omp_deep_mapping_comps.
+ (gfc_omp_deep_mapping_do): Add new argument for vector of new
+ iterators. Pass argument in calls to gfc_omp_deep_mapping_item.
+ (gfc_omp_deep_mapping_cnt): Pass NULL to new argument for
+ gfc_omp_deep_mapping_do.
+ (gfc_omp_deep_mapping): Add new argument for vector of new
+ iterators. Pass argument in calls to gfc_omp_deep_mapping_do.
+ * trans.h (gfc_omp_deep_mapping): Add new argument.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * trans-openmp.cc (gfc_omp_deep_mapping_map): Remove const from ctx
+ argument. Add arguments for iterators and the statement sequence to
+ go into the iterator loop. Add statement sequence to iterator loop
+ body. Generate iterator loop entries for generated maps, insert
+ the map decls and sizes into the iterator element arrays, replace
+ original decls with the address of the element arrays, and
+ sizes/biases with SIZE_INT.
+ (gfc_omp_deep_mapping_comps): Remove const from ctx. Add argument for
+ iterators. Pass iterators to calls to gfc_omp_deep_mapping_item and
+ gfc_omp_deep_mapping_comps.
+ (gfc_omp_deep_mapping_item): Remove const from ctx. Add argument for
+ iterators. Collect generated side-effect statements and pass to
+ gfc_omp_deep_mapping_map along with the iterators. Pass iterators
+ to gfc_omp_deep_mapping_comps.
+ (gfc_omp_deep_mapping_do): Remove const from ctx. Pass iterators to
+ gfc_omp_deep_mapping_item.
+ (gfc_omp_deep_mapping_cnt): Remove const from ctx.
+ (gfc_omp_deep_mapping): Likewise.
+ * trans.h (gfc_omp_deep_mapping_cnt): Likewise.
+ (gfc_omp_deep_mapping): Likewise.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * openmp.cc (gfc_omp_instantiate_mapper): Add argument for namespace.
+ Apply namespace to new clauses. Propagate namespace to nested
+ mappers.
+ (gfc_omp_instantiate_mappers): Pass namespace of clause to clauses
+ generated by mappers.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * trans-openmp.cc (gfc_trans_omp_array_section): Use macros for
+ accessing iterator elements.
+ (handle_iterator): Likewise.
+ (gfc_trans_omp_clauses): Likewise.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * trans-openmp.cc (gfc_trans_omp_clauses): Disable strided updates
+ when iterators are used in the clause.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * dump-parse-tree.cc (show_omp_namelist): Add iterator support for
+ OMP_LIST_TO and OMP_LIST_FROM.
+ * match.cc (gfc_free_namelist): Free namespace for OMP_LIST_TO and
+ OMP_LIST_FROM.
+ * openmp.cc (gfc_free_omp_clauses): Free namespace for OMP_LIST_TO
+ and OMP_LIST_FROM.
+ (gfc_match_motion_var_list): Parse 'iterator' modifier.
+ (resolve_omp_clauses): Resolve iterators for OMP_LIST_TO and
+ OMP_LIST_FROM.
+ * trans-openmp.cc (gfc_trans_omp_clauses): Handle iterators in
+ OMP_LIST_TO and OMP_LIST_FROM clauses. Add expressions to
+ iter_block rather than block.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * dump-parse-tree.cc (show_omp_namelist): Add iterator support for
+ OMP_LIST_MAP.
+ * match.cc (gfc_free_namelist): Free namespace for OMP_LIST_MAP.
+ * openmp.cc (gfc_free_omp_clauses): Free namespace in namelist for
+ OMP_LIST_MAP.
+ (gfc_match_omp_clauses): Parse 'iterator' modifier for 'map' clause.
+ (resolve_omp_clauses): Resolve iterators for OMP_LIST_MAP.
+ * trans-openmp.cc: Include tree-ssa-loop-niter.h.
+ (gfc_trans_omp_array_section): Add iterator argument. Replace
+ instances of iterator variables with the initial value when
+ computing biases.
+ (gfc_trans_omp_clauses): Handle iterators in OMP_LIST_MAP clauses.
+ Add expressions to iter_block rather than block. Do not apply
+ iterators to firstprivate maps. Pass iterator to
+ gfc_trans_omp_array_section.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * trans-openmp.cc (gfc_trans_omp_array_section): Use temporaries only
+ when translating OpenACC.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gfortran.h (struct gfc_omp_namelist): Move udm field into a new
+ union u3.
+ * match.cc (gfc_free_omp_namelist): Change references to u2.udm to
+ u3.udm.
+ * module.cc (load_omp_udms): Likewise.
+ (write_omp_udm): Likewise.
+ * openmp.cc (gfc_match_motion_var_list): Likewise.
+ (gfc_match_omp_clauses): Likewise.
+ (resolve_omp_clauses): Likewise.
+ (gfc_omp_instantiate_mapper): Likewise.
+ * trans-openmp.cc (gfc_trans_omp_clauses): Likewise.
+ (gfc_find_nested_mappers): Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * cpp.cc (cpp_define_builtins): Updated _OPENACC to "201811"
+ for OpenACC 2.7.
+ * intrinsic.texi (OpenACC Module OPENACC): Adjust version
+ references to 2.7 from 2.6.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * openmp.cc (oacc_reduction_defined_type_p): New function.
+ (resolve_omp_clauses): Adjust OpenACC array reduction error case.
+ Adjust OMP_LIST_REDUCTION case. Use oacc_reduction_defined_type_p for
+ OpenACC.
+ * trans-openmp.cc (gfc_trans_omp_array_reduction_or_udr):
+ Add 'stmtblock_t *block', and 'bool openacc' parameters. Add array and
+ array section handling for openacc case. Adjust part of function to be
+ !openacc only.
+ (gfc_trans_omp_reduction_list):
+ Add 'stmtblock_t *block', and 'bool openacc' parameters, pass to calls
+ to gfc_trans_omp_array_reduction_or_udr.
+ (gfc_trans_omp_array_section): Adjust setting of OMP_CLAUSE_SIZE to only
+ OMP_CLAUSE_MAP clauses. Adjust calculations of decls and bias to use
+ temporary variables instead of tree expression inside clauses.
+ (gfc_trans_omp_clauses): Add 'block' and 'openacc' arguments to calls to
+ gfc_trans_omp_reduction_list.
+ (gfc_trans_omp_do): Pass 'op == EXEC_OACC_LOOP' as 'bool openacc'
+ parameter in call to gfc_trans_omp_clauses.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * trans-openmp.cc (gfc_trans_omp_array_section):
+ Set OMP_CLAUSE_MAP_POINTS_TO_READONLY on pointer clause.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Andrew Stubbs <ams@baylibre.com>
+ Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * 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.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * trans-openmp.cc (gfc_omp_deep_map_kind_p): Handle
+ GOMP_MAP_{TO,FROM}_GRID, GOMP_MAP_GRID_{DIM,STRIDE}.
+ (gfc_trans_omp_arrayshape_type, gfc_omp_calculate_gcd,
+ gfc_desc_to_omp_noncontig_array, gfc_omp_contiguous_update_p): New
+ functions.
+ (gfc_trans_omp_clauses): Handle noncontiguous to/from clauses for OMP
+ "target update" directives.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gfortran.h (gfc_omp_namelist_udm): Add MAPPER_ID field to store the
+ mapper name to use for lookup during resolution.
+ * match.cc (gfc_free_omp_namelist): Handle OMP_LIST_TO and
+ OMP_LIST_FROM when freeing mapper references.
+ * module.cc (load_omp_udms, write_omp_udm): Handle MAPPER_ID field.
+ * openmp.cc (gfc_match_omp_clauses): Handle explicitly-specified
+ 'default' name. Don't do mapper lookup here, but record mapper name if
+ the user specifies one.
+ (resolve_omp_clauses): Do mapper lookup here instead. Report error for
+ missing named mapper.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+
+ * gfortran.h (gfc_omp_instantiate_mappers): Adjust declaration
+ to return an error status instead of void.
+ * openmp.cc (gfc_gomp_instantiate_mappers): Likewise for the
+ the definition.
+ * trans-openmp.cc (gfc_trans_omp_target): Check return status of
+ call to gfc_omp_instantiate_mappers and insert an error_mark_node
+ on failure instead of continuing normal processing of the construct.
+ (gfc_trans_omp_target_data): Likewise.
+ (gfc_trans_omp_target_enter_data): Likewise.
+ (gfc_trans_omp_target_exit_data): Likewise.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gfortran.h (gfc_omp_clauses): Add NS field.
+ * openmp.cc (verify_omp_clauses_symbol_dups,
+ omp_verify_map_motion_clauses): New functions, broken out of...
+ (resolve_omp_clauses): Here. Record namespace containing clauses.
+ Call above functions.
+ (resolve_omp_mapper_clauses): New function, using helper functions
+ broken out above.
+ (gfc_resolve_omp_directive): Add NS parameter to resolve_omp_clauses
+ calls.
+ (gfc_omp_instantiate_mappers): Call resolve_omp_mapper_clauses if we
+ instantiate any mappers.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gfortran.h (toc_directive): Move here.
+ (gfc_omp_instantiate_mappers, gfc_get_location): Add prototypes.
+ * openmp.cc (omp_split_map_op, omp_join_map_op, omp_map_decayed_kind,
+ omp_basic_map_kind_name, gfc_subst_replace, gfc_subst_prepend_ref,
+ gfc_subst_in_expr_1, gfc_subst_in_expr, gfc_subst_mapper_var): Move
+ here.
+ (gfc_omp_instantiate_mapper, gfc_omp_instantiate_mappers): Move here
+ and rename.
+ * trans-openmp.cc (toc_directive, omp_split_map_op, omp_join_map_op,
+ omp_map_decayed_kind, gfc_subst_replace, gfc_subst_prepend_ref,
+ gfc_subst_in_expr_1, gfc_subst_in_expr, gfc_subst_mapper_var,
+ gfc_trans_omp_instantiate_mapper, gfc_trans_omp_instantiate_mappers):
+ Remove from here.
+ (gfc_trans_omp_target, gfc_trans_omp_target_data,
+ gfc_trans_omp_target_enter_data, gfc_trans_omp_target_exit_data):
+ Rename calls to gfc_omp_instantiate_mappers.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * trans-openmp.cc (omp_split_map_op, omp_join_map_op,
+ omp_map_decayed_kind): New functions.
+ (gfc_trans_omp_instantiate_mapper): Add CD parameter. Implement map
+ kind decay.
+ (gfc_trans_omp_instantiate_mappers): Add CD parameter. Pass to above
+ function.
+ (gfc_trans_omp_target_data): Instantiate mappers for 'omp target data'.
+ (gfc_trans_omp_target_enter_data): Instantiate mappers for 'omp target
+ enter data'.
+ (gfc_trans_omp_target_exit_data): Instantiate mappers for 'omp target
+ exit data'.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * dump-parse-tree.cc (show_attr): Show omp_udm_artificial_var flag.
+ (show_omp_namelist): Support OMP_MAP_POINTER_ONLY and OMP_MAP_UNSET.
+ * f95-lang.cc (LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES,
+ LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE,
+ LANG_HOOKS_OMP_MAP_ARRAY_SECTION): Define language hooks.
+ * gfortran.h (gfc_statement): Add ST_OMP_DECLARE_MAPPER.
+ (symbol_attribute): Add omp_udm_artificial_var attribute.
+ (gfc_omp_map_op): Add OMP_MAP_POINTER_ONLY and OMP_MAP_UNSET.
+ (gfc_omp_namelist): Add udm pointer to u2 union.
+ (gfc_omp_udm): New struct.
+ (gfc_omp_namelist_udm): New struct.
+ (gfc_symtree): Add omp_udm pointer.
+ (gfc_namespace): Add omp_udm_root symtree. Add omp_udm_ns flag.
+ (gfc_free_omp_namelist): Update prototype.
+ (gfc_free_omp_udm, gfc_omp_udm_find, gfc_find_omp_udm,
+ gfc_resolve_omp_udms): Add prototypes.
+ * match.cc (gfc_free_omp_namelist): Change FREE_NS and FREE_ALIGN
+ parameters to LIST number, to handle freeing user-defined mapper
+ namelists safely.
+ * match.h (gfc_match_omp_declare_mapper): Add prototype.
+ * module.cc (ab_attribute): Add AB_OMP_DECLARE_MAPPER_VAR.
+ (attr_bits): Add OMP_DECLARE_MAPPER_VAR.
+ (mio_symbol_attribute): Read/write AB_OMP_DECLARE_MAPPER_VAR attribute.
+ Set referenced attr on read.
+ (omp_map_clause_ops, omp_map_cardinality): New arrays.
+ (load_omp_udms, check_omp_declare_mappers): New functions.
+ (read_module): Load and check OMP declare mappers.
+ (write_omp_udm, write_omp_udms): New functions.
+ (write_module): Write OMP declare mappers.
+ * openmp.cc (gfc_free_omp_clauses, gfc_match_omp_variable_list,
+ gfc_match_omp_to_link, gfc_match_omp_depend_sink,
+ gfc_match_omp_clause_reduction): Update calls to gfc_free_omp_namelist.
+ (gfc_free_omp_udm, gfc_find_omp_udm, gfc_omp_udm_find,
+ gfc_match_omp_declare_mapper): New functions.
+ (gfc_match_omp_clauses): Add DEFAULT_MAP_OP parameter. Update calls to
+ gfc_free_omp_namelist. Add declare mapper support.
+ (resolve_omp_clauses): Add declare mapper support. Update calls to
+ gfc_free_omp_namelist.
+ (gfc_resolve_omp_udm, gfc_resolve_omp_udms): New functions.
+ * parse.cc (decode_omp_directive): Add declare mapper support.
+ (case_omp_decl): Add ST_OMP_DECLARE_MAPPER case.
+ (gfc_ascii_statement): Add ST_OMP_DECLARE_MAPPER case.
+ * resolve.cc (resolve_types): Call gfc_resolve_omp_udms.
+ * st.cc (gfc_free_statement): Update call to gfc_free_omp_namelist.
+ * symbol.cc (free_omp_udm_tree): New function.
+ (gfc_free_namespace): Call above.
+ * trans-decl.cc (omp_declare_mapper_ns): New global.
+ (gfc_finish_var_decl, gfc_generate_function_code): Support declare
+ mappers.
+ (gfc_trans_deferred_vars): Ignore artificial declare-mapper vars.
+ * trans-openmp.cc (tree-iterator.h): Include.
+ (toc_directive): New enum.
+ (gfc_trans_omp_array_section): Change OP and OPENMP parameters to
+ toc_directive CD ('clause directive').
+ (gfc_omp_finish_mapper_clauses, gfc_omp_extract_mapper_directive,
+ gfc_omp_map_array_section): New functions.
+ (omp_clause_directive): New enum.
+ (gfc_trans_omp_clauses): Remove DECLARE_SIMD and OPENACC parameters.
+ Replace with toc_directive CD, defaulting to TOC_OPENMP. Add declare
+ mapper support and OMP_MAP_POINTER_ONLY support.
+ (gfc_trans_omp_construct, gfc_trans_oacc_executable_directive,
+ gfc_trans_oacc_combined_directive): Update calls to
+ gfc_trans_omp_clauses.
+ (gfc_subst_replace, gfc_subst_prepend_ref): New variables.
+ (gfc_subst_in_expr_1, gfc_subst_in_expr, gfc_subst_mapper_var,
+ gfc_trans_omp_instantiate_mapper, gfc_trans_omp_instantiate_mappers,
+ gfc_record_mapper_bindings_code_fn, gfc_record_mapper_bindings_expr_fn,
+ gfc_find_nested_mappers, gfc_record_mapper_bindings): New functions.
+ (gfc_typespec * hash traits): New template.
+ (omp_declare_mapper_ns): Extern declaration.
+ (gfc_trans_omp_target): Call gfc_trans_omp_instantiate_mappers and
+ gfc_record_mapper_bindings. Update calls to gfc_trans_omp_clauses.
+ (gfc_trans_omp_declare_simd, gfc_trans_omp_declare_variant): Update
+ calls to gfc_trans_omp_clauses.
+ (gfc_trans_omp_mapper_name, gfc_trans_omp_declare_mapper,
+ gfc_trans_omp_declare_mappers): New functions.
+ * trans-stmt.h (gfc_trans_omp_declare_mappers): Add prototype.
+ * trans.h (gfc_omp_finish_mapper_clauses,
+ gfc_omp_extract_mapper_directive, gfc_omp_map_array_section): Add
+ prototypes.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * parse.cc (tree.h, fold-const.h, tree-hash-traits.h): Add includes
+ (for additions to omp-general.h).
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * trans-openmp.cc (gfc_omp_finish_clause): Treat implicitly-mapped
+ assumed-size arrays as zero-sized for OpenACC, rather than an error.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+ Sandra Loosemore <sandra@baylibre.com>
+
+ * trans-openmp.cc (gfc_omp_finish_clause): Handle "declare create" for
+ scalar allocatable variables.
+ (gfc_trans_omp_clauses): Don't include allocatable vars in synthetic
+ "acc data" region created for "declare create" variables. Mark such
+ variables with the "oacc declare create" attribute instead. Don't
+ create ALWAYS_POINTER mapping for target-to-host updates of declare
+ create variables.
+ (gfc_trans_oacc_declare): Handle empty clause list.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * openmp.cc (resolve_omp_clauses): Apply to OpenMP target update.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * trans-array.cc (gfc_conv_array_initializer): Set PURPOSE
+ when building constructor for get_initialized_tmp_var.
+ * trans-openmp.cc (gfc_trans_omp_clauses): Handle uses_allocators.
+ * types.def (BT_FN_VOID_PTRMODE, BT_FN_PTRMODE_PTRMODE_INT_PTR): Add.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <thomas@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * gfortran.h (enum gfc_omp_map_op): Add OMP_MAP_DECLARE_ALLOCATE,
+ OMP_MAP_DECLARE_DEALLOCATE.
+ (gfc_omp_clauses): Add update_allocatable.
+ * trans-array.cc (gfc_array_allocate): Call
+ gfc_trans_oacc_declare_allocate for decls that have oacc_declare_create
+ attribute set.
+ * trans-decl.cc (find_module_oacc_declare_clauses): Relax
+ oacc_declare_create to OMP_MAP_ALLOC, and oacc_declare_copyin to
+ OMP_MAP_TO, in order to match OpenACC 2.5 semantics.
+ * trans-openmp.cc (gfc_omp_check_optional_argument): Handle non-decl
+ case.
+ (gfc_trans_omp_clauses): Use GOMP_MAP_ALWAYS_POINTER (for update
+ directive) or GOMP_MAP_FIRSTPRIVATE_POINTER (otherwise) for
+ allocatable scalar decls. Handle OMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}
+ clauses.
+ (gfc_trans_oacc_executable_directive): Use GOMP_MAP_ALWAYS_POINTER
+ for allocatable scalar data clauses inside acc update directives.
+ (gfc_trans_oacc_declare_allocate): New function.
+ * trans-stmt.cc (gfc_trans_allocate): Call
+ gfc_trans_oacc_declare_allocate for decls with oacc_declare_create
+ attribute set.
+ (gfc_trans_deallocate): Likewise.
+ * trans.h (gfc_trans_oacc_declare_allocate): Declare.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+ Nathan Sidwell <nathan@acm.org>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+
+ * trans-openmp.cc (gfc_omp_clause_copy_ctor): Permit reductions.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ James Norris <jnorris@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+
+ * openmp.cc (gfc_match_omp_map_clause): Re-write handling of the
+ deviceptr clause. Add new common_blocks argument. Propagate it to
+ gfc_match_omp_variable_list.
+ (gfc_match_omp_clauses): Update calls to gfc_match_omp_map_clauses.
+ (resolve_positive_int_expr): Promote the warning to an error.
+ (check_array_not_assumed): Remove pointer check.
+ (resolve_oacc_nested_loops): Error on do concurrent loops.
+ * trans-openmp.cc (gfc_omp_finish_clause): Don't create pointer data
+ mappings for deviceptr clauses.
+ (gfc_trans_omp_clauses): Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ PR other/76739
+ * f95-lang.cc (DEF_FUNCTION_TYPE_VAR_5): New symbol.
+ * types.def (BT_FN_VOID_INT_SIZE_PTR_PTR_PTR_VAR): New type. \ No newline at end of file
diff --git a/gcc/fortran/cpp.cc b/gcc/fortran/cpp.cc
index 1b70420..ffddee4 100644
--- a/gcc/fortran/cpp.cc
+++ b/gcc/fortran/cpp.cc
@@ -172,7 +172,7 @@ cpp_define_builtins (cpp_reader *pfile)
cpp_define (pfile, "_LANGUAGE_FORTRAN=1");
if (flag_openacc)
- cpp_define (pfile, "_OPENACC=201711");
+ cpp_define (pfile, "_OPENACC=201811");
if (flag_openmp)
cpp_define (pfile, "_OPENMP=201511");
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 3c10603..648109b 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -924,6 +924,8 @@ show_attr (symbol_attribute *attr, const char * module)
fputs (" PDT-STRING", dumpfile);
if (attr->omp_udr_artificial_var)
fputs (" OMP-UDR-ARTIFICIAL-VAR", dumpfile);
+ if (attr->omp_udm_artificial_var)
+ fputs (" OMP-UDM-ARTIFICIAL-VAR", dumpfile);
if (attr->omp_declare_target)
fputs (" OMP-DECLARE-TARGET", dumpfile);
if (attr->omp_declare_target_link)
@@ -1461,7 +1463,9 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
for (; n; n = n->next)
{
gfc_current_ns = ns_curr;
- if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND)
+ if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND
+ || list_type == OMP_LIST_MAP
+ || list_type == OMP_LIST_TO || list_type == OMP_LIST_FROM)
{
gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr;
if (n->u2.ns != ns_iter)
@@ -1473,8 +1477,16 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
fputs ("AFFINITY (", dumpfile);
else if (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST)
fputs ("DOACROSS (", dumpfile);
- else
+ else if (list_type == OMP_LIST_DEPEND)
fputs ("DEPEND (", dumpfile);
+ else if (list_type == OMP_LIST_MAP)
+ fputs ("MAP (", dumpfile);
+ else if (list_type == OMP_LIST_TO)
+ fputs ("TO (", dumpfile);
+ else if (list_type == OMP_LIST_FROM)
+ fputs ("FROM (", dumpfile);
+ else
+ gcc_unreachable ();
}
if (n->u2.ns)
{
@@ -1606,6 +1618,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
fputs ("always,present,tofrom:", dumpfile); break;
case OMP_MAP_DELETE: fputs ("delete:", dumpfile); break;
case OMP_MAP_RELEASE: fputs ("release:", dumpfile); break;
+ case OMP_MAP_POINTER_ONLY: fputs ("pointeronly:", dumpfile); break;
+ case OMP_MAP_UNSET: fputs ("unset:", dumpfile); break;
default: break;
}
else if (list_type == OMP_LIST_LINEAR && n->u.linear.old_modifier)
diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index 1f09553..3808fed 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -148,6 +148,9 @@ gfc_get_sarif_source_language (const char *)
#undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
#undef LANG_HOOKS_OMP_CLAUSE_DTOR
#undef LANG_HOOKS_OMP_FINISH_CLAUSE
+#undef LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES
+#undef LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE
+#undef LANG_HOOKS_OMP_MAP_ARRAY_SECTION
#undef LANG_HOOKS_OMP_DEEP_MAPPING
#undef LANG_HOOKS_OMP_DEEP_MAPPING_P
#undef LANG_HOOKS_OMP_DEEP_MAPPING_CNT
@@ -191,6 +194,10 @@ gfc_get_sarif_source_language (const char *)
#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor
#define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor
#define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause
+#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES gfc_omp_finish_mapper_clauses
+#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE \
+ gfc_omp_extract_mapper_directive
+#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION gfc_omp_map_array_section
#define LANG_HOOKS_OMP_DEEP_MAPPING gfc_omp_deep_mapping
#define LANG_HOOKS_OMP_DEEP_MAPPING_P gfc_omp_deep_mapping_p
#define LANG_HOOKS_OMP_DEEP_MAPPING_CNT gfc_omp_deep_mapping_cnt
@@ -674,6 +681,8 @@ gfc_init_builtin_functions (void)
#define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
#define DEF_FUNCTION_TYPE_VAR_1(NAME, RETURN, ARG1) NAME,
#define DEF_FUNCTION_TYPE_VAR_2(NAME, RETURN, ARG1, ARG2) NAME,
+#define DEF_FUNCTION_TYPE_VAR_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
+ NAME,
#define DEF_FUNCTION_TYPE_VAR_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
ARG6) NAME,
#define DEF_FUNCTION_TYPE_VAR_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
@@ -696,6 +705,7 @@ gfc_init_builtin_functions (void)
#undef DEF_FUNCTION_TYPE_VAR_0
#undef DEF_FUNCTION_TYPE_VAR_1
#undef DEF_FUNCTION_TYPE_VAR_2
+#undef DEF_FUNCTION_TYPE_VAR_5
#undef DEF_FUNCTION_TYPE_VAR_6
#undef DEF_FUNCTION_TYPE_VAR_7
#undef DEF_POINTER_TYPE
@@ -1208,6 +1218,15 @@ gfc_init_builtin_functions (void)
builtin_types[(int) ARG1], \
builtin_types[(int) ARG2], \
NULL_TREE);
+#define DEF_FUNCTION_TYPE_VAR_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) \
+ builtin_types[(int) ENUM] \
+ = build_varargs_function_type_list (builtin_types[(int) RETURN], \
+ builtin_types[(int) ARG1], \
+ builtin_types[(int) ARG2], \
+ builtin_types[(int) ARG3], \
+ builtin_types[(int) ARG4], \
+ builtin_types[(int) ARG5], \
+ NULL_TREE);
#define DEF_FUNCTION_TYPE_VAR_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
ARG6) \
builtin_types[(int) ENUM] \
@@ -1249,6 +1268,7 @@ gfc_init_builtin_functions (void)
#undef DEF_FUNCTION_TYPE_VAR_0
#undef DEF_FUNCTION_TYPE_VAR_1
#undef DEF_FUNCTION_TYPE_VAR_2
+#undef DEF_FUNCTION_TYPE_VAR_5
#undef DEF_FUNCTION_TYPE_VAR_6
#undef DEF_FUNCTION_TYPE_VAR_7
#undef DEF_POINTER_TYPE
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ad4f8b3..903712a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -273,8 +273,9 @@ enum gfc_statement
ST_OMP_TASKWAIT, ST_OMP_TASKYIELD, ST_OMP_CANCEL, ST_OMP_CANCELLATION_POINT,
ST_OMP_TASKGROUP, ST_OMP_END_TASKGROUP, ST_OMP_SIMD, ST_OMP_END_SIMD,
ST_OMP_DO_SIMD, ST_OMP_END_DO_SIMD, ST_OMP_PARALLEL_DO_SIMD,
- ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_REDUCTION,
- ST_OMP_TARGET, ST_OMP_END_TARGET, ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA,
+ ST_OMP_END_PARALLEL_DO_SIMD, ST_OMP_DECLARE_SIMD, ST_OMP_DECLARE_MAPPER,
+ ST_OMP_DECLARE_REDUCTION, ST_OMP_TARGET, ST_OMP_END_TARGET,
+ ST_OMP_TARGET_DATA, ST_OMP_END_TARGET_DATA,
ST_OMP_TARGET_UPDATE, ST_OMP_DECLARE_TARGET, ST_OMP_DECLARE_VARIANT,
ST_OMP_TEAMS, ST_OMP_END_TEAMS, ST_OMP_DISTRIBUTE, ST_OMP_END_DISTRIBUTE,
ST_OMP_DISTRIBUTE_SIMD, ST_OMP_END_DISTRIBUTE_SIMD,
@@ -1018,6 +1019,10 @@ typedef struct
!$OMP DECLARE REDUCTION. */
unsigned omp_udr_artificial_var:1;
+ /* This is a placeholder variable used in an !$OMP DECLARE MAPPER
+ directive. */
+ unsigned omp_udm_artificial_var:1;
+
/* Mentioned in OMP DECLARE TARGET. */
unsigned omp_declare_target:1;
unsigned omp_declare_target_link:1;
@@ -1348,7 +1353,11 @@ enum gfc_omp_map_op
OMP_MAP_PRESENT_TOFROM,
OMP_MAP_ALWAYS_PRESENT_TO,
OMP_MAP_ALWAYS_PRESENT_FROM,
- OMP_MAP_ALWAYS_PRESENT_TOFROM
+ OMP_MAP_ALWAYS_PRESENT_TOFROM,
+ OMP_MAP_DECLARE_ALLOCATE,
+ OMP_MAP_DECLARE_DEALLOCATE,
+ OMP_MAP_POINTER_ONLY,
+ OMP_MAP_UNSET
};
enum gfc_omp_defaultmap
@@ -1434,6 +1443,10 @@ typedef struct gfc_omp_namelist
struct gfc_omp_namelist *duplicate_of;
char *init_interop;
} u2;
+ union
+ {
+ struct gfc_omp_namelist_udm *udm;
+ } u3;
struct gfc_omp_namelist *next;
locus where;
}
@@ -1634,6 +1647,7 @@ typedef struct gfc_omp_clauses
struct gfc_omp_assumptions *assume;
struct gfc_expr_list *sizes_list;
const char *critical_name;
+ gfc_namespace *ns;
enum gfc_omp_default_sharing default_sharing;
enum gfc_omp_atomic_op atomic_op;
enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
@@ -1675,7 +1689,7 @@ typedef struct gfc_omp_clauses
unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
unsigned par_auto:1, gang_static:1;
unsigned if_present:1, finalize:1;
- unsigned nohost:1;
+ unsigned nohost:1, update_allocatable:1;
locus loc;
}
gfc_omp_clauses;
@@ -1810,6 +1824,38 @@ typedef struct gfc_omp_namelist_udr
gfc_omp_namelist_udr;
#define gfc_get_omp_namelist_udr() XCNEW (gfc_omp_namelist_udr)
+
+typedef struct gfc_omp_udm
+{
+ struct gfc_omp_udm *next;
+ locus where; /* Where the !$omp declare mapper construct occurred. */
+
+ const char *mapper_id;
+ gfc_typespec ts;
+
+ struct gfc_symbol *var_sym;
+ struct gfc_namespace *mapper_ns;
+
+ /* We probably don't need a whole gfc_omp_clauses here. We only use the
+ OMP_LIST_MAP clause list. */
+ gfc_omp_clauses *clauses;
+
+ tree backend_decl;
+}
+gfc_omp_udm;
+#define gfc_get_omp_udm() XCNEW (gfc_omp_udm)
+
+typedef struct gfc_omp_namelist_udm
+{
+ /* Used to store mapper_id before resolution. */
+ const char *mapper_id;
+
+ bool multiple_elems_p;
+ struct gfc_omp_udm *udm;
+}
+gfc_omp_namelist_udm;
+#define gfc_get_omp_namelist_udm() XCNEW (gfc_omp_namelist_udm)
+
/* The gfc_st_label structure is a BBT attached to a namespace that
records the usage of statement labels within that space. */
@@ -2178,6 +2224,7 @@ typedef struct gfc_symtree
gfc_common_head *common;
gfc_typebound_proc *tb;
gfc_omp_udr *omp_udr;
+ gfc_omp_udm *omp_udm;
}
n;
}
@@ -2221,6 +2268,8 @@ typedef struct gfc_namespace
gfc_symtree *common_root;
/* Tree containing all the OpenMP user defined reductions. */
gfc_symtree *omp_udr_root;
+ /* Tree containing all the OpenMP user defined mappers. */
+ gfc_symtree *omp_udm_root;
/* Tree containing type-bound procedures. */
gfc_symtree *tb_sym_root;
@@ -2344,6 +2393,9 @@ typedef struct gfc_namespace
/* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */
unsigned omp_udr_ns:1;
+ /* Set to 1 for !$OMP DECLARE MAPPER namespaces. */
+ unsigned omp_udm_ns:1;
+
/* Set to 1 for !$ACC ROUTINE namespaces. */
unsigned oacc_routine:1;
@@ -3363,6 +3415,19 @@ typedef struct gfc_finalizer
gfc_finalizer;
#define gfc_get_finalizer() XCNEW (gfc_finalizer)
+/* Control clause translation per-directive for gfc_trans_omp_clauses. Also
+ used for gfc_omp_instantiate_mappers. */
+
+enum toc_directive
+{
+ TOC_OPENMP,
+ TOC_OPENMP_DECLARE_SIMD,
+ TOC_OPENMP_DECLARE_MAPPER,
+ TOC_OPENMP_EXIT_DATA,
+ TOC_OPENACC,
+ TOC_OPENACC_DECLARE,
+ TOC_OPENACC_EXIT_DATA
+};
/************************ Function prototypes *************************/
@@ -3825,7 +3890,7 @@ void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
-void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool, bool, bool);
+void gfc_free_omp_namelist (gfc_omp_namelist *, int = OMP_LIST_NUM);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);
@@ -3846,8 +3911,12 @@ void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list);
void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
void gfc_free_omp_udr (gfc_omp_udr *);
+void gfc_free_omp_udm (gfc_omp_udm *);
void gfc_free_omp_variants (gfc_omp_variant *);
gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
+gfc_omp_udm *gfc_omp_udm_find (gfc_symtree *, gfc_typespec *);
+gfc_omp_udm *gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id,
+ gfc_typespec *ts);
void gfc_resolve_omp_allocate (gfc_namespace *, gfc_omp_namelist *);
void gfc_resolve_omp_assumptions (gfc_omp_assumptions *);
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
@@ -3857,6 +3926,10 @@ void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_declare (gfc_namespace *);
void gfc_resolve_omp_udrs (gfc_symtree *);
+void gfc_resolve_omp_udms (gfc_symtree *);
+bool gfc_omp_instantiate_mappers (gfc_code *, gfc_omp_clauses *,
+ toc_directive = TOC_OPENMP,
+ int = OMP_LIST_MAP);
void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
void gfc_omp_restore_state (struct gfc_omp_saved_state *);
void gfc_free_expr_list (gfc_expr_list *);
@@ -4113,6 +4186,7 @@ bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
/* trans.cc */
void gfc_generate_code (gfc_namespace *);
void gfc_generate_module_code (gfc_namespace *);
+location_t gfc_get_location (locus *);
/* trans-intrinsic.cc */
bool gfc_inline_intrinsic_function_p (gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 8c160e5..a7171bf 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -15787,7 +15787,7 @@ The following scalar integer named constants are of the kind
@section OpenACC Module @code{OPENACC}
@table @asis
@item @emph{Standard}:
-OpenACC Application Programming Interface v2.6
+OpenACC Application Programming Interface v2.7
@end table
@@ -15801,9 +15801,9 @@ are listed below.
For details refer to the actual
@uref{https://www.openacc.org/,
-OpenACC Application Programming Interface v2.6}.
+OpenACC Application Programming Interface v2.7}.
@code{OPENACC} provides the scalar default-integer
named constant @code{openacc_version} with a value of the form
@var{yyyymm}, where @code{yyyy} is the year and @var{mm} the month
-of the OpenACC version; for OpenACC v2.6 the value is @code{201711}.
+of the OpenACC version; for OpenACC v2.7 the value is @code{201811}.
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 0f6b8e9..4ea7735 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -5879,10 +5879,17 @@ gfc_free_namelist (gfc_namelist *name)
/* Free an OpenMP namelist structure. */
void
-gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
- bool free_align_allocator,
- bool free_mem_traits_space, bool free_init)
+gfc_free_omp_namelist (gfc_omp_namelist *name, int list)
{
+ bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND
+ || list == OMP_LIST_MAP
+ || list == OMP_LIST_TO || list == OMP_LIST_FROM);
+ bool free_mapper = (list == OMP_LIST_MAP
+ || list == OMP_LIST_TO
+ || list == OMP_LIST_FROM);
+ bool free_align_allocator = (list == OMP_LIST_ALLOCATE);
+ bool free_mem_traits_space = (list == OMP_LIST_USES_ALLOCATORS);
+ bool free_init = (list == OMP_LIST_INIT);
gfc_omp_namelist *n;
gfc_expr *last_allocator = NULL;
char *last_init_interop = NULL;
@@ -5915,7 +5922,9 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
free (name->u2.init_interop);
}
}
- else if (name->u2.udr)
+ else if (free_mapper && name->u3.udm)
+ free (name->u3.udm);
+ else if (!free_mapper && name->u2.udr)
{
if (name->u2.udr->combiner)
gfc_free_statement (name->u2.udr->combiner);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 410361c..2df2773 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -159,6 +159,7 @@ match gfc_match_omp_begin_metadirective (void);
match gfc_match_omp_cancel (void);
match gfc_match_omp_cancellation_point (void);
match gfc_match_omp_critical (void);
+match gfc_match_omp_declare_mapper (void);
match gfc_match_omp_declare_reduction (void);
match gfc_match_omp_declare_simd (void);
match gfc_match_omp_declare_target (void);
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 070b316..1389dee 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -2088,7 +2088,8 @@ enum ab_attribute
AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
- AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
+ AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY,
+ AB_OMP_DECLARE_MAPPER_VAR, AB_OMP_DECLARE_TARGET,
AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK,
@@ -2157,6 +2158,7 @@ static const mstring attr_bits[] =
minit ("CLASS_POINTER", AB_CLASS_POINTER),
minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE),
minit ("UNLIMITED_POLY", AB_UNLIMITED_POLY),
+ minit ("OMP_DECLARE_MAPPER_VAR", AB_OMP_DECLARE_MAPPER_VAR),
minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET),
minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY),
minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE),
@@ -2380,6 +2382,8 @@ mio_symbol_attribute (symbol_attribute *attr)
MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits);
if (attr->vtab)
MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
+ if (attr->omp_udm_artificial_var)
+ MIO_NAME (ab_attribute) (AB_OMP_DECLARE_MAPPER_VAR, attr_bits);
if (attr->omp_declare_target)
MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET, attr_bits);
if (attr->array_outer_dependency)
@@ -2645,6 +2649,17 @@ mio_symbol_attribute (symbol_attribute *attr)
case AB_VTAB:
attr->vtab = 1;
break;
+ case AB_OMP_DECLARE_MAPPER_VAR:
+ attr->omp_udm_artificial_var = 1;
+ /* For the placeholder variable used in an !$OMP DECLARE MAPPER,
+ we don't know if the final clauses will reference used
+ variables or not, yet. Make sure the clause list doesn't get
+ skipped in trans-openmp.cc by forcing the variable referenced
+ attribute true here (else on reading the module, the symbol is
+ created with "referenced" false, and nothing else sets it to
+ true). */
+ attr->referenced = 1;
+ break;
case AB_OMP_DECLARE_TARGET:
attr->omp_declare_target = 1;
break;
@@ -5458,6 +5473,135 @@ load_omp_udrs (void)
}
+/* We only need some of the enumeration values of gfc_omp_map_op for mapping
+ ops in the "!$omp declare mapper" clause list. */
+
+static const mstring omp_map_clause_ops[] =
+{
+ minit ("ALLOC", OMP_MAP_ALLOC),
+ minit ("TO", OMP_MAP_TO),
+ minit ("FROM", OMP_MAP_FROM),
+ minit ("TOFROM", OMP_MAP_TOFROM),
+ minit ("ALWAYS_TO", OMP_MAP_ALWAYS_TO),
+ minit ("ALWAYS_FROM", OMP_MAP_ALWAYS_FROM),
+ minit ("ALWAYS_TOFROM", OMP_MAP_ALWAYS_TOFROM),
+ minit ("POINTER_ONLY", OMP_MAP_POINTER_ONLY),
+ minit ("UNSET", OMP_MAP_UNSET),
+ minit (NULL, -1)
+};
+
+
+/* Whether a namelist in an "!$omp declare mapper" maps a single element or
+ multiple elements. */
+
+static const mstring omp_map_cardinality[] =
+{
+ minit ("SINGLE", 0),
+ minit ("MULTIPLE", 1),
+ minit (NULL, -1)
+};
+
+/* This function loads OpenMP user-defined mappers. */
+
+static void
+load_omp_udms (void)
+{
+ mio_lparen ();
+ while (peek_atom () != ATOM_RPAREN)
+ {
+ const char *mapper_id = NULL;
+ gfc_symtree *st;
+
+ mio_lparen ();
+ gfc_omp_udm *udm = gfc_get_omp_udm ();
+
+ require_atom (ATOM_INTEGER);
+ pointer_info *udmpi = get_integer (atom_int);
+ associate_integer_pointer (udmpi, udm);
+
+ mio_pool_string (&mapper_id);
+
+ /* Note: for a derived-type typespec, we might not have loaded the
+ "u.derived" symbol yet. Defer checking duplicates until
+ check_omp_declare_mappers is called after loading all symbols. */
+ mio_typespec (&udm->ts);
+
+ if (mapper_id == NULL)
+ mapper_id = gfc_get_string ("%s", "");
+
+ st = gfc_find_symtree (gfc_current_ns->omp_udm_root, mapper_id);
+
+ pointer_info *p = mio_symbol_ref (&udm->var_sym);
+ pointer_info *q = get_integer (p->u.rsym.ns);
+
+ udm->where = gfc_current_locus;
+ udm->mapper_id = mapper_id;
+ udm->mapper_ns = gfc_get_namespace (gfc_current_ns, 1);
+ udm->mapper_ns->proc_name = gfc_current_ns->proc_name;
+ udm->mapper_ns->omp_udm_ns = 1;
+
+ associate_integer_pointer (q, udm->mapper_ns);
+
+ gfc_omp_namelist *clauses = NULL;
+ gfc_omp_namelist **clausep = &clauses;
+
+ mio_lparen ();
+ while (peek_atom () != ATOM_RPAREN)
+ {
+ /* Read each map clause. */
+ gfc_omp_namelist *n = gfc_get_omp_namelist ();
+
+ mio_lparen ();
+
+ n->u.map.op = (gfc_omp_map_op) mio_name (0, omp_map_clause_ops);
+ mio_symbol_ref (&n->sym);
+ mio_expr (&n->expr);
+
+ mio_lparen ();
+
+ if (peek_atom () != ATOM_RPAREN)
+ {
+ n->u3.udm = gfc_get_omp_namelist_udm ();
+ mio_pool_string (&n->u3.udm->mapper_id);
+
+ if (n->u3.udm->mapper_id == NULL)
+ n->u3.udm->mapper_id = gfc_get_string ("%s", "");
+
+ n->u3.udm->multiple_elems_p = mio_name (0, omp_map_cardinality);
+ mio_pointer_ref (&n->u3.udm->udm);
+ }
+
+ mio_rparen ();
+
+ n->where = gfc_current_locus;
+
+ mio_rparen ();
+
+ *clausep = n;
+ clausep = &n->next;
+ }
+ mio_rparen ();
+
+ udm->clauses = gfc_get_omp_clauses ();
+ udm->clauses->lists[OMP_LIST_MAP] = clauses;
+
+ if (st)
+ {
+ udm->next = st->n.omp_udm;
+ st->n.omp_udm = udm;
+ }
+ else
+ {
+ st = gfc_new_symtree (&gfc_current_ns->omp_udm_root, mapper_id);
+ st->n.omp_udm = udm;
+ }
+
+ mio_rparen ();
+ }
+ mio_rparen ();
+}
+
+
/* Recursive function to traverse the pointer_info tree and load a
needed symbol. We return nonzero if we load a symbol and stop the
traversal, because the act of loading can alter the tree. */
@@ -5648,12 +5792,44 @@ check_for_ambiguous (gfc_symtree *st, pointer_info *info)
}
+static void
+check_omp_declare_mappers (gfc_symtree *st)
+{
+ if (!st)
+ return;
+
+ check_omp_declare_mappers (st->left);
+ check_omp_declare_mappers (st->right);
+
+ gfc_omp_udm **udmp = &st->n.omp_udm;
+ gfc_symtree tmp_st;
+
+ while (*udmp)
+ {
+ gfc_omp_udm *udm = *udmp;
+ tmp_st.n.omp_udm = udm->next;
+ gfc_omp_udm *prev_udm = gfc_omp_udm_find (&tmp_st, &udm->ts);
+ if (prev_udm)
+ {
+ gfc_error ("Ambiguous !$OMP DECLARE MAPPER from module %s at %L",
+ udm->ts.u.derived->module, &udm->where);
+ gfc_error ("Previous !$OMP DECLARE MAPPER from module %s at %L",
+ prev_udm->ts.u.derived->module, &prev_udm->where);
+ /* Delete the duplicate. */
+ *udmp = (*udmp)->next;
+ }
+ else
+ udmp = &(*udmp)->next;
+ }
+}
+
+
/* Read a module file. */
static void
read_module (void)
{
- module_locus operator_interfaces, user_operators, omp_udrs;
+ module_locus operator_interfaces, user_operators, omp_udrs, omp_udms;
const char *p;
char name[GFC_MAX_SYMBOL_LEN + 1];
int i;
@@ -5680,6 +5856,10 @@ read_module (void)
get_module_locus (&omp_udrs);
skip_list ();
+ /* Skip OpenMP UDMs. */
+ get_module_locus (&omp_udms);
+ skip_list ();
+
mio_lparen ();
/* Create the fixup nodes for all the symbols. */
@@ -6014,6 +6194,10 @@ read_module (void)
set_module_locus (&omp_udrs);
load_omp_udrs ();
+ /* Load OpenMP user defined mappers. */
+ set_module_locus (&omp_udms);
+ load_omp_udms ();
+
/* At this point, we read those symbols that are needed but haven't
been loaded yet. If one symbol requires another, the other gets
marked as NEEDED if its previous state was UNUSED. */
@@ -6046,6 +6230,9 @@ read_module (void)
module_name);
}
+ /* Check "omp declare mappers" for duplicates from different modules. */
+ check_omp_declare_mappers (gfc_current_ns->omp_udm_root);
+
/* Clean up symbol nodes that were never loaded, create references
to hidden symbols. */
@@ -6424,6 +6611,66 @@ write_omp_udrs (gfc_symtree *st)
}
+static void
+write_omp_udm (gfc_omp_udm *udm)
+{
+ /* If "!$omp declare mapper" type is private, don't write it. */
+ if (!gfc_check_symbol_access (udm->ts.u.derived))
+ return;
+
+ mio_lparen ();
+ /* We need this pointer ref to identify this mapper so that other mappers
+ can refer to it. */
+ mio_pointer_ref (&udm);
+ mio_pool_string (&udm->mapper_id);
+ mio_typespec (&udm->ts);
+
+ if (udm->var_sym->module == NULL)
+ udm->var_sym->module = module_name;
+
+ mio_symbol_ref (&udm->var_sym);
+ mio_lparen ();
+ gfc_omp_namelist *n;
+ for (n = udm->clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+ {
+ mio_lparen ();
+
+ mio_name (n->u.map.op, omp_map_clause_ops);
+ mio_symbol_ref (&n->sym);
+ mio_expr (&n->expr);
+
+ mio_lparen ();
+
+ if (n->u3.udm)
+ {
+ mio_pool_string (&n->u3.udm->mapper_id);
+ mio_name (n->u3.udm->multiple_elems_p, omp_map_cardinality);
+ mio_pointer_ref (&n->u3.udm->udm);
+ }
+
+ mio_rparen ();
+
+ mio_rparen ();
+ }
+ mio_rparen ();
+ mio_rparen ();
+}
+
+
+static void
+write_omp_udms (gfc_symtree *st)
+{
+ if (st == NULL)
+ return;
+
+ write_omp_udms (st->left);
+ gfc_omp_udm *udm;
+ for (udm = st->n.omp_udm; udm; udm = udm->next)
+ write_omp_udm (udm);
+ write_omp_udms (st->right);
+}
+
+
/* Type for the temporary tree used when writing secondary symbols. */
struct sorted_pointer_info
@@ -6685,6 +6932,12 @@ write_module (void)
write_char ('\n');
write_char ('\n');
+ mio_lparen ();
+ write_omp_udms (gfc_current_ns->omp_udm_root);
+ mio_rparen ();
+ write_char ('\n');
+ write_char ('\n');
+
/* Write symbol information. First we traverse all symbols in the
primary namespace, writing those that need to be written.
Sometimes writing one symbol will cause another to need to be
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index df82940..c202045 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -203,11 +203,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->num_workers_expr);
gfc_free_expr (c->vector_length_expr);
for (i = 0; i < OMP_LIST_NUM; i++)
- gfc_free_omp_namelist (c->lists[i],
- i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND,
- i == OMP_LIST_ALLOCATE,
- i == OMP_LIST_USES_ALLOCATORS,
- i == OMP_LIST_INIT);
+ gfc_free_omp_namelist (c->lists[i], i);
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
gfc_free_expr_list (c->sizes_list);
@@ -337,8 +333,7 @@ gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list)
gfc_omp_declare_variant *current = list;
list = list->next;
gfc_free_omp_set_selector_list (current->set_selectors);
- gfc_free_omp_namelist (current->adjust_args_list, false, false, false,
- false);
+ gfc_free_omp_namelist (current->adjust_args_list);
free (current);
}
}
@@ -372,6 +367,19 @@ gfc_free_omp_variants (gfc_omp_variant *variant)
}
}
+/* Free an !$omp declare mapper. */
+
+void
+gfc_free_omp_udm (gfc_omp_udm *omp_udm)
+{
+ if (omp_udm)
+ {
+ gfc_free_omp_udm (omp_udm->next);
+ gfc_free_namespace (omp_udm->mapper_ns);
+ free (omp_udm);
+ }
+}
+
static gfc_omp_udr *
gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts)
{
@@ -606,7 +614,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head, false, false, false, false);
+ gfc_free_omp_namelist (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -696,7 +704,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head, false, false, false, false);
+ gfc_free_omp_namelist (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -808,7 +816,7 @@ syntax:
gfc_error ("Syntax error in OpenMP SINK dependence-type list at %C");
cleanup:
- gfc_free_omp_namelist (head, false, false, false, false);
+ gfc_free_omp_namelist (head);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -1417,16 +1425,93 @@ gfc_match_motion_var_list (const char *str, gfc_omp_namelist **list,
if (m != MATCH_YES)
return m;
- match m_present = gfc_match (" present : ");
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+ locus old_loc = gfc_current_locus;
+ int present_modifier = 0;
+ int mapper_modifier = 0;
+ int iterator_modifier = 0;
+ locus second_mapper_locus = old_loc;
+ locus second_present_locus = old_loc;
+ locus second_iterator_locus = old_loc;
+ char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' };
+
+ for (;;)
+ {
+ locus current_locus = gfc_current_locus;
+ if (gfc_match ("present ") == MATCH_YES)
+ {
+ 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)
+ second_iterator_locus = current_locus;
+ }
+ else
+ break;
+ gfc_match (", ");
+ }
+
+ if (gfc_match (" : ") != MATCH_YES)
+ {
+ gfc_current_locus = old_loc;
+ present_modifier = 0;
+ mapper_modifier = 0;
+ iterator_modifier = 0;
+ }
+
+ if (present_modifier > 1)
+ {
+ 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",
+ &second_iterator_locus);
+ return MATCH_ERROR;
+ }
+
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
m = gfc_match_omp_variable_list ("", list, false, NULL, headp, true, true);
+ gfc_current_ns = ns_curr;
if (m != MATCH_YES)
return m;
- if (m_present == MATCH_YES)
+ gfc_omp_namelist *n;
+ for (n = **headp; n; n = n->next)
{
- gfc_omp_namelist *n;
- for (n = **headp; n; n = n->next)
+ 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;
+ ns_iter->refs++;
+ }
}
return MATCH_YES;
}
@@ -1573,7 +1658,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
*head = NULL;
gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
buffer, &old_loc);
- gfc_free_omp_namelist (n, false, false, false, false);
+ gfc_free_omp_namelist (n, list_idx);
}
else
for (n = *head; n; n = n->next)
@@ -1864,7 +1949,7 @@ gfc_match_omp_clause_uses_allocators (gfc_omp_clauses *c)
return MATCH_YES;
error:
- gfc_free_omp_namelist (head, false, false, true, false);
+ gfc_free_omp_namelist (head, OMP_LIST_USES_ALLOCATORS);
return MATCH_ERROR;
}
@@ -2330,13 +2415,52 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name)
"clause at %L");
}
+
+/* Search upwards though namespace NS and its parents to find an
+ !$omp declare mapper named MAPPER_ID, for typespec TS. */
+
+gfc_omp_udm *
+gfc_find_omp_udm (gfc_namespace *ns, const char *mapper_id, gfc_typespec *ts)
+{
+ gfc_symtree *st;
+
+ if (ns == NULL)
+ ns = gfc_current_ns;
+
+ do
+ {
+ gfc_omp_udm *omp_udm;
+
+ st = gfc_find_symtree (ns->omp_udm_root, mapper_id);
+
+ if (st != NULL)
+ {
+ for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next)
+ if (gfc_compare_types (&omp_udm->ts, ts))
+ return omp_udm;
+ }
+
+ /* Don't escape an interface block. */
+ if (ns && !ns->has_import_set
+ && ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY)
+ break;
+
+ ns = ns->parent;
+ }
+ while (ns != NULL);
+
+ return NULL;
+}
+
+
/* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
clauses that are allowed for a particular directive. */
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
bool first = true, bool needs_space = true,
- bool openacc = false, bool openmp_target = false)
+ bool openacc = false, bool openmp_target = false,
+ gfc_omp_map_op default_map_op = OMP_MAP_TOFROM)
{
bool error = false;
gfc_omp_clauses *c = gfc_get_omp_clauses ();
@@ -2393,7 +2517,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
{
- gfc_free_omp_namelist (*head, false, false, false, false);
+ gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -3150,10 +3274,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)
{
@@ -3416,7 +3545,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
end_colon = true;
else if (gfc_match (" )") != MATCH_YES)
{
- gfc_free_omp_namelist (*head, false, false, false, false);
+ gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -3427,7 +3556,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
{
if (gfc_match (" %e )", &step) != MATCH_YES)
{
- gfc_free_omp_namelist (*head, false, false, false, false);
+ gfc_free_omp_namelist (*head);
gfc_current_locus = old_loc;
*head = NULL;
goto error;
@@ -3524,7 +3653,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if (has_error)
{
- gfc_free_omp_namelist (*head, false, false, false, false);
+ gfc_free_omp_namelist (*head);
*head = NULL;
goto error;
}
@@ -3566,9 +3695,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
int always_modifier = 0;
int close_modifier = 0;
int present_modifier = 0;
+ int mapper_modifier = 0;
+ int iterator_modifier = 0;
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
locus second_always_locus = old_loc2;
locus second_close_locus = old_loc2;
+ locus second_mapper_locus = old_loc2;
locus second_present_locus = old_loc2;
+ locus second_iterator_locus = old_loc2;
+ char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' };
for (;;)
{
@@ -3588,12 +3723,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
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)
+ goto error;
+ if (strcmp (mapper_id, "default") == 0)
+ mapper_id[0] = '\0';
+ }
+ else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES)
+ {
+ if (iterator_modifier++ == 1)
+ second_iterator_locus = current_locus;
+ }
else
break;
gfc_match (", ");
}
- gfc_omp_map_op map_op = OMP_MAP_TOFROM;
+ gfc_omp_map_op map_op = default_map_op;
int always_present_modifier
= always_modifier && present_modifier;
@@ -3624,6 +3774,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
gfc_current_locus = old_loc2;
always_modifier = 0;
close_modifier = 0;
+ mapper_modifier = 0;
}
if (always_modifier > 1)
@@ -3644,15 +3795,41 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&second_present_locus);
break;
}
+ if (mapper_modifier > 1)
+ {
+ gfc_error ("too many %<mapper%> modifiers at %L",
+ &second_mapper_locus);
+ break;
+ }
+ if (iterator_modifier > 1)
+ {
+ gfc_error ("too many %<iterator%> modifiers at %L",
+ &second_iterator_locus);
+ break;
+ }
head = NULL;
- if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
- false, NULL, &head,
- true, true) == MATCH_YES)
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
+ false, NULL, &head, true, true);
+ gfc_current_ns = ns_curr;
+ if (m == MATCH_YES)
{
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
- n->u.map.op = map_op;
+ {
+ n->u.map.op = map_op;
+ if (mapper_id[0] != '\0')
+ {
+ n->u3.udm = gfc_get_omp_namelist_udm ();
+ n->u3.udm->mapper_id
+ = gfc_get_string ("%s", mapper_id);
+ }
+ n->u2.ns = ns_iter;
+ if (ns_iter)
+ ns_iter->refs++;
+ }
continue;
}
gfc_current_locus = old_loc;
@@ -4250,10 +4427,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (m == MATCH_YES)
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)
@@ -5185,7 +5367,7 @@ gfc_match_omp_allocate (void)
gfc_error ("Unexpected expression as list item at %L in ALLOCATE "
"directive", &n->expr->where);
- gfc_free_omp_namelist (vars, false, true, false, false);
+ gfc_free_omp_namelist (vars, OMP_LIST_ALLOCATE);
goto error;
}
@@ -5604,14 +5786,14 @@ gfc_match_omp_flush (void)
{
gfc_error ("List specified together with memory order clause in FLUSH "
"directive at %C");
- gfc_free_omp_namelist (list, false, false, false, false);
+ gfc_free_omp_namelist (list);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
- gfc_free_omp_namelist (list, false, false, false, false);
+ gfc_free_omp_namelist (list);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
@@ -5662,6 +5844,153 @@ gfc_match_omp_declare_simd (void)
}
+/* Find a matching "!$omp declare mapper" for typespec TS in symtree ST. */
+
+gfc_omp_udm *
+gfc_omp_udm_find (gfc_symtree *st, gfc_typespec *ts)
+{
+ gfc_omp_udm *omp_udm;
+
+ if (st == NULL)
+ return NULL;
+
+ for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next)
+ if ((omp_udm->ts.type == BT_DERIVED || omp_udm->ts.type == BT_CLASS)
+ && (ts->type == BT_DERIVED || ts->type == BT_CLASS)
+ && strcmp (omp_udm->ts.u.derived->name, ts->u.derived->name) == 0)
+ return omp_udm;
+
+ return NULL;
+}
+
+
+match
+gfc_match_omp_declare_mapper (void)
+{
+ match m;
+ gfc_typespec ts;
+ char mapper_id[GFC_MAX_SYMBOL_LEN + 1];
+ char var[GFC_MAX_SYMBOL_LEN + 1];
+ gfc_namespace *mapper_ns = NULL;
+ gfc_symtree *var_st;
+ gfc_symtree *st;
+ gfc_omp_udm *omp_udm = NULL, *prev_udm = NULL;
+ locus where = gfc_current_locus;
+
+ if (gfc_match_char ('(') != MATCH_YES)
+ return MATCH_ERROR;
+
+ locus old_locus = gfc_current_locus;
+
+ m = gfc_match (" %n : ", mapper_id);
+
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ /* As a special case, a mapper named "default" and an unnamed mapper are
+ both the default mapper for a given type. */
+ if (strcmp (mapper_id, "default") == 0)
+ mapper_id[0] = '\0';
+
+ if (gfc_peek_ascii_char () == ':')
+ {
+ /* If we see '::', the user did not name the mapper, and instead we just
+ saw the type. So backtrack and try parsing as a type instead. */
+ mapper_id[0] = '\0';
+ gfc_current_locus = old_locus;
+ }
+
+ /* This accepts 't' but not e.g. 'type(t)'. Is that correct? */
+ m = gfc_match_type_spec (&ts);
+ if (m != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (ts.type != BT_DERIVED)
+ {
+ gfc_error_now ("!$OMP DECLARE MAPPER with non-derived type at %C");
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match (" :: ") != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (gfc_match_name (var) != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (gfc_match_char (')') != MATCH_YES)
+ return MATCH_ERROR;
+
+ st = gfc_find_symtree (gfc_current_ns->omp_udm_root, mapper_id);
+
+ /* Now we need to set up a new namespace, and create a new sym_tree for our
+ dummy variable so we can use it in the following list of mapping
+ clauses. */
+
+ gfc_current_ns = mapper_ns = gfc_get_namespace (gfc_current_ns, 1);
+ mapper_ns->proc_name = mapper_ns->parent->proc_name;
+ mapper_ns->omp_udm_ns = 1;
+
+ gfc_get_sym_tree (var, mapper_ns, &var_st, false);
+ var_st->n.sym->ts = ts;
+ var_st->n.sym->attr.omp_udm_artificial_var = 1;
+ var_st->n.sym->attr.flavor = FL_VARIABLE;
+ gfc_commit_symbols ();
+
+ gfc_omp_clauses *clauses = NULL;
+
+ m = gfc_match_omp_clauses (&clauses, omp_mask (OMP_CLAUSE_MAP), true, true,
+ false, false, OMP_MAP_UNSET);
+ if (m != MATCH_YES)
+ goto failure;
+
+ omp_udm = gfc_get_omp_udm ();
+ omp_udm->next = NULL;
+ omp_udm->where = where;
+ omp_udm->mapper_id = gfc_get_string ("%s", mapper_id);
+ omp_udm->ts = ts;
+ omp_udm->var_sym = var_st->n.sym;
+ omp_udm->mapper_ns = mapper_ns;
+ omp_udm->clauses = clauses;
+
+ gfc_current_ns = mapper_ns->parent;
+
+ prev_udm = gfc_omp_udm_find (st, &ts);
+ if (prev_udm)
+ {
+ gfc_error_now ("Redefinition of !$OMP DECLARE MAPPER at %L", &where);
+ gfc_error_now ("Previous !$OMP DECLARE MAPPER at %L", &prev_udm->where);
+ }
+ else if (st)
+ {
+ omp_udm->next = st->n.omp_udm;
+ st->n.omp_udm = omp_udm;
+ }
+ else
+ {
+ st = gfc_new_symtree (&gfc_current_ns->omp_udm_root, mapper_id);
+ st->n.omp_udm = omp_udm;
+ }
+
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after !$OMP DECLARE MAPPER at %C");
+ gfc_current_locus = where;
+ return MATCH_ERROR;
+ }
+
+ return MATCH_YES;
+
+failure:
+ if (mapper_ns)
+ gfc_current_ns = mapper_ns->parent;
+ gfc_free_omp_udm (omp_udm);
+
+ gfc_clear_error ();
+
+ return MATCH_ERROR;
+}
+
+
static bool
match_udr_expr (gfc_symtree *omp_sym1, gfc_symtree *omp_sym2)
{
@@ -8198,6 +8527,95 @@ oacc_is_loop (gfc_code *code)
|| code->op == EXEC_OACC_LOOP;
}
+static bool
+oacc_reduction_defined_type_p (enum gfc_omp_reduction_op rop, gfc_typespec *ts,
+ const char **rop_name = NULL)
+{
+ gcc_assert (rop != OMP_REDUCTION_USER && rop != OMP_REDUCTION_NONE);
+
+ if (rop_name)
+ switch (rop)
+ {
+ case OMP_REDUCTION_MAX:
+ *rop_name = "max";
+ break;
+ case OMP_REDUCTION_MIN:
+ *rop_name = "min";
+ break;
+ case OMP_REDUCTION_IAND:
+ *rop_name = "iand";
+ break;
+ case OMP_REDUCTION_IOR:
+ *rop_name = "ior";
+ break;
+ case OMP_REDUCTION_IEOR:
+ *rop_name = "ieor";
+ break;
+ default:
+ *rop_name = gfc_op2string ((gfc_intrinsic_op) rop);
+ break;
+ }
+
+ if (ts->type == BT_INTEGER)
+ switch (rop)
+ {
+ case OMP_REDUCTION_AND:
+ case OMP_REDUCTION_OR:
+ case OMP_REDUCTION_EQV:
+ case OMP_REDUCTION_NEQV:
+ return false;
+ default:
+ return true;
+ }
+
+ if (ts->type == BT_LOGICAL)
+ switch (rop)
+ {
+ case OMP_REDUCTION_AND:
+ case OMP_REDUCTION_OR:
+ case OMP_REDUCTION_EQV:
+ case OMP_REDUCTION_NEQV:
+ return true;
+ default:
+ return false;
+ }
+
+ if (ts->type == BT_REAL || ts->type == BT_COMPLEX)
+ switch (rop)
+ {
+ case OMP_REDUCTION_PLUS:
+ case OMP_REDUCTION_TIMES:
+ case OMP_REDUCTION_MINUS:
+ return true;
+
+ case OMP_REDUCTION_AND:
+ case OMP_REDUCTION_OR:
+ case OMP_REDUCTION_EQV:
+ case OMP_REDUCTION_NEQV:
+ return false;
+
+ case OMP_REDUCTION_MAX:
+ case OMP_REDUCTION_MIN:
+ return ts->type != BT_COMPLEX;
+ case OMP_REDUCTION_IAND:
+ case OMP_REDUCTION_IOR:
+ case OMP_REDUCTION_IEOR:
+ return false;
+ default:
+ gcc_unreachable ();
+ }
+
+ if (ts->type == BT_DERIVED)
+ {
+ for (gfc_component *p = ts->u.derived->components; p; p = p->next)
+ if (!oacc_reduction_defined_type_p (rop, &p->ts))
+ return false;
+ return true;
+ }
+
+ return false;
+}
+
static void
resolve_scalar_int_expr (gfc_expr *expr, const char *clause)
{
@@ -8215,9 +8633,8 @@ resolve_positive_int_expr (gfc_expr *expr, const char *clause)
if (expr->expr_type == EXPR_CONSTANT
&& expr->ts.type == BT_INTEGER
&& mpz_sgn (expr->value.integer) <= 0)
- gfc_warning ((flag_openmp || flag_openmp_simd) ? OPT_Wopenmp : 0,
- "INTEGER expression of %s clause at %L must be positive",
- clause, &expr->where);
+ gfc_error ("INTEGER expression of %s clause at %L must be positive",
+ clause, &expr->where);
}
static void
@@ -8585,263 +9002,15 @@ gfc_resolve_omp_assumptions (gfc_omp_assumptions *assume)
&el->expr->where);
}
-
-/* OpenMP directive resolving routines. */
+/* Check OMP_CLAUSES for duplicate symbols and various other constraints.
+ Helper function for resolve_omp_clauses and resolve_omp_mapper_clauses. */
static void
-resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
- gfc_namespace *ns, bool openacc = false)
+verify_omp_clauses_symbol_dups (gfc_code *code, gfc_omp_clauses *omp_clauses,
+ gfc_namespace *ns, bool openacc)
{
- gfc_omp_namelist *n, *last;
- gfc_expr_list *el;
+ gfc_omp_namelist *n;
int list;
- int ifc;
- bool if_without_mod = false;
- gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
- static const char *clause_names[]
- = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "UNIFORM", "AFFINITY", "ALIGNED", "LINEAR", "DEPEND", "MAP",
- "TO", "FROM", "INCLUSIVE", "EXCLUSIVE",
- "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
- "IN_REDUCTION", "TASK_REDUCTION",
- "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
- "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
- "NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER",
- "USES_ALLOCATORS", "INIT", "USE", "DESTROY", "INTEROP", "ADJUST_ARGS" };
- STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
-
- if (omp_clauses == NULL)
- return;
-
- if (ns == NULL)
- ns = gfc_current_ns;
-
- if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse)
- gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L",
- &code->loc);
- if (omp_clauses->order_concurrent && omp_clauses->ordered)
- gfc_error ("ORDER clause must not be used together with ORDERED at %L",
- &code->loc);
- if (omp_clauses->if_expr)
- {
- gfc_expr *expr = omp_clauses->if_expr;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_LOGICAL || expr->rank != 0)
- gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
- &expr->where);
- if_without_mod = true;
- }
- for (ifc = 0; ifc < OMP_IF_LAST; ifc++)
- if (omp_clauses->if_exprs[ifc])
- {
- gfc_expr *expr = omp_clauses->if_exprs[ifc];
- bool ok = true;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_LOGICAL || expr->rank != 0)
- gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
- &expr->where);
- else if (if_without_mod)
- {
- gfc_error ("IF clause without modifier at %L used together with "
- "IF clauses with modifiers",
- &omp_clauses->if_expr->where);
- if_without_mod = false;
- }
- else
- switch (code->op)
- {
- case EXEC_OMP_CANCEL:
- ok = ifc == OMP_IF_CANCEL;
- break;
-
- case EXEC_OMP_PARALLEL:
- case EXEC_OMP_PARALLEL_DO:
- case EXEC_OMP_PARALLEL_LOOP:
- case EXEC_OMP_PARALLEL_MASKED:
- case EXEC_OMP_PARALLEL_MASTER:
- case EXEC_OMP_PARALLEL_SECTIONS:
- case EXEC_OMP_PARALLEL_WORKSHARE:
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- ok = ifc == OMP_IF_PARALLEL;
- break;
-
- case EXEC_OMP_PARALLEL_DO_SIMD:
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_SIMD;
- break;
-
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
- ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_TASKLOOP;
- break;
-
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- ok = (ifc == OMP_IF_PARALLEL
- || ifc == OMP_IF_TASKLOOP
- || ifc == OMP_IF_SIMD);
- break;
-
- case EXEC_OMP_SIMD:
- case EXEC_OMP_DO_SIMD:
- case EXEC_OMP_DISTRIBUTE_SIMD:
- case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
- ok = ifc == OMP_IF_SIMD;
- break;
-
- case EXEC_OMP_TASK:
- ok = ifc == OMP_IF_TASK;
- break;
-
- case EXEC_OMP_TASKLOOP:
- case EXEC_OMP_MASKED_TASKLOOP:
- case EXEC_OMP_MASTER_TASKLOOP:
- ok = ifc == OMP_IF_TASKLOOP;
- break;
-
- case EXEC_OMP_TASKLOOP_SIMD:
- case EXEC_OMP_MASKED_TASKLOOP_SIMD:
- case EXEC_OMP_MASTER_TASKLOOP_SIMD:
- ok = ifc == OMP_IF_TASKLOOP || ifc == OMP_IF_SIMD;
- break;
-
- case EXEC_OMP_TARGET:
- case EXEC_OMP_TARGET_TEAMS:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TARGET_TEAMS_LOOP:
- ok = ifc == OMP_IF_TARGET;
- break;
-
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- case EXEC_OMP_TARGET_SIMD:
- ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_SIMD;
- break;
-
- case EXEC_OMP_TARGET_DATA:
- ok = ifc == OMP_IF_TARGET_DATA;
- break;
-
- case EXEC_OMP_TARGET_UPDATE:
- ok = ifc == OMP_IF_TARGET_UPDATE;
- break;
-
- case EXEC_OMP_TARGET_ENTER_DATA:
- ok = ifc == OMP_IF_TARGET_ENTER_DATA;
- break;
-
- case EXEC_OMP_TARGET_EXIT_DATA:
- ok = ifc == OMP_IF_TARGET_EXIT_DATA;
- break;
-
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TARGET_PARALLEL:
- case EXEC_OMP_TARGET_PARALLEL_DO:
- case EXEC_OMP_TARGET_PARALLEL_LOOP:
- ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_PARALLEL;
- break;
-
- case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- ok = (ifc == OMP_IF_TARGET
- || ifc == OMP_IF_PARALLEL
- || ifc == OMP_IF_SIMD);
- break;
-
- default:
- ok = false;
- break;
- }
- if (!ok)
- {
- static const char *ifs[] = {
- "CANCEL",
- "PARALLEL",
- "SIMD",
- "TASK",
- "TASKLOOP",
- "TARGET",
- "TARGET DATA",
- "TARGET UPDATE",
- "TARGET ENTER DATA",
- "TARGET EXIT DATA"
- };
- gfc_error ("IF clause modifier %s at %L not appropriate for "
- "the current OpenMP construct", ifs[ifc], &expr->where);
- }
- }
-
- if (omp_clauses->self_expr)
- {
- gfc_expr *expr = omp_clauses->self_expr;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_LOGICAL || expr->rank != 0)
- gfc_error ("SELF clause at %L requires a scalar LOGICAL expression",
- &expr->where);
- }
-
- if (omp_clauses->final_expr)
- {
- gfc_expr *expr = omp_clauses->final_expr;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_LOGICAL || expr->rank != 0)
- gfc_error ("FINAL clause at %L requires a scalar LOGICAL expression",
- &expr->where);
- }
- if (omp_clauses->novariants)
- {
- gfc_expr *expr = omp_clauses->novariants;
- if (!gfc_resolve_expr (expr) || expr->ts.type != BT_LOGICAL
- || expr->rank != 0)
- gfc_error (
- "NOVARIANTS clause at %L requires a scalar LOGICAL expression",
- &expr->where);
- if_without_mod = true;
- }
- if (omp_clauses->nocontext)
- {
- gfc_expr *expr = omp_clauses->nocontext;
- if (!gfc_resolve_expr (expr) || expr->ts.type != BT_LOGICAL
- || expr->rank != 0)
- gfc_error (
- "NOCONTEXT clause at %L requires a scalar LOGICAL expression",
- &expr->where);
- if_without_mod = true;
- }
- if (omp_clauses->num_threads)
- resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS");
- if (omp_clauses->chunk_size)
- {
- gfc_expr *expr = omp_clauses->chunk_size;
- if (!gfc_resolve_expr (expr)
- || expr->ts.type != BT_INTEGER || expr->rank != 0)
- gfc_error ("SCHEDULE clause's chunk_size at %L requires "
- "a scalar INTEGER expression", &expr->where);
- else if (expr->expr_type == EXPR_CONSTANT
- && expr->ts.type == BT_INTEGER
- && mpz_sgn (expr->value.integer) <= 0)
- gfc_warning (OPT_Wopenmp, "INTEGER expression of SCHEDULE clause's "
- "chunk_size at %L must be positive", &expr->where);
- }
- if (omp_clauses->sched_kind != OMP_SCHED_NONE
- && omp_clauses->sched_nonmonotonic)
- {
- if (omp_clauses->sched_monotonic)
- gfc_error ("Both MONOTONIC and NONMONOTONIC schedule modifiers "
- "specified at %L", &code->loc);
- else if (omp_clauses->ordered)
- gfc_error ("NONMONOTONIC schedule modifier specified with ORDERED "
- "clause at %L", &code->loc);
- }
-
- if (omp_clauses->depobj
- && (!gfc_resolve_expr (omp_clauses->depobj)
- || omp_clauses->depobj->ts.type != BT_INTEGER
- || omp_clauses->depobj->ts.kind != 2 * gfc_index_integer_kind
- || omp_clauses->depobj->rank != 0))
- gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer "
- "of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where);
/* Check that no symbol appears on multiple clauses, except that
a symbol can appear on both firstprivate and lastprivate. */
@@ -8858,9 +9027,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->reduc_mark = 0;
if (n->sym->attr.flavor == FL_VARIABLE
|| n->sym->attr.proc_pointer
- || (!code && (!n->sym->attr.dummy || n->sym->ns != ns)))
+ || (!code
+ && !ns->omp_udm_ns
+ && (!n->sym->attr.dummy || n->sym->ns != ns)))
{
- if (!code && (!n->sym->attr.dummy || n->sym->ns != ns))
+ if (!code
+ && !ns->omp_udm_ns
+ && (!n->sym->attr.dummy || n->sym->ns != ns))
gfc_error ("Variable %qs is not a dummy argument at %L",
n->sym->name, &n->where);
continue;
@@ -8869,22 +9042,23 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& n->sym->result == n->sym
&& n->sym->attr.function)
{
- if (ns->proc_name == n->sym
- || (ns->parent && ns->parent->proc_name == n->sym))
+ if (gfc_current_ns->proc_name == n->sym
+ || (gfc_current_ns->parent
+ && gfc_current_ns->parent->proc_name == n->sym))
continue;
- if (ns->proc_name->attr.entry_master)
+ if (gfc_current_ns->proc_name->attr.entry_master)
{
- gfc_entry_list *el = ns->entries;
+ gfc_entry_list *el = gfc_current_ns->entries;
for (; el; el = el->next)
if (el->sym == n->sym)
break;
if (el)
continue;
}
- if (ns->parent
- && ns->parent->proc_name->attr.entry_master)
+ if (gfc_current_ns->parent
+ && gfc_current_ns->parent->proc_name->attr.entry_master)
{
- gfc_entry_list *el = ns->parent->entries;
+ gfc_entry_list *el = gfc_current_ns->parent->entries;
for (; el; el = el->next)
if (el->sym == n->sym)
break;
@@ -9011,45 +9185,6 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
- if (code
- && code->op == EXEC_OMP_INTEROP
- && omp_clauses->lists[OMP_LIST_DEPEND])
- {
- if (!omp_clauses->lists[OMP_LIST_INIT]
- && !omp_clauses->lists[OMP_LIST_USE]
- && !omp_clauses->lists[OMP_LIST_DESTROY])
- {
- gfc_error ("DEPEND clause at %L requires action clause with "
- "%<targetsync%> interop-type",
- &omp_clauses->lists[OMP_LIST_DEPEND]->where);
- }
- for (n = omp_clauses->lists[OMP_LIST_INIT]; n; n = n->next)
- if (!n->u.init.targetsync)
- {
- gfc_error ("DEPEND clause at %L requires %<targetsync%> "
- "interop-type, lacking it for %qs at %L",
- &omp_clauses->lists[OMP_LIST_DEPEND]->where,
- n->sym->name, &n->where);
- break;
- }
- }
- if (code && (code->op == EXEC_OMP_INTEROP || code->op == EXEC_OMP_DISPATCH))
- for (list = OMP_LIST_INIT; list <= OMP_LIST_INTEROP; list++)
- for (n = omp_clauses->lists[list]; n; n = n->next)
- {
- if (n->sym->ts.type != BT_INTEGER
- || n->sym->ts.kind != gfc_index_integer_kind
- || n->sym->attr.dimension
- || n->sym->attr.flavor != FL_VARIABLE)
- gfc_error ("%qs at %L in %qs clause must be a scalar integer "
- "variable of %<omp_interop_kind%> kind", n->sym->name,
- &n->where, clause_names[list]);
- if (list != OMP_LIST_USE && list != OMP_LIST_INTEROP
- && n->sym->attr.intent == INTENT_IN)
- gfc_error ("%qs at %L in %qs clause must be definable",
- n->sym->name, &n->where, clause_names[list]);
- }
-
/* Detect specifically the case where we have "map(x) private(x)" and raise
an error. If we have "...simd" combined directives though, the "private"
applies to the simd part, so this is permitted though. */
@@ -9179,7 +9314,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
{
prev->next = n->next;
n->next = NULL;
- gfc_free_omp_namelist (n, false, true, false, false);
+ gfc_free_omp_namelist (n, OMP_LIST_ALLOCATE);
n = prev->next;
}
continue;
@@ -9339,7 +9474,569 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
+ for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
+ n->sym->mark = 0;
+ for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next)
+ if (n->expr == NULL)
+ n->sym->mark = 1;
+ for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
+ {
+ if (n->expr == NULL && n->sym->mark)
+ gfc_error ("Symbol %qs present on both FROM and TO clauses at %L",
+ n->sym->name, &n->where);
+ else
+ n->sym->mark = 1;
+ }
+}
+
+/* Check that the parameter of a MAP, TO and FROM clause N meets certain
+ constraints. Helper function for resolve_omp_clauses and
+ resolve_omp_mapper_clauses. */
+
+static bool
+omp_verify_map_motion_clauses (gfc_code *code, int list, const char *name,
+ gfc_omp_namelist *n, bool openacc)
+{
+ gfc_ref *lastref = NULL, *lastslice = NULL;
+ bool resolved = false;
+ if (n->expr)
+ {
+ lastref = n->expr->ref;
+ resolved = gfc_resolve_expr (n->expr);
+
+ /* Look through component refs to find last array
+ reference. */
+ if (resolved)
+ {
+ for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_COMPONENT
+ || ref->type == REF_SUBSTRING
+ || ref->type == REF_INQUIRY)
+ lastref = ref;
+ else if (ref->type == REF_ARRAY)
+ {
+ for (int i = 0; i < ref->u.ar.dimen; i++)
+ if (ref->u.ar.dimen_type[i] == DIMEN_RANGE)
+ lastslice = ref;
+
+ lastref = ref;
+ }
+
+ /* The "!$acc cache" directive allows rectangular subarrays to be
+ specified, with some restrictions on the form of bounds (not
+ implemented).
+ Only raise an error here if we're really sure the array isn't
+ contiguous. An expression such as arr(-n:n,-n:n) could be
+ contiguous even if it looks like it may not be. Also OpenMP's
+ 'target update' permits strides for the to/from clause. */
+ if (code
+ && code->op != EXEC_OACC_UPDATE
+ && code->op != EXEC_OMP_TARGET_UPDATE
+ && list != OMP_LIST_CACHE
+ && list != OMP_LIST_DEPEND
+ && !gfc_is_simply_contiguous (n->expr, false, true)
+ && gfc_is_not_contiguous (n->expr)
+ && !(lastslice && (lastslice->next
+ || lastslice->type != REF_ARRAY)))
+ gfc_error ("Array is not contiguous at %L",
+ &n->where);
+ }
+ }
+ if (openacc && list == OMP_LIST_MAP
+ && (n->u.map.op == OMP_MAP_ATTACH || n->u.map.op == OMP_MAP_DETACH))
+ {
+ symbol_attribute attr;
+ if (n->expr)
+ attr = gfc_expr_attr (n->expr);
+ else
+ attr = n->sym->attr;
+ if (!attr.pointer && !attr.allocatable)
+ gfc_error ("%qs clause argument must be ALLOCATABLE or a POINTER "
+ "at %L",
+ (n->u.map.op == OMP_MAP_ATTACH) ? "attach" : "detach",
+ &n->where);
+ }
+ if (lastref
+ || (n->expr && (!resolved || n->expr->expr_type != EXPR_VARIABLE)))
+ {
+ if (!lastslice && lastref && lastref->type == REF_SUBSTRING)
+ gfc_error ("Unexpected substring reference in %s clause "
+ "at %L", name, &n->where);
+ else if (!lastslice && lastref && lastref->type == REF_INQUIRY)
+ {
+ gcc_assert (lastref->u.i == INQUIRY_RE
+ || lastref->u.i == INQUIRY_IM);
+ gfc_error ("Unexpected complex-parts designator "
+ "reference in %s clause at %L",
+ name, &n->where);
+ }
+ else if (!resolved
+ || n->expr->expr_type != EXPR_VARIABLE
+ || (lastslice
+ && (lastslice->next || lastslice->type != REF_ARRAY)))
+ gfc_error ("%qs in %s clause at %L is not a proper "
+ "array section", n->sym->name, name,
+ &n->where);
+ else if (lastslice)
+ {
+ int i;
+ gfc_array_ref *ar = &lastslice->u.ar;
+ for (i = 0; i < ar->dimen; i++)
+ if (ar->stride[i]
+ && code
+ && code->op != EXEC_OACC_UPDATE
+ && code->op != EXEC_OMP_TARGET_UPDATE)
+ {
+ gfc_error ("Stride should not be specified for "
+ "array section in %s clause at %L",
+ name, &n->where);
+ return false;
+ }
+ else if (ar->dimen_type[i] != DIMEN_ELEMENT
+ && ar->dimen_type[i] != DIMEN_RANGE)
+ {
+ gfc_error ("%qs in %s clause at %L is not a "
+ "proper array section",
+ n->sym->name, name, &n->where);
+ return false;
+ }
+ else if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY)
+ && ar->start[i]
+ && ar->start[i]->expr_type == EXPR_CONSTANT
+ && ar->end[i]
+ && ar->end[i]->expr_type == EXPR_CONSTANT
+ && mpz_cmp (ar->start[i]->value.integer,
+ ar->end[i]->value.integer) > 0)
+ {
+ gfc_error ("%qs in %s clause at %L is a zero size array "
+ "section", n->sym->name, list == OMP_LIST_DEPEND
+ ? "DEPEND" : "AFFINITY", &n->where);
+ return false;
+ }
+ }
+ }
+ else if (openacc)
+ {
+ if (list == OMP_LIST_MAP && n->u.map.op == OMP_MAP_FORCE_DEVICEPTR)
+ resolve_oacc_deviceptr_clause (n->sym, n->where, name);
+ else
+ resolve_oacc_data_clauses (n->sym, n->where, name);
+ }
+ else if (list != OMP_LIST_DEPEND
+ && n->sym->as
+ && n->sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+
+ if (!code || list != OMP_LIST_MAP || openacc)
+ return true;
+
+ switch (code->op)
+ {
+ case EXEC_OMP_TARGET:
+ case EXEC_OMP_TARGET_PARALLEL:
+ case EXEC_OMP_TARGET_PARALLEL_DO:
+ case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_PARALLEL_LOOP:
+ case EXEC_OMP_TARGET_SIMD:
+ case EXEC_OMP_TARGET_TEAMS:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_LOOP:
+ case EXEC_OMP_TARGET_DATA:
+ switch (n->u.map.op)
+ {
+ case OMP_MAP_TO:
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_PRESENT_TO:
+ case OMP_MAP_ALWAYS_PRESENT_TO:
+ case OMP_MAP_FROM:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_ALWAYS_PRESENT_FROM:
+ case OMP_MAP_TOFROM:
+ case OMP_MAP_ALWAYS_TOFROM:
+ case OMP_MAP_PRESENT_TOFROM:
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ case OMP_MAP_ALLOC:
+ case OMP_MAP_PRESENT_ALLOC:
+ break;
+ default:
+ gfc_error ("TARGET%s with map-type other than TO, FROM, TOFROM, or "
+ "ALLOC on MAP clause at %L",
+ code->op == EXEC_OMP_TARGET_DATA ? " DATA" : "",
+ &n->where);
+ break;
+ }
+ break;
+ case EXEC_OMP_TARGET_ENTER_DATA:
+ switch (n->u.map.op)
+ {
+ case OMP_MAP_TO:
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_PRESENT_TO:
+ case OMP_MAP_ALWAYS_PRESENT_TO:
+ case OMP_MAP_ALLOC:
+ case OMP_MAP_PRESENT_ALLOC:
+ break;
+ case OMP_MAP_TOFROM:
+ n->u.map.op = OMP_MAP_TO;
+ break;
+ case OMP_MAP_ALWAYS_TOFROM:
+ n->u.map.op = OMP_MAP_ALWAYS_TO;
+ break;
+ case OMP_MAP_PRESENT_TOFROM:
+ n->u.map.op = OMP_MAP_PRESENT_TO;
+ break;
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ n->u.map.op = OMP_MAP_ALWAYS_PRESENT_TO;
+ break;
+ default:
+ gfc_error ("TARGET ENTER DATA with map-type other than TO, TOFROM "
+ "or ALLOC on MAP clause at %L", &n->where);
+ break;
+ }
+ break;
+ case EXEC_OMP_TARGET_EXIT_DATA:
+ switch (n->u.map.op)
+ {
+ case OMP_MAP_FROM:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_ALWAYS_PRESENT_FROM:
+ case OMP_MAP_RELEASE:
+ case OMP_MAP_DELETE:
+ break;
+ case OMP_MAP_TOFROM:
+ n->u.map.op = OMP_MAP_FROM;
+ break;
+ case OMP_MAP_ALWAYS_TOFROM:
+ n->u.map.op = OMP_MAP_ALWAYS_FROM;
+ break;
+ case OMP_MAP_PRESENT_TOFROM:
+ n->u.map.op = OMP_MAP_PRESENT_FROM;
+ break;
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ n->u.map.op = OMP_MAP_ALWAYS_PRESENT_FROM;
+ break;
+ default:
+ gfc_error ("TARGET EXIT DATA with map-type other than FROM, TOFROM, "
+ "RELEASE, or DELETE on MAP clause at %L", &n->where);
+ break;
+ }
+ break;
+ default:
+ ;
+ }
+
+ return true;
+}
+/* OpenMP directive resolving routines. */
+
+static void
+resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
+ gfc_namespace *ns, bool openacc = false)
+{
+ gfc_omp_namelist *n, *last;
+ gfc_expr_list *el;
+ int list;
+ int ifc;
+ bool if_without_mod = false;
+ gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
+ static const char *clause_names[]
+ = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
+ "COPYIN", "UNIFORM", "AFFINITY", "ALIGNED", "LINEAR", "DEPEND", "MAP",
+ "TO", "FROM", "INCLUSIVE", "EXCLUSIVE",
+ "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
+ "IN_REDUCTION", "TASK_REDUCTION",
+ "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
+ "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
+ "NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER",
+ "USES_ALLOCATORS", "INIT", "USE", "DESTROY", "INTEROP", "ADJUST_ARGS" };
+ STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
+
+ if (omp_clauses == NULL)
+ return;
+
+ if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse)
+ gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L",
+ &code->loc);
+ if (omp_clauses->order_concurrent && omp_clauses->ordered)
+ gfc_error ("ORDER clause must not be used together with ORDERED at %L",
+ &code->loc);
+
+ /* If we're invoking any declared mappers as a result of these clauses,
+ we may need to know the namespace their directive was originally
+ defined within in order to resolve clauses again after substitution.
+ Record it here. */
+ if (ns)
+ omp_clauses->ns = ns;
+
+ if (omp_clauses->if_expr)
+ {
+ gfc_expr *expr = omp_clauses->if_expr;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_LOGICAL || expr->rank != 0)
+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+ &expr->where);
+ if_without_mod = true;
+ }
+ for (ifc = 0; ifc < OMP_IF_LAST; ifc++)
+ if (omp_clauses->if_exprs[ifc])
+ {
+ gfc_expr *expr = omp_clauses->if_exprs[ifc];
+ bool ok = true;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_LOGICAL || expr->rank != 0)
+ gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+ &expr->where);
+ else if (if_without_mod)
+ {
+ gfc_error ("IF clause without modifier at %L used together with "
+ "IF clauses with modifiers",
+ &omp_clauses->if_expr->where);
+ if_without_mod = false;
+ }
+ else
+ switch (code->op)
+ {
+ case EXEC_OMP_CANCEL:
+ ok = ifc == OMP_IF_CANCEL;
+ break;
+
+ case EXEC_OMP_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_LOOP:
+ case EXEC_OMP_PARALLEL_MASKED:
+ case EXEC_OMP_PARALLEL_MASTER:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ ok = ifc == OMP_IF_PARALLEL;
+ break;
+
+ case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_SIMD;
+ break;
+
+ case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+ case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+ ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_TASKLOOP;
+ break;
+
+ case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+ case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+ ok = (ifc == OMP_IF_PARALLEL
+ || ifc == OMP_IF_TASKLOOP
+ || ifc == OMP_IF_SIMD);
+ break;
+
+ case EXEC_OMP_SIMD:
+ case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+ ok = ifc == OMP_IF_SIMD;
+ break;
+
+ case EXEC_OMP_TASK:
+ ok = ifc == OMP_IF_TASK;
+ break;
+
+ case EXEC_OMP_TASKLOOP:
+ case EXEC_OMP_MASKED_TASKLOOP:
+ case EXEC_OMP_MASTER_TASKLOOP:
+ ok = ifc == OMP_IF_TASKLOOP;
+ break;
+
+ case EXEC_OMP_TASKLOOP_SIMD:
+ case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+ case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+ ok = ifc == OMP_IF_TASKLOOP || ifc == OMP_IF_SIMD;
+ break;
+
+ case EXEC_OMP_TARGET:
+ case EXEC_OMP_TARGET_TEAMS:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+ case EXEC_OMP_TARGET_TEAMS_LOOP:
+ ok = ifc == OMP_IF_TARGET;
+ break;
+
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TARGET_SIMD:
+ ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_SIMD;
+ break;
+
+ case EXEC_OMP_TARGET_DATA:
+ ok = ifc == OMP_IF_TARGET_DATA;
+ break;
+
+ case EXEC_OMP_TARGET_UPDATE:
+ ok = ifc == OMP_IF_TARGET_UPDATE;
+ break;
+
+ case EXEC_OMP_TARGET_ENTER_DATA:
+ ok = ifc == OMP_IF_TARGET_ENTER_DATA;
+ break;
+
+ case EXEC_OMP_TARGET_EXIT_DATA:
+ ok = ifc == OMP_IF_TARGET_EXIT_DATA;
+ break;
+
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TARGET_PARALLEL:
+ case EXEC_OMP_TARGET_PARALLEL_DO:
+ case EXEC_OMP_TARGET_PARALLEL_LOOP:
+ ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_PARALLEL;
+ break;
+
+ case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ ok = (ifc == OMP_IF_TARGET
+ || ifc == OMP_IF_PARALLEL
+ || ifc == OMP_IF_SIMD);
+ break;
+
+ default:
+ ok = false;
+ break;
+ }
+ if (!ok)
+ {
+ static const char *ifs[] = {
+ "CANCEL",
+ "PARALLEL",
+ "SIMD",
+ "TASK",
+ "TASKLOOP",
+ "TARGET",
+ "TARGET DATA",
+ "TARGET UPDATE",
+ "TARGET ENTER DATA",
+ "TARGET EXIT DATA"
+ };
+ gfc_error ("IF clause modifier %s at %L not appropriate for "
+ "the current OpenMP construct", ifs[ifc], &expr->where);
+ }
+ }
+
+ if (omp_clauses->self_expr)
+ {
+ gfc_expr *expr = omp_clauses->self_expr;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_LOGICAL || expr->rank != 0)
+ gfc_error ("SELF clause at %L requires a scalar LOGICAL expression",
+ &expr->where);
+ }
+
+ if (omp_clauses->final_expr)
+ {
+ gfc_expr *expr = omp_clauses->final_expr;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_LOGICAL || expr->rank != 0)
+ gfc_error ("FINAL clause at %L requires a scalar LOGICAL expression",
+ &expr->where);
+ }
+ if (omp_clauses->novariants)
+ {
+ gfc_expr *expr = omp_clauses->novariants;
+ if (!gfc_resolve_expr (expr) || expr->ts.type != BT_LOGICAL
+ || expr->rank != 0)
+ gfc_error (
+ "NOVARIANTS clause at %L requires a scalar LOGICAL expression",
+ &expr->where);
+ if_without_mod = true;
+ }
+ if (omp_clauses->nocontext)
+ {
+ gfc_expr *expr = omp_clauses->nocontext;
+ if (!gfc_resolve_expr (expr) || expr->ts.type != BT_LOGICAL
+ || expr->rank != 0)
+ gfc_error (
+ "NOCONTEXT clause at %L requires a scalar LOGICAL expression",
+ &expr->where);
+ if_without_mod = true;
+ }
+ if (omp_clauses->num_threads)
+ resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS");
+ if (omp_clauses->chunk_size)
+ {
+ gfc_expr *expr = omp_clauses->chunk_size;
+ if (!gfc_resolve_expr (expr)
+ || expr->ts.type != BT_INTEGER || expr->rank != 0)
+ gfc_error ("SCHEDULE clause's chunk_size at %L requires "
+ "a scalar INTEGER expression", &expr->where);
+ else if (expr->expr_type == EXPR_CONSTANT
+ && expr->ts.type == BT_INTEGER
+ && mpz_sgn (expr->value.integer) <= 0)
+ gfc_warning (0, "INTEGER expression of SCHEDULE clause's chunk_size "
+ "at %L must be positive", &expr->where);
+ }
+ if (omp_clauses->sched_kind != OMP_SCHED_NONE
+ && omp_clauses->sched_nonmonotonic)
+ {
+ if (omp_clauses->sched_monotonic)
+ gfc_error ("Both MONOTONIC and NONMONOTONIC schedule modifiers "
+ "specified at %L", &code->loc);
+ else if (omp_clauses->ordered)
+ gfc_error ("NONMONOTONIC schedule modifier specified with ORDERED "
+ "clause at %L", &code->loc);
+ }
+
+ if (omp_clauses->depobj
+ && (!gfc_resolve_expr (omp_clauses->depobj)
+ || omp_clauses->depobj->ts.type != BT_INTEGER
+ || omp_clauses->depobj->ts.kind != 2 * gfc_index_integer_kind
+ || omp_clauses->depobj->rank != 0))
+ gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer "
+ "of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where);
+
+ if (code
+ && code->op == EXEC_OMP_INTEROP
+ && omp_clauses->lists[OMP_LIST_DEPEND])
+ {
+ if (!omp_clauses->lists[OMP_LIST_INIT]
+ && !omp_clauses->lists[OMP_LIST_USE]
+ && !omp_clauses->lists[OMP_LIST_DESTROY])
+ {
+ gfc_error ("DEPEND clause at %L requires action clause with "
+ "%<targetsync%> interop-type",
+ &omp_clauses->lists[OMP_LIST_DEPEND]->where);
+ }
+ for (n = omp_clauses->lists[OMP_LIST_INIT]; n; n = n->next)
+ if (!n->u.init.targetsync)
+ {
+ gfc_error ("DEPEND clause at %L requires %<targetsync%> "
+ "interop-type, lacking it for %qs at %L",
+ &omp_clauses->lists[OMP_LIST_DEPEND]->where,
+ n->sym->name, &n->where);
+ break;
+ }
+ }
+ if (code && (code->op == EXEC_OMP_INTEROP || code->op == EXEC_OMP_DISPATCH))
+ for (list = OMP_LIST_INIT; list <= OMP_LIST_INTEROP; list++)
+ for (n = omp_clauses->lists[list]; n; n = n->next)
+ {
+ if (n->sym->ts.type != BT_INTEGER
+ || n->sym->ts.kind != gfc_index_integer_kind
+ || n->sym->attr.dimension
+ || n->sym->attr.flavor != FL_VARIABLE)
+ gfc_error ("%qs at %L in %qs clause must be a scalar integer "
+ "variable of %<omp_interop_kind%> kind", n->sym->name,
+ &n->where, clause_names[list]);
+ if (list != OMP_LIST_USE && list != OMP_LIST_INTEROP
+ && n->sym->attr.intent == INTENT_IN)
+ gfc_error ("%qs at %L in %qs clause must be definable",
+ n->sym->name, &n->where, clause_names[list]);
+ }
+
+ verify_omp_clauses_symbol_dups (code, omp_clauses, ns, openacc);
+
/* OpenACC reductions. */
if (openacc)
{
@@ -9354,27 +10051,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
else
n->sym->mark = 1;
- /* OpenACC does not support reductions on arrays. */
- if (n->sym->as)
+ /* OpenACC current only supports array reductions on explicit-shape
+ arrays. */
+ if ((n->sym->as && n->sym->as->type != AS_EXPLICIT)
+ || n->sym->attr.codimension)
gfc_error ("Array %qs is not permitted in reduction at %L",
n->sym->name, &n->where);
}
}
- for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
- n->sym->mark = 0;
- for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next)
- if (n->expr == NULL)
- n->sym->mark = 1;
- for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
- {
- if (n->expr == NULL && n->sym->mark)
- gfc_error ("Symbol %qs present on both FROM and TO clauses at %L",
- n->sym->name, &n->where);
- else
- n->sym->mark = 1;
- }
-
bool has_inscan = false, has_notinscan = false;
for (list = 0; list < OMP_LIST_NUM; list++)
if ((n = omp_clauses->lists[list]) != NULL)
@@ -9452,6 +10137,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
break;
+ case OMP_LIST_REDUCTION:
+ if (!openacc)
+ goto default_case;
+ gcc_fallthrough ();
case OMP_LIST_AFFINITY:
case OMP_LIST_DEPEND:
case OMP_LIST_MAP:
@@ -9460,7 +10149,41 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
- if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY)
+ if (openacc && list == OMP_LIST_REDUCTION)
+ {
+ if (n->sym->attr.threadprivate)
+ gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+ if (n->sym->attr.cray_pointee)
+ gfc_error ("Cray pointee %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+ if (n->sym->attr.associate_var)
+ gfc_error ("Associate name %qs in %s clause at %L",
+ n->sym->attr.select_type_temporary
+ ? n->sym->assoc->target->symtree->n.sym->name
+ : n->sym->name, name, &n->where);
+ if (n->sym->attr.proc_pointer)
+ gfc_error ("Procedure pointer %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+ if (n->sym->attr.pointer)
+ gfc_error ("POINTER object %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+ if (n->sym->attr.cray_pointer)
+ gfc_error ("Cray pointer %qs in %s clause at %L",
+ n->sym->name, name, &n->where);
+
+ const char *rop_name;
+ if (!oacc_reduction_defined_type_p (n->u.reduction_op,
+ &n->sym->ts, &rop_name))
+ {
+ gfc_error ("Reduction operator %s is not valid for %qs at %L",
+ rop_name, n->sym->name, &n->where);
+ break;
+ }
+ }
+ if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY
+ || list == OMP_LIST_MAP
+ || list == OMP_LIST_TO || list == OMP_LIST_FROM)
&& n->u2.ns && !n->u2.ns->resolved)
{
n->u2.ns->resolved = 1;
@@ -9543,247 +10266,39 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"type shall be a scalar integer of "
"OMP_DEPEND_KIND kind", &n->expr->where);
}
- gfc_ref *lastref = NULL, *lastslice = NULL;
- bool resolved = false;
- if (n->expr)
+ if (!omp_verify_map_motion_clauses (code, list, name, n,
+ openacc))
+ break;
+ if (list == OMP_LIST_MAP
+ || list == OMP_LIST_TO
+ || list == OMP_LIST_FROM)
{
- lastref = n->expr->ref;
- resolved = gfc_resolve_expr (n->expr);
-
- /* Look through component refs to find last array
- reference. */
- if (resolved)
- {
- for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
- if (ref->type == REF_COMPONENT
- || ref->type == REF_SUBSTRING
- || ref->type == REF_INQUIRY)
- lastref = ref;
- else if (ref->type == REF_ARRAY)
- {
- for (int i = 0; i < ref->u.ar.dimen; i++)
- if (ref->u.ar.dimen_type[i] == DIMEN_RANGE)
- lastslice = ref;
+ gfc_typespec *ts;
- lastref = ref;
- }
-
- /* The "!$acc cache" directive allows rectangular
- subarrays to be specified, with some restrictions
- on the form of bounds (not implemented).
- Only raise an error here if we're really sure the
- array isn't contiguous. An expression such as
- arr(-n:n,-n:n) could be contiguous even if it looks
- like it may not be. */
- if (code->op != EXEC_OACC_UPDATE
- && list != OMP_LIST_CACHE
- && list != OMP_LIST_DEPEND
- && !gfc_is_simply_contiguous (n->expr, false, true)
- && gfc_is_not_contiguous (n->expr)
- && !(lastslice
- && (lastslice->next
- || lastslice->type != REF_ARRAY)))
- gfc_error ("Array is not contiguous at %L",
- &n->where);
- }
- }
- if (openacc
- && list == OMP_LIST_MAP
- && (n->u.map.op == OMP_MAP_ATTACH
- || n->u.map.op == OMP_MAP_DETACH))
- {
- symbol_attribute attr;
if (n->expr)
- attr = gfc_expr_attr (n->expr);
+ ts = &n->expr->ts;
else
- attr = n->sym->attr;
- if (!attr.pointer && !attr.allocatable)
- gfc_error ("%qs clause argument must be ALLOCATABLE or "
- "a POINTER at %L",
- (n->u.map.op == OMP_MAP_ATTACH) ? "attach"
- : "detach", &n->where);
- }
- if (lastref
- || (n->expr
- && (!resolved || n->expr->expr_type != EXPR_VARIABLE)))
- {
- if (!lastslice
- && lastref
- && lastref->type == REF_SUBSTRING)
- gfc_error ("Unexpected substring reference in %s clause "
- "at %L", name, &n->where);
- else if (!lastslice
- && lastref
- && lastref->type == REF_INQUIRY)
- {
- gcc_assert (lastref->u.i == INQUIRY_RE
- || lastref->u.i == INQUIRY_IM);
- gfc_error ("Unexpected complex-parts designator "
- "reference in %s clause at %L",
- name, &n->where);
- }
- else if (!resolved
- || n->expr->expr_type != EXPR_VARIABLE
- || (lastslice
- && (lastslice->next
- || lastslice->type != REF_ARRAY)))
- gfc_error ("%qs in %s clause at %L is not a proper "
- "array section", n->sym->name, name,
- &n->where);
- else if (lastslice)
+ ts = &n->sym->ts;
+
+ const char *mapper_id
+ = n->u3.udm ? n->u3.udm->mapper_id : "";
+
+ gfc_omp_udm *udm = gfc_find_omp_udm (gfc_current_ns,
+ mapper_id, ts);
+ if (mapper_id[0] != '\0' && !udm)
+ gfc_error ("User-defined mapper %qs not found at %L",
+ mapper_id, &n->where);
+ else if (udm)
{
- int i;
- gfc_array_ref *ar = &lastslice->u.ar;
- for (i = 0; i < ar->dimen; i++)
- if (ar->stride[i] && code->op != EXEC_OACC_UPDATE)
- {
- gfc_error ("Stride should not be specified for "
- "array section in %s clause at %L",
- name, &n->where);
- break;
- }
- else if (ar->dimen_type[i] != DIMEN_ELEMENT
- && ar->dimen_type[i] != DIMEN_RANGE)
- {
- gfc_error ("%qs in %s clause at %L is not a "
- "proper array section",
- n->sym->name, name, &n->where);
- break;
- }
- else if ((list == OMP_LIST_DEPEND
- || list == OMP_LIST_AFFINITY)
- && ar->start[i]
- && ar->start[i]->expr_type == EXPR_CONSTANT
- && ar->end[i]
- && ar->end[i]->expr_type == EXPR_CONSTANT
- && mpz_cmp (ar->start[i]->value.integer,
- ar->end[i]->value.integer) > 0)
- {
- gfc_error ("%qs in %s clause at %L is a "
- "zero size array section",
- n->sym->name,
- list == OMP_LIST_DEPEND
- ? "DEPEND" : "AFFINITY", &n->where);
- break;
- }
+ if (!n->u3.udm)
+ {
+ n->u3.udm = gfc_get_omp_namelist_udm ();
+ gcc_assert (mapper_id[0] == '\0');
+ n->u3.udm->mapper_id = mapper_id;
+ }
+ n->u3.udm->udm = udm;
}
}
- else if (openacc)
- {
- if (list == OMP_LIST_MAP
- && n->u.map.op == OMP_MAP_FORCE_DEVICEPTR)
- resolve_oacc_deviceptr_clause (n->sym, n->where, name);
- else
- resolve_oacc_data_clauses (n->sym, n->where, name);
- }
- else if (list != OMP_LIST_DEPEND
- && n->sym->as
- && n->sym->as->type == AS_ASSUMED_SIZE)
- gfc_error ("Assumed size array %qs in %s clause at %L",
- n->sym->name, name, &n->where);
- if (list == OMP_LIST_MAP && !openacc)
- switch (code->op)
- {
- case EXEC_OMP_TARGET:
- case EXEC_OMP_TARGET_PARALLEL:
- case EXEC_OMP_TARGET_PARALLEL_DO:
- case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_PARALLEL_LOOP:
- case EXEC_OMP_TARGET_SIMD:
- case EXEC_OMP_TARGET_TEAMS:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- case EXEC_OMP_TARGET_TEAMS_LOOP:
- case EXEC_OMP_TARGET_DATA:
- switch (n->u.map.op)
- {
- case OMP_MAP_TO:
- case OMP_MAP_ALWAYS_TO:
- case OMP_MAP_PRESENT_TO:
- case OMP_MAP_ALWAYS_PRESENT_TO:
- case OMP_MAP_FROM:
- case OMP_MAP_ALWAYS_FROM:
- case OMP_MAP_PRESENT_FROM:
- case OMP_MAP_ALWAYS_PRESENT_FROM:
- case OMP_MAP_TOFROM:
- case OMP_MAP_ALWAYS_TOFROM:
- case OMP_MAP_PRESENT_TOFROM:
- case OMP_MAP_ALWAYS_PRESENT_TOFROM:
- case OMP_MAP_ALLOC:
- case OMP_MAP_PRESENT_ALLOC:
- break;
- default:
- gfc_error ("TARGET%s with map-type other than TO, "
- "FROM, TOFROM, or ALLOC on MAP clause "
- "at %L",
- code->op == EXEC_OMP_TARGET_DATA
- ? " DATA" : "", &n->where);
- break;
- }
- break;
- case EXEC_OMP_TARGET_ENTER_DATA:
- switch (n->u.map.op)
- {
- case OMP_MAP_TO:
- case OMP_MAP_ALWAYS_TO:
- case OMP_MAP_PRESENT_TO:
- case OMP_MAP_ALWAYS_PRESENT_TO:
- case OMP_MAP_ALLOC:
- case OMP_MAP_PRESENT_ALLOC:
- break;
- case OMP_MAP_TOFROM:
- n->u.map.op = OMP_MAP_TO;
- break;
- case OMP_MAP_ALWAYS_TOFROM:
- n->u.map.op = OMP_MAP_ALWAYS_TO;
- break;
- case OMP_MAP_PRESENT_TOFROM:
- n->u.map.op = OMP_MAP_PRESENT_TO;
- break;
- case OMP_MAP_ALWAYS_PRESENT_TOFROM:
- n->u.map.op = OMP_MAP_ALWAYS_PRESENT_TO;
- break;
- default:
- gfc_error ("TARGET ENTER DATA with map-type other "
- "than TO, TOFROM or ALLOC on MAP clause "
- "at %L", &n->where);
- break;
- }
- break;
- case EXEC_OMP_TARGET_EXIT_DATA:
- switch (n->u.map.op)
- {
- case OMP_MAP_FROM:
- case OMP_MAP_ALWAYS_FROM:
- case OMP_MAP_PRESENT_FROM:
- case OMP_MAP_ALWAYS_PRESENT_FROM:
- case OMP_MAP_RELEASE:
- case OMP_MAP_DELETE:
- break;
- case OMP_MAP_TOFROM:
- n->u.map.op = OMP_MAP_FROM;
- break;
- case OMP_MAP_ALWAYS_TOFROM:
- n->u.map.op = OMP_MAP_ALWAYS_FROM;
- break;
- case OMP_MAP_PRESENT_TOFROM:
- n->u.map.op = OMP_MAP_PRESENT_FROM;
- break;
- case OMP_MAP_ALWAYS_PRESENT_TOFROM:
- n->u.map.op = OMP_MAP_ALWAYS_PRESENT_FROM;
- break;
- default:
- gfc_error ("TARGET EXIT DATA with map-type other "
- "than FROM, TOFROM, RELEASE, or DELETE on "
- "MAP clause at %L", &n->where);
- break;
- }
- break;
- default:
- break;
- }
}
if (list != OMP_LIST_DEPEND)
@@ -9909,6 +10424,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
break;
}
default:
+ default_case:
for (; n != NULL; n = n->next)
{
if (n->sym == NULL)
@@ -10061,39 +10577,46 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
case OMP_LIST_IN_REDUCTION:
case OMP_LIST_TASK_REDUCTION:
case OMP_LIST_REDUCTION_INSCAN:
- switch (n->u.reduction_op)
+ if (openacc)
{
- case OMP_REDUCTION_PLUS:
- case OMP_REDUCTION_TIMES:
- case OMP_REDUCTION_MINUS:
- if (!gfc_numeric_ts (&n->sym->ts))
+ if (!oacc_reduction_defined_type_p (n->u.reduction_op,
+ &n->sym->ts))
bad = true;
- break;
- case OMP_REDUCTION_AND:
- case OMP_REDUCTION_OR:
- case OMP_REDUCTION_EQV:
- case OMP_REDUCTION_NEQV:
- if (n->sym->ts.type != BT_LOGICAL)
- bad = true;
- break;
- case OMP_REDUCTION_MAX:
- case OMP_REDUCTION_MIN:
- if (n->sym->ts.type != BT_INTEGER
- && n->sym->ts.type != BT_REAL)
- bad = true;
- break;
- case OMP_REDUCTION_IAND:
- case OMP_REDUCTION_IOR:
- case OMP_REDUCTION_IEOR:
- if (n->sym->ts.type != BT_INTEGER)
- bad = true;
- break;
- case OMP_REDUCTION_USER:
- bad = true;
- break;
- default:
- break;
}
+ else
+ switch (n->u.reduction_op)
+ {
+ case OMP_REDUCTION_PLUS:
+ case OMP_REDUCTION_TIMES:
+ case OMP_REDUCTION_MINUS:
+ if (!gfc_numeric_ts (&n->sym->ts))
+ bad = true;
+ break;
+ case OMP_REDUCTION_AND:
+ case OMP_REDUCTION_OR:
+ case OMP_REDUCTION_EQV:
+ case OMP_REDUCTION_NEQV:
+ if (n->sym->ts.type != BT_LOGICAL)
+ bad = true;
+ break;
+ case OMP_REDUCTION_MAX:
+ case OMP_REDUCTION_MIN:
+ if (n->sym->ts.type != BT_INTEGER
+ && n->sym->ts.type != BT_REAL)
+ bad = true;
+ break;
+ case OMP_REDUCTION_IAND:
+ case OMP_REDUCTION_IOR:
+ case OMP_REDUCTION_IEOR:
+ if (n->sym->ts.type != BT_INTEGER)
+ bad = true;
+ break;
+ case OMP_REDUCTION_USER:
+ bad = true;
+ break;
+ default:
+ break;
+ }
if (!bad)
n->u2.udr = NULL;
else
@@ -10456,6 +10979,46 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_resolve_omp_assumptions (omp_clauses->assume);
}
+/* This very simplified version of the above function is for use after mapper
+ instantiation. It avoids dealing with anything other than basic
+ verification for map/to/from clauses. */
+
+static void
+resolve_omp_mapper_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
+ gfc_namespace *ns)
+{
+ gfc_omp_namelist *n;
+ int list;
+
+ verify_omp_clauses_symbol_dups (code, omp_clauses, ns, false);
+
+ for (list = OMP_LIST_MAP; list <= OMP_LIST_FROM; list++)
+ if ((n = omp_clauses->lists[list]) != NULL)
+ {
+ const char *name = NULL;
+ switch (list)
+ {
+ case OMP_LIST_MAP:
+ if (name == NULL)
+ name = "MAP";
+ /* Fallthrough. */
+ case OMP_LIST_TO:
+ if (name == NULL)
+ name = "TO";
+ /* Fallthrough. */
+ case OMP_LIST_FROM:
+ if (name == NULL)
+ name = "FROM";
+ for (; n != NULL; n = n->next)
+ if (!omp_verify_map_motion_clauses (code, list, name, n, false))
+ break;
+ break;
+ default:
+ ;
+ }
+ }
+}
+
/* Return true if SYM is ever referenced in EXPR except in the SE node. */
@@ -13019,11 +13582,11 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_DEPOBJ:
if (code->ext.omp_clauses)
- resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
+ resolve_omp_clauses (code, code->ext.omp_clauses, ns);
break;
case EXEC_OMP_TARGET_UPDATE:
if (code->ext.omp_clauses)
- resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
+ resolve_omp_clauses (code, code->ext.omp_clauses, ns);
if (code->ext.omp_clauses == NULL
|| (code->ext.omp_clauses->lists[OMP_LIST_TO] == NULL
&& code->ext.omp_clauses->lists[OMP_LIST_FROM] == NULL))
@@ -13282,3 +13845,485 @@ gfc_resolve_omp_udrs (gfc_symtree *st)
for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next)
gfc_resolve_omp_udr (omp_udr);
}
+
+static enum gfc_omp_map_op
+omp_split_map_op (enum gfc_omp_map_op op, bool *force_p, bool *always_p,
+ bool *present_p)
+{
+ *force_p = *always_p = *present_p = false;
+
+ switch (op)
+ {
+ case OMP_MAP_FORCE_ALLOC:
+ case OMP_MAP_FORCE_TO:
+ case OMP_MAP_FORCE_FROM:
+ case OMP_MAP_FORCE_TOFROM:
+ case OMP_MAP_FORCE_PRESENT:
+ *force_p = true;
+ break;
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_ALWAYS_TOFROM:
+ *always_p = true;
+ break;
+ case OMP_MAP_ALWAYS_PRESENT_TO:
+ case OMP_MAP_ALWAYS_PRESENT_FROM:
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ *always_p = true;
+ /* Fallthrough. */
+ case OMP_MAP_PRESENT_ALLOC:
+ case OMP_MAP_PRESENT_TO:
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_PRESENT_TOFROM:
+ *present_p = true;
+ break;
+ default:
+ ;
+ }
+
+ switch (op)
+ {
+ case OMP_MAP_ALLOC:
+ case OMP_MAP_FORCE_ALLOC:
+ case OMP_MAP_PRESENT_ALLOC:
+ return OMP_MAP_ALLOC;
+ case OMP_MAP_TO:
+ case OMP_MAP_FORCE_TO:
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_PRESENT_TO:
+ case OMP_MAP_ALWAYS_PRESENT_TO:
+ return OMP_MAP_TO;
+ case OMP_MAP_FROM:
+ case OMP_MAP_FORCE_FROM:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_ALWAYS_PRESENT_FROM:
+ return OMP_MAP_FROM;
+ case OMP_MAP_TOFROM:
+ case OMP_MAP_FORCE_TOFROM:
+ case OMP_MAP_ALWAYS_TOFROM:
+ case OMP_MAP_PRESENT_TOFROM:
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ return OMP_MAP_TOFROM;
+ default:
+ ;
+ }
+ return op;
+}
+
+static enum gfc_omp_map_op
+omp_join_map_op (enum gfc_omp_map_op op, bool force_p, bool always_p,
+ bool present_p)
+{
+ gcc_assert (!force_p || !(always_p || present_p));
+
+ switch (op)
+ {
+ case OMP_MAP_ALLOC:
+ if (force_p)
+ return OMP_MAP_FORCE_ALLOC;
+ else if (present_p)
+ return OMP_MAP_PRESENT_ALLOC;
+ break;
+
+ case OMP_MAP_TO:
+ if (force_p)
+ return OMP_MAP_FORCE_TO;
+ else if (always_p && present_p)
+ return OMP_MAP_ALWAYS_PRESENT_TO;
+ else if (always_p)
+ return OMP_MAP_ALWAYS_TO;
+ else if (present_p)
+ return OMP_MAP_PRESENT_TO;
+ break;
+
+ case OMP_MAP_FROM:
+ if (force_p)
+ return OMP_MAP_FORCE_FROM;
+ else if (always_p && present_p)
+ return OMP_MAP_ALWAYS_PRESENT_FROM;
+ else if (always_p)
+ return OMP_MAP_ALWAYS_FROM;
+ else if (present_p)
+ return OMP_MAP_PRESENT_FROM;
+ break;
+
+ case OMP_MAP_TOFROM:
+ if (force_p)
+ return OMP_MAP_FORCE_TOFROM;
+ else if (always_p && present_p)
+ return OMP_MAP_ALWAYS_PRESENT_TOFROM;
+ else if (always_p)
+ return OMP_MAP_ALWAYS_TOFROM;
+ else if (present_p)
+ return OMP_MAP_PRESENT_TOFROM;
+ break;
+
+ default:
+ ;
+ }
+
+ return op;
+}
+
+/* Map kind decay (OpenMP 5.2, 5.8.8 "declare mapper Directive"). Return the
+ map kind to use given MAPPER_KIND specified in the mapper and INVOKED_AS
+ specified on the clause that invokes the mapper. See also
+ c-family/c-omp.cc:omp_map_decayed_kind. */
+
+static enum gfc_omp_map_op
+omp_map_decayed_kind (enum gfc_omp_map_op mapper_kind,
+ enum gfc_omp_map_op invoked_as, bool exit_p)
+{
+ if (invoked_as == OMP_MAP_RELEASE || invoked_as == OMP_MAP_DELETE)
+ return invoked_as;
+
+ bool force_p, always_p, present_p;
+
+ invoked_as = omp_split_map_op (invoked_as, &force_p, &always_p, &present_p);
+ gfc_omp_map_op decay_to;
+
+ switch (mapper_kind)
+ {
+ case OMP_MAP_ALLOC:
+ if (exit_p && invoked_as == OMP_MAP_FROM)
+ decay_to = OMP_MAP_RELEASE;
+ else
+ decay_to = OMP_MAP_ALLOC;
+ break;
+
+ case OMP_MAP_TO:
+ if (invoked_as == OMP_MAP_FROM)
+ decay_to = exit_p ? OMP_MAP_RELEASE : OMP_MAP_ALLOC;
+ else if (invoked_as == OMP_MAP_ALLOC)
+ decay_to = OMP_MAP_ALLOC;
+ else
+ decay_to = OMP_MAP_TO;
+ break;
+
+ case OMP_MAP_FROM:
+ if (invoked_as == OMP_MAP_ALLOC || invoked_as == OMP_MAP_TO)
+ decay_to = OMP_MAP_ALLOC;
+ else
+ decay_to = OMP_MAP_FROM;
+ break;
+
+ case OMP_MAP_TOFROM:
+ case OMP_MAP_UNSET:
+ decay_to = invoked_as;
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ return omp_join_map_op (decay_to, force_p, always_p, present_p);
+}
+
+static const char *
+omp_basic_map_kind_name (enum gfc_omp_map_op op)
+{
+ switch (op)
+ {
+ case OMP_MAP_ALLOC:
+ return "ALLOC";
+ case OMP_MAP_TO:
+ return "TO";
+ case OMP_MAP_FROM:
+ return "FROM";
+ case OMP_MAP_TOFROM:
+ return "TOFROM";
+ case OMP_MAP_RELEASE:
+ return "RELEASE";
+ case OMP_MAP_DELETE:
+ return "DELETE";
+ default:
+ gcc_unreachable ();
+ }
+}
+
+static gfc_symtree *gfc_subst_replace;
+static gfc_ref *gfc_subst_prepend_ref;
+
+static bool
+gfc_subst_in_expr_1 (gfc_expr *expr, gfc_symbol *search, int *)
+{
+ /* The base-object for component accesses may be stored in expr->symtree.
+ If it's the symbol for our "declare mapper" placeholder variable,
+ substitute it. */
+ if (expr->symtree && expr->symtree->n.sym == search)
+ {
+ gfc_ref **lastptr = NULL;
+ expr->symtree = gfc_subst_replace;
+
+ if (!gfc_subst_prepend_ref)
+ return false;
+
+ gfc_ref *prepend_ref = gfc_copy_ref (gfc_subst_prepend_ref);
+
+ for (gfc_ref *walk = prepend_ref; walk; walk = walk->next)
+ lastptr = &walk->next;
+
+ *lastptr = expr->ref;
+ expr->ref = prepend_ref;
+ }
+
+ return false;
+}
+
+static void
+gfc_subst_in_expr (gfc_expr *expr, gfc_symbol *search, gfc_symtree *replace,
+ gfc_ref *prepend_ref)
+{
+ gfc_subst_replace = replace;
+ gfc_subst_prepend_ref = prepend_ref;
+ gfc_traverse_expr (expr, search, gfc_subst_in_expr_1, 0);
+}
+
+static void
+gfc_subst_mapper_var (gfc_symbol **out_sym, gfc_expr **out_expr,
+ gfc_symbol *orig_sym, gfc_expr *orig_expr,
+ gfc_symbol *dummy_var,
+ gfc_symbol *templ_sym, gfc_expr *templ_expr)
+{
+ gfc_ref *orig_ref = orig_expr ? orig_expr->ref : NULL;
+ gfc_symtree *orig_st = gfc_find_symtree (orig_sym->ns->sym_root,
+ orig_sym->name);
+
+ if (dummy_var == templ_sym)
+ *out_sym = orig_sym;
+ else
+ *out_sym = templ_sym;
+
+ if (templ_expr)
+ {
+ *out_expr = gfc_copy_expr (templ_expr);
+ gfc_subst_in_expr (*out_expr, dummy_var, orig_st, orig_ref);
+ }
+ else if (orig_expr)
+ *out_expr = gfc_copy_expr (orig_expr);
+ else
+ *out_expr = NULL;
+}
+
+static gfc_omp_namelist **
+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,
+ gfc_namespace *ns,
+ toc_directive cd, int list)
+{
+ /* Here "sym" and "expr" describe the clause as written, to be substituted
+ for the dummy variable in the mapper definition. */
+ struct gfc_symbol *sym = clause->sym;
+ struct gfc_expr *expr = clause->expr;
+ gfc_omp_namelist *mapper_clause = udm->clauses->lists[OMP_LIST_MAP];
+ bool pointer_needed_p = false;
+
+ if (expr)
+ {
+ gfc_ref *lastref = expr->ref, *lastcomp = NULL;
+
+ for (; lastref->next; lastref = lastref->next)
+ if (lastref->type == REF_COMPONENT)
+ lastcomp = lastref;
+
+ if (lastref
+ && lastref->type == REF_ARRAY
+ && (lastref->u.ar.type == AR_SECTION
+ || lastref->u.ar.type == AR_FULL))
+ {
+ mpz_t elems;
+ bool multiple_elems_p = false;
+
+ if (gfc_array_size (expr, &elems))
+ {
+ HOST_WIDE_INT nelems = gfc_mpz_get_hwi (elems);
+ if (nelems > 1)
+ multiple_elems_p = true;
+ }
+ else
+ multiple_elems_p = true;
+
+ if (multiple_elems_p && clause->u3.udm)
+ {
+ clause->u3.udm->multiple_elems_p = true;
+ *outlistp = clause;
+ return &(*outlistp)->next;
+ }
+ }
+
+ if (lastcomp
+ && lastcomp->type == REF_COMPONENT
+ && (lastcomp->u.c.component->attr.pointer
+ || lastcomp->u.c.component->attr.allocatable))
+ pointer_needed_p = true;
+ }
+
+ if (pointer_needed_p)
+ {
+ /* If we're instantiating a mapper via a pointer, we need to map that
+ pointer as well as mapping the entities explicitly listed in the
+ mapper definition. Create a node for that. */
+ gfc_omp_namelist *new_clause = gfc_get_omp_namelist ();
+ new_clause->sym = sym;
+ new_clause->expr = gfc_copy_expr (expr);
+ /* We want the pointer itself: cut off any further accessors after the
+ last component reference (e.g. array indices). */
+ gfc_ref *lastcomp = NULL;
+ for (gfc_ref *lastref = new_clause->expr->ref;
+ lastref;
+ lastref = lastref->next)
+ if (lastref->type == REF_COMPONENT)
+ lastcomp = lastref;
+ gcc_assert (lastcomp != NULL);
+ lastcomp->next = NULL;
+ new_clause->u.map.op = OMP_MAP_POINTER_ONLY;
+ *outlistp = new_clause;
+ outlistp = &new_clause->next;
+ }
+
+ for (; mapper_clause; mapper_clause = mapper_clause->next)
+ {
+ gfc_omp_namelist *new_clause = gfc_get_omp_namelist ();
+
+ gfc_subst_mapper_var (&new_clause->sym, &new_clause->expr,
+ sym, expr, udm->var_sym, mapper_clause->sym,
+ mapper_clause->expr);
+
+ enum gfc_omp_map_op map_clause_op = mapper_clause->u.map.op;
+ enum gfc_omp_map_op new_kind
+ = omp_map_decayed_kind (map_clause_op, outer_map_op,
+ (cd == TOC_OPENMP_EXIT_DATA
+ || list == OMP_LIST_FROM));
+ if (list == OMP_LIST_FROM || list == OMP_LIST_TO)
+ {
+ switch (new_kind)
+ {
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_PRESENT_TO:
+ new_clause->u.present_modifier = true;
+ /* Fallthrough. */
+ case OMP_MAP_FROM:
+ case OMP_MAP_TO:
+ break;
+ default:
+ {
+ bool present_p, force_p, always_p;
+ gfc_omp_map_op basic_kind
+ = omp_split_map_op (map_clause_op, &force_p, &always_p,
+ &present_p);
+ free (new_clause);
+ 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;
+ }
+ }
+ }
+ else
+ new_clause->u.map.op = new_kind;
+
+ new_clause->where = clause->where;
+ new_clause->u2.ns = ns;
+
+ if (mapper_clause->u3.udm
+ && mapper_clause->u3.udm->udm != udm)
+ {
+ gfc_omp_udm *inner_udm = mapper_clause->u3.udm->udm;
+ outlistp = gfc_omp_instantiate_mapper (code, outlistp, new_clause,
+ outer_map_op, inner_udm, ns,
+ cd, list);
+ }
+ else
+ {
+ *outlistp = new_clause;
+ outlistp = &new_clause->next;
+ }
+ }
+
+ return outlistp;
+}
+
+/* Instantiate mappers for CLAUSES for LIST. Returns true on success and
+ 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, gfc_omp_clauses *clauses,
+ toc_directive cd, int list)
+{
+ gfc_omp_namelist *clause = clauses->lists[list];
+ gfc_omp_namelist **clausep = &clauses->lists[list];
+ bool invoked_mappers = false;
+ int orig_errors, new_errors;
+ gfc_get_errors (NULL, &orig_errors);
+
+ for (; clause; clause = *clausep)
+ {
+ if (clause->u3.udm)
+ {
+ gfc_omp_map_op outer_map_op;
+
+ switch (list)
+ {
+ case OMP_LIST_TO:
+ outer_map_op = clause->u.present_modifier ? OMP_MAP_PRESENT_TO
+ : OMP_MAP_TO;
+ break;
+ case OMP_LIST_FROM:
+ outer_map_op = clause->u.present_modifier ? OMP_MAP_PRESENT_FROM
+ : OMP_MAP_FROM;
+ break;
+ case OMP_LIST_MAP:
+ outer_map_op = clause->u.map.op;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ clausep = gfc_omp_instantiate_mapper (code, clausep, clause,
+ outer_map_op,
+ clause->u3.udm->udm,
+ clause->u2.ns, cd, list);
+ *clausep = clause->next;
+ invoked_mappers = true;
+ }
+ else
+ clausep = &clause->next;
+ }
+
+ if (invoked_mappers)
+ {
+ gfc_namespace *old_ns = gfc_current_ns;
+ if (clauses->ns)
+ gfc_current_ns = clauses->ns;
+ resolve_omp_mapper_clauses (code, clauses, gfc_current_ns);
+ gfc_current_ns = old_ns;
+ }
+
+ gfc_get_errors (NULL, &new_errors);
+ return new_errors == orig_errors;
+}
+
+/* Resolve !$omp declare mapper constructs. */
+
+static void
+gfc_resolve_omp_udm (gfc_omp_udm *omp_udm)
+{
+ resolve_omp_clauses (NULL, omp_udm->clauses, omp_udm->mapper_ns);
+}
+
+void
+gfc_resolve_omp_udms (gfc_symtree *st)
+{
+ gfc_omp_udm *omp_udm;
+
+ if (st == NULL)
+ return;
+ gfc_resolve_omp_udms (st->left);
+ gfc_resolve_omp_udms (st->right);
+ for (omp_udm = st->n.omp_udm; omp_udm; omp_udm = omp_udm->next)
+ gfc_resolve_omp_udm (omp_udm);
+}
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index a95bb62..0af35da 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -27,6 +27,9 @@ along with GCC; see the file COPYING3. If not see
#include "match.h"
#include "parse.h"
#include "tree-core.h"
+#include "tree.h"
+#include "fold-const.h"
+#include "tree-hash-traits.h"
#include "omp-general.h"
/* Current statement label. Zero means no statement label. Because new_st
@@ -1081,6 +1084,10 @@ decode_omp_directive (void)
matcho ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL);
break;
case 'd':
+ matchds ("declare mapper", gfc_match_omp_declare_mapper,
+ ST_OMP_DECLARE_MAPPER);
+ matchds ("declare reduction", gfc_match_omp_declare_reduction,
+ ST_OMP_DECLARE_REDUCTION);
matcho ("depobj", gfc_match_omp_depobj, ST_OMP_DEPOBJ);
matcho ("dispatch", gfc_match_omp_dispatch, ST_OMP_DISPATCH);
matchs ("distribute parallel do simd",
@@ -1987,7 +1994,8 @@ next_statement (void)
#define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
case ST_OMP_DECLARE_VARIANT: case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: \
- case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
+ case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE: \
+ case ST_OMP_DECLARE_MAPPER
/* OpenMP statements that are followed by a structured block. */
@@ -2676,6 +2684,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
case ST_OMP_CRITICAL:
p = "!$OMP CRITICAL";
break;
+ case ST_OMP_DECLARE_MAPPER:
+ p = "!$OMP DECLARE MAPPER";
+ break;
case ST_OMP_DECLARE_REDUCTION:
p = "!$OMP DECLARE REDUCTION";
break;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 1db886e..9d31062 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -19288,6 +19288,8 @@ resolve_types (gfc_namespace *ns)
gfc_resolve_omp_udrs (ns->omp_udr_root);
+ gfc_resolve_omp_udms (ns->omp_udm_root);
+
ns->types_resolved = 1;
gfc_current_ns = old_ns;
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index f7f67b1..d8c2fc6 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -295,7 +295,7 @@ gfc_free_statement (gfc_code *p)
break;
case EXEC_OMP_FLUSH:
- gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false, false);
+ gfc_free_omp_namelist (p->ext.omp_namelist);
break;
case EXEC_OMP_BARRIER:
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 81aa81d..a5bb9fa 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -4041,6 +4041,21 @@ free_omp_udr_tree (gfc_symtree * omp_udr_tree)
free (omp_udr_tree);
}
+/* Similar, for !$omp declare mappers. */
+
+static void
+free_omp_udm_tree (gfc_symtree *omp_udm_tree)
+{
+ if (omp_udm_tree == NULL)
+ return;
+
+ free_omp_udm_tree (omp_udm_tree->left);
+ free_omp_udm_tree (omp_udm_tree->right);
+
+ gfc_free_omp_udm (omp_udm_tree->n.omp_udm);
+ free (omp_udm_tree);
+}
+
/* Recursive function that deletes an entire tree and all the user
operator nodes that it contains. */
@@ -4215,6 +4230,7 @@ gfc_free_namespace (gfc_namespace *&ns)
free_uop_tree (ns->uop_root);
free_common_tree (ns->common_root);
free_omp_udr_tree (ns->omp_udr_root);
+ free_omp_udm_tree (ns->omp_udm_root);
free_tb_tree (ns->tb_sym_root);
free_tb_tree (ns->tb_uop_root);
gfc_free_finalizer_list (ns->finalizers);
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9606131..ddcb1fe 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6504,6 +6504,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false,
non_ulimate_coarray_ptr_comp;
tree omp_cond = NULL_TREE, omp_alt_alloc = NULL_TREE;
+ bool oacc_declare = false;
ref = expr->ref;
@@ -6518,6 +6519,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
allocatable = expr->symtree->n.sym->attr.allocatable;
dimension = expr->symtree->n.sym->attr.dimension;
non_ulimate_coarray_ptr_comp = false;
+ oacc_declare = expr->symtree->n.sym->attr.oacc_declare_create;
}
else
{
@@ -6755,6 +6757,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
tmp = fold_convert (gfc_array_index_type, element_size);
gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp);
+ if (oacc_declare)
+ gfc_trans_oacc_declare_allocate (&set_descriptor_block, expr, true);
}
set_descriptor = gfc_finish_block (&set_descriptor_block);
@@ -6842,10 +6846,6 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
&expr->where, flag_max_array_constructor);
return NULL_TREE;
}
- if (mpz_cmp_si (c->offset, 0) != 0)
- index = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
- else
- index = NULL_TREE;
if (mpz_cmp_si (c->repeat, 1) > 0)
{
@@ -6870,6 +6870,11 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
else
range = NULL;
+ if (range == NULL || mpz_cmp_si (c->offset, 0) != 0)
+ index = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
+ else
+ index = NULL_TREE;
+
gfc_init_se (&se, NULL);
switch (c->expr->expr_type)
{
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 4f2ea76..fb5418f 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -92,6 +92,11 @@ static stmtblock_t caf_init_block;
tree gfc_static_ctors;
+/* The namespace in which to look up "declare mapper" mappers (in
+ trans-openmp.cc:gfc_trans_omp_target). This is somewhat grubby. */
+
+gfc_namespace *omp_declare_mapper_ns;
+
/* Whether we've seen a symbol from an IEEE module in the namespace. */
static int seen_ieee_symbol;
@@ -651,9 +656,12 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
function scope. */
if (current_function_decl != NULL_TREE)
{
- if (sym->ns->proc_name
- && (sym->ns->proc_name->backend_decl == current_function_decl
- || sym->result == sym))
+ if (sym->ns->omp_udm_ns)
+ /* ...except for in omp declare mappers, which are special. */
+ pushdecl (decl);
+ else if (sym->ns->proc_name
+ && (sym->ns->proc_name->backend_decl == current_function_decl
+ || sym->result == sym))
gfc_add_decl_to_function (decl);
else if (sym->ns->proc_name
&& sym->ns->proc_name->attr.flavor == FL_LABEL)
@@ -4837,6 +4845,9 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (sym->assoc)
continue;
+ if (sym->attr.omp_udm_artificial_var)
+ continue;
+
/* Set the vptr of unlimited polymorphic pointer variables so that
they do not cause segfaults in select type, when the selector
is an intrinsic type. */
@@ -6941,10 +6952,10 @@ find_module_oacc_declare_clauses (gfc_symbol *sym)
gfc_omp_map_op map_op;
if (sym->attr.oacc_declare_create)
- map_op = OMP_MAP_FORCE_ALLOC;
+ map_op = OMP_MAP_ALLOC;
if (sym->attr.oacc_declare_copyin)
- map_op = OMP_MAP_FORCE_TO;
+ map_op = OMP_MAP_TO;
if (sym->attr.oacc_declare_deviceptr)
map_op = OMP_MAP_FORCE_DEVICEPTR;
@@ -7995,6 +8006,16 @@ gfc_generate_function_code (gfc_namespace * ns)
if (flag_openmp)
gfc_traverse_ns (ns, gfc_handle_omp_declare_variant);
+ {
+ tree dm_saved_parent_function_decls = saved_parent_function_decls;
+ saved_parent_function_decls = saved_function_decls;
+ /* NOTE: Decls referenced in a mapper (other than the placeholder variable)
+ may be added to "saved_parent_function_decls". */
+ gfc_trans_omp_declare_mappers (ns->omp_udm_root);
+ saved_function_decls = saved_parent_function_decls;
+ saved_parent_function_decls = dm_saved_parent_function_decls;
+ }
+
gfc_generate_contained_functions (ns);
has_coarray_vars_or_accessors = caf_accessor_head != NULL;
@@ -8063,9 +8084,15 @@ gfc_generate_function_code (gfc_namespace * ns)
finish_oacc_declare (ns, sym, false);
+ /* Record the namespace for looking up OpenMP declare mappers in. */
+ omp_declare_mapper_ns = ns;
+
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
+ /* Unset this to avoid accidentally using a stale pointer. */
+ omp_declare_mapper_ns = NULL;
+
if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
|| (sym->result && sym->result != sym
&& sym->result->ts.type == BT_DERIVED
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 2a48d4a..7a63f52 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -27,6 +27,7 @@ along with GCC; see the file COPYING3. If not see
#include "gfortran.h"
#include "basic-block.h"
#include "tree-ssa.h"
+#include "tree-ssa-loop-niter.h" /* for simplify_replace_tree. */
#include "function.h"
#include "gimple.h"
#include "gimple-expr.h"
@@ -55,6 +56,7 @@ along with GCC; see the file COPYING3. If not see
#define GCC_DIAG_STYLE __gcc_gfc__
#include "attribs.h"
#include "function.h"
+#include "tree-iterator.h"
int ompws_flags;
@@ -102,6 +104,10 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check)
if (!for_present_check)
return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE;
+ if (!DECL_P (decl))
+ return fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+ decl, null_pointer_node);
+
if (!DECL_LANG_SPECIFIC (decl))
return NULL_TREE;
@@ -909,7 +915,8 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
stmtblock_t block, cond_block;
gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
- || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
+ || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR
+ || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_REDUCTION);
/* Privatize pointer, only; cf. gfc_omp_predetermined_sharing. */
if (DECL_P (OMP_CLAUSE_DECL (clause))
@@ -1590,6 +1597,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
tree decl = OMP_CLAUSE_DECL (c);
location_t loc = OMP_CLAUSE_LOCATION (c);
+ bool assumed_size = false;
/* Assumed-size arrays can't be mapped implicitly, they have to be
mapped explicitly using array sections. */
@@ -1600,11 +1608,19 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
== NULL)
{
- error_at (OMP_CLAUSE_LOCATION (c),
- "implicit mapping of assumed size array %qD", decl);
- return;
+ if (openacc)
+ assumed_size = true;
+ else
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "implicit mapping of assumed size array %qD", decl);
+ return;
+ }
}
+ if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FORCE_DEVICEPTR)
+ return;
+
tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
tree present = gfc_omp_check_optional_argument (decl, true);
tree orig_decl = NULL_TREE;
@@ -1619,7 +1635,16 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
orig_decl = decl;
c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_POINTER);
+ if (openacc
+ && GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
+ && OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FORCE_PRESENT)
+ /* This allows "declare create" to work for scalar allocatables. The
+ resulting mapping nodes are:
+ force_present(*var) firstprivate_pointer(var)
+ which is the same as an explicit "present" clause gives. */
+ OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_FIRSTPRIVATE_POINTER);
+ else
+ OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_POINTER);
OMP_CLAUSE_DECL (c4) = decl;
OMP_CLAUSE_SIZE (c4) = size_int (0);
decl = build_fold_indirect_ref (decl);
@@ -1645,7 +1670,9 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
else
{
OMP_CLAUSE_DECL (c) = decl;
- OMP_CLAUSE_SIZE (c) = NULL_TREE;
+ OMP_CLAUSE_SIZE (c) = assumed_size ? size_zero_node : NULL_TREE;
+ if (assumed_size)
+ OMP_CLAUSE_MAP_MAYBE_ZERO_LENGTH_ARRAY_SECTION (c) = 1;
}
if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
&& (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
@@ -1852,7 +1879,9 @@ static void
gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
location_t loc, tree data_array, tree sizes_array,
tree kinds_array, tree offset_data, tree offset,
- gimple_seq *seq, const gimple *ctx)
+ gimple_seq *seq, gimple *ctx,
+ tree iterators, gimple_seq loops_pre_seq,
+ vec<tree> *new_iterators)
{
tree one = build_int_cst (size_type_node, 1);
@@ -1863,26 +1892,67 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
data = TREE_OPERAND (data, 0);
}
+ gomp_target *target_stmt = as_a<gomp_target *> (ctx);
+ gimple_seq *loops_seq_p = gimple_omp_target_iterator_loops_ptr (target_stmt);
+
+ if (loops_pre_seq)
+ {
+ gimple_seq *loop_body_p
+ = enter_omp_iterator_loop_context (iterators, loops_seq_p);
+ gimple_seq_add_seq (loop_body_p, loops_pre_seq);
+ exit_omp_iterator_loop_context ();
+ }
+
+ tree data_expr = data;
+ tree data_iter = NULL_TREE;
+ if (iterators)
+ {
+ data_iter = add_new_omp_iterators_entry (iterators, loops_seq_p);
+ new_iterators->safe_push (data_iter);
+ assign_to_iterator_elems_array (data_expr, data_iter, target_stmt);
+ data_expr = OMP_ITERATORS_ELEMS (data_iter);
+ if (TREE_CODE (TREE_TYPE (data_expr)) == ARRAY_TYPE)
+ data_expr = build_fold_addr_expr_with_type (data_expr, ptr_type_node);
+ }
/* data_array[offset_data] = data; */
tree tmp = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (data_array)),
unshare_expr (data_array), offset_data,
NULL_TREE, NULL_TREE);
- gimplify_assign (tmp, data, seq);
+ gimplify_assign (tmp, data_expr, seq);
/* offset_data++ */
tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset_data, one);
gimplify_assign (offset_data, tmp, seq);
+ tree data_addr_expr = build_fold_addr_expr (data);
+ tree data_addr_iter = NULL_TREE;
+ if (iterators)
+ {
+ data_addr_iter = add_new_omp_iterators_entry (iterators, loops_seq_p);
+ new_iterators->safe_push (data_addr_iter);
+ assign_to_iterator_elems_array (data_addr_expr, data_addr_iter,
+ target_stmt);
+ data_addr_expr = OMP_ITERATORS_ELEMS (data_addr_iter);
+ if (TREE_CODE (TREE_TYPE (data_addr_expr)) == ARRAY_TYPE)
+ data_addr_expr = build_fold_addr_expr_with_type (data_addr_expr,
+ ptr_type_node);
+ }
/* data_array[offset_data] = &data; */
tmp = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (data_array)),
unshare_expr (data_array),
offset_data, NULL_TREE, NULL_TREE);
- gimplify_assign (tmp, build_fold_addr_expr (data), seq);
+ gimplify_assign (tmp, data_addr_expr, seq);
/* offset_data++ */
tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset_data, one);
gimplify_assign (offset_data, tmp, seq);
+ tree size_expr = size;
+ if (iterators)
+ {
+ assign_to_iterator_elems_array (size_expr, data_iter, target_stmt, 1);
+ size_expr = size_int (SIZE_MAX);
+ }
/* sizes_array[offset] = size */
tmp = build2_loc (loc, MULT_EXPR, size_type_node,
TYPE_SIZE_UNIT (size_type_node), offset);
@@ -1892,7 +1962,7 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE);
gimple_seq_add_seq (seq, seq2);
tmp = build_fold_indirect_ref_loc (loc, tmp);
- gimplify_assign (tmp, size, seq);
+ gimplify_assign (tmp, size_expr, seq);
/* FIXME: tkind |= talign << talign_shift; */
/* kinds_array[offset] = tkind. */
@@ -1910,6 +1980,12 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset, one);
gimplify_assign (offset, tmp, seq);
+ tree bias_expr = build_zero_cst (size_type_node);
+ if (iterators)
+ {
+ assign_to_iterator_elems_array (bias_expr, data_addr_iter, target_stmt, 1);
+ bias_expr = size_int (SIZE_MAX);
+ }
/* sizes_array[offset] = bias (= 0). */
tmp = build2_loc (loc, MULT_EXPR, size_type_node,
TYPE_SIZE_UNIT (size_type_node), offset);
@@ -1919,7 +1995,7 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE);
gimple_seq_add_seq (seq, seq2);
tmp = build_fold_indirect_ref_loc (loc, tmp);
- gimplify_assign (tmp, build_zero_cst (size_type_node), seq);
+ gimplify_assign (tmp, bias_expr, seq);
gcc_assert (gimple_code (ctx) == GIMPLE_OMP_TARGET);
tkind = (gimple_omp_target_kind (ctx) == GF_OMP_TARGET_KIND_EXIT_DATA
@@ -1944,7 +2020,8 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
static void gfc_omp_deep_mapping_item (bool, bool, bool, location_t, tree,
tree *, unsigned HOST_WIDE_INT, tree,
tree, tree, tree, tree, tree,
- gimple_seq *, const gimple *, bool *);
+ gimple_seq *, gimple *, bool *,
+ tree, vec <tree> *);
/* Map allocatable components. */
static void
@@ -1952,8 +2029,9 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl,
tree *token, unsigned HOST_WIDE_INT tkind,
tree data_array, tree sizes_array, tree kinds_array,
tree offset_data, tree offset, tree num,
- gimple_seq *seq, const gimple *ctx,
- bool *poly_warned)
+ gimple_seq *seq, gimple *ctx,
+ bool *poly_warned, tree iterators,
+ vec <tree> *new_iterators)
{
tree type = TREE_TYPE (decl);
if (TREE_CODE (type) != RECORD_TYPE)
@@ -1971,7 +2049,8 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl,
gfc_omp_deep_mapping_item (is_cnt, true, true, loc, tmp, token,
tkind, data_array, sizes_array,
kinds_array, offset_data, offset, num,
- seq, ctx, poly_warned);
+ seq, ctx, poly_warned, iterators,
+ new_iterators);
}
else if (GFC_DECL_GET_SCALAR_POINTER (field)
|| GFC_DESCRIPTOR_TYPE_P (type))
@@ -1984,12 +2063,13 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl,
gfc_omp_deep_mapping_item (is_cnt, false, false, loc, tmp,
token, tkind, data_array, sizes_array,
kinds_array, offset_data, offset, num,
- seq, ctx, poly_warned);
+ seq, ctx, poly_warned, iterators,
+ new_iterators);
else
gfc_omp_deep_mapping_comps (is_cnt, loc, tmp, token, tkind,
data_array, sizes_array, kinds_array,
offset_data, offset, num, seq, ctx,
- poly_warned);
+ poly_warned, iterators, new_iterators);
}
}
}
@@ -2132,7 +2212,8 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
unsigned HOST_WIDE_INT tkind, tree data_array,
tree sizes_array, tree kinds_array, tree offset_data,
tree offset, tree num, gimple_seq *seq,
- const gimple *ctx, bool *poly_warned)
+ gimple *ctx, bool *poly_warned,
+ tree iterators, vec<tree> *new_iterators)
{
tree tmp;
tree type = TREE_TYPE (decl);
@@ -2190,6 +2271,9 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
type = TREE_TYPE (decl);
}
+ gimple_seq loops_pre_seq = NULL;
+ gimple_seq *loops_pre_seq_p = iterators ? &loops_pre_seq : seq;
+
if (is_cnt && do_copy)
{
tree tmp = fold_build2_loc (loc, PLUS_EXPR, size_type_node,
@@ -2208,7 +2292,7 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
: gfc_conv_descriptor_elem_len (decl));
tmp = (POINTER_TYPE_P (TREE_TYPE (decl))
? build_fold_indirect_ref (decl) : decl);
- size = gfc_omp_get_array_size (loc, tmp, seq);
+ size = gfc_omp_get_array_size (loc, tmp, loops_pre_seq_p);
bytesize = fold_build2_loc (loc, MULT_EXPR, size_type_node,
fold_convert (size_type_node, size),
fold_convert (size_type_node, elem_len));
@@ -2236,7 +2320,8 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
gfc_omp_deep_mapping_map (tmp, bytesize, tkind2, loc, data_array,
sizes_array, kinds_array, offset_data,
- offset, seq, ctx);
+ offset, seq, ctx, iterators, loops_pre_seq,
+ new_iterators);
}
tmp = decl;
@@ -2252,7 +2337,8 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
{
elem_len = gfc_conv_descriptor_elem_len (decl);
size = fold_convert (size_type_node,
- gfc_omp_get_array_size (loc, decl, seq));
+ gfc_omp_get_array_size (loc, decl,
+ loops_pre_seq_p));
}
decl = gfc_conv_descriptor_data_get (decl);
decl = gfc_omp_elmental_loop (loc, decl, size, elem_len, seq, &seq2);
@@ -2275,7 +2361,7 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
gfc_omp_deep_mapping_comps (is_cnt, loc, decl, token, tkind,
data_array, sizes_array, kinds_array,
offset_data, offset, num, seq, ctx,
- poly_warned);
+ poly_warned, iterators, new_iterators);
gimple_seq_add_seq (seq, seq2);
}
if (end_label)
@@ -2346,6 +2432,10 @@ gfc_omp_deep_map_kind_p (tree clause)
case GOMP_MAP_FIRSTPRIVATE_POINTER:
case GOMP_MAP_FIRSTPRIVATE_REFERENCE:
case GOMP_MAP_ATTACH_DETACH:
+ case GOMP_MAP_TO_GRID:
+ case GOMP_MAP_FROM_GRID:
+ case GOMP_MAP_GRID_DIM:
+ case GOMP_MAP_GRID_STRIDE:
break;
default:
gcc_unreachable ();
@@ -2420,10 +2510,10 @@ gfc_omp_deep_mapping_p (const gimple *ctx, tree clause)
/* Handle gfc_omp_deep_mapping{,_cnt} */
static tree
-gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
+gfc_omp_deep_mapping_do (bool is_cnt, gimple *ctx, tree clause,
unsigned HOST_WIDE_INT tkind, tree data, tree sizes,
tree kinds, tree offset_data, tree offset,
- gimple_seq *seq)
+ gimple_seq *seq, vec<tree> *new_iterators)
{
tree num = NULL_TREE;
location_t loc = OMP_CLAUSE_LOCATION (clause);
@@ -2538,13 +2628,16 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
gfc_omp_deep_mapping_item (is_cnt, do_copy, do_alloc_check, loc, decl,
&token, tkind, data, sizes, kinds,
offset_data, offset, num, seq, ctx,
- &poly_warned);
+ &poly_warned,
+ OMP_CLAUSE_ITERATORS (clause),
+ new_iterators);
gimple_seq_add_stmt (seq, gimple_build_label (end_label));
}
else
gfc_omp_deep_mapping_item (is_cnt, do_copy, do_alloc_check, loc, decl,
&token, tkind, data, sizes, kinds, offset_data,
- offset, num, seq, ctx, &poly_warned);
+ offset, num, seq, ctx, &poly_warned,
+ OMP_CLAUSE_ITERATORS (clause), new_iterators);
/* Multiply by 2 as there are two mappings: data + pointer assign. */
if (is_cnt)
gimplify_assign (num,
@@ -2557,21 +2650,21 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
/* Return tree with a variable which contains the count of deep-mappyings
(value depends, e.g., on allocation status) */
tree
-gfc_omp_deep_mapping_cnt (const gimple *ctx, tree clause, gimple_seq *seq)
+gfc_omp_deep_mapping_cnt (gimple *ctx, tree clause, gimple_seq *seq)
{
return gfc_omp_deep_mapping_do (true, ctx, clause, 0, NULL_TREE, NULL_TREE,
- NULL_TREE, NULL_TREE, NULL_TREE, seq);
+ NULL_TREE, NULL_TREE, NULL_TREE, seq, NULL);
}
/* Does the actual deep mapping. */
void
-gfc_omp_deep_mapping (const gimple *ctx, tree clause,
+gfc_omp_deep_mapping (gimple *ctx, tree clause,
unsigned HOST_WIDE_INT tkind, tree data,
tree sizes, tree kinds, tree offset_data, tree offset,
- gimple_seq *seq)
+ gimple_seq *seq, vec<tree> *new_iterators)
{
(void) gfc_omp_deep_mapping_do (false, ctx, clause, tkind, data, sizes, kinds,
- offset_data, offset, seq);
+ offset_data, offset, seq, new_iterators);
}
/* Return true if DECL is a scalar variable (for the purpose of
@@ -2830,7 +2923,9 @@ omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
}
static void
-gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
+gfc_trans_omp_array_reduction_or_udr (stmtblock_t *block, tree c,
+ gfc_omp_namelist *n, locus where,
+ bool openacc)
{
gfc_symbol *sym = n->sym;
gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
@@ -2858,6 +2953,98 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
type = TREE_TYPE (type);
}
+ if (openacc)
+ {
+ if ((n->expr == NULL && n->sym->as != NULL)
+ || (n->expr
+ && n->expr->ref->type == REF_ARRAY
+ && n->expr->ref->u.ar.type == AR_FULL))
+ {
+ tree t = build_fold_addr_expr (decl);
+ t = build2 (MEM_REF, type, t,
+ build_int_cst (build_pointer_type (integer_type_node), 0));
+ OMP_CLAUSE_DECL (c) = t;
+ return;
+ }
+
+ if (n->expr
+ && n->expr->expr_type == EXPR_VARIABLE
+ && n->expr->ref->type == REF_ARRAY
+ && !n->expr->ref->next)
+ {
+ bool t = gfc_resolve_expr (n->expr);
+ gcc_assert (t);
+
+ gfc_se se;
+ bool is_element = n->expr->ref->u.ar.type == AR_ELEMENT;
+ tree ptr;
+ gfc_init_se (&se, NULL);
+ if (is_element)
+ {
+ gfc_conv_expr_reference (&se, n->expr);
+ gfc_add_block_to_block (block, &se.pre);
+ ptr = se.expr;
+
+ tree elem_type;
+ tree type
+ = build_range_type (TREE_TYPE (TREE_TYPE (ptr)),
+ integer_zero_node,
+ integer_zero_node);
+ elem_type = build_array_type (TREE_TYPE (type), type);
+ gcc_assert (TREE_CODE (ptr) == ADDR_EXPR
+ && TREE_CODE (TREE_OPERAND (ptr, 0)) == ARRAY_REF);
+ tree aref = TREE_OPERAND (ptr, 0);
+ tree array = TREE_OPERAND (aref, 0);
+ tree offset = TREE_OPERAND (aref, 1);
+ tree t = build2 (POINTER_PLUS_EXPR,
+ build_pointer_type (elem_type),
+ build_fold_addr_expr (array),
+ fold_convert (size_type_node, offset));
+ t = build2 (MEM_REF, elem_type, t, null_pointer_node);
+ OMP_CLAUSE_DECL (c) = t;
+ return;
+ }
+ else
+ {
+ gfc_conv_expr_descriptor (&se, n->expr);
+ gfc_add_block_to_block (block, &se.pre);
+
+ ptr = gfc_conv_array_data (se.expr);
+ tree type = TREE_TYPE (TREE_TYPE (TREE_TYPE (ptr)));
+ tree idx
+ = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (se.expr)) - 1];
+ tree sz
+ = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ gfc_conv_descriptor_ubound_get (se.expr, idx),
+ gfc_conv_descriptor_lbound_get (se.expr, idx));
+ sz = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+ sz, gfc_index_one_node);
+ tree domain
+ = build_index_type (fold_build2 (MINUS_EXPR,
+ gfc_array_index_type,
+ sz, gfc_index_one_node));
+ tree t, array_type = build_array_type (type, domain, false);
+ tree offset = create_tmp_var (sizetype);
+ t = build2 (MINUS_EXPR, sizetype,
+ fold_convert (sizetype, ptr),
+ fold_convert (sizetype,
+ build_fold_addr_expr (decl)));
+ t = build2 (MODIFY_EXPR, sizetype, offset, t);
+ gfc_add_expr_to_block (block, t);
+
+ t = build2 (POINTER_PLUS_EXPR, build_pointer_type (array_type),
+ build_fold_addr_expr (decl), offset);
+ t = build2 (MEM_REF, array_type, t, null_pointer_node);
+ OMP_CLAUSE_DECL (c) = t;
+ return;
+ }
+ gcc_assert (se.post.head == NULL_TREE);
+ gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
+ OMP_CLAUSE_DECL (c) = build_fold_indirect_ref (ptr);
+ return;
+ }
+ }
+
/* Create a fake symbol for init value. */
memset (&init_val_sym, 0, sizeof (init_val_sym));
init_val_sym.ns = sym->ns;
@@ -3085,21 +3272,24 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
poplevel (0, 0);
OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
- /* Create the merge statement list. */
- pushlevel ();
- if (e4)
- stmt = gfc_trans_assignment (e3, e4, false, true);
- else
- stmt = gfc_trans_call (n->u2.udr->combiner, false,
- NULL_TREE, NULL_TREE, false);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
+ if (!openacc)
+ {
+ /* Create the merge statement list. */
+ pushlevel ();
+ if (e4)
+ stmt = gfc_trans_assignment (e3, e4, false, true);
+ else
+ stmt = gfc_trans_call (n->u2.udr->combiner, false,
+ NULL_TREE, NULL_TREE, false);
+ if (TREE_CODE (stmt) != BIND_EXPR)
+ stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
+ else
+ poplevel (0, 0);
+ OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
- /* And stick the placeholder VAR_DECL into the clause as well. */
- OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
+ /* And stick the placeholder VAR_DECL into the clause as well. */
+ OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
+ }
gfc_current_locus = old_loc;
@@ -3129,8 +3319,10 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
}
static tree
-gfc_trans_omp_reduction_list (int kind, gfc_omp_namelist *namelist, tree list,
- locus where, bool mark_addressable)
+gfc_trans_omp_reduction_list (stmtblock_t *block, int kind,
+ gfc_omp_namelist *namelist, tree list,
+ locus where, bool mark_addressable,
+ bool openacc)
{
omp_clause_code clause = OMP_CLAUSE_REDUCTION;
switch (kind)
@@ -3210,7 +3402,8 @@ gfc_trans_omp_reduction_list (int kind, gfc_omp_namelist *namelist, tree list,
if (namelist->sym->attr.dimension
|| namelist->u.reduction_op == OMP_REDUCTION_USER
|| namelist->sym->attr.allocatable)
- gfc_trans_omp_array_reduction_or_udr (node, namelist, where);
+ gfc_trans_omp_array_reduction_or_udr (block, node, namelist,
+ where, openacc);
list = gfc_trans_add_clause (node, list);
}
}
@@ -3234,15 +3427,18 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
static vec<tree, va_heap, vl_embed> *doacross_steps;
-
/* Translate an array section or array element. */
static void
-gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
+gfc_trans_omp_array_section (stmtblock_t *block, toc_directive cd,
gfc_omp_namelist *n, tree decl, bool element,
- bool openmp, gomp_map_kind ptr_kind, tree &node,
- tree &node2, tree &node3, tree &node4)
+ gomp_map_kind ptr_kind, tree &node,
+ tree &node2, tree &node3, tree &node4,
+ tree iterator)
{
+ bool openmp = (cd < TOC_OPENACC);
+ bool omp_exit_data = (cd == TOC_OPENMP_EXIT_DATA);
+ bool oacc_exit_data = (cd == TOC_OPENACC_EXIT_DATA);
gfc_se se;
tree ptr, ptr2;
tree elemsz = NULL_TREE;
@@ -3278,13 +3474,15 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
{
tree type = TREE_TYPE (se.expr);
gfc_add_block_to_block (block, &se.pre);
- OMP_CLAUSE_SIZE (node) = gfc_full_array_size (block, se.expr,
- GFC_TYPE_ARRAY_RANK (type));
if (!elemsz)
elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
elemsz = fold_convert (gfc_array_index_type, elemsz);
- OMP_CLAUSE_SIZE (node) = fold_build2 (MULT_EXPR, gfc_array_index_type,
- OMP_CLAUSE_SIZE (node), elemsz);
+ tree size = gfc_full_array_size (block, se.expr,
+ GFC_TYPE_ARRAY_RANK (type));
+ size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, elemsz);
+ if (OMP_CLAUSE_CODE (node) == OMP_CLAUSE_MAP)
+ OMP_CLAUSE_SIZE (node) = size;
+
if (n->expr->ts.type == BT_DERIVED
&& n->expr->ts.u.derived->attr.alloc_comp)
{
@@ -3306,7 +3504,7 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
if (POINTER_TYPE_P (TREE_TYPE (decl))
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
&& ptr_kind == GOMP_MAP_POINTER
- && op != EXEC_OMP_TARGET_EXIT_DATA
+ && !omp_exit_data
&& OMP_CLAUSE_MAP_KIND (node) != GOMP_MAP_RELEASE
&& OMP_CLAUSE_MAP_KIND (node) != GOMP_MAP_DELETE)
@@ -3325,8 +3523,7 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
gomp_map_kind map_kind;
if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_DELETE)
map_kind = OMP_CLAUSE_MAP_KIND (node);
- else if (op == EXEC_OMP_TARGET_EXIT_DATA
- || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE)
+ else if (omp_exit_data || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE)
map_kind = GOMP_MAP_RELEASE;
else
map_kind = GOMP_MAP_TO;
@@ -3344,9 +3541,8 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
OMP_CLAUSE_DECL (node2) = decl;
OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_DELETE
- || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE
- || op == EXEC_OMP_TARGET_EXIT_DATA
- || op == EXEC_OACC_EXIT_DATA)
+ || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE || omp_exit_data
+ || oacc_exit_data)
{
gomp_map_kind map_kind
= OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_DELETE ? GOMP_MAP_DELETE
@@ -3377,6 +3573,15 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
fold_convert (ptrdiff_type_node, ptr2));
offset = build2 (TRUNC_DIV_EXPR, ptrdiff_type_node,
offset, fold_convert (ptrdiff_type_node, elemsz));
+
+ if (!openmp)
+ {
+ tree offset_tmp = create_tmp_var (ptrdiff_type_node);
+ gfc_add_expr_to_block (block, build2 (MODIFY_EXPR,
+ ptrdiff_type_node,
+ offset_tmp, offset));
+ offset = offset_tmp;
+ }
offset = build4_loc (input_location, ARRAY_REF,
TREE_TYPE (TREE_TYPE (decl)),
decl, offset, NULL_TREE, NULL_TREE);
@@ -3395,9 +3600,128 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
OMP_CLAUSE_DECL (node3) = decl;
}
- ptr2 = fold_convert (ptrdiff_type_node, ptr2);
- OMP_CLAUSE_SIZE (node3) = fold_build2 (MINUS_EXPR, ptrdiff_type_node,
- ptr, ptr2);
+
+ for (tree it = iterator; it; it = TREE_CHAIN (it))
+ {
+ ptr = simplify_replace_tree (ptr, OMP_ITERATORS_VAR (it),
+ OMP_ITERATORS_BEGIN (it));
+ ptr2 = simplify_replace_tree (ptr2, OMP_ITERATORS_VAR (it),
+ OMP_ITERATORS_BEGIN (it));
+ }
+ ptr = fold_build2 (MINUS_EXPR, ptrdiff_type_node, ptr,
+ fold_convert (ptrdiff_type_node, ptr2));
+ if (!openmp)
+ {
+ tree ptr_tmp = create_tmp_var (ptrdiff_type_node);
+ gfc_add_expr_to_block (block, build2 (MODIFY_EXPR, ptrdiff_type_node,
+ ptr_tmp, ptr));
+ ptr = ptr_tmp;
+ }
+ OMP_CLAUSE_SIZE (node3) = ptr;
+
+ if (n->u.map.readonly)
+ OMP_CLAUSE_MAP_POINTS_TO_READONLY (node3) = 1;
+}
+
+/* CLAUSES is a list of clauses resulting from an "omp declare mapper"
+ instantiation in gimplify.cc. In some cases we don't know if we need to
+ create any extra mapping nodes as a result of mapper expansion until after
+ substitution has taken place, so do that now. */
+
+tree
+gfc_omp_finish_mapper_clauses (tree clauses)
+{
+ tree *clausep = &clauses;
+
+ while (*clausep)
+ {
+ tree n = *clausep;
+
+ if (OMP_CLAUSE_CODE (n) != OMP_CLAUSE_MAP)
+ {
+ clausep = &OMP_CLAUSE_CHAIN (*clausep);
+ continue;
+ }
+
+ tree decl = OMP_CLAUSE_DECL (n);
+
+ switch (OMP_CLAUSE_MAP_KIND (n))
+ {
+ case GOMP_MAP_ALLOC:
+ case GOMP_MAP_TO:
+ case GOMP_MAP_FROM:
+ case GOMP_MAP_TOFROM:
+ case GOMP_MAP_ALWAYS_TO:
+ case GOMP_MAP_ALWAYS_FROM:
+ case GOMP_MAP_ALWAYS_TOFROM:
+ {
+ if ((TREE_CODE (decl) == INDIRECT_REF
+ || (TREE_CODE (decl) == MEM_REF
+ && integer_zerop (TREE_OPERAND (decl, 1))))
+ && DECL_P (TREE_OPERAND (decl, 0)))
+ {
+ tree ptr = TREE_OPERAND (decl, 0);
+ /* A DECL_P pointer arising from a mapper expansion needs a
+ GOMP_MAP_POINTER after it. */
+ tree pnode = build_omp_clause (OMP_CLAUSE_LOCATION (n),
+ OMP_CLAUSE_MAP);
+ /* Should this ever be FIRSTPRIVATE_POINTER or
+ FIRSTPRIVATE_REFERENCE? */
+ OMP_CLAUSE_SET_MAP_KIND (pnode, GOMP_MAP_POINTER);
+ OMP_CLAUSE_DECL (pnode) = ptr;
+ OMP_CLAUSE_SIZE (pnode) = size_zero_node;
+ OMP_CLAUSE_CHAIN (pnode) = OMP_CLAUSE_CHAIN (n);
+ OMP_CLAUSE_CHAIN (n) = pnode;
+ clausep = &OMP_CLAUSE_CHAIN (pnode);
+ continue;
+ }
+ }
+ break;
+
+ default:
+ ;
+ }
+
+ clausep = &OMP_CLAUSE_CHAIN (*clausep);
+ }
+
+ return clauses;
+}
+
+tree
+gfc_omp_extract_mapper_directive (tree fndecl)
+{
+ tree body = DECL_SAVED_TREE (fndecl);
+
+ if (TREE_CODE (body) == BIND_EXPR)
+ body = BIND_EXPR_BODY (body);
+
+ if (TREE_CODE (body) == OMP_DECLARE_MAPPER)
+ return body;
+
+ if (TREE_CODE (body) != STATEMENT_LIST)
+ return error_mark_node;
+
+ tree_stmt_iterator tsi;
+ for (tsi = tsi_start (body); !tsi_end_p (tsi); tsi_next (&tsi))
+ {
+ tree stmt = tsi_stmt (tsi);
+ if (TREE_CODE (stmt) == OMP_DECLARE_MAPPER)
+ {
+ gcc_assert (tsi_one_before_end_p (tsi));
+ return stmt;
+ }
+ }
+
+ return error_mark_node;
+}
+
+tree
+gfc_omp_map_array_section (location_t, tree section)
+{
+ /* For Fortran, detection of attempts to use array sections or full arrays
+ whose elements are mapped with a mapper happens elsewhere. */
+ return section;
}
static tree
@@ -3412,7 +3736,7 @@ handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
tree last = make_tree_vec (6);
tree iter_var = gfc_get_symbol_decl (sym);
tree type = TREE_TYPE (iter_var);
- TREE_VEC_ELT (last, 0) = iter_var;
+ OMP_ITERATORS_VAR (last) = iter_var;
DECL_CHAIN (iter_var) = BLOCK_VARS (block);
BLOCK_VARS (block) = iter_var;
@@ -3422,18 +3746,18 @@ handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
gfc_conv_expr (&se, c->expr);
gfc_add_block_to_block (iter_block, &se.pre);
gfc_add_block_to_block (iter_block, &se.post);
- TREE_VEC_ELT (last, 1) = fold_convert (type,
- gfc_evaluate_now (se.expr,
- iter_block));
+ OMP_ITERATORS_BEGIN (last) = fold_convert (type,
+ gfc_evaluate_now (se.expr,
+ iter_block));
/* end */
c = gfc_constructor_next (c);
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, c->expr);
gfc_add_block_to_block (iter_block, &se.pre);
gfc_add_block_to_block (iter_block, &se.post);
- TREE_VEC_ELT (last, 2) = fold_convert (type,
- gfc_evaluate_now (se.expr,
- iter_block));
+ OMP_ITERATORS_END (last) = fold_convert (type,
+ gfc_evaluate_now (se.expr,
+ iter_block));
/* step */
c = gfc_constructor_next (c);
tree step;
@@ -3450,9 +3774,9 @@ handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
}
else
step = build_int_cst (type, 1);
- TREE_VEC_ELT (last, 3) = step;
+ OMP_ITERATORS_STEP (last) = step;
/* orig_step */
- TREE_VEC_ELT (last, 4) = save_expr (step);
+ OMP_ITERATORS_ORIG_STEP (last) = save_expr (step);
TREE_CHAIN (last) = list;
list = last;
}
@@ -3526,11 +3850,355 @@ get_symbol_rooted_namelist (hash_map<gfc_symbol *,
return NULL;
}
+/* We build an "un-Fortrannish" array-of-arrays here to pass our calculated
+ array bounds to the middle end for strided/rectangular OpenMP
+ "target update" operations. */
+
+static tree
+gfc_trans_omp_arrayshape_type (tree type, vec<tree> *dims)
+{
+ gcc_assert (dims->length () > 0);
+
+ for (unsigned i = 0; i < dims->length (); i++)
+ {
+ tree dim = fold_convert (sizetype, (*dims)[i]);
+ /* We need the index of the last element, not the array size. */
+ dim = size_binop (MINUS_EXPR, dim, size_one_node);
+ tree idxtype = build_index_type (dim);
+ type = build_array_type (type, idxtype);
+ }
+
+ return type;
+}
+
+/* Emit code to find the greatest common divisor of two (gfc_array_index_type)
+ trees to BLOCK. This is Euclid's algorithm:
+
+ int
+ gcd (int a, int b)
+ {
+ int tmp;
+ while (b != 0)
+ {
+ tmp = b;
+ b = a % b;
+ a = tmp;
+ }
+ return a;
+ }
+*/
+
+static void
+gfc_omp_calculate_gcd (stmtblock_t *block, tree dst, tree a, tree b)
+{
+ tree tmp = gfc_create_var (gfc_array_index_type, "tmp");
+ tree avar = gfc_create_var (gfc_array_index_type, "a");
+ tree bvar = gfc_create_var (gfc_array_index_type, "b");
+
+ /* Avoid clobbering the inputs. */
+ gfc_add_modify (block, avar, a);
+ gfc_add_modify (block, bvar, b);
+
+ tree label_cond = gfc_build_label_decl (NULL_TREE);
+ tree label_loop = gfc_build_label_decl (NULL_TREE);
+ TREE_USED (label_cond) = 1;
+ TREE_USED (label_loop) = 1;
+
+ gfc_add_expr_to_block (block, build1_v (GOTO_EXPR, label_cond));
+ gfc_add_expr_to_block (block, build1_v (LABEL_EXPR, label_loop));
+
+ gfc_add_modify (block, tmp, bvar);
+ gfc_add_modify (block, bvar,
+ fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+ gfc_array_index_type, avar, bvar));
+ gfc_add_modify (block, avar, tmp);
+
+ gfc_add_expr_to_block (block, build1_v (LABEL_EXPR, label_cond));
+
+ tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, bvar,
+ gfc_index_zero_node);
+ tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_loop),
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (block, tmp);
+
+ gfc_add_modify (block, dst, avar);
+}
+
+/* Convert a gfortran array descriptor -- specifically the per-dimension
+ strides -- into a form that can be easily translated to a noncontiguous
+ OpenMP "target update" operation. We emit a specialized version of a
+ function like this inline:
+
+ void
+ gfc_desc_to_omp_noncontig_array (int *dims, int *strides, int ndims,
+ int *fstrides, int *flo, int *fhi)
+ {
+ dims[ndims - 1] = (fhi[ndims - 1] - flo[ndims - 1] + 1);
+ strides[0] = fstrides[0];
+ if (ndims > 1)
+ strides[ndims - 1] = 1;
+ if (ndims == 2)
+ dims[0] = fstrides[1];
+ else if (ndims > 2)
+ {
+ int grains[ndims - 2];
+
+ int bigger_grain = fstrides[ndims - 1];
+ for (int i = ndims - 2; i > 0; i--)
+ {
+ grains[i - 1] = gcd (fstrides[i], bigger_grain);
+ bigger_grain = grains[i - 1];
+ }
+
+ int volume = 1;
+ for (int i = 0; i < ndims - 2; i++)
+ {
+ int g = grains[i];
+ dims[i] = g / volume;
+ strides[i + 1] = fstrides[i + 1] / g;
+ volume = volume * dims[i];
+ }
+ dims[ndims - 2] = fstrides[ndims - 1] / volume;
+ }
+ }
+
+ where "fstrides", "flo" and "fhi" represent the stride, low bound and upper
+ bound of each dimension in the Fortran array descriptor.
+
+ (Note that most of the complexity only applies to arrays with more than two
+ dimensions, and the final stanza won't be emitted at all for lower-ranked
+ arrays.)
+
+ The output of the algorithm is a set of dimensions dims[] = { D, C, B, A }
+ "as if" the array was declared like this (in C):
+
+ type arr[A][B][C][D];
+
+ i.e. with the innermost dimension first, and a set of strides (in terms of
+ the step size along each dimension, without previous dimensions multiplied
+ in).
+
+ As an example, if we have an array:
+
+ allocate (arr(18,19,20,21,22))
+
+ and an update operation:
+
+ !$omp target update to(arr(1:3:2,1:4:3,1:5:4,1:6:5,1:7:6))
+
+ the strides we see in the Fortran array descriptor will be:
+
+ 2 54 1368 34200 861840
+
+ as given by:
+
+ 2 = stride0
+ 54 = dim0 * stride1
+ 1368 = dim0 * dim1 * stride2
+ 34200 = dim0 * dim1 * dim2 * stride3
+ 861840 = dim0 * dim1 * dim2 * dim3 * stride4
+
+ where "dimN" are the extents of each dimension (18,19,20,21,22), and
+ "strideN" are the strides in terms of step length along each dimension
+ (2,3,4,5,6).
+
+ We'd like to figure out what the original dimN, strideN were from the
+ Fortran array descriptor, but that's in general impossible. Furthermore,
+ if we naively divide a stride by the preceding stride, the result isn't
+ necessarily an integer, as for e.g.:
+
+ 861840/34200 = 25.2
+
+ What we can do though is figure out the greatest common divisor of
+ each stride and the preceding one, from the largest down, and use those as
+ units of granularity, i.e. the size of the corresponding dimension we pass
+ to the middle-end/runtime. The stepwise stride is then the number of
+ times each "grain" fits into the Fortran array descriptor stride.
+
+ The output of the algorithm will be:
+
+ dims strides
+ 18 2
+ 76 3
+ 5 1
+ 126 5
+ 9 1
+
+ These numbers work fine for libgomp target.c:omp_target_memcpy_rect_worker.
+ Multiplying them through also gives the same numbers as the source Fortran
+ array strides, i.e. dim0*dim1*dim2*stride3 (18*76*5*5) = 34200. */
+
+static void
+gfc_desc_to_omp_noncontig_array (stmtblock_t *block, tree *ompdimsp,
+ tree *ompstridesp, tree desc, int ndims)
+{
+ tree lastdim = build_int_cst (gfc_array_index_type, ndims - 1);
+ tree dimrange = build_index_type (lastdim);
+ tree ndimarrtype = build_array_type (gfc_array_index_type, dimrange);
+ tree ompdims = gfc_create_var (ndimarrtype, "dims");
+ tree ompstrides = gfc_create_var (ndimarrtype, "strides");
+
+ *ompdimsp = ompdims;
+ *ompstridesp = ompstrides;
+
+ /* dims[ndims - 1] = (fhi[ndims - 1] - flo[ndims - 1] + 1); */
+ tree lastlbound = gfc_conv_array_lbound (desc, ndims - 1);
+ tree lastubound = gfc_conv_array_ubound (desc, ndims - 1);
+ tree lastrange = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, lastubound,
+ lastlbound);
+ lastrange = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+ lastrange, gfc_index_one_node);
+
+ gfc_add_modify (block,
+ gfc_build_array_ref (ompdims, lastdim, NULL_TREE, true),
+ lastrange);
+
+ /* strides[0] = fstrides[0]; */
+ tree stride0 = gfc_conv_array_stride (desc, 0);
+ gfc_add_modify (block,
+ gfc_build_array_ref (ompstrides, gfc_index_zero_node,
+ NULL_TREE, true),
+ stride0);
+
+ if (ndims > 1)
+ /* strides[ndims - 1] = 1; */
+ gfc_add_modify (block,
+ gfc_build_array_ref (ompstrides, lastdim, NULL_TREE, true),
+ gfc_index_one_node);
+
+ if (ndims == 2)
+ /* dims[0] = fstrides[1]; */
+ gfc_add_modify (block,
+ gfc_build_array_ref (ompdims, gfc_index_zero_node,
+ NULL_TREE, true),
+ gfc_conv_array_stride (desc, 1));
+ else if (ndims > 2)
+ {
+ /* int grains[ndims - 2]; */
+ tree lastgrain = build_int_cst (gfc_array_index_type, ndims - 3);
+ tree grainrange = build_index_type (lastgrain);
+ tree grainarrtype = build_array_type (gfc_array_index_type, grainrange);
+ tree grains = gfc_create_var (grainarrtype, "grains");
+
+ /* int bigger_grain = fstrides[ndims - 1]; */
+ tree bigger_grain = gfc_create_var (gfc_array_index_type, "bigger_grain");
+ tree fstridem1 = gfc_conv_array_stride (desc, ndims - 1);
+ gfc_add_modify (block, bigger_grain, fstridem1);
+
+ /*
+ for (int i = ndims - 2; i > 0; i--)
+ {
+ grains[i - 1] = gcd (fstrides[i], bigger_grain);
+ bigger_grain = grains[i - 1];
+ }
+ */
+ stmtblock_t loop_body;
+ gfc_init_block (&loop_body);
+
+ tree idx = gfc_create_var (gfc_array_index_type, "idx");
+
+ tree gcdtmp = gfc_create_var (gfc_array_index_type, "tmp");
+ gfc_omp_calculate_gcd (&loop_body, gcdtmp,
+ gfc_conv_descriptor_stride_get (desc, idx),
+ bigger_grain);
+ tree idxm1 = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, idx,
+ gfc_index_one_node);
+ gfc_add_modify (&loop_body,
+ gfc_build_array_ref (grains, idxm1, NULL_TREE, true),
+ gcdtmp);
+ gfc_add_modify (&loop_body, bigger_grain, gcdtmp);
+
+ gfc_simple_for_loop (block, idx,
+ build_int_cst (gfc_array_index_type, ndims - 2),
+ gfc_index_zero_node, GT_EXPR,
+ build_int_cst (gfc_array_index_type, -1),
+ gfc_finish_block (&loop_body));
+ /*
+ int volume = 1;
+ for (int i = 0; i < ndims - 2; i++)
+ {
+ int g = grains[i];
+ dims[i] = g / volume;
+ strides[i + 1] = fstrides[i + 1] / g;
+ volume = volume * dims[i];
+ }
+ */
+ tree volume = gfc_create_var (gfc_array_index_type, "volume");
+ gfc_add_modify (block, volume, gfc_index_one_node);
+
+ gfc_init_block (&loop_body);
+ tree grain = gfc_create_var (gfc_array_index_type, "grain");
+ gfc_add_modify (&loop_body, grain,
+ gfc_build_array_ref (grains, idx, NULL_TREE, true));
+ tree dims_i = gfc_build_array_ref (ompdims, idx, NULL_TREE, true);
+ gfc_add_modify (&loop_body, dims_i,
+ fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ gfc_array_index_type, grain, volume));
+ tree nidx = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, idx,
+ gfc_index_one_node);
+ tree strides_ni = gfc_build_array_ref (ompstrides, nidx, NULL_TREE, true);
+ tree fstrides_ni = gfc_conv_descriptor_stride_get (desc, nidx);
+ gfc_add_modify (&loop_body, strides_ni,
+ fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ gfc_array_index_type, fstrides_ni,
+ grain));
+ gfc_add_modify (&loop_body, volume,
+ fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, volume, dims_i));
+
+ gfc_simple_for_loop (block, idx, gfc_index_zero_node,
+ build_int_cst (gfc_array_index_type, ndims - 2),
+ LT_EXPR, gfc_index_one_node,
+ gfc_finish_block (&loop_body));
+
+ /* dims[ndims - 2] = fstrides[ndims - 1] / volume; */
+ tree dimsm2
+ = gfc_build_array_ref (ompdims,
+ build_int_cst (gfc_array_index_type, ndims - 2),
+ NULL_TREE, true);
+ gfc_add_modify (block, dimsm2,
+ fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+ gfc_array_index_type, fstridem1,
+ volume));
+ }
+}
+
+/* Return TRUE if update for N can definitely be done with a single contiguous
+ transfer. If no or if we can't tell, return FALSE. */
+
+static bool
+gfc_omp_contiguous_update_p (gfc_omp_namelist *n)
+{
+ gfc_expr *contig_expr = n->expr;
+
+ if (!n->expr)
+ {
+ if (n->sym->attr.contiguous)
+ return true;
+
+ tree desc = gfc_trans_omp_variable (n->sym, false);
+ tree type = TREE_TYPE (desc);
+ if (!GFC_ARRAY_TYPE_P (type) && !GFC_DESCRIPTOR_TYPE_P (type))
+ return true;
+
+ contig_expr = gfc_lval_expr_from_sym (n->sym);
+ }
+
+ return gfc_is_simply_contiguous (contig_expr, false, true);
+}
+
static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
- locus where, bool declare_simd = false,
- bool openacc = false, gfc_exec_op op = EXEC_NOP)
+ locus where, toc_directive cd = TOC_OPENMP)
{
+ bool declare_simd = (cd == TOC_OPENMP_DECLARE_SIMD);
+ bool openacc = (cd >= TOC_OPENACC);
+ bool declare_mapper = (cd == TOC_OPENMP_DECLARE_MAPPER);
+ bool omp_exit_data = (cd == TOC_OPENMP_EXIT_DATA);
+ bool oacc_exit_data = (cd == TOC_OPENACC_EXIT_DATA);
tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c;
tree iterator = NULL_TREE;
tree tree_block = NULL_TREE;
@@ -3560,8 +4228,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_LIST_TASK_REDUCTION:
/* An OpenACC async clause indicates the need to set reduction
arguments addressable, to allow asynchronous copy-out. */
- omp_clauses = gfc_trans_omp_reduction_list (list, n, omp_clauses,
- where, clauses->async);
+ omp_clauses = gfc_trans_omp_reduction_list (block, list, n, omp_clauses,
+ where, clauses->async,
+ openacc);
break;
case OMP_LIST_PRIVATE:
clause_code = OMP_CLAUSE_PRIVATE;
@@ -3723,7 +4392,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, n->u2.allocator);
gfc_add_block_to_block (block, &se.pre);
- allocator_ = gfc_evaluate_now (se.expr, block);
+ t = se.expr;
+ if (DECL_P (t) && se.post.head == NULL_TREE)
+ allocator_ = (POINTER_TYPE_P (TREE_TYPE (t))
+ ? build_fold_indirect_ref (t): t);
+ else
+ allocator_ = gfc_evaluate_now (t, block);
gfc_add_block_to_block (block, &se.post);
}
OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
@@ -3862,7 +4536,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (iterator && prev->u2.ns != n->u2.ns)
{
BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
- TREE_VEC_ELT (iterator, 5) = tree_block;
+ OMP_ITERATORS_BLOCK (iterator) = tree_block;
for (tree c = omp_clauses; c != prev_clauses;
c = OMP_CLAUSE_CHAIN (c))
OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
@@ -4019,7 +4693,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (iterator)
{
BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
- TREE_VEC_ELT (iterator, 5) = tree_block;
+ OMP_ITERATORS_BLOCK (iterator) = tree_block;
for (tree c = omp_clauses; c != prev_clauses;
c = OMP_CLAUSE_CHAIN (c))
OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
@@ -4027,11 +4701,64 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
break;
case OMP_LIST_MAP:
+ iterator = NULL_TREE;
+ prev = NULL;
+ prev_clauses = omp_clauses;
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.referenced)
continue;
+ if (iterator && prev->u2.ns != n->u2.ns)
+ {
+ /* Finish previous iterator group. */
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ OMP_ITERATORS_BLOCK (iterator) = tree_block;
+ for (tree c = omp_clauses; c != prev_clauses;
+ c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_POINTER
+ && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+ OMP_CLAUSE_ITERATORS (c) = iterator;
+ prev_clauses = omp_clauses;
+ iterator = NULL_TREE;
+ }
+ if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
+ {
+ /* Start a new iterator group. */
+ gfc_init_block (&iter_block);
+ tree_block = make_node (BLOCK);
+ TREE_USED (tree_block) = 1;
+ BLOCK_VARS (tree_block) = NULL_TREE;
+ prev_clauses = omp_clauses;
+ iterator = handle_iterator (n->u2.ns, block, tree_block);
+ }
+ if (!iterator)
+ gfc_init_block (&iter_block);
+ prev = n;
+
+ /* We do not want to include allocatable vars in a synthetic
+ "acc data" region created for "!$acc declare create" vars.
+ Such variables are handled by augmenting allocate/deallocate
+ statements elsewhere (with
+ "acc enter data declare_allocate(...)", etc.). */
+ if (cd == TOC_OPENACC_DECLARE
+ && n->u.map.op == OMP_MAP_ALLOC
+ && n->sym->attr.allocatable
+ && n->sym->attr.oacc_declare_create)
+ {
+ tree tree_var = gfc_get_symbol_decl (n->sym);
+ if (!lookup_attribute ("oacc declare create",
+ DECL_ATTRIBUTES (tree_var)))
+ DECL_ATTRIBUTES (tree_var)
+ = tree_cons (get_identifier ("oacc declare create"),
+ NULL_TREE, DECL_ATTRIBUTES (tree_var));
+ /* We might need to turn what would normally be a
+ "firstprivate" mapping into a "present" mapping. For the
+ latter, we need the decl to be addressable. */
+ TREE_ADDRESSABLE (tree_var) = 1;
+ continue;
+ }
+
location_t map_loc = gfc_get_location (&n->where);
bool always_modifier = false;
tree node = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
@@ -4133,6 +4860,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_MAP_FORCE_DEVICEPTR:
OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR);
break;
+ case OMP_MAP_DECLARE_ALLOCATE:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DECLARE_ALLOCATE);
+ break;
+ case OMP_MAP_DECLARE_DEALLOCATE:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DECLARE_DEALLOCATE);
+ break;
+ case OMP_MAP_POINTER_ONLY:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC);
+ break;
+ case OMP_MAP_UNSET:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_UNSET);
+ break;
default:
gcc_unreachable ();
}
@@ -4176,7 +4915,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
&& n->sym->ts.deferred
&& n->sym->attr.omp_declare_target
&& (always_modifier || n->sym->attr.pointer)
- && op != EXEC_OMP_TARGET_EXIT_DATA
+ && !omp_exit_data
&& n->u.map.op != OMP_MAP_DELETE
&& n->u.map.op != OMP_MAP_RELEASE)
{
@@ -4205,6 +4944,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
goto finalize_map_clause;
}
else if (POINTER_TYPE_P (type)
+ && n->u.map.op == OMP_MAP_FORCE_DEVICEPTR)
+ {
+ OMP_CLAUSE_DECL (node) = decl;
+ goto finalize_map_clause;
+ }
+ else if (POINTER_TYPE_P (type)
&& (gfc_omp_privatize_by_reference (decl)
|| GFC_DECL_GET_SCALAR_POINTER (decl)
|| GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
@@ -4232,7 +4977,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
TRUTH_NOT_EXPR,
boolean_type_node,
present);
- gfc_add_expr_to_block (block,
+ gfc_add_expr_to_block (&iter_block,
build3_loc (input_location,
COND_EXPR,
void_type_node,
@@ -4240,15 +4985,23 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
NULL_TREE));
}
/* For descriptor types, the unmapping happens below. */
- if (op != EXEC_OMP_TARGET_EXIT_DATA
+ if (!omp_exit_data
|| !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
{
enum gomp_map_kind gmk = GOMP_MAP_POINTER;
- if (op == EXEC_OMP_TARGET_EXIT_DATA
- && n->u.map.op == OMP_MAP_DELETE)
+ if (omp_exit_data && n->u.map.op == OMP_MAP_DELETE)
gmk = GOMP_MAP_DELETE;
- else if (op == EXEC_OMP_TARGET_EXIT_DATA)
+ else if (omp_exit_data)
gmk = GOMP_MAP_RELEASE;
+ else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
+ && n->sym->attr.oacc_declare_create
+ && n->u.map.op != OMP_MAP_FORCE_FROM)
+ {
+ if (clauses->update_allocatable)
+ gmk = GOMP_MAP_ALWAYS_POINTER;
+ else
+ gmk = GOMP_MAP_FIRSTPRIVATE_POINTER;
+ }
tree size;
if (gmk == GOMP_MAP_RELEASE || gmk == GOMP_MAP_DELETE)
size = TYPE_SIZE_UNIT (TREE_TYPE (decl));
@@ -4266,10 +5019,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
|| GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
{
enum gomp_map_kind gmk;
- if (op == EXEC_OMP_TARGET_EXIT_DATA
- && n->u.map.op == OMP_MAP_DELETE)
+ if (omp_exit_data && n->u.map.op == OMP_MAP_DELETE)
gmk = GOMP_MAP_DELETE;
- else if (op == EXEC_OMP_TARGET_EXIT_DATA)
+ else if (omp_exit_data)
gmk = GOMP_MAP_RELEASE;
else
gmk = GOMP_MAP_POINTER;
@@ -4290,7 +5042,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree type = TREE_TYPE (decl);
tree ptr = gfc_conv_descriptor_data_get (decl);
if (present)
- ptr = gfc_build_cond_assign_expr (block, present, ptr,
+ ptr = gfc_build_cond_assign_expr (&iter_block,
+ present, ptr,
null_pointer_node);
gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
ptr = build_fold_indirect_ref (ptr);
@@ -4300,14 +5053,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
if (n->u.map.op == OMP_MAP_DELETE)
map_kind = GOMP_MAP_DELETE;
- else if (op == EXEC_OMP_TARGET_EXIT_DATA
- || n->u.map.op == OMP_MAP_RELEASE)
+ else if (omp_exit_data || n->u.map.op == OMP_MAP_RELEASE)
map_kind = GOMP_MAP_RELEASE;
else
map_kind = GOMP_MAP_TO_PSET;
OMP_CLAUSE_SET_MAP_KIND (node2, map_kind);
- if (op != EXEC_OMP_TARGET_EXIT_DATA
+ if (!omp_exit_data
&& n->u.map.op != OMP_MAP_DELETE
&& n->u.map.op != OMP_MAP_RELEASE)
{
@@ -4317,7 +5069,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
ptr = gfc_conv_descriptor_data_get (decl);
ptr = gfc_build_addr_expr (NULL, ptr);
ptr = gfc_build_cond_assign_expr (
- block, present, ptr, null_pointer_node);
+ &iter_block, present, ptr, null_pointer_node);
ptr = build_fold_indirect_ref (ptr);
OMP_CLAUSE_DECL (node3) = ptr;
}
@@ -4406,7 +5158,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
TRUTH_ANDIF_EXPR,
boolean_type_node,
present, cond);
- gfc_add_expr_to_block (block,
+ gfc_add_expr_to_block (&iter_block,
build3_loc (input_location,
COND_EXPR,
void_type_node,
@@ -4435,12 +5187,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree cond = build3_loc (input_location, COND_EXPR,
void_type_node, present,
cond_body, NULL_TREE);
- gfc_add_expr_to_block (block, cond);
+ gfc_add_expr_to_block (&iter_block, cond);
OMP_CLAUSE_SIZE (node) = var;
}
else
{
- gfc_add_block_to_block (block, &cond_block);
+ gfc_add_block_to_block (&iter_block, &cond_block);
OMP_CLAUSE_SIZE (node) = size;
}
}
@@ -4452,8 +5204,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
/* A single indirectref is handled by the middle end. */
gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
tree tmp = TREE_OPERAND (decl, 0);
- tmp = gfc_build_cond_assign_expr (block, present, tmp,
- null_pointer_node);
+ tmp = gfc_build_cond_assign_expr (&iter_block,
+ present, tmp,
+ null_pointer_node);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (tmp);
}
else
@@ -4486,7 +5239,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
size_type_node,
cond, size,
size_zero_node);
- size = gfc_evaluate_now (size, block);
+ size = gfc_evaluate_now (size, &iter_block);
OMP_CLAUSE_SIZE (node) = size;
}
if ((TREE_CODE (decl) != PARM_DECL
@@ -4502,7 +5255,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tmp = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
: TYPE_SIZE_UNIT (TREE_TYPE (decl));
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (decl) == INDIRECT_REF)
@@ -4532,9 +5286,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
&& !(POINTER_TYPE_P (type)
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))))
k = GOMP_MAP_FIRSTPRIVATE_POINTER;
- gfc_trans_omp_array_section (block, op, n, decl, element,
- !openacc, k, node, node2,
- node3, node4);
+ gfc_trans_omp_array_section (&iter_block,
+ cd, n, decl, element,
+ k, node, node2, node3, node4,
+ iterator);
}
else if (n->expr
&& n->expr->expr_type == EXPR_VARIABLE
@@ -4550,12 +5305,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, n->expr);
- gfc_add_block_to_block (block, &se.pre);
+ gfc_add_block_to_block (&iter_block, &se.pre);
/* For BT_CHARACTER a pointer is returned. */
OMP_CLAUSE_DECL (node)
= POINTER_TYPE_P (TREE_TYPE (se.expr))
? build_fold_indirect_ref (se.expr) : se.expr;
- gfc_add_block_to_block (block, &se.post);
+ gfc_add_block_to_block (&iter_block, &se.post);
if (pointer || allocatable)
{
/* If it's a bare attach/detach clause, we just want
@@ -4593,7 +5348,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gomp_map_kind kind;
if (n->u.map.op == OMP_MAP_DELETE)
kind = GOMP_MAP_DELETE;
- else if (op == EXEC_OMP_TARGET_EXIT_DATA)
+ else if (omp_exit_data)
kind = GOMP_MAP_RELEASE;
else
kind = GOMP_MAP_TO;
@@ -4616,7 +5371,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
? DECL_SIZE_UNIT (se.expr)
: TYPE_SIZE_UNIT (TREE_TYPE (se.expr)));
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (se.expr) == INDIRECT_REF)
@@ -4652,8 +5408,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (ref->u.ar.type == AR_ELEMENT && ref->next)
gfc_conv_array_ref (&se, &ref->u.ar, n->expr,
&n->expr->where);
- else
- gcc_assert (!ref->next);
+ else if (ref->next)
+ {
+ gfc_error ("cannot map array in expression "
+ "at %C");
+ OMP_CLAUSE_DECL (node) = error_mark_node;
+ OMP_CLAUSE_SIZE (node) = NULL_TREE;
+ node2 = NULL_TREE;
+ goto finalize_map_clause;
+ }
}
else
sorry_at (gfc_get_location (&n->where),
@@ -4681,6 +5444,17 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_SIZE (node) = size_zero_node;
goto finalize_map_clause;
}
+ else if (n->u.map.op == OMP_MAP_POINTER_ONLY)
+ {
+ /* A descriptor must be copied to the target. */
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))
+ OMP_CLAUSE_SET_MAP_KIND (node,
+ GOMP_MAP_ALWAYS_TO);
+ OMP_CLAUSE_DECL (node) = inner;
+ OMP_CLAUSE_SIZE (node)
+ = TYPE_SIZE_UNIT (TREE_TYPE (inner));
+ goto finalize_map_clause;
+ }
gfc_omp_namelist *n2
= openacc ? NULL : clauses->lists[OMP_LIST_MAP];
@@ -4768,7 +5542,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
to ensure that it is not gimplified + is a decl. */
tree tmp = OMP_CLAUSE_SIZE (node);
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (inner) == INDIRECT_REF)
@@ -4796,6 +5571,16 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_SIZE (node) = size_zero_node;
goto finalize_map_clause;
}
+ else if (n->u.map.op == OMP_MAP_POINTER_ONLY)
+ {
+ /* A descriptor must be copied to the target. */
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO);
+ OMP_CLAUSE_DECL (node) = inner;
+ OMP_CLAUSE_SIZE (node)
+ = TYPE_SIZE_UNIT (TREE_TYPE (inner));
+ goto finalize_map_clause;
+ }
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))
{
@@ -4806,7 +5591,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_DECL (node) = ptr;
int rank = GFC_TYPE_ARRAY_RANK (type);
OMP_CLAUSE_SIZE (node)
- = gfc_full_array_size (block, inner, rank);
+ = gfc_full_array_size (&iter_block, inner, rank);
tree elemsz
= TYPE_SIZE_UNIT (gfc_get_element_type (type));
map_kind = OMP_CLAUSE_MAP_KIND (node);
@@ -4818,8 +5603,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
else if (n->u.map.op == OMP_MAP_RELEASE
|| n->u.map.op == OMP_MAP_DELETE)
;
- else if (op == EXEC_OMP_TARGET_EXIT_DATA
- || op == EXEC_OACC_EXIT_DATA)
+ else if (omp_exit_data || oacc_exit_data)
map_kind = GOMP_MAP_RELEASE;
else
map_kind = GOMP_MAP_ALLOC;
@@ -4868,7 +5652,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree tmp = OMP_CLAUSE_SIZE (node);
tree var = gfc_create_var (TREE_TYPE (tmp),
NULL);
- gfc_add_modify_loc (map_loc, block,
+ gfc_add_modify_loc (map_loc, &iter_block,
var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
@@ -4931,6 +5715,14 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
if (drop_mapping)
continue;
+ if (n->u3.udm && n->u3.udm->multiple_elems_p)
+
+ {
+ gfc_error ("cannot map non-unit size array "
+ "with mapper at %C");
+ node2 = NULL_TREE;
+ goto finalize_map_clause;
+ }
}
node3 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
OMP_CLAUSE_SET_MAP_KIND (node3,
@@ -4958,9 +5750,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
/* An array element or section. */
bool element = lastref->u.ar.type == AR_ELEMENT;
gomp_map_kind kind = GOMP_MAP_ATTACH_DETACH;
- gfc_trans_omp_array_section (block, op, n, inner, element,
- !openacc, kind, node, node2,
- node3, node4);
+ gfc_trans_omp_array_section (&iter_block,
+ cd, n, inner, element,
+ kind, node, node2, node3,
+ node4, iterator);
}
else
gcc_unreachable ();
@@ -4970,25 +5763,129 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
finalize_map_clause:
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- if (node2)
- omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
- if (node3)
- omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
- if (node4)
- omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
- if (node5)
- omp_clauses = gfc_trans_add_clause (node5, omp_clauses);
+ if (!iterator)
+ gfc_add_block_to_block (block, &iter_block);
+
+ /* If we're processing an "omp declare mapper" directive, group
+ together multiple nodes used for some given map clause using
+ GOMP_MAP_MAPPING_GROUP. These are then either flattened or
+ appropriately transformed if they cause a nested mapper to be
+ invoked. */
+
+ if (declare_mapper)
+ {
+ tree cl, container;
+
+ if (node2 || node3 || node4 || node5)
+ cl = tree_cons (node, NULL_TREE, NULL_TREE);
+ else
+ cl = node;
+
+ if (node2)
+ cl = tree_cons (node2, NULL_TREE, cl);
+ if (node3)
+ cl = tree_cons (node3, NULL_TREE, cl);
+ if (node4)
+ cl = tree_cons (node4, NULL_TREE, cl);
+ if (node5)
+ cl = tree_cons (node5, NULL_TREE, cl);
+
+ if (node != cl)
+ {
+ cl = nreverse (cl);
+
+ container = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (container,
+ GOMP_MAP_MAPPING_GROUP);
+ OMP_CLAUSE_DECL (container) = cl;
+ }
+ else
+ container = cl;
+
+ if (n->u3.udm
+ && n->u3.udm->udm->mapper_id
+ && n->u3.udm->udm->mapper_id[0] != '\0')
+ {
+ tree push = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (push, GOMP_MAP_PUSH_MAPPER_NAME);
+ OMP_CLAUSE_DECL (push)
+ = get_identifier (n->u3.udm->udm->mapper_id);
+ tree pop = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (pop, GOMP_MAP_POP_MAPPER_NAME);
+ OMP_CLAUSE_DECL (pop) = null_pointer_node;
+ omp_clauses = gfc_trans_add_clause (push, omp_clauses);
+ omp_clauses = gfc_trans_add_clause (container,
+ omp_clauses);
+ omp_clauses = gfc_trans_add_clause (pop, omp_clauses);
+ }
+ else
+ omp_clauses = gfc_trans_add_clause (container, omp_clauses);
+ }
+ else
+ {
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+
+ if (node2)
+ omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
+ if (node3)
+ omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
+ if (node4)
+ omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
+ if (node5)
+ omp_clauses = gfc_trans_add_clause (node5, omp_clauses);
+ }
+ }
+ if (iterator)
+ {
+ /* Finish last iterator group. */
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ OMP_ITERATORS_BLOCK (iterator) = tree_block;
+ for (tree c = omp_clauses; c != prev_clauses;
+ c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_POINTER
+ && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+ OMP_CLAUSE_ITERATORS (c) = iterator;
}
break;
case OMP_LIST_TO:
case OMP_LIST_FROM:
case OMP_LIST_CACHE:
+ iterator = NULL_TREE;
+ prev = NULL;
+ prev_clauses = omp_clauses;
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.referenced)
continue;
+ if (iterator && prev->u2.ns != n->u2.ns)
+ {
+ /* Finish previous iterator group. */
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ OMP_ITERATORS_BLOCK (iterator) = tree_block;
+ for (tree c = omp_clauses; c != prev_clauses;
+ c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_ITERATORS (c) = iterator;
+ prev_clauses = omp_clauses;
+ iterator = NULL_TREE;
+ }
+ if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
+ {
+ /* Start a new iterator group. */
+ gfc_init_block (&iter_block);
+ tree_block = make_node (BLOCK);
+ TREE_USED (tree_block) = 1;
+ BLOCK_VARS (tree_block) = NULL_TREE;
+ prev_clauses = omp_clauses;
+ iterator = handle_iterator (n->u2.ns, block, tree_block);
+ }
+ if (!iterator)
+ gfc_init_block (&iter_block);
+ prev = n;
+
switch (list)
{
case OMP_LIST_TO:
@@ -5003,6 +5900,168 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
default:
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 || (lastref && lastref->type == REF_ARRAY))
+ && !gfc_omp_contiguous_update_p (n))
+ {
+ int ndims;
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+
+ tree desc, span = NULL_TREE;
+
+ if (n->expr)
+ {
+ if (n->expr->rank)
+ gfc_conv_expr_descriptor (&se, n->expr);
+ else
+ gfc_conv_expr (&se, n->expr);
+
+ desc = se.expr;
+ /* The span is the distance between two array elements
+ along the innermost dimension (there may be padding
+ or other data between elements, e.g. of a derived-type
+ array). */
+ span = gfc_get_array_span (desc, n->expr);
+ ndims = lastref->u.ar.dimen;
+ }
+ else
+ {
+ desc = gfc_trans_omp_variable (n->sym, false);
+ tree type = TREE_TYPE (desc);
+ if (GFC_DESCRIPTOR_TYPE_P (type))
+ span = gfc_conv_descriptor_span_get (desc);
+ ndims = GFC_TYPE_ARRAY_RANK (type);
+ }
+
+ gfc_add_block_to_block (block, &se.pre);
+
+ tree ompdims, ompstrides;
+
+ gfc_desc_to_omp_noncontig_array (block, &ompdims,
+ &ompstrides, desc, ndims);
+
+ tree type = TREE_TYPE (desc);
+ tree etype = gfc_get_element_type (type);
+ tree elsize = fold_convert (gfc_array_index_type,
+ size_in_bytes (etype));
+
+ tree ptr = gfc_conv_array_data (desc);
+ tree offset = gfc_conv_array_offset (desc);
+
+ if (!span)
+ /* The span is the element size. */
+ span = elsize;
+
+ tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+
+ switch (list)
+ {
+ case OMP_LIST_TO:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TO_GRID);
+ break;
+ case OMP_LIST_FROM:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FROM_GRID);
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
+ tree byte_offset = fold_convert (sizetype, offset);
+ byte_offset = size_binop (MULT_EXPR, byte_offset,
+ fold_convert (sizetype, span));
+ tree origin
+ = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
+ TREE_TYPE (ptr), ptr, byte_offset);
+
+ OMP_CLAUSE_SIZE (node) = elsize;
+
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+
+ auto_vec<tree, 5> dims;
+
+ for (int r = 0; r < ndims; r++)
+ {
+ tree d
+ = gfc_build_array_ref (ompdims,
+ build_int_cst
+ (gfc_array_index_type, r),
+ NULL_TREE, true);
+ d = gfc_evaluate_now (d, block);
+ dims.safe_push (d);
+ }
+
+ for (int r = ndims - 1; r >= 0; r--)
+ {
+ tree stride_r, len_r, lowbound_r;
+
+ tree rcst = build_int_cst (gfc_array_index_type, r);
+
+ stride_r = gfc_build_array_ref (ompstrides, rcst,
+ NULL_TREE, true);
+ lowbound_r = gfc_conv_array_lbound (desc, r);
+ len_r
+ = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ gfc_conv_array_ubound (desc, r),
+ lowbound_r);
+ len_r
+ = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ len_r, gfc_index_one_node);
+
+ lowbound_r
+ = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, lowbound_r,
+ stride_r);
+
+ stride_r = gfc_evaluate_now (stride_r, block);
+ lowbound_r = gfc_evaluate_now (lowbound_r, block);
+ len_r = gfc_evaluate_now (len_r, block);
+
+ tree dim = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (dim, GOMP_MAP_GRID_DIM);
+ OMP_CLAUSE_DECL (dim) = lowbound_r;
+ OMP_CLAUSE_SIZE (dim) = len_r;
+
+ omp_clauses = gfc_trans_add_clause (dim, omp_clauses);
+
+ if (!integer_onep (stride_r)
+ || (r == 0 && !operand_equal_p (span, elsize)))
+ {
+ tree snode = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (snode,
+ GOMP_MAP_GRID_STRIDE);
+ OMP_CLAUSE_DECL (snode) = stride_r;
+ if (r == 0 && !operand_equal_p (span, elsize))
+ OMP_CLAUSE_SIZE (snode) = span;
+ omp_clauses = gfc_trans_add_clause (snode,
+ omp_clauses);
+ }
+ }
+ origin = build_fold_indirect_ref (origin);
+ tree eltype = gfc_get_element_type (TREE_TYPE (desc));
+ tree arrtype
+ = gfc_trans_omp_arrayshape_type (eltype, &dims);
+ OMP_CLAUSE_DECL (node)
+ = build1_loc (input_location, VIEW_CONVERT_EXPR,
+ arrtype, origin);
+ continue;
+ }
+
tree node = build_omp_clause (gfc_get_location (&n->where),
clause_code);
if (n->expr == NULL
@@ -5027,7 +6086,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
ptr = build_fold_indirect_ref (ptr);
OMP_CLAUSE_DECL (node) = ptr;
OMP_CLAUSE_SIZE (node)
- = gfc_full_array_size (block, decl,
+ = gfc_full_array_size (&iter_block, decl,
GFC_TYPE_ARRAY_RANK (type));
tree elemsz
= TYPE_SIZE_UNIT (gfc_get_element_type (type));
@@ -5052,7 +6111,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
{
gfc_conv_expr_reference (&se, n->expr);
ptr = se.expr;
- gfc_add_block_to_block (block, &se.pre);
+ gfc_add_block_to_block (&iter_block, &se.pre);
OMP_CLAUSE_SIZE (node)
= TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (ptr)));
}
@@ -5061,9 +6120,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gfc_conv_expr_descriptor (&se, n->expr);
ptr = gfc_conv_array_data (se.expr);
tree type = TREE_TYPE (se.expr);
- gfc_add_block_to_block (block, &se.pre);
+ gfc_add_block_to_block (&iter_block, &se.pre);
OMP_CLAUSE_SIZE (node)
- = gfc_full_array_size (block, se.expr,
+ = gfc_full_array_size (&iter_block, se.expr,
GFC_TYPE_ARRAY_RANK (type));
tree elemsz
= TYPE_SIZE_UNIT (gfc_get_element_type (type));
@@ -5072,7 +6131,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
= fold_build2 (MULT_EXPR, gfc_array_index_type,
OMP_CLAUSE_SIZE (node), elemsz);
}
- gfc_add_block_to_block (block, &se.post);
+ gfc_add_block_to_block (&iter_block, &se.post);
gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
}
@@ -5080,17 +6139,52 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_MOTION_PRESENT (node) = 1;
if (list == OMP_LIST_CACHE && n->u.map.readonly)
OMP_CLAUSE__CACHE__READONLY (node) = 1;
+
+ if (!iterator)
+ gfc_add_block_to_block (block, &iter_block);
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
+ if (iterator)
+ {
+ /* Finish last iterator group. */
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ OMP_ITERATORS_BLOCK (iterator) = tree_block;
+ for (tree c = omp_clauses; c != prev_clauses;
+ c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_ITERATORS (c) = iterator;
+ }
break;
case OMP_LIST_USES_ALLOCATORS:
- /* Ignore pre-defined allocators as no special treatment is needed. */
for (; n != NULL; n = n->next)
- if (n->sym->attr.flavor == FL_VARIABLE)
- break;
- if (n != NULL)
- sorry_at (input_location, "%<uses_allocators%> clause with traits "
- "and memory spaces");
+ {
+ if (!n->sym->attr.referenced)
+ continue;
+ tree node = build_omp_clause (input_location,
+ OMP_CLAUSE_USES_ALLOCATORS);
+ tree t;
+ if (n->sym->attr.flavor == FL_VARIABLE)
+ t = gfc_get_symbol_decl (n->sym);
+ else
+ {
+ t = gfc_conv_mpz_to_tree (n->sym->value->value.integer,
+ n->sym->ts.kind);
+ t = fold_convert (ptr_type_node, t);
+ }
+ OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR(node) = t;
+ if (n->u.memspace_sym)
+ {
+ n->u.memspace_sym->attr.referenced = true;
+ OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (node)
+ = gfc_get_symbol_decl (n->u.memspace_sym);
+ }
+ if (n->u2.traits_sym)
+ {
+ n->u2.traits_sym->attr.referenced = true;
+ OMP_CLAUSE_USES_ALLOCATORS_TRAITS (node)
+ = gfc_get_symbol_decl (n->u2.traits_sym);
+ }
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ }
break;
default:
break;
@@ -5972,7 +7066,7 @@ gfc_trans_oacc_construct (gfc_code *code)
gfc_start_block (&block);
oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, true);
+ code->loc, TOC_OPENACC);
pushlevel ();
stmt = gfc_trans_omp_code (code->block->next, true);
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -5988,12 +7082,14 @@ gfc_trans_oacc_executable_directive (gfc_code *code)
{
stmtblock_t block;
tree stmt, oacc_clauses;
+ gfc_omp_clauses *clauses = code->ext.omp_clauses;
enum tree_code construct_code;
switch (code->op)
{
case EXEC_OACC_UPDATE:
construct_code = OACC_UPDATE;
+ clauses->update_allocatable = 1;
break;
case EXEC_OACC_ENTER_DATA:
construct_code = OACC_ENTER_DATA;
@@ -6009,8 +7105,11 @@ gfc_trans_oacc_executable_directive (gfc_code *code)
}
gfc_start_block (&block);
- oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, true, code->op);
+ oacc_clauses
+ = gfc_trans_omp_clauses (&block, code->ext.omp_clauses, code->loc,
+ construct_code == OACC_EXIT_DATA
+ ? TOC_OPENACC_EXIT_DATA
+ : TOC_OPENACC);
stmt = build1_loc (input_location, construct_code, void_type_node,
oacc_clauses);
gfc_add_expr_to_block (&block, stmt);
@@ -6813,7 +7912,9 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
on the simd construct and DO's clauses are translated elsewhere. */
do_clauses->sched_simd = false;
- omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
+ omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc,
+ (op == EXEC_OACC_LOOP
+ ? TOC_OPENACC : TOC_OPENMP));
for (i = 0; i < collapse; i++)
{
@@ -7258,7 +8359,7 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
if (construct_code == OACC_KERNELS)
construct_clauses.lists[OMP_LIST_REDUCTION] = NULL;
oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
- code->loc, false, true);
+ code->loc, TOC_OPENACC);
}
if (!loop_clauses.seq)
pblock = &block;
@@ -8795,6 +9896,158 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
return gfc_finish_block (&block);
}
+/* Code callback for gfc_code_walker. */
+
+static int
+gfc_record_mapper_bindings_code_fn (gfc_code **, int *, void *)
+{
+ return 0;
+}
+
+template <>
+struct default_hash_traits <omp_name_type<gfc_typespec *>>
+ : typed_noop_remove <omp_name_type<gfc_typespec *>>
+{
+ GTY((skip)) typedef omp_name_type<gfc_typespec *> value_type;
+ GTY((skip)) typedef omp_name_type<gfc_typespec *> compare_type;
+
+ static hashval_t
+ hash (omp_name_type<gfc_typespec *> p)
+ {
+ tree typenode = gfc_typenode_for_spec (p.type);
+ return p.name ? iterative_hash_expr (p.name, TYPE_UID (typenode))
+ : TYPE_UID (typenode);
+ }
+
+ static const bool empty_zero_p = true;
+
+ static bool
+ is_empty (omp_name_type<gfc_typespec *> p)
+ {
+ return p.type == NULL;
+ }
+
+ static bool
+ is_deleted (omp_name_type<gfc_typespec *>)
+ {
+ return false;
+ }
+
+ static bool
+ equal (const omp_name_type<gfc_typespec *> &a,
+ const omp_name_type<gfc_typespec *> &b)
+ {
+ if (a.name == NULL_TREE && b.name == NULL_TREE)
+ return a.type == b.type;
+ else if (a.name == NULL_TREE || b.name == NULL_TREE)
+ return false;
+ else
+ return a.name == b.name && gfc_compare_types (a.type, b.type);
+ }
+
+ static void
+ mark_empty (omp_name_type<gfc_typespec *> &e)
+ {
+ e.type = NULL;
+ }
+};
+
+
+extern gfc_namespace *omp_declare_mapper_ns;
+
+/* Conceptually similar to c-omp.cc:c_omp_find_nested_mappers, but using
+ Fortran typespec to idenfify mappers. */
+
+static void
+gfc_find_nested_mappers (omp_mapper_list<gfc_typespec *> *mlist,
+ gfc_omp_udm *udm)
+{
+ gfc_omp_namelist *ns = udm->clauses->lists[OMP_LIST_MAP];
+
+ for (; ns; ns = ns->next)
+ {
+ if (ns->u3.udm && ns->u3.udm->udm != udm)
+ {
+ gfc_omp_udm *nested_udm = ns->u3.udm->udm;
+ tree mapper_id
+ = (nested_udm->mapper_id ? get_identifier (nested_udm->mapper_id)
+ : NULL_TREE);
+ mlist->add_mapper (mapper_id, &nested_udm->ts,
+ nested_udm->backend_decl);
+ gfc_find_nested_mappers (mlist, nested_udm);
+ }
+ }
+}
+
+/* Expr callback for gfc_code_walker. */
+
+static int
+gfc_record_mapper_bindings_expr_fn (gfc_expr **exprp, int *, void *data)
+{
+ gfc_typespec *ts = NULL;
+ omp_mapper_list<gfc_typespec *> *mlist
+ = (omp_mapper_list<gfc_typespec *> *) data;
+
+ if ((*exprp)->symtree)
+ {
+ gfc_symbol *sym = (*exprp)->symtree->n.sym;
+ if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
+ ts = &sym->ts;
+ }
+ else if ((*exprp)->base_expr)
+ {
+ gfc_expr *base_expr = (*exprp)->base_expr;
+ if (base_expr->ts.type == BT_DERIVED || base_expr->ts.type == BT_CLASS)
+ ts = &base_expr->ts;
+ }
+
+ if (!ts)
+ return 0;
+
+ gfc_omp_udm *udm = gfc_find_omp_udm (omp_declare_mapper_ns, "", ts);
+
+ if (udm)
+ {
+ mlist->add_mapper (NULL_TREE, &udm->ts, udm->backend_decl);
+ gfc_find_nested_mappers (mlist, udm);
+ }
+
+ return 0;
+}
+
+static void
+gfc_record_mapper_bindings (tree *clauses, gfc_code *code)
+{
+ hash_set<omp_name_type<gfc_typespec *>> seen_types;
+ auto_vec<tree> mappers;
+ omp_mapper_list<gfc_typespec *> mlist (&seen_types, &mappers);
+
+ gfc_code_walker (&code, gfc_record_mapper_bindings_code_fn,
+ gfc_record_mapper_bindings_expr_fn, (void *) &mlist);
+
+ unsigned int i;
+ tree mapperfn;
+ FOR_EACH_VEC_ELT (mappers, i, mapperfn)
+ {
+ tree mapper = gfc_omp_extract_mapper_directive (mapperfn);
+ if (mapper == error_mark_node)
+ continue;
+ tree mapper_name = OMP_DECLARE_MAPPER_ID (mapper);
+ tree decl = OMP_DECLARE_MAPPER_DECL (mapper);
+
+ if (mapper_name && IDENTIFIER_POINTER (mapper_name)[0] == '\0')
+ mapper_name = NULL_TREE;
+
+ tree c = build_omp_clause (input_location, OMP_CLAUSE__MAPPER_BINDING_);
+ OMP_CLAUSE__MAPPER_BINDING__ID (c) = mapper_name;
+ OMP_CLAUSE__MAPPER_BINDING__DECL (c) = decl;
+ OMP_CLAUSE__MAPPER_BINDING__MAPPER (c) = mapperfn;
+
+ OMP_CLAUSE_CHAIN (c) = *clauses;
+ *clauses = c;
+ }
+}
+
static tree
gfc_trans_omp_target (gfc_code *code)
{
@@ -8805,14 +10058,22 @@ gfc_trans_omp_target (gfc_code *code)
gfc_start_block (&block);
gfc_split_omp_clauses (code, clausesa);
if (flag_openmp)
- omp_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET],
- code->loc);
+ {
+ gfc_omp_clauses *target_clauses = &clausesa[GFC_OMP_SPLIT_TARGET];
+ if (!gfc_omp_instantiate_mappers (code, target_clauses))
+ {
+ stmt = error_mark_node;
+ goto done;
+ }
+ omp_clauses = gfc_trans_omp_clauses (&block, target_clauses,
+ code->loc);
+ }
switch (code->op)
{
case EXEC_OMP_TARGET:
pushlevel ();
stmt = gfc_trans_omp_code (code->block->next, true);
+ gfc_record_mapper_bindings (&omp_clauses, code->block->next);
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
break;
case EXEC_OMP_TARGET_PARALLEL:
@@ -8825,6 +10086,7 @@ gfc_trans_omp_target (gfc_code *code)
= gfc_trans_omp_clauses (&iblock, &clausesa[GFC_OMP_SPLIT_PARALLEL],
code->loc);
stmt = gfc_trans_omp_code (code->block->next, true);
+ gfc_record_mapper_bindings (&omp_clauses, code->block->next);
stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
inner_clauses);
gfc_add_expr_to_block (&iblock, stmt);
@@ -8904,6 +10166,7 @@ gfc_trans_omp_target (gfc_code *code)
OMP_TARGET_COMBINED (stmt) = 1;
cfun->has_omp_target = true;
}
+ done:
gfc_add_expr_to_block (&block, stmt);
gfc_free_split_omp_clauses (code, clausesa);
return gfc_finish_block (&block);
@@ -9082,11 +10345,17 @@ gfc_trans_omp_target_data (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 = gfc_trans_omp_code (code->block->next, true);
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET_DATA,
- void_type_node, stmt, omp_clauses);
+ gfc_omp_clauses *target_data_clauses = code->ext.omp_clauses;
+ if (gfc_omp_instantiate_mappers (code, target_data_clauses))
+ {
+ omp_clauses = gfc_trans_omp_clauses (&block, target_data_clauses,
+ code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET_DATA,
+ void_type_node, stmt, omp_clauses);
+ }
+ else
+ stmt = error_mark_node;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
@@ -9098,10 +10367,16 @@ gfc_trans_omp_target_enter_data (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_ENTER_DATA, void_type_node,
- omp_clauses);
+ gfc_omp_clauses *target_enter_data_clauses = code->ext.omp_clauses;
+ if (gfc_omp_instantiate_mappers (code, target_enter_data_clauses))
+ {
+ omp_clauses = gfc_trans_omp_clauses (&block, target_enter_data_clauses,
+ code->loc);
+ stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node,
+ omp_clauses);
+ }
+ else
+ stmt = error_mark_node;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
@@ -9113,10 +10388,17 @@ gfc_trans_omp_target_exit_data (gfc_code *code)
tree stmt, omp_clauses;
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, false, code->op);
- stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,
- omp_clauses);
+ gfc_omp_clauses *target_exit_data_clauses = code->ext.omp_clauses;
+ if (gfc_omp_instantiate_mappers (code, target_exit_data_clauses,
+ TOC_OPENMP_EXIT_DATA))
+ {
+ omp_clauses = gfc_trans_omp_clauses (&block, target_exit_data_clauses,
+ code->loc, TOC_OPENMP_EXIT_DATA);
+ stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,
+ omp_clauses);
+ }
+ else
+ stmt = error_mark_node;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
@@ -9128,10 +10410,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);
}
@@ -9325,15 +10616,51 @@ gfc_trans_oacc_declare (gfc_code *code)
gfc_start_block (&block);
oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses,
- code->loc, false, true);
+ code->loc, TOC_OPENACC_DECLARE);
stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
- oacc_clauses);
+ if (oacc_clauses)
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
+/* Create an OpenACC enter or exit data construct for an OpenACC declared
+ variable that has been allocated or deallocated. */
+
+tree
+gfc_trans_oacc_declare_allocate (stmtblock_t *block, gfc_expr *expr,
+ bool allocate)
+{
+ gfc_omp_clauses *clauses = gfc_get_omp_clauses ();
+ gfc_omp_namelist *p = gfc_get_omp_namelist ();
+ tree oacc_clauses, stmt;
+ enum tree_code construct_code;
+
+ p->sym = expr->symtree->n.sym;
+ p->where = expr->where;
+
+ if (allocate)
+ {
+ p->u.map.op = OMP_MAP_DECLARE_ALLOCATE;
+ construct_code = OACC_ENTER_DATA;
+ }
+ else
+ {
+ p->u.map.op = OMP_MAP_DECLARE_DEALLOCATE;
+ construct_code = OACC_EXIT_DATA;
+ }
+ clauses->lists[OMP_LIST_MAP] = p;
+
+ oacc_clauses = gfc_trans_omp_clauses (block, clauses, expr->where);
+ stmt = build1_loc (input_location, construct_code, void_type_node,
+ oacc_clauses);
+ gfc_add_expr_to_block (block, stmt);
+
+ return stmt;
+}
+
tree
gfc_trans_oacc_directive (gfc_code *code)
{
@@ -9505,7 +10832,8 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
gfc_omp_declare_simd *ods;
for (ods = ns->omp_declare_simd; ods; ods = ods->next)
{
- tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true);
+ tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where,
+ TOC_OPENMP_DECLARE_SIMD);
tree fndecl = ns->proc_name->backend_decl;
if (c != NULL_TREE)
c = tree_cons (NULL_TREE, c, NULL_TREE);
@@ -9585,7 +10913,8 @@ gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
break;
case OMP_TRAIT_PROPERTY_CLAUSE_LIST:
properties = gfc_trans_omp_clauses (NULL, otp->clauses,
- where, true);
+ where,
+ TOC_OPENMP_DECLARE_SIMD);
break;
default:
gcc_unreachable ();
@@ -9847,8 +11176,14 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns, gfc_namespace *parent_ns)
if (omp_context_selector_matches (set_selectors,
NULL_TREE, false))
{
- tree need_device_ptr_list = NULL_TREE;
- tree need_device_addr_list = NULL_TREE;
+ tree adjust_args_tree_list = NULL_TREE;
+ auto add_adjust_args
+ = [chain = &adjust_args_tree_list] (tree n) mutable
+ {
+ gcc_assert (chain && *chain == NULL_TREE);
+ *chain = n;
+ chain = &TREE_CHAIN (n);
+ };
tree append_args_tree = NULL_TREE;
tree id = get_identifier ("omp declare variant base");
tree variant = gfc_get_symbol_decl (variant_proc_sym);
@@ -10010,6 +11345,7 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns, gfc_namespace *parent_ns)
&arg_list->sym->declared_at);
continue;
}
+
}
if (arg_list->u.adj_args.need_ptr
&& (arg->sym->ts.f90_type != BT_VOID
@@ -10039,6 +11375,34 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns, gfc_namespace *parent_ns)
&arg->sym->declared_at, &loc);
continue;
}
+ if (arg_list->u.adj_args.need_addr
+ && arg->sym->ts.type == BT_CLASS)
+ {
+ // In OpenMP 6.1, mapping polymorphic variables
+ // is undefined behavior. 'sorry' would be an
+ // alternative or some other wording.
+ gfc_error ("Argument %qs at %L to list item in "
+ "%<need_device_addr%> at %L must not "
+ "be polymorphic",
+ arg->sym->name,
+ &arg->sym->declared_at, &loc);
+ continue;
+ }
+ if (arg_list->u.adj_args.need_addr
+ && arg->sym->attr.optional)
+ {
+ // OPTIONAL has the issue that we need to handle
+ // absent arguments on the caller side, which
+ // adds extra complications.
+ gfc_error ("Sorry, argument %qs at %L to list "
+ "item in %<need_device_addr%> at %L "
+ "with OPTIONAL argument is "
+ "not yet supported",
+ arg->sym->name,
+ &arg->sym->declared_at, &loc);
+ continue;
+ }
+
if (adjust_args_list.contains (arg->sym))
{
gfc_error ("%qs at %L is specified more than "
@@ -10047,48 +11411,33 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns, gfc_namespace *parent_ns)
}
adjust_args_list.safe_push (arg->sym);
- if (arg_list->u.adj_args.need_addr)
- {
- /* TODO: Has to to support OPTIONAL and array
- descriptors; should check for CLASS, coarrays?
- Reject "abc" and 123 as actual arguments (in
- gimplify.cc or in the FE? Reject noncontiguous
- actuals? Cf. also PR C++/118859.
- Also check array-valued type(c_ptr). */
- static bool warned = false;
- if (!warned)
- sorry_at (gfc_get_location (&loc),
- "%<need_device_addr%> not yet "
- "supported");
- warned = true;
- continue;
- }
if (arg_list->u.adj_args.need_ptr
|| arg_list->u.adj_args.need_addr)
{
+ tree modifier
+ = arg_list->u.adj_args.need_ptr
+ ? get_identifier ("need_device_ptr")
+ : get_identifier ("need_device_addr");
+ gcc_checking_assert
+ (!arg_list->u.adj_args.need_addr
+ || modifier
+ == get_identifier ("need_device_addr"));
// Store 0-based argument index,
// as in gimplify_call_expr
- tree t
+ tree item
= build_tree_list (
NULL_TREE,
build_int_cst (integer_type_node,
idx + arg_idx_offset));
- if (arg_list->u.adj_args.need_ptr)
- need_device_ptr_list
- = chainon (need_device_ptr_list, t);
- else
- need_device_addr_list
- = chainon (need_device_addr_list, t);
+ add_adjust_args (build_tree_list (modifier,
+ item));
}
}
}
tree t = NULL_TREE;
- if (need_device_ptr_list
- || need_device_addr_list
- || append_args_tree)
+ if (adjust_args_tree_list || append_args_tree)
{
- t = build_tree_list (need_device_ptr_list,
- need_device_addr_list),
+ t = build_tree_list (NULL_TREE, adjust_args_tree_list),
TREE_CHAIN (t) = append_args_tree;
DECL_ATTRIBUTES (variant) = tree_cons (
get_identifier ("omp declare variant variant args"), t,
@@ -10187,3 +11536,112 @@ gfc_trans_omp_metadirective (gfc_code *code)
return metadirective_tree;
}
+
+static tree
+gfc_trans_omp_mapper_name (const char *mapper_id, gfc_typespec *ts)
+{
+ /* Enough space for "<mapper_id>:CLASS(<typename>)" + '\0'. */
+ char buffer[2 * GFC_MAX_SYMBOL_LEN + 9];
+ const char *type_name = gfc_typename (ts);
+ if (!mapper_id)
+ mapper_id = "default";
+ snprintf (buffer, sizeof (buffer), "omp declare mapper %s:%s", mapper_id,
+ type_name);
+ return get_identifier (buffer);
+}
+
+/* Here we need to translate the internal representation of an OpenMP
+ "declare mapper" into a form that can be consumed by the middle-end. */
+
+static void
+gfc_trans_omp_declare_mapper (gfc_omp_udm *udm)
+{
+ tree mapper_name = gfc_trans_omp_mapper_name (udm->mapper_id, &udm->ts);
+ tree fn;
+ tree saved_fn_decl = current_function_decl;
+ tree decl, decls;
+
+ if (saved_fn_decl)
+ push_function_context ();
+
+ tree tmp = build_function_type_list (void_type_node, NULL_TREE);
+ fn = build_decl (input_location, FUNCTION_DECL, mapper_name, tmp);
+
+ DECL_ARTIFICIAL (fn) = 1;
+ DECL_EXTERNAL (fn) = 1;
+ DECL_DECLARED_INLINE_P (fn) = 1;
+ DECL_IGNORED_P (fn) = 1;
+ SET_DECL_ASSEMBLER_NAME (fn, get_identifier ("<udm>"));
+ DECL_ATTRIBUTES (fn)
+ = tree_cons (get_identifier ("gnu_inline"), NULL_TREE,
+ DECL_ATTRIBUTES (fn));
+
+ decl = build_decl (input_location, RESULT_DECL, NULL_TREE, void_type_node);
+ DECL_ARTIFICIAL (decl) = 1;
+ DECL_IGNORED_P (decl) = 1;
+ DECL_CONTEXT (decl) = fn;
+ DECL_RESULT (fn) = decl;
+
+ pushdecl (fn);
+ current_function_decl = fn;
+
+ allocate_struct_function (fn, false);
+
+ pushlevel ();
+
+ stmtblock_t block;
+ gfc_init_block (&block);
+
+ tree mapper_id = udm->mapper_id ? get_identifier (udm->mapper_id) : NULL_TREE;
+ tree type = gfc_typenode_for_spec (&udm->ts);
+ tree var = gfc_get_symbol_decl (udm->var_sym);
+
+ DECL_CONTEXT (var) = fn;
+ /* Normally a "use"-related variable will get the DECL_EXTERN flag set, but
+ we don't want that here because it interferes with rewriting the decl. */
+ DECL_EXTERNAL (var) = 0;
+
+ tree maplist = gfc_trans_omp_clauses (&block, udm->clauses, udm->where,
+ TOC_OPENMP_DECLARE_MAPPER);
+
+ tree stmt = make_node (OMP_DECLARE_MAPPER);
+ TREE_TYPE (stmt) = type;
+ OMP_DECLARE_MAPPER_ID (stmt) = mapper_id;
+ OMP_DECLARE_MAPPER_DECL (stmt) = var;
+ OMP_DECLARE_MAPPER_CLAUSES (stmt) = maplist;
+
+ gfc_add_expr_to_block (&block, stmt);
+ DECL_SAVED_TREE (fn) = gfc_finish_block (&block);
+ decls = getdecls ();
+ poplevel (1, 1);
+ BLOCK_SUPERCONTEXT (DECL_INITIAL (fn)) = fn;
+
+ DECL_SAVED_TREE (fn) = fold_build3_loc (input_location, BIND_EXPR,
+ void_type_node, decls,
+ DECL_SAVED_TREE (fn),
+ DECL_INITIAL (fn));
+ dump_function (TDI_original, fn);
+
+ udm->backend_decl = fn;
+
+ set_cfun (NULL);
+
+ if (saved_fn_decl)
+ {
+ pop_function_context ();
+ current_function_decl = saved_fn_decl;
+ }
+}
+
+void
+gfc_trans_omp_declare_mappers (gfc_symtree *omp_udm_root)
+{
+ if (!omp_udm_root)
+ return;
+
+ gfc_trans_omp_declare_mappers (omp_udm_root->left);
+ gfc_trans_omp_declare_mappers (omp_udm_root->right);
+
+ for (gfc_omp_udm *udm = omp_udm_root->n.omp_udm; udm; udm = udm->next)
+ gfc_trans_omp_declare_mapper (udm);
+}
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 37f8aca..2dfecff 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7330,6 +7330,10 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
else
gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat,
omp_cond, omp_alt_alloc, succ_add_expr);
+
+ /* Allocate memory for OpenACC declared variables. */
+ if (expr->symtree->n.sym->attr.oacc_declare_create)
+ gfc_trans_oacc_declare_allocate (&se.pre, expr, true);
}
else
{
@@ -7876,6 +7880,10 @@ gfc_trans_deallocate (gfc_code *code)
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
{
+ if (!is_coarray
+ && expr->symtree->n.sym->attr.oacc_declare_create)
+ gfc_trans_oacc_declare_allocate (&se.pre, expr, false);
+
gfc_coarray_deregtype caf_dtype;
if (is_coarray)
@@ -7929,6 +7937,10 @@ gfc_trans_deallocate (gfc_code *code)
}
else
{
+ /* Deallocate memory for OpenACC declared variables. */
+ if (expr->symtree->n.sym->attr.oacc_declare_create)
+ gfc_trans_oacc_declare_allocate (&se.pre, expr, false);
+
tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, label_finish,
false, al->expr,
al->expr->ts, NULL_TREE,
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 67b1970..439a822 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -72,6 +72,7 @@ tree gfc_trans_omp_directive (gfc_code *);
void gfc_trans_omp_declare_simd (gfc_namespace *);
void gfc_trans_omp_declare_variant (gfc_namespace *, gfc_namespace *);
tree gfc_trans_omp_metadirective (gfc_code *code);
+void gfc_trans_omp_declare_mappers (gfc_symtree *);
tree gfc_trans_oacc_directive (gfc_code *);
tree gfc_trans_oacc_declare (gfc_namespace *);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index ae7be9f..f327e01 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -839,10 +839,14 @@ tree gfc_omp_clause_assign_op (tree, tree, tree);
tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
tree gfc_omp_clause_dtor (tree, tree);
void gfc_omp_finish_clause (tree, gimple_seq *, bool);
+tree gfc_omp_finish_mapper_clauses (tree);
+tree gfc_omp_extract_mapper_directive (tree);
+tree gfc_omp_map_array_section (location_t, tree);
bool gfc_omp_deep_mapping_p (const gimple *, tree);
-tree gfc_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *);
-void gfc_omp_deep_mapping (const gimple *, tree, unsigned HOST_WIDE_INT, tree,
- tree, tree, tree, tree, gimple_seq *);
+tree gfc_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *);
+void gfc_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT, tree,
+ tree, tree, tree, tree, gimple_seq *,
+ vec<tree> *);
bool gfc_omp_allocatable_p (tree);
bool gfc_omp_scalar_p (tree, bool);
bool gfc_omp_scalar_target_p (tree);
@@ -851,6 +855,7 @@ bool gfc_omp_private_debug_clause (tree, bool);
bool gfc_omp_private_outer_ref (tree);
struct gimplify_omp_ctx;
void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
+tree gfc_trans_oacc_declare_allocate (stmtblock_t *, gfc_expr *, bool);
/* In trans-intrinsic.cc. */
void gfc_conv_intrinsic_mvbits (gfc_se *, gfc_actual_arglist *,
diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def
index dd9b8df..b8c7d5d 100644
--- a/gcc/fortran/types.def
+++ b/gcc/fortran/types.def
@@ -80,6 +80,7 @@ DEF_FUNCTION_TYPE_0 (BT_FN_UINT, BT_UINT)
DEF_FUNCTION_TYPE_0 (BT_FN_VOID, BT_VOID)
DEF_FUNCTION_TYPE_1 (BT_FN_VOID_PTR, BT_VOID, BT_PTR)
+DEF_FUNCTION_TYPE_1 (BT_FN_VOID_PTRMODE, BT_VOID, BT_PTRMODE)
DEF_FUNCTION_TYPE_1 (BT_FN_VOID_PTRPTR, BT_VOID, BT_PTR_PTR)
DEF_FUNCTION_TYPE_1 (BT_FN_VOID_VPTR, BT_VOID, BT_VOLATILE_PTR)
DEF_FUNCTION_TYPE_1 (BT_FN_INT_INT, BT_INT, BT_INT)
@@ -156,6 +157,8 @@ DEF_FUNCTION_TYPE_3 (BT_FN_VOID_SIZE_SIZE_PTR, BT_VOID, BT_SIZE, BT_SIZE,
DEF_FUNCTION_TYPE_3 (BT_FN_UINT_UINT_PTR_PTR, BT_UINT, BT_UINT, BT_PTR, BT_PTR)
DEF_FUNCTION_TYPE_3 (BT_FN_PTR_SIZE_SIZE_PTRMODE,
BT_PTR, BT_SIZE, BT_SIZE, BT_PTRMODE)
+DEF_FUNCTION_TYPE_3 (BT_FN_PTRMODE_PTRMODE_INT_PTR, BT_PTRMODE, BT_PTRMODE,
+ BT_INT, BT_PTR)
DEF_FUNCTION_TYPE_4 (BT_FN_PTR_PTR_SIZE_PTRMODE_PTRMODE,
BT_PTR, BT_PTR, BT_SIZE, BT_PTRMODE, BT_PTRMODE)
@@ -283,6 +286,9 @@ DEF_FUNCTION_TYPE_VAR_7 (BT_FN_VOID_INT_SIZE_PTR_PTR_PTR_INT_INT_VAR,
BT_VOID, BT_INT, BT_SIZE, BT_PTR, BT_PTR,
BT_PTR, BT_INT, BT_INT)
+DEF_FUNCTION_TYPE_VAR_5 (BT_FN_VOID_INT_SIZE_PTR_PTR_PTR_VAR,
+ BT_VOID, BT_INT, BT_SIZE, BT_PTR, BT_PTR, BT_PTR)
+
DEF_FUNCTION_TYPE_VAR_6 (BT_FN_VOID_INT_OMPFN_SIZE_PTR_PTR_PTR_VAR,
BT_VOID, BT_INT, BT_PTR_FN_VOID_PTR, BT_SIZE,
BT_PTR, BT_PTR, BT_PTR)
diff --git a/gcc/gimple-expr.cc b/gcc/gimple-expr.cc
index c0367f4..69a5b7e 100644
--- a/gcc/gimple-expr.cc
+++ b/gcc/gimple-expr.cc
@@ -385,6 +385,8 @@ copy_var_decl (tree var, tree name, tree type)
DECL_CONTEXT (copy) = DECL_CONTEXT (var);
TREE_USED (copy) = 1;
DECL_SEEN_IN_BIND_EXPR_P (copy) = 1;
+ if (VAR_P (var))
+ VAR_POINTS_TO_READONLY (copy) = VAR_POINTS_TO_READONLY (var);
DECL_ATTRIBUTES (copy) = DECL_ATTRIBUTES (var);
if (DECL_USER_ALIGN (var))
{
diff --git a/gcc/gimple-pretty-print.cc b/gcc/gimple-pretty-print.cc
index 4e20b4c..6929cd0 100644
--- a/gcc/gimple-pretty-print.cc
+++ b/gcc/gimple-pretty-print.cc
@@ -1837,6 +1837,12 @@ dump_gimple_omp_target (pretty_printer *pp, const gomp_target *gs,
default:
gcc_unreachable ();
}
+ if (gimple_omp_target_iterator_loops (gs))
+ {
+ pp_string (pp, "// Expanded iterator loops for #pragma omp target\n");
+ dump_gimple_seq (pp, gimple_omp_target_iterator_loops (gs), spc, flags);
+ pp_newline (pp);
+ }
if (flags & TDF_RAW)
{
dump_gimple_fmt (pp, spc, flags, "%G%s <%+BODY <%S>%nCLAUSES <", gs,
diff --git a/gcc/gimple.cc b/gcc/gimple.cc
index 9acfa38..70ed3be 100644
--- a/gcc/gimple.cc
+++ b/gcc/gimple.cc
@@ -1295,10 +1295,13 @@ gimple_build_omp_interop (tree clauses)
BODY is the sequence of statements that will be executed.
KIND is the kind of the region.
- CLAUSES are any of the construct's clauses. */
+ CLAUSES are any of the construct's clauses.
+ ITERATOR_LOOPS is an optional sequence containing constructed loops
+ for OpenMP iterators. */
gomp_target *
-gimple_build_omp_target (gimple_seq body, int kind, tree clauses)
+gimple_build_omp_target (gimple_seq body, int kind, tree clauses,
+ gimple_seq iterator_loops)
{
gomp_target *p
= as_a <gomp_target *> (gimple_alloc (GIMPLE_OMP_TARGET, 0));
@@ -1306,6 +1309,7 @@ gimple_build_omp_target (gimple_seq body, int kind, tree clauses)
gimple_omp_set_body (p, body);
gimple_omp_target_set_clauses (p, clauses);
gimple_omp_target_set_kind (p, kind);
+ gimple_omp_target_set_iterator_loops (p, iterator_loops);
return p;
}
diff --git a/gcc/gimple.def b/gcc/gimple.def
index 54248a8..3e1e13e 100644
--- a/gcc/gimple.def
+++ b/gcc/gimple.def
@@ -393,7 +393,7 @@ DEFGSCODE(GIMPLE_OMP_SINGLE, "gimple_omp_single", GSS_OMP_SINGLE_LAYOUT)
DATA_ARG is a vec of 3 local variables in the parent function
containing data to be mapped to CHILD_FN. This is used to
implement the MAP clauses. */
-DEFGSCODE(GIMPLE_OMP_TARGET, "gimple_omp_target", GSS_OMP_PARALLEL_LAYOUT)
+DEFGSCODE(GIMPLE_OMP_TARGET, "gimple_omp_target", GSS_OMP_TARGET)
/* GIMPLE_OMP_TEAMS <BODY, CLAUSES, CHILD_FN, DATA_ARG> represents
#pragma omp teams
diff --git a/gcc/gimple.h b/gcc/gimple.h
index 112e5ae..d971dd6 100644
--- a/gcc/gimple.h
+++ b/gcc/gimple.h
@@ -682,11 +682,14 @@ struct GTY((tag("GSS_OMP_PARALLEL_LAYOUT")))
};
/* GIMPLE_OMP_TARGET */
-struct GTY((tag("GSS_OMP_PARALLEL_LAYOUT")))
+struct GTY((tag("GSS_OMP_TARGET")))
gomp_target : public gimple_statement_omp_parallel_layout
{
- /* No extra fields; adds invariant:
- stmt->code == GIMPLE_OMP_TARGET. */
+ /* [ WORD 1-10 ] : base class */
+
+ /* [ WORD 11 ]
+ Iterator loops. */
+ gimple_seq iterator_loops;
};
/* GIMPLE_OMP_TASK */
@@ -1607,7 +1610,7 @@ gomp_scan *gimple_build_omp_scan (gimple_seq, tree);
gomp_sections *gimple_build_omp_sections (gimple_seq, tree);
gimple *gimple_build_omp_sections_switch (void);
gomp_single *gimple_build_omp_single (gimple_seq, tree);
-gomp_target *gimple_build_omp_target (gimple_seq, int, tree);
+gomp_target *gimple_build_omp_target (gimple_seq, int, tree, gimple_seq = NULL);
gomp_teams *gimple_build_omp_teams (gimple_seq, tree);
gomp_atomic_load *gimple_build_omp_atomic_load (tree, tree,
enum omp_memory_order);
@@ -6348,6 +6351,37 @@ gimple_omp_target_set_data_arg (gomp_target *omp_target_stmt,
}
+/* Return the Gimple sequence used to store loops for OpenMP iterators used
+ by OMP_TARGET_STMT. */
+
+inline gimple_seq
+gimple_omp_target_iterator_loops (const gomp_target *omp_target_stmt)
+{
+ return omp_target_stmt->iterator_loops;
+}
+
+
+/* Return a pointer to the Gimple sequence used to store loops for OpenMP
+ iterators used by OMP_TARGET_STMT. */
+
+inline gimple_seq *
+gimple_omp_target_iterator_loops_ptr (gomp_target *omp_target_stmt)
+{
+ return &omp_target_stmt->iterator_loops;
+}
+
+
+/* Set ITERATOR_LOOPS to be the Gimple sequence used to store loops
+ constructed for OpenMP iterators in OMP_TARGET_STMT. */
+
+inline void
+gimple_omp_target_set_iterator_loops (gomp_target *omp_target_stmt,
+ gimple_seq iterator_loops)
+{
+ omp_target_stmt->iterator_loops = iterator_loops;
+}
+
+
/* Return the clauses associated with OMP_TEAMS GS. */
inline tree
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 4f385b1..ad7c3ff 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -71,6 +71,8 @@ along with GCC; see the file COPYING3. If not see
#include "context.h"
#include "tree-nested.h"
#include "gcc-urlifier.h"
+#include "dwarf2out.h"
+#include "tree-ssa-loop-niter.h" /* For simplify_replace_tree. */
/* Identifier for a basic condition, mapping it to other basic conditions of
its Boolean expression. Basic conditions given the same uid (in the same
@@ -180,6 +182,9 @@ enum gimplify_omp_var_data
/* Flag for GOVD_FIRSTPRIVATE: OMP_CLAUSE_FIRSTPRIVATE_IMPLICIT. */
GOVD_FIRSTPRIVATE_IMPLICIT = 0x4000000,
+ /* Flag for OpenACC deviceptrs. */
+ GOVD_DEVICEPTR = (1<<24),
+
GOVD_DATA_SHARE_CLASS = (GOVD_SHARED | GOVD_PRIVATE | GOVD_FIRSTPRIVATE
| GOVD_LASTPRIVATE | GOVD_REDUCTION | GOVD_LINEAR
| GOVD_LOCAL)
@@ -269,10 +274,53 @@ enum gimplify_defaultmap_kind
GDMK_POINTER
};
+/* Used for topological sorting of mapping groups. UNVISITED means we haven't
+ started processing the group yet. The TEMPORARY mark is used when we first
+ encounter a group on a depth-first traversal, and the PERMANENT mark is used
+ when we have processed all the group's children (i.e. all the base pointers
+ referred to by the group's mapping nodes, recursively). */
+
+enum omp_tsort_mark {
+ UNVISITED,
+ TEMPORARY,
+ PERMANENT
+};
+
+/* A group of OMP_CLAUSE_MAP nodes that correspond to a single "map"
+ clause. */
+
+struct omp_mapping_group {
+ tree *grp_start;
+ tree grp_end;
+ omp_tsort_mark mark;
+ /* If we've removed the group but need to reindex, mark the group as
+ deleted. */
+ bool deleted;
+ /* The group points to an already-created "GOMP_MAP_STRUCT
+ GOMP_MAP_ATTACH_DETACH" pair. */
+ bool reprocess_struct;
+ /* The group should use "zero-length" allocations for pointers that are not
+ mapped "to" on the same directive. */
+ bool fragile;
+ struct omp_mapping_group *sibling;
+ struct omp_mapping_group *next;
+
+ omp_mapping_group (tree *_start, tree _end)
+ : grp_start (_start), grp_end (_end), mark (UNVISITED), deleted (false),
+ reprocess_struct (false), fragile (false), sibling (NULL), next (NULL)
+ {
+ }
+
+ omp_mapping_group ()
+ {
+ }
+};
+
struct gimplify_omp_ctx
{
struct gimplify_omp_ctx *outer_context;
splay_tree variables;
+ hash_map<omp_name_type<tree>, tree> *implicit_mappers;
hash_set<tree> *privatized_types;
tree clauses;
/* Iteration variables in an OMP_FOR. */
@@ -289,7 +337,14 @@ struct gimplify_omp_ctx
bool has_depend;
bool in_for_exprs;
bool in_call_args;
+ bool ompacc;
int defaultmap[5];
+ hash_map<tree, omp_mapping_group *> *decl_data_clause;
+};
+
+struct privatize_reduction
+{
+ tree ref_var, local_var;
};
static struct gimplify_ctx *gimplify_ctxp;
@@ -507,6 +562,7 @@ new_omp_context (enum omp_region_type region_type)
c = XCNEW (struct gimplify_omp_ctx);
c->outer_context = gimplify_omp_ctxp;
c->variables = splay_tree_new (splay_tree_compare_decl_uid, 0, 0);
+ c->implicit_mappers = new hash_map<omp_name_type<tree>, tree>;
c->privatized_types = new hash_set<tree>;
c->location = input_location;
c->region_type = region_type;
@@ -519,6 +575,7 @@ new_omp_context (enum omp_region_type region_type)
c->defaultmap[GDMK_AGGREGATE] = GOVD_MAP;
c->defaultmap[GDMK_ALLOCATABLE] = GOVD_MAP;
c->defaultmap[GDMK_POINTER] = GOVD_MAP;
+ c->decl_data_clause = NULL;
return c;
}
@@ -530,7 +587,9 @@ delete_omp_context (struct gimplify_omp_ctx *c)
{
splay_tree_delete (c->variables);
delete c->privatized_types;
+ delete c->implicit_mappers;
c->loop_iter_var.release ();
+ delete c->decl_data_clause;
XDELETE (c);
}
@@ -1431,28 +1490,62 @@ gimplify_bind_expr (tree *expr_p, gimple_seq *pre_p)
&& DECL_CONTEXT (t) == current_function_decl
&& TREE_USED (t)
&& (attr = lookup_attribute ("omp allocate", DECL_ATTRIBUTES (t)))
- != NULL_TREE)
+ != NULL_TREE
+ && TREE_PURPOSE (TREE_VALUE (attr)) != error_mark_node)
{
gcc_assert (!DECL_HAS_VALUE_EXPR_P (t));
tree alloc = TREE_PURPOSE (TREE_VALUE (attr));
tree align = TREE_VALUE (TREE_VALUE (attr));
+ /* The C++ front end smuggles a location through the chain field,
+ clear it to avoid conflicts with Fortran specific code. */
+ if (TREE_CHAIN (TREE_VALUE (attr)) != NULL_TREE
+ && TREE_CODE (TREE_CHAIN (TREE_VALUE (attr))) == NOP_EXPR)
+ TREE_CHAIN (TREE_VALUE (attr)) = NULL_TREE;
/* Allocate directives that appear in a target region must specify
an allocator clause unless a requires directive with the
dynamic_allocators clause is present in the same compilation
unit. */
bool missing_dyn_alloc = false;
- if (alloc == NULL_TREE
- && ((omp_requires_mask & OMP_REQUIRES_DYNAMIC_ALLOCATORS)
- == 0))
+ if ((omp_requires_mask & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0)
{
/* This comes too early for omp_discover_declare_target...,
but should at least catch the most common cases. */
missing_dyn_alloc
- = cgraph_node::get (current_function_decl)->offloadable;
+ = (alloc == NULL_TREE
+ && cgraph_node::get (current_function_decl)->offloadable);
for (struct gimplify_omp_ctx *ctx2 = ctx;
ctx2 && !missing_dyn_alloc; ctx2 = ctx2->outer_context)
if (ctx2->code == OMP_TARGET)
- missing_dyn_alloc = true;
+ {
+ if (alloc == NULL_TREE)
+ missing_dyn_alloc = true;
+ else if (TREE_CODE (alloc) != INTEGER_CST)
+ {
+ tree alloc2 = alloc;
+ if (TREE_CODE (alloc2) == MEM_REF
+ || TREE_CODE (alloc2) == INDIRECT_REF)
+ alloc2 = TREE_OPERAND (alloc2, 0);
+ tree c2;
+ for (c2 = ctx2->clauses; c2;
+ c2 = OMP_CLAUSE_CHAIN (c2))
+ if (OMP_CLAUSE_CODE (c2)
+ == OMP_CLAUSE_USES_ALLOCATORS)
+ {
+ tree t2
+ = OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c2);
+ if (operand_equal_p (alloc2, t2))
+ break;
+ }
+ if (c2 == NULL_TREE)
+ error_at (EXPR_LOC_OR_LOC (
+ alloc, DECL_SOURCE_LOCATION (t)),
+ "%qE in %<allocator%> clause inside a "
+ "target region must be specified in an "
+ "%<uses_allocators%> clause on the "
+ "%<target%> directive", alloc2);
+ }
+ break;
+ }
}
if (missing_dyn_alloc)
error_at (DECL_SOURCE_LOCATION (t),
@@ -3888,7 +3981,7 @@ modify_call_for_omp_dispatch (tree expr, tree dispatch_clauses,
bool want_value, bool pointerize)
{
location_t loc = EXPR_LOCATION (expr);
- tree fndecl = get_callee_fndecl (expr);
+ const tree fndecl = get_callee_fndecl (expr);
/* Skip processing if we don't get the expected call form. */
if (!fndecl)
@@ -3897,23 +3990,180 @@ modify_call_for_omp_dispatch (tree expr, tree dispatch_clauses,
tree init_code = NULL_TREE;
tree cleanup = NULL_TREE;
tree clobbers = NULL_TREE;
- int nargs = call_expr_nargs (expr);
+ const int nargs = call_expr_nargs (expr);
tree dispatch_device_num = NULL_TREE;
tree dispatch_interop = NULL_TREE;
tree dispatch_append_args = NULL_TREE;
+ /* Equal to the number of parameters. */
int nfirst_args = 0;
- tree dispatch_adjust_args_list
- = lookup_attribute ("omp declare variant variant args",
- DECL_ATTRIBUTES (fndecl));
- if (dispatch_adjust_args_list)
+ const const_tree nothing_id = get_identifier ("nothing");
+ const const_tree need_ptr_id = get_identifier ("need_device_ptr");
+ const const_tree need_addr_id = get_identifier ("need_device_addr");
+
+ vec<tree> dispatch_adjust_args_specifiers = vNULL;
+
+ if (tree declare_variant_variant_args_attr
+ = lookup_attribute ("omp declare variant variant args",
+ DECL_ATTRIBUTES (fndecl)))
{
+ /* Due to how the nodes are layed out, unpacking them is pretty
+ incomprehensible. */
+ gcc_assert (TREE_VALUE (declare_variant_variant_args_attr));
+ dispatch_append_args
+ = TREE_CHAIN (TREE_VALUE (declare_variant_variant_args_attr));
+ tree dispatch_adjust_args_list
+ = TREE_VALUE (declare_variant_variant_args_attr);
+ gcc_assert (dispatch_adjust_args_list);
dispatch_adjust_args_list = TREE_VALUE (dispatch_adjust_args_list);
- dispatch_append_args = TREE_CHAIN (dispatch_adjust_args_list);
- if (TREE_PURPOSE (dispatch_adjust_args_list) == NULL_TREE
- && TREE_VALUE (dispatch_adjust_args_list) == NULL_TREE)
- dispatch_adjust_args_list = NULL_TREE;
+
+ if (dispatch_adjust_args_list)
+ {
+ dispatch_adjust_args_specifiers.create (nargs);
+ for (int arg_idx = 0; arg_idx < nargs; ++arg_idx)
+ dispatch_adjust_args_specifiers.quick_push (NULL_TREE);
+
+ for (tree n = dispatch_adjust_args_list; n; n = TREE_CHAIN (n))
+ {
+ gcc_assert (TREE_VALUE (n)
+ && (TREE_PURPOSE (n) == nothing_id
+ || TREE_PURPOSE (n) == need_ptr_id
+ || TREE_PURPOSE (n) == need_addr_id));
+ tree item = TREE_VALUE (n);
+ /* Diagnostics make more sense if we defer these. */
+ if (TREE_CODE (TREE_VALUE (item)) == TREE_LIST)
+ continue;
+ gcc_assert (TREE_CODE (TREE_VALUE (item)) == INTEGER_CST);
+ const int idx = tree_to_shwi (TREE_VALUE (item));
+ if (idx >= nargs)
+ {
+ /* Adjust to a 1 based index for output. */
+ const int adjusted = idx + 1;
+ error_at (EXPR_LOCATION (TREE_PURPOSE (item)),
+ "parameter index %d is out of range with %d "
+ "arguments",
+ adjusted, nargs);
+ continue;
+ }
+ tree& spec_at_idx = dispatch_adjust_args_specifiers[idx];
+ gcc_assert (spec_at_idx == NULL_TREE);
+ spec_at_idx = n;
+ }
+ /* There might be a better place to put this. */
+ const bool variadic_func_p = [&] ()
+ {
+ tree parm_type = TYPE_ARG_TYPES (TREE_TYPE (fndecl));
+ while (parm_type && parm_type != void_list_node)
+ parm_type = TREE_CHAIN (parm_type);
+ return parm_type != void_list_node;
+ } (); /* IILE. */
+ auto expand_range = [&] (tree modifier_id, tree loc, tree range)
+ {
+ /* We only encounter numeric ranges here if fn is variadic. */
+ gcc_assert (variadic_func_p);
+ const location_t range_loc = EXPR_LOCATION (loc);
+ const tree lb_node = TREE_PURPOSE (range);
+ const tree ub_node = TREE_VALUE (range);
+ const bool relative_lb = TREE_PURPOSE (lb_node) != NULL_TREE;
+ const bool relative_ub = TREE_PURPOSE (ub_node) != NULL_TREE;
+ const ptrdiff_t lb_raw = tree_to_shwi (TREE_VALUE (lb_node));
+ const ptrdiff_t ub_raw = tree_to_shwi (TREE_VALUE (ub_node));
+ /* relative_lb implies lb_raw <= -1,
+ relative_ub implies ub_raw <= 0. */
+ gcc_assert ((relative_lb || relative_ub)
+ && (!relative_lb || lb_raw <= -1)
+ && (!relative_ub || ub_raw <= 0));
+ /* (relative_lb && relative_ub) implies lb_raw < ub_raw. */
+ gcc_assert (!(relative_lb && relative_ub) || lb_raw < ub_raw);
+ const ptrdiff_t lb = relative_lb ? lb_raw + nargs : lb_raw;
+ const ptrdiff_t ub = relative_ub ? ub_raw + nargs : ub_raw;
+ /* This will never happen, still gotta diagnose it. */
+ if (lb > INT_MAX || ub > INT_MAX)
+ {
+ if (lb > INT_MAX)
+ error_at (range_loc, "lb overflow");
+ else if (ub > INT_MAX)
+ error_at (range_loc, "ub overflow");
+ return;
+ }
+ /* Internally, ub is stored as one-past-the-end. */
+ if (lb < 0 || ub < 1)
+ {
+ if (lb < 0)
+ /* FIXME: Use location of lb specifically. */
+ error_at (range_loc,
+ "lower bound with logical offset is negative "
+ "with %d arguments",
+ nargs);
+ if (ub < 1)
+ /* FIXME: Use location of ub specifically. */
+ error_at (range_loc,
+ "upper bound with logical offset is negative "
+ "with %d arguments",
+ nargs);
+ return;
+ }
+ /* It's okay for lb and ub to be equal, we allow empty ranges
+ at this point. Don't bother diagnosing this if either bound
+ is out of range. */
+ if (lb > ub)
+ {
+ if (relative_lb)
+ error_at (range_loc,
+ "lower bound with logical offset is greater "
+ "than upper bound with %d arguments",
+ nargs);
+ else
+ error_at (range_loc,
+ "upper bound with logical offset is less than "
+ "lower bound with %d arguments",
+ nargs);
+ return;
+ }
+
+ for (int idx = lb; idx < ub; ++idx)
+ {
+ tree& spec_at_idx = dispatch_adjust_args_specifiers[idx];
+ if (spec_at_idx != NULL_TREE)
+ {
+ tree item = TREE_VALUE (spec_at_idx);
+ location_t dupe_loc
+ = EXPR_LOCATION (TREE_PURPOSE (item));
+ /* FIXME: Use nfirst_args to determine whether an index
+ refers to a variadic argument to enhance the
+ diagnostic. */
+ error_at (range_loc,
+ "expansion of numeric range with %d "
+ "arguments specifies an already specified "
+ "parameter",
+ nargs);
+ inform (dupe_loc, "parameter previously specified here");
+ /* Give up after the first collision to avoid spamming
+ errors. Alternatively, we could also remember which
+ ones we diagnosed, but it doesn't seem worth it. */
+ return;
+ }
+ else
+ {
+ /* We don't need to create an index node anymore,
+ it is represented by the position in vec. */
+ tree new_item = build_tree_list (loc, NULL_TREE);
+ spec_at_idx = build_tree_list (modifier_id, new_item);
+ }
+ }
+ };
+ for (tree n = dispatch_adjust_args_list; n; n = TREE_CHAIN (n))
+ {
+ tree item = TREE_VALUE (n);
+ if (TREE_CODE (TREE_VALUE (item)) != TREE_LIST)
+ continue;
+ expand_range (TREE_PURPOSE (n),
+ TREE_PURPOSE (item),
+ TREE_VALUE (item));
+ }
+ }
}
+
if (dispatch_append_args)
{
nfirst_args = tree_to_shwi (TREE_PURPOSE (dispatch_append_args));
@@ -3923,9 +4173,8 @@ modify_call_for_omp_dispatch (tree expr, tree dispatch_clauses,
if (dispatch_device_num)
dispatch_device_num = OMP_CLAUSE_DEVICE_ID (dispatch_device_num);
dispatch_interop = omp_find_clause (dispatch_clauses, OMP_CLAUSE_INTEROP);
- int nappend = 0, ninterop = 0;
- for (tree t = dispatch_append_args; t; t = TREE_CHAIN (t))
- nappend++;
+ const int nappend = list_length (dispatch_append_args);
+ int ninterop = 0;
/* FIXME: error checking should be taken out of this function and
handled before any attempt at filtering or resolution happens.
@@ -4153,10 +4402,14 @@ modify_call_for_omp_dispatch (tree expr, tree dispatch_clauses,
i += nappend;
for (j = nfirst_args; j < nargs; j++)
buffer[i++] = CALL_EXPR_ARG (expr, j);
- nargs += nappend;
+ /* Leave nargs alone so we don't need to account for changes of varargs
+ indices when adjusting the arguments below.
+ We also don't want any surprises if we move the above append_args
+ handling down, as it depends on nargs. */
+ const int new_nargs = nargs + nappend;
tree call = expr;
expr = build_call_array_loc (EXPR_LOCATION (expr), TREE_TYPE (call),
- CALL_EXPR_FN (call), nargs, buffer);
+ CALL_EXPR_FN (call), new_nargs, buffer);
/* Copy all CALL_EXPR flags. */
CALL_EXPR_STATIC_CHAIN (expr) = CALL_EXPR_STATIC_CHAIN (call);
@@ -4168,139 +4421,220 @@ modify_call_for_omp_dispatch (tree expr, tree dispatch_clauses,
CALL_EXPR_VA_ARG_PACK (expr) = CALL_EXPR_VA_ARG_PACK (call);
}
- /* Nothing to do for adjust_args? */
- if (!dispatch_adjust_args_list || !TYPE_ARG_TYPES (TREE_TYPE (fndecl)))
- goto add_cleanup;
-
- /* Handle adjust_args. */
- for (int i = 0; i < nargs; i++)
+ auto adjust_the_arg = [&] (tree arg, tree aa_spec)
{
- tree *arg_p = &CALL_EXPR_ARG (expr, i);
+ if (integer_zerop (arg) || !aa_spec)
+ return arg;
+ const bool need_device_ptr = TREE_PURPOSE (aa_spec) == need_ptr_id;
+ const bool need_device_addr = TREE_PURPOSE (aa_spec) == need_addr_id;
+ if (!need_device_ptr && !need_device_addr)
+ return arg;
- /* Nothing to do if arg is constant null pointer. */
- if (integer_zerop (*arg_p))
- continue;
+ auto find_arg_in_clause = [&] (const_tree clauses) -> const_tree
+ {
+ const const_tree arg_decl = [&] ()
+ {
+ tree arg_decl = tree_strip_nop_conversions (arg);
+ if (TREE_CODE (arg_decl) == ADDR_EXPR)
+ arg_decl = TREE_OPERAND (arg_decl, 0);
+ return arg_decl;
+ } (); /* IILE. */
+ for (const_tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
+ {
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_HAS_DEVICE_ADDR)
+ continue;
+ const tree name_in_clause = DECL_NAME (OMP_CLAUSE_DECL (c));
+ if ((VAR_P (arg_decl) || TREE_CODE (arg_decl) == PARM_DECL)
+ && name_in_clause == DECL_NAME (arg_decl))
+ return c;
+ }
+ return NULL_TREE;
+ };
+ /* The code this was refactored from stops on the first clause with a
+ matching var/parm specified in it. */
+ const_tree clause_with_arg = find_arg_in_clause (dispatch_clauses);
+ /* I assume if a var/parm is used in multiple clauses it gets diagnosed
+ before we get here, make sure that is true. */
+ gcc_checking_assert (!clause_with_arg
+ || !find_arg_in_clause
+ (OMP_CLAUSE_CHAIN (clause_with_arg)));
+
+ const bool is_device_ptr = clause_with_arg
+ && OMP_CLAUSE_CODE (clause_with_arg)
+ == OMP_CLAUSE_IS_DEVICE_PTR;
+ const bool has_device_addr = clause_with_arg
+ && OMP_CLAUSE_CODE (clause_with_arg)
+ == OMP_CLAUSE_HAS_DEVICE_ADDR;
+ /* Obviously impossible with how things are currently implemented. */
+ gcc_assert (!(is_device_ptr && has_device_addr));
+
+ if (need_device_addr && is_device_ptr)
+ warning_at (OMP_CLAUSE_LOCATION (clause_with_arg),
+ OPT_Wopenmp,
+ "%<is_device_ptr%> for %qD does not imply "
+ "%<has_device_addr%> required for %<need_device_addr%>",
+ OMP_CLAUSE_DECL (clause_with_arg));
+ if (need_device_ptr && has_device_addr)
+ warning_at (OMP_CLAUSE_LOCATION (clause_with_arg),
+ OPT_Wopenmp,
+ "%<has_device_addr%> for %qD does not imply "
+ "%<is_device_ptr%> required for %<need_device_ptr%>",
+ OMP_CLAUSE_DECL (clause_with_arg));
+ /* ARG does not need to be adjusted. */
+ if ((need_device_ptr && is_device_ptr)
+ || (need_device_addr && has_device_addr))
+ return arg;
+
+ if (dispatch_device_num == NULL_TREE)
+ {
+ // device_num = omp_get_default_device ()
+ tree fn = builtin_decl_explicit (BUILT_IN_OMP_GET_DEFAULT_DEVICE);
+ tree call = build_call_expr (fn, 0);
+ dispatch_device_num = create_tmp_var_raw (TREE_TYPE (call));
+ tree init = build4 (TARGET_EXPR, TREE_TYPE (call),
+ dispatch_device_num, call, NULL_TREE, NULL_TREE);
+ if (init_code)
+ init_code = build2 (COMPOUND_EXPR, TREE_TYPE (init),
+ init_code, init);
+ else
+ init_code = init;
+ }
- bool need_device_ptr = false;
- bool need_device_addr = false;
- for (int need_addr = 0; need_addr <= 1; need_addr++)
- for (tree arg = (need_addr
- ? TREE_VALUE (dispatch_adjust_args_list)
- : TREE_PURPOSE (dispatch_adjust_args_list));
- arg != NULL; arg = TREE_CHAIN (arg))
- {
- if (TREE_VALUE (arg)
- && TREE_CODE (TREE_VALUE (arg)) == INTEGER_CST
- && wi::eq_p (i, wi::to_wide (TREE_VALUE (arg))))
- {
- if (need_addr)
- need_device_addr = true;
- else
- need_device_ptr = true;
- break;
- }
- }
+ // We want to emit the following statement:
+ // mapped_arg = omp_get_mapped_ptr (arg,
+ // device_num)
+ // but arg has to be the actual pointer, not a
+ // reference or a conversion expression.
+ tree fn = builtin_decl_explicit (BUILT_IN_OMP_GET_MAPPED_PTR);
+ tree mapped_arg = NULL_TREE;
+ bool reference_to_ptr_p = false;
+
+ tree argtype = TREE_TYPE (arg);
+ if (!POINTER_TYPE_P (argtype))
+ {
+ sorry_at (EXPR_LOCATION (arg),
+ "Invalid non-pointer/reference argument "
+ "not diagnosed properly earlier");
+ return arg;
+ }
- if (need_device_ptr || need_device_addr)
+ /* Fortran C_PTR passed by reference? Also handle the weird case
+ where an array of C_PTR is passed instead of its first element. */
+ if (need_device_ptr
+ && lang_GNU_Fortran ()
+ && (POINTER_TYPE_P (TREE_TYPE (argtype))
+ || (TREE_CODE (TREE_TYPE (argtype)) == ARRAY_TYPE
+ && POINTER_TYPE_P (TREE_TYPE (TREE_TYPE (argtype))))))
+ reference_to_ptr_p = true;
+
+ /* C++ pointer passed by reference? */
+ else if (need_device_ptr
+ && TREE_CODE (argtype) == REFERENCE_TYPE
+ && TREE_CODE (TREE_TYPE (argtype)) == POINTER_TYPE)
+ reference_to_ptr_p = true;
+
+ /* If reference_to_ptr_p is true, we need to dereference arg to
+ get the actual pointer. */
+ tree actual_ptr = (reference_to_ptr_p
+ ? build_fold_indirect_ref (arg) : arg);
+ tree actual_ptr_type = TREE_TYPE (actual_ptr);
+ STRIP_NOPS (actual_ptr);
+
+ if (lang_hooks.decls.omp_array_data (actual_ptr, true))
{
- bool is_device_ptr = false;
- bool has_device_addr = false;
+ /* This is a Fortran array with a descriptor. The actual_ptr that
+ lives on the target is the array data, not the descriptor. */
+ tree array_data
+ = lang_hooks.decls.omp_array_data (actual_ptr, false);
+ tree mapped_array_data =
+ build_call_expr_loc (loc, fn, 2, array_data, dispatch_device_num);
+
+ gcc_assert (TREE_CODE (array_data) == COMPONENT_REF);
+
+ /* We need to create a new array descriptor newd that points at the
+ mapped actual_ptr instead of the original one. Start by
+ creating the new descriptor and copy-initializing it from the
+ existing one. */
+ tree oldd = TREE_OPERAND (array_data, 0);
+ tree newd = create_tmp_var (TREE_TYPE (oldd), get_name (oldd));
+ tree t2 = build2 (MODIFY_EXPR, void_type_node, newd, oldd);
+ if (init_code)
+ init_code = build2 (COMPOUND_EXPR, void_type_node, init_code, t2);
+ else
+ init_code = t2;
+
+ /* Now stash the mapped array pointer in the new descriptor newd. */
+ tree lhs = build3 (COMPONENT_REF, TREE_TYPE (array_data), newd,
+ TREE_OPERAND (array_data, 1),
+ TREE_OPERAND (array_data, 2));
+ t2 = build2 (MODIFY_EXPR, void_type_node, lhs, mapped_array_data);
+ init_code = build2 (COMPOUND_EXPR, void_type_node, init_code, t2);
+ mapped_arg = build_fold_addr_expr (newd);
+ }
+ else
+ mapped_arg
+ = build_call_expr_loc (loc, fn, 2, actual_ptr, dispatch_device_num);
- for (tree c = dispatch_clauses; c; c = TREE_CHAIN (c))
- {
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IS_DEVICE_PTR
- || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR)
- {
- tree decl1 = DECL_NAME (OMP_CLAUSE_DECL (c));
- tree decl2 = tree_strip_nop_conversions (*arg_p);
- if (TREE_CODE (decl2) == ADDR_EXPR)
- decl2 = TREE_OPERAND (decl2, 0);
- if (VAR_P (decl2) || TREE_CODE (decl2) == PARM_DECL)
- {
- decl2 = DECL_NAME (decl2);
- if (decl1 == decl2
- && OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IS_DEVICE_PTR)
- {
- if (need_device_addr)
- warning_at (OMP_CLAUSE_LOCATION (c),
- OPT_Wopenmp,
- "%<is_device_ptr%> for %qD does"
- " not imply %<has_device_addr%> "
- "required for %<need_device_addr%>",
- OMP_CLAUSE_DECL (c));
- is_device_ptr = true;
- break;
- }
- else if (decl1 == decl2)
- {
- if (need_device_ptr)
- warning_at (OMP_CLAUSE_LOCATION (c),
- OPT_Wopenmp,
- "%<has_device_addr%> for %qD does"
- " not imply %<is_device_ptr%> "
- "required for %<need_device_ptr%>",
- OMP_CLAUSE_DECL (c));
- has_device_addr = true;
- break;
- }
- }
- }
- }
+ /* Cast mapped_arg back to its original type, and if we need a
+ reference, build one. */
+ mapped_arg = build1 (NOP_EXPR, actual_ptr_type, mapped_arg);
+ if (reference_to_ptr_p)
+ mapped_arg = build_fold_addr_expr (mapped_arg);
+ return mapped_arg;
+ };
- if ((need_device_ptr && !is_device_ptr)
- || (need_device_addr && !has_device_addr))
- {
- if (dispatch_device_num == NULL_TREE)
- {
- // device_num = omp_get_default_device ()
- tree fn
- = builtin_decl_explicit (BUILT_IN_OMP_GET_DEFAULT_DEVICE);
- tree call = build_call_expr (fn, 0);
- dispatch_device_num = create_tmp_var_raw (TREE_TYPE (call));
- tree init
- = build4 (TARGET_EXPR, TREE_TYPE (call),
- dispatch_device_num, call, NULL_TREE, NULL_TREE);
- if (init_code)
- init_code = build2 (COMPOUND_EXPR, TREE_TYPE (init),
- init_code, init);
- else
- init_code = init;
- }
+ /* Nothing to do for adjust_args? */
+ const bool adjust_args_needed = [&] ()
+ {
+ if (!dispatch_adjust_args_specifiers.exists ())
+ return false;
+ for (auto const& aa_spec : dispatch_adjust_args_specifiers)
+ {
+ if (aa_spec
+ && (TREE_PURPOSE (aa_spec) == need_ptr_id
+ || TREE_PURPOSE (aa_spec) == need_addr_id))
+ return true;
+ }
+ return false;
+ } (); /* IILE. */
- // We want to emit the following statement:
- // mapped_arg = omp_get_mapped_ptr (arg,
- // device_num)
- // but arg has to be the actual pointer, not a
- // reference or a conversion expression.
- tree actual_ptr
- = ((TREE_CODE (*arg_p) == ADDR_EXPR)
- ? TREE_OPERAND (*arg_p, 0)
- : *arg_p);
- if (TREE_CODE (actual_ptr) == NOP_EXPR
- && (TREE_CODE (TREE_TYPE (TREE_OPERAND (actual_ptr, 0)))
- == REFERENCE_TYPE))
- {
- actual_ptr = TREE_OPERAND (actual_ptr, 0);
- actual_ptr = build1 (INDIRECT_REF,
- TREE_TYPE (actual_ptr),
- actual_ptr);
- }
- tree fn = builtin_decl_explicit (BUILT_IN_OMP_GET_MAPPED_PTR);
- tree mapped_arg = build_call_expr_loc (loc, fn, 2, actual_ptr,
- dispatch_device_num);
-
- if (TREE_CODE (*arg_p) == ADDR_EXPR
- || (TREE_CODE (TREE_TYPE (actual_ptr)) == REFERENCE_TYPE))
- mapped_arg = build_fold_addr_expr (mapped_arg);
- else if (TREE_CODE (*arg_p) == NOP_EXPR)
- mapped_arg = build1 (NOP_EXPR, TREE_TYPE (*arg_p),
- mapped_arg);
- *arg_p = mapped_arg;
- }
+ if (adjust_args_needed)
+ {
+ /* FIXME: We need to check argument types. */
+ const int num_parms = nfirst_args ? nfirst_args : nargs;
+ /* adjust_the_arg returns arg unchanged if no adjustments are needed. */
+ for (int idx = 0; idx < num_parms; ++idx)
+ {
+ gcc_assert (dispatch_adjust_args_specifiers.length ()
+ > static_cast<size_t>(idx));
+ const tree aa_spec = dispatch_adjust_args_specifiers[idx];
+ tree *const arg = &CALL_EXPR_ARG (expr, idx);
+ *arg = adjust_the_arg (*arg, aa_spec);
+ }
+ /* Variadic args come after append_args args, we can't do adjust_args
+ until after append_args is done though because append_args needs to
+ push into init_code first. We can probably fix this, but until then
+ we just need to adjust our index into CALL_EXPR_ARG by the number of
+ appended args.
+ It would just be simpler if we could handle adjust_args first, but I
+ don't know if there is a trivial way of handling the init_code
+ ordering.
+ This only handles varargs in functions that have an append_args
+ clause, varargs are handled in the above loop otherwise and this loop
+ is skipped. */
+ const int varargs_start = num_parms;
+ for (int idx = varargs_start; idx < nargs; ++idx)
+ {
+ gcc_assert (dispatch_adjust_args_specifiers.length ()
+ > static_cast<size_t>(idx));
+ const tree aa_spec = dispatch_adjust_args_specifiers[idx];
+ const int call_expr_arg_idx = idx + nappend;
+ tree *const arg = &CALL_EXPR_ARG (expr, call_expr_arg_idx);
+ *arg = adjust_the_arg (*arg, aa_spec);
}
}
- add_cleanup:
if (cleanup)
{
tree result = NULL_TREE;
@@ -8670,20 +9004,27 @@ omp_add_variable (struct gimplify_omp_ctx *ctx, tree decl, unsigned int flags)
else
splay_tree_insert (ctx->variables, (splay_tree_key)decl, flags);
- /* For reductions clauses in OpenACC loop directives, by default create a
- copy clause on the enclosing parallel construct for carrying back the
- results. */
+ /* For OpenACC loop directives, when a reduction clause is placed on
+ the outermost acc loop within an acc parallel or kernels
+ construct, it must have an implied copy data mapping. E.g.
+
+ #pragma acc parallel
+ {
+ #pragma acc loop reduction (+:sum)
+
+ a copy clause for sum should be added on the enclosing parallel
+ construct for carrying back the results. */
if (ctx->region_type == ORT_ACC && (flags & GOVD_REDUCTION))
{
struct gimplify_omp_ctx *outer_ctx = ctx->outer_context;
- while (outer_ctx)
+ if (outer_ctx)
{
n = splay_tree_lookup (outer_ctx->variables, (splay_tree_key)decl);
if (n != NULL)
{
/* Ignore local variables and explicitly declared clauses. */
if (n->value & (GOVD_LOCAL | GOVD_EXPLICIT))
- break;
+ ;
else if (outer_ctx->region_type == ORT_ACC_KERNELS)
{
/* According to the OpenACC spec, such a reduction variable
@@ -8703,9 +9044,7 @@ omp_add_variable (struct gimplify_omp_ctx *ctx, tree decl, unsigned int flags)
{
splay_tree_insert (outer_ctx->variables, (splay_tree_key)decl,
GOVD_MAP | GOVD_SEEN);
- break;
}
- outer_ctx = outer_ctx->outer_context;
}
}
}
@@ -9214,6 +9553,7 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code)
error ("variable %qE declared in enclosing "
"%<host_data%> region", DECL_NAME (decl));
nflags |= GOVD_MAP;
+ nflags |= (n2->value & GOVD_DEVICEPTR);
if (octx->region_type == ORT_ACC_DATA
&& (n2->value & GOVD_MAP_0LEN_ARRAY))
nflags |= GOVD_MAP_0LEN_ARRAY;
@@ -9523,9 +9863,7 @@ gimplify_omp_affinity (tree *list_p, gimple_seq *pre_p)
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
{
tree t = OMP_CLAUSE_DECL (c);
- if (TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (t))
{
if (TREE_VALUE (t) == null_pointer_node)
continue;
@@ -9539,19 +9877,19 @@ gimplify_omp_affinity (tree *list_p, gimple_seq *pre_p)
}
for (tree it = TREE_PURPOSE (t); it; it = TREE_CHAIN (it))
{
- if (gimplify_expr (&TREE_VEC_ELT (it, 1), pre_p, NULL,
+ if (gimplify_expr (&OMP_ITERATORS_BEGIN (it), pre_p, NULL,
is_gimple_val, fb_rvalue) == GS_ERROR
- || gimplify_expr (&TREE_VEC_ELT (it, 2), pre_p, NULL,
+ || gimplify_expr (&OMP_ITERATORS_END (it), pre_p, NULL,
is_gimple_val, fb_rvalue) == GS_ERROR
- || gimplify_expr (&TREE_VEC_ELT (it, 3), pre_p, NULL,
+ || gimplify_expr (&OMP_ITERATORS_STEP (it), pre_p, NULL,
is_gimple_val, fb_rvalue) == GS_ERROR
- || (gimplify_expr (&TREE_VEC_ELT (it, 4), pre_p, NULL,
- is_gimple_val, fb_rvalue)
+ || (gimplify_expr (&OMP_ITERATORS_ORIG_STEP (it), pre_p,
+ NULL, is_gimple_val, fb_rvalue)
== GS_ERROR))
return;
}
last_iter = TREE_PURPOSE (t);
- tree block = TREE_VEC_ELT (TREE_PURPOSE (t), 5);
+ tree block = OMP_ITERATORS_BLOCK (TREE_PURPOSE (t));
last_bind = build3 (BIND_EXPR, void_type_node, BLOCK_VARS (block),
NULL, block);
last_body = &BIND_EXPR_BODY (last_bind);
@@ -9559,10 +9897,10 @@ gimplify_omp_affinity (tree *list_p, gimple_seq *pre_p)
location_t loc = OMP_CLAUSE_LOCATION (c);
for (tree it = TREE_PURPOSE (t); it; it = TREE_CHAIN (it))
{
- tree var = TREE_VEC_ELT (it, 0);
- tree begin = TREE_VEC_ELT (it, 1);
- tree end = TREE_VEC_ELT (it, 2);
- tree step = TREE_VEC_ELT (it, 3);
+ tree var = OMP_ITERATORS_VAR (it);
+ tree begin = OMP_ITERATORS_BEGIN (it);
+ tree end = OMP_ITERATORS_END (it);
+ tree step = OMP_ITERATORS_STEP (it);
loc = DECL_SOURCE_LOCATION (var);
tree tem = build2_loc (loc, MODIFY_EXPR, void_type_node,
var, begin);
@@ -9630,6 +9968,640 @@ gimplify_omp_affinity (tree *list_p, gimple_seq *pre_p)
return;
}
+/* Returns a tree expression containing the total iteration count of the
+ OpenMP iterator IT. */
+
+static tree
+compute_omp_iterator_count (tree it, gimple_seq *pre_p)
+{
+ tree tcnt = size_one_node;
+ for (; it; it = TREE_CHAIN (it))
+ {
+ if (gimplify_expr (&OMP_ITERATORS_BEGIN (it), pre_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR
+ || gimplify_expr (&OMP_ITERATORS_END (it), pre_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR
+ || gimplify_expr (&OMP_ITERATORS_STEP (it), pre_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR
+ || (gimplify_expr (&OMP_ITERATORS_ORIG_STEP (it), pre_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR))
+ return NULL_TREE;
+ tree var = OMP_ITERATORS_VAR (it);
+ tree begin = OMP_ITERATORS_BEGIN (it);
+ tree end = OMP_ITERATORS_END (it);
+ tree step = OMP_ITERATORS_STEP (it);
+ tree orig_step = OMP_ITERATORS_ORIG_STEP (it);
+ tree type = TREE_TYPE (var);
+ tree stype = TREE_TYPE (step);
+ location_t loc = DECL_SOURCE_LOCATION (var);
+ tree endmbegin;
+ /* Compute count for this iterator as
+ orig_step > 0
+ ? (begin < end ? (end - begin + (step - 1)) / step : 0)
+ : (begin > end ? (end - begin + (step + 1)) / step : 0)
+ and compute product of those for the entire clause. */
+ if (POINTER_TYPE_P (type))
+ endmbegin = fold_build2_loc (loc, POINTER_DIFF_EXPR, stype, end, begin);
+ else
+ endmbegin = fold_build2_loc (loc, MINUS_EXPR, type, end, begin);
+ /* Account for iteration stopping on the end value in Fortran rather
+ than before it. */
+ tree stepm1 = step;
+ tree stepp1 = step;
+ if (!lang_GNU_Fortran ())
+ {
+ stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step,
+ build_int_cst (stype, 1));
+ stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step,
+ build_int_cst (stype, 1));
+ }
+ tree pos = fold_build2_loc (loc, PLUS_EXPR, stype,
+ unshare_expr (endmbegin), stepm1);
+ pos = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, pos, step);
+ tree neg = fold_build2_loc (loc, PLUS_EXPR, stype, endmbegin, stepp1);
+ if (TYPE_UNSIGNED (stype))
+ {
+ neg = fold_build1_loc (loc, NEGATE_EXPR, stype, neg);
+ step = fold_build1_loc (loc, NEGATE_EXPR, stype, step);
+ }
+ neg = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, neg, step);
+ step = NULL_TREE;
+ tree_code cmp_op = lang_GNU_Fortran () ? LE_EXPR : LT_EXPR;
+ tree cond = fold_build2_loc (loc, cmp_op, boolean_type_node, begin, end);
+ pos = fold_build3_loc (loc, COND_EXPR, stype, cond, pos,
+ build_int_cst (stype, 0));
+ cond = fold_build2_loc (loc, cmp_op, boolean_type_node, end, begin);
+ neg = fold_build3_loc (loc, COND_EXPR, stype, cond, neg,
+ build_int_cst (stype, 0));
+ tree osteptype = TREE_TYPE (orig_step);
+ cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, orig_step,
+ build_int_cst (osteptype, 0));
+ tree cnt = fold_build3_loc (loc, COND_EXPR, stype, cond, pos, neg);
+ cnt = fold_convert_loc (loc, sizetype, cnt);
+ if (gimplify_expr (&cnt, pre_p, NULL, is_gimple_val,
+ fb_rvalue) == GS_ERROR)
+ return NULL_TREE;
+ tcnt = size_binop_loc (loc, MULT_EXPR, tcnt, cnt);
+ }
+ if (gimplify_expr (&tcnt, pre_p, NULL, is_gimple_val, fb_rvalue) == GS_ERROR)
+ return NULL_TREE;
+
+ return tcnt;
+}
+
+/* Build loops iterating over the space defined by the OpenMP iterator IT.
+ Returns a pointer to the BIND_EXPR_BODY in the innermost loop body.
+ LAST_BIND is set to point to the BIND_EXPR containing the whole loop. */
+
+static tree *
+build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
+{
+ if (*last_bind)
+ gimplify_and_add (*last_bind, pre_p);
+ tree block = OMP_ITERATORS_BLOCK (it);
+ tree block_stmts = lang_GNU_Fortran () ? BLOCK_SUBBLOCKS (block) : NULL_TREE;
+ *last_bind = build3 (BIND_EXPR, void_type_node,
+ BLOCK_VARS (block), NULL, block);
+ TREE_SIDE_EFFECTS (*last_bind) = 1;
+ tree *p = &BIND_EXPR_BODY (*last_bind);
+ for (; it; it = TREE_CHAIN (it))
+ {
+ tree var = OMP_ITERATORS_VAR (it);
+ tree begin = OMP_ITERATORS_BEGIN (it);
+ tree end = OMP_ITERATORS_END (it);
+ tree step = OMP_ITERATORS_STEP (it);
+ tree orig_step = OMP_ITERATORS_ORIG_STEP (it);
+ block = OMP_ITERATORS_BLOCK (it);
+ tree type = TREE_TYPE (var);
+ location_t loc = DECL_SOURCE_LOCATION (var);
+ /* Emit:
+ var = begin;
+ goto cond_label;
+ beg_label:
+ ...
+ var = var + step;
+ cond_label:
+ if (orig_step > 0) {
+ if (var < end) goto beg_label; // <= for Fortran
+ } else {
+ if (var > end) goto beg_label; // >= for Fortran
+ }
+ for each iterator, with inner iterators added to
+ the ... above. */
+ tree beg_label = create_artificial_label (loc);
+ tree cond_label = NULL_TREE;
+ tree tem = build2_loc (loc, MODIFY_EXPR, void_type_node, var, begin);
+ append_to_statement_list_force (tem, p);
+ tem = build_and_jump (&cond_label);
+ append_to_statement_list_force (tem, p);
+ tem = build1 (LABEL_EXPR, void_type_node, beg_label);
+ append_to_statement_list (tem, p);
+ tree bind = build3 (BIND_EXPR, void_type_node, NULL_TREE,
+ NULL_TREE, NULL_TREE);
+ TREE_SIDE_EFFECTS (bind) = 1;
+ SET_EXPR_LOCATION (bind, loc);
+ append_to_statement_list_force (bind, p);
+ if (POINTER_TYPE_P (type))
+ tem = build2_loc (loc, POINTER_PLUS_EXPR, type,
+ var, fold_convert_loc (loc, sizetype, step));
+ else
+ tem = build2_loc (loc, PLUS_EXPR, type, var, step);
+ tem = build2_loc (loc, MODIFY_EXPR, void_type_node, var, tem);
+ append_to_statement_list_force (tem, p);
+ tem = build1 (LABEL_EXPR, void_type_node, cond_label);
+ append_to_statement_list (tem, p);
+ tree cond = fold_build2_loc (loc, lang_GNU_Fortran () ? LE_EXPR : LT_EXPR,
+ boolean_type_node, var, end);
+ tree pos = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
+ build_and_jump (&beg_label), void_node);
+ cond = fold_build2_loc (loc, lang_GNU_Fortran () ? GE_EXPR : GT_EXPR,
+ boolean_type_node, var, end);
+ tree neg = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
+ build_and_jump (&beg_label), void_node);
+ tree osteptype = TREE_TYPE (orig_step);
+ cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, orig_step,
+ build_int_cst (osteptype, 0));
+ tem = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, pos, neg);
+ append_to_statement_list_force (tem, p);
+ p = &BIND_EXPR_BODY (bind);
+ /* The Fortran front-end stashes statements into the BLOCK_SUBBLOCKS
+ of the last element of the first iterator. These should go into the
+ body of the innermost loop. */
+ if (!TREE_CHAIN (it))
+ append_to_statement_list_force (block_stmts, p);
+ }
+
+ return p;
+}
+
+
+/* Callback for walk_tree to find a VAR_DECL (stored in DATA) in the
+ tree TP. */
+
+static tree
+find_var_decl (tree *tp, int *, void *data)
+{
+ if (*tp == (tree) data)
+ return *tp;
+
+ return NULL_TREE;
+}
+
+/* Returns an element-by-element copy of OMP iterator tree IT. */
+
+static tree
+copy_omp_iterator (tree it, int elem_count = -1)
+{
+ if (elem_count < 0)
+ elem_count = TREE_VEC_LENGTH (it);
+ tree new_it = make_tree_vec (elem_count);
+ for (int i = 0; i < TREE_VEC_LENGTH (it); i++)
+ TREE_VEC_ELT (new_it, i) = TREE_VEC_ELT (it, i);
+
+ return new_it;
+}
+
+/* Helper function for walk_tree in remap_omp_iterator_var. */
+
+static tree
+remap_omp_iterator_var_1 (tree *tp, int *, void *data)
+{
+ tree old_var = ((tree *) data)[0];
+ tree new_var = ((tree *) data)[1];
+
+ if (*tp == old_var)
+ *tp = new_var;
+ return NULL_TREE;
+}
+
+/* Replace instances of OLD_VAR in TP with NEW_VAR. */
+
+static void
+remap_omp_iterator_var (tree *tp, tree old_var, tree new_var)
+{
+ tree vars[2] = { old_var, new_var };
+ walk_tree (tp, remap_omp_iterator_var_1, vars, NULL);
+}
+
+/* Scan through all clauses using OpenMP iterators in LIST_P. If any
+ clauses have iterators with variables that are not used by the clause
+ decl or size, issue a warning and replace the iterator with a copy with
+ the unused variables removed. */
+
+static void
+remove_unused_omp_iterator_vars (tree *list_p)
+{
+ auto_vec< vec<tree> > iter_vars;
+ auto_vec<tree> new_iterators;
+
+ for (tree c = *list_p; c; c = OMP_CLAUSE_CHAIN (c))
+ {
+ if (!OMP_CLAUSE_HAS_ITERATORS (c))
+ continue;
+ auto_vec<tree> vars;
+ bool need_new_iterators = false;
+ for (tree it = OMP_CLAUSE_ITERATORS (c); it; it = TREE_CHAIN (it))
+ {
+ tree var = OMP_ITERATORS_VAR (it);
+ tree t = walk_tree (&OMP_CLAUSE_DECL (c), find_var_decl, var, NULL);
+ if (t == NULL_TREE)
+ t = walk_tree (&OMP_CLAUSE_SIZE (c), find_var_decl, var, NULL);
+ if (t == NULL_TREE)
+ {
+ need_new_iterators = true;
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP
+ || OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ATTACH_DETACH)
+ warning_at (OMP_CLAUSE_LOCATION (c), 0,
+ "iterator variable %qE not used in clause "
+ "expression", DECL_NAME (var));
+ }
+ else
+ vars.safe_push (var);
+ }
+ if (!need_new_iterators)
+ continue;
+ if (need_new_iterators && vars.is_empty ())
+ {
+ /* No iteration variables are used in the clause - remove the
+ iterator from the clause. */
+ OMP_CLAUSE_ITERATORS (c) = NULL_TREE;
+ continue;
+ }
+
+ /* If a new iterator has been created for the current set of used
+ iterator variables, then use that as the iterator. Otherwise,
+ create a new iterator for the current iterator variable set. */
+ unsigned i;
+ for (i = 0; i < iter_vars.length (); i++)
+ {
+ if (vars.length () != iter_vars[i].length ())
+ continue;
+ bool identical_p = true;
+ for (unsigned j = 0; j < vars.length () && identical_p; j++)
+ identical_p = vars[j] == iter_vars[i][j];
+
+ if (identical_p)
+ break;
+ }
+ if (i < iter_vars.length ())
+ OMP_CLAUSE_ITERATORS (c) = new_iterators[i];
+ else
+ {
+ tree new_iters = NULL_TREE;
+ tree *new_iters_p = &new_iters;
+ tree new_vars = NULL_TREE;
+ tree *new_vars_p = &new_vars;
+ i = 0;
+ for (tree it = OMP_CLAUSE_ITERATORS (c); it && i < vars.length();
+ it = TREE_CHAIN (it))
+ {
+ tree var = OMP_ITERATORS_VAR (it);
+ if (var == vars[i])
+ {
+ *new_iters_p = copy_omp_iterator (it);
+ *new_vars_p = build_decl (OMP_CLAUSE_LOCATION (c), VAR_DECL,
+ DECL_NAME (var), TREE_TYPE (var));
+ DECL_ARTIFICIAL (*new_vars_p) = 1;
+ DECL_CONTEXT (*new_vars_p) = DECL_CONTEXT (var);
+ OMP_ITERATORS_VAR (*new_iters_p) = *new_vars_p;
+ new_iters_p = &TREE_CHAIN (*new_iters_p);
+ new_vars_p = &DECL_CHAIN (*new_vars_p);
+ i++;
+ }
+ }
+ tree old_block = OMP_ITERATORS_BLOCK (OMP_CLAUSE_ITERATORS (c));
+ tree new_block = make_node (BLOCK);
+ BLOCK_VARS (new_block) = new_vars;
+ if (BLOCK_SUBBLOCKS (old_block))
+ {
+ BLOCK_SUBBLOCKS (new_block) = BLOCK_SUBBLOCKS (old_block);
+ BLOCK_SUBBLOCKS (old_block) = NULL_TREE;
+ }
+ OMP_ITERATORS_BLOCK (new_iters) = new_block;
+ new_iterators.safe_push (new_iters);
+ iter_vars.safe_push (vars.copy ());
+ OMP_CLAUSE_ITERATORS (c) = new_iters;
+ }
+
+ /* Remap clause to use the new variables. */
+ i = 0;
+ for (tree it = OMP_CLAUSE_ITERATORS (c); it; it = TREE_CHAIN (it))
+ {
+ tree old_var = vars[i++];
+ tree new_var = OMP_ITERATORS_VAR (it);
+ remap_omp_iterator_var (&OMP_CLAUSE_DECL (c), old_var, new_var);
+ remap_omp_iterator_var (&OMP_CLAUSE_SIZE (c), old_var, new_var);
+ }
+ }
+
+ for (unsigned i = 0; i < iter_vars.length (); i++)
+ iter_vars[i].release ();
+}
+
+struct iterator_loop_info_t
+{
+ tree bind;
+ tree count;
+ tree index;
+ tree body_label;
+ auto_vec<tree> clauses;
+};
+
+typedef hash_map<tree, iterator_loop_info_t> iterator_loop_info_map_t;
+
+tree
+omp_iterator_elems_length (tree count)
+{
+ tree count_2 = size_binop (MULT_EXPR, count, size_int (2));
+ return size_binop (PLUS_EXPR, count_2, size_int (1));
+}
+
+/* Builds a loop to expand any OpenMP iterators in the clauses in LIST_P,
+ reusing any previously built loops if they use the same set of iterators.
+ Generated Gimple statements are placed into LOOPS_SEQ_P. The clause
+ iterators are updated with information on how and where to insert code into
+ the loop body. */
+
+static void
+build_omp_iterators_loops (tree *list_p, gimple_seq *loops_seq_p)
+{
+ iterator_loop_info_map_t loops;
+
+ for (tree c = *list_p; c; c = OMP_CLAUSE_CHAIN (c))
+ {
+ if (!OMP_CLAUSE_HAS_ITERATORS (c))
+ continue;
+
+ bool built_p;
+ iterator_loop_info_t &loop
+ = loops.get_or_insert (OMP_CLAUSE_ITERATORS (c), &built_p);
+
+ if (!built_p)
+ {
+ loop.count = compute_omp_iterator_count (OMP_CLAUSE_ITERATORS (c),
+ loops_seq_p);
+ if (!loop.count)
+ continue;
+
+ loop.bind = NULL_TREE;
+ tree *body = build_omp_iterator_loop (OMP_CLAUSE_ITERATORS (c),
+ loops_seq_p, &loop.bind);
+
+ loop.index = create_tmp_var (sizetype);
+ SET_EXPR_LOCATION (loop.bind, OMP_CLAUSE_LOCATION (c));
+
+ /* BEFORE LOOP: */
+ /* idx = -1; */
+ /* This should be initialized to before the individual elements,
+ as idx is pre-incremented in the loop body. */
+ gimple *assign = gimple_build_assign (loop.index, size_int (-1));
+ gimple_seq_add_stmt (loops_seq_p, assign);
+
+ /* IN LOOP BODY: */
+ /* Create a label so we can find this point later. */
+ loop.body_label = create_artificial_label (OMP_CLAUSE_LOCATION (c));
+ tree tem = build1 (LABEL_EXPR, void_type_node, loop.body_label);
+ append_to_statement_list_force (tem, body);
+
+ /* idx += 2; */
+ tem = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR,
+ void_type_node, loop.index,
+ size_binop (PLUS_EXPR, loop.index, size_int (2)));
+ append_to_statement_list_force (tem, body);
+ }
+
+ /* Create array to hold expanded values. */
+ tree arr_length = omp_iterator_elems_length (loop.count);
+ tree elems_type = TREE_CONSTANT (arr_length)
+ ? build_array_type (ptr_type_node,
+ build_index_type (arr_length))
+ : build_pointer_type (ptr_type_node);
+ tree elems = create_tmp_var_raw (elems_type, "omp_iter_data");
+ TREE_ADDRESSABLE (elems) = 1;
+ gimple_add_tmp_var (elems);
+
+ /* BEFORE LOOP: */
+ /* elems[0] = count; */
+ tree lhs = TREE_CODE (TREE_TYPE (elems)) == ARRAY_TYPE
+ ? build4 (ARRAY_REF, ptr_type_node, elems, size_int (0), NULL_TREE,
+ NULL_TREE)
+ : build1 (INDIRECT_REF, ptr_type_node, elems);
+ tree tem = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR,
+ void_type_node, lhs, loop.count);
+ gimplify_and_add (tem, loops_seq_p);
+
+ /* Make a copy of the iterator with extra info at the end. */
+ int elem_count = TREE_VEC_LENGTH (OMP_CLAUSE_ITERATORS (c));
+ tree new_iterator = copy_omp_iterator (OMP_CLAUSE_ITERATORS (c),
+ elem_count + 4);
+ OMP_ITERATORS_LABEL (new_iterator) = loop.body_label;
+ OMP_ITERATORS_INDEX (new_iterator) = loop.index;
+ OMP_ITERATORS_ELEMS (new_iterator) = elems;
+ OMP_ITERATORS_COUNT (new_iterator) = loop.count;
+ TREE_CHAIN (new_iterator) = TREE_CHAIN (OMP_CLAUSE_ITERATORS (c));
+ OMP_CLAUSE_ITERATORS (c) = new_iterator;
+
+ loop.clauses.safe_push (c);
+ }
+
+ /* Now gimplify and add all the loops that were built. */
+ for (hash_map<tree, iterator_loop_info_t>::iterator it = loops.begin ();
+ it != loops.end (); ++it)
+ gimplify_and_add ((*it).second.bind, loops_seq_p);
+}
+
+/* Helper function for enter_omp_iterator_loop_context. */
+
+static gimple_seq *
+enter_omp_iterator_loop_context_1 (tree iterator, gimple_seq *loops_seq_p)
+{
+ /* Drill into the nested bind expressions to get to the loop body. */
+ for (gimple_stmt_iterator gsi = gsi_start (*loops_seq_p);
+ !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ gimple *stmt = gsi_stmt (gsi);
+
+ switch (gimple_code (stmt))
+ {
+ case GIMPLE_BIND:
+ {
+ gbind *bind_stmt = as_a<gbind *> (stmt);
+ gimple_push_bind_expr (bind_stmt);
+ gimple_seq *bind_body_p = gimple_bind_body_ptr (bind_stmt);
+ gimple_seq *seq =
+ enter_omp_iterator_loop_context_1 (iterator, bind_body_p);
+ if (seq)
+ return seq;
+ gimple_pop_bind_expr ();
+ }
+ break;
+ case GIMPLE_TRY:
+ {
+ gimple_seq *try_eval_p = gimple_try_eval_ptr (stmt);
+ gimple_seq *seq =
+ enter_omp_iterator_loop_context_1 (iterator, try_eval_p);
+ if (seq)
+ return seq;
+ }
+ break;
+ case GIMPLE_LABEL:
+ {
+ glabel *label_stmt = as_a<glabel *> (stmt);
+ tree label = gimple_label_label (label_stmt);
+ if (label == OMP_ITERATORS_LABEL (iterator))
+ return loops_seq_p;
+ }
+ break;
+ default:
+ break;
+ }
+ }
+
+ return NULL;
+}
+
+gimple_seq *
+enter_omp_iterator_loop_context (tree iterator, gimple_seq *loops_seq_p)
+{
+ push_gimplify_context ();
+
+ gimple_seq *seq = enter_omp_iterator_loop_context_1 (iterator, loops_seq_p);
+ gcc_assert (seq);
+ return seq;
+}
+
+/* Enter the Gimplification context in LOOPS_SEQ_P for the iterator loop
+ associated with OpenMP clause C. Returns the gimple_seq for the loop body
+ if C has OpenMP iterators, or ALT_SEQ_P if not. */
+
+static gimple_seq *
+enter_omp_iterator_loop_context (tree c, gimple_seq *loops_seq_p,
+ gimple_seq *alt_seq_p)
+{
+ if (!OMP_CLAUSE_HAS_ITERATORS (c))
+ return alt_seq_p;
+
+ return enter_omp_iterator_loop_context (OMP_CLAUSE_ITERATORS (c),
+ loops_seq_p);
+}
+
+/* Enter the Gimplification context in STMT for the iterator loop associated
+ with OpenMP clause C. Returns the gimple_seq for the loop body if C has
+ OpenMP iterators, or ALT_SEQ_P if not. */
+
+gimple_seq *
+enter_omp_iterator_loop_context (tree c, gomp_target *stmt,
+ gimple_seq *alt_seq_p)
+{
+ gimple_seq *loops_seq_p = gimple_omp_target_iterator_loops_ptr (stmt);
+ return enter_omp_iterator_loop_context (c, loops_seq_p, alt_seq_p);
+}
+
+void
+exit_omp_iterator_loop_context (void)
+{
+ while (!gimplify_ctxp->bind_expr_stack.is_empty ())
+ gimple_pop_bind_expr ();
+ pop_gimplify_context (NULL);
+}
+
+/* Exit the Gimplification context for the OpenMP clause C. */
+
+void
+exit_omp_iterator_loop_context (tree c)
+{
+ if (!OMP_CLAUSE_HAS_ITERATORS (c))
+ return;
+ exit_omp_iterator_loop_context ();
+}
+
+void
+assign_to_iterator_elems_array (tree t, tree iterator, gomp_target *stmt,
+ int index_offset)
+{
+ tree index = OMP_ITERATORS_INDEX (iterator);
+ if (index_offset)
+ index = size_binop (PLUS_EXPR, index, size_int (index_offset));
+ tree elems = OMP_ITERATORS_ELEMS (iterator);
+ gimple_seq *loop_body_p = gimple_omp_target_iterator_loops_ptr (stmt);
+ loop_body_p = enter_omp_iterator_loop_context (iterator, loop_body_p);
+
+ /* IN LOOP BODY: */
+ /* elems[index+index_offset] = t; */
+ tree lhs;
+ if (TREE_CODE (TREE_TYPE (elems)) == ARRAY_TYPE)
+ lhs = build4 (ARRAY_REF, ptr_type_node, elems, index, NULL_TREE, NULL_TREE);
+ else
+ {
+ tree tmp = size_binop (MULT_EXPR, index, TYPE_SIZE_UNIT (ptr_type_node));
+ tmp = size_binop (POINTER_PLUS_EXPR, elems, tmp);
+ lhs = build1 (INDIRECT_REF, ptr_type_node, tmp);
+ }
+ gimplify_assign (lhs, t, loop_body_p);
+ exit_omp_iterator_loop_context ();
+}
+
+tree
+add_new_omp_iterators_entry (tree iters, gimple_seq *loops_seq_p)
+{
+ gimple_stmt_iterator gsi;
+ gcc_assert (OMP_ITERATORS_EXPANDED_P (iters));
+
+ /* Search for <index> = -1. */
+ tree index = OMP_ITERATORS_INDEX (iters);
+ for (gsi = gsi_start (*loops_seq_p); !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ gimple *stmt = gsi_stmt (gsi);
+ if (gimple_code (stmt) == GIMPLE_ASSIGN
+ && gimple_assign_lhs (stmt) == index
+ && gimple_assign_rhs1 (stmt) == size_int (-1))
+ break;
+ }
+ gcc_assert (!gsi_end_p (gsi));
+
+ /* Create array for this clause. */
+ tree arr_length = omp_iterator_elems_length (OMP_ITERATORS_COUNT (iters));
+ tree elems_type = TREE_CONSTANT (arr_length)
+ ? build_array_type (ptr_type_node,
+ build_index_type (arr_length))
+ : build_pointer_type (ptr_type_node);
+ tree elems = create_tmp_var_raw (elems_type, "omp_iter_data");
+ TREE_ADDRESSABLE (elems) = 1;
+ gimple_add_tmp_var (elems);
+
+ /* BEFORE LOOP: */
+ /* elems[0] = count; */
+ tree lhs = TREE_CODE (TREE_TYPE (elems)) == ARRAY_TYPE
+ ? build4 (ARRAY_REF, ptr_type_node, elems, size_int (0), NULL_TREE,
+ NULL_TREE)
+ : build1 (INDIRECT_REF, ptr_type_node, elems);
+
+ gimple_seq assign_seq = NULL;
+ gimplify_assign (lhs, OMP_ITERATORS_COUNT (iters), &assign_seq);
+ gsi_insert_seq_after (&gsi, assign_seq, GSI_SAME_STMT);
+
+ /* Update iterator information. */
+ tree new_iterator = copy_omp_iterator (iters);
+ OMP_ITERATORS_ELEMS (new_iterator) = elems;
+ TREE_CHAIN (new_iterator) = TREE_CHAIN (iters);
+
+ return new_iterator;
+}
+
+/* Insert new OpenMP clause C into pre-existing iterator loop LOOPS_SEQ_P.
+ If the clause has an iterator, then that iterator is assumed to be in
+ the expanded form (i.e. it has info regarding the loop, expanded elements
+ etc.). */
+
+void
+add_new_omp_iterators_clause (tree c, gimple_seq *loops_seq_p)
+{
+ tree iters = OMP_CLAUSE_ITERATORS (c);
+ if (!iters)
+ return;
+ OMP_CLAUSE_ITERATORS (c) = add_new_omp_iterators_entry (iters, loops_seq_p);
+}
+
/* If *LIST_P contains any OpenMP depend clauses with iterators,
lower all the depend clauses by populating corresponding depend
array. Returns 0 if there are no such depend clauses, or
@@ -9674,89 +10646,13 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p)
tree t = OMP_CLAUSE_DECL (c);
if (first_loc == UNKNOWN_LOCATION)
first_loc = OMP_CLAUSE_LOCATION (c);
- if (TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (t))
{
if (TREE_PURPOSE (t) != last_iter)
{
- tree tcnt = size_one_node;
- for (tree it = TREE_PURPOSE (t); it; it = TREE_CHAIN (it))
- {
- if (gimplify_expr (&TREE_VEC_ELT (it, 1), pre_p, NULL,
- is_gimple_val, fb_rvalue) == GS_ERROR
- || gimplify_expr (&TREE_VEC_ELT (it, 2), pre_p, NULL,
- is_gimple_val, fb_rvalue) == GS_ERROR
- || gimplify_expr (&TREE_VEC_ELT (it, 3), pre_p, NULL,
- is_gimple_val, fb_rvalue) == GS_ERROR
- || (gimplify_expr (&TREE_VEC_ELT (it, 4), pre_p, NULL,
- is_gimple_val, fb_rvalue)
- == GS_ERROR))
- return 2;
- tree var = TREE_VEC_ELT (it, 0);
- tree begin = TREE_VEC_ELT (it, 1);
- tree end = TREE_VEC_ELT (it, 2);
- tree step = TREE_VEC_ELT (it, 3);
- tree orig_step = TREE_VEC_ELT (it, 4);
- tree type = TREE_TYPE (var);
- tree stype = TREE_TYPE (step);
- location_t loc = DECL_SOURCE_LOCATION (var);
- tree endmbegin;
- /* Compute count for this iterator as
- orig_step > 0
- ? (begin < end ? (end - begin + (step - 1)) / step : 0)
- : (begin > end ? (end - begin + (step + 1)) / step : 0)
- and compute product of those for the entire depend
- clause. */
- if (POINTER_TYPE_P (type))
- endmbegin = fold_build2_loc (loc, POINTER_DIFF_EXPR,
- stype, end, begin);
- else
- endmbegin = fold_build2_loc (loc, MINUS_EXPR, type,
- end, begin);
- tree stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype,
- step,
- build_int_cst (stype, 1));
- tree stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step,
- build_int_cst (stype, 1));
- tree pos = fold_build2_loc (loc, PLUS_EXPR, stype,
- unshare_expr (endmbegin),
- stepm1);
- pos = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype,
- pos, step);
- tree neg = fold_build2_loc (loc, PLUS_EXPR, stype,
- endmbegin, stepp1);
- if (TYPE_UNSIGNED (stype))
- {
- neg = fold_build1_loc (loc, NEGATE_EXPR, stype, neg);
- step = fold_build1_loc (loc, NEGATE_EXPR, stype, step);
- }
- neg = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype,
- neg, step);
- step = NULL_TREE;
- tree cond = fold_build2_loc (loc, LT_EXPR,
- boolean_type_node,
- begin, end);
- pos = fold_build3_loc (loc, COND_EXPR, stype, cond, pos,
- build_int_cst (stype, 0));
- cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node,
- end, begin);
- neg = fold_build3_loc (loc, COND_EXPR, stype, cond, neg,
- build_int_cst (stype, 0));
- tree osteptype = TREE_TYPE (orig_step);
- cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node,
- orig_step,
- build_int_cst (osteptype, 0));
- tree cnt = fold_build3_loc (loc, COND_EXPR, stype,
- cond, pos, neg);
- cnt = fold_convert_loc (loc, sizetype, cnt);
- if (gimplify_expr (&cnt, pre_p, NULL, is_gimple_val,
- fb_rvalue) == GS_ERROR)
- return 2;
- tcnt = size_binop_loc (loc, MULT_EXPR, tcnt, cnt);
- }
- if (gimplify_expr (&tcnt, pre_p, NULL, is_gimple_val,
- fb_rvalue) == GS_ERROR)
+ tree tcnt = compute_omp_iterator_count (TREE_PURPOSE (t),
+ pre_p);
+ if (!tcnt)
return 2;
last_iter = TREE_PURPOSE (t);
last_count = tcnt;
@@ -9910,91 +10806,13 @@ gimplify_omp_depend (tree *list_p, gimple_seq *pre_p)
gcc_unreachable ();
}
tree t = OMP_CLAUSE_DECL (c);
- if (TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (t))
{
if (TREE_PURPOSE (t) != last_iter)
{
- if (last_bind)
- gimplify_and_add (last_bind, pre_p);
- tree block = TREE_VEC_ELT (TREE_PURPOSE (t), 5);
- last_bind = build3 (BIND_EXPR, void_type_node,
- BLOCK_VARS (block), NULL, block);
- TREE_SIDE_EFFECTS (last_bind) = 1;
+ last_body = build_omp_iterator_loop (TREE_PURPOSE (t), pre_p,
+ &last_bind);
SET_EXPR_LOCATION (last_bind, OMP_CLAUSE_LOCATION (c));
- tree *p = &BIND_EXPR_BODY (last_bind);
- for (tree it = TREE_PURPOSE (t); it; it = TREE_CHAIN (it))
- {
- tree var = TREE_VEC_ELT (it, 0);
- tree begin = TREE_VEC_ELT (it, 1);
- tree end = TREE_VEC_ELT (it, 2);
- tree step = TREE_VEC_ELT (it, 3);
- tree orig_step = TREE_VEC_ELT (it, 4);
- tree type = TREE_TYPE (var);
- location_t loc = DECL_SOURCE_LOCATION (var);
- /* Emit:
- var = begin;
- goto cond_label;
- beg_label:
- ...
- var = var + step;
- cond_label:
- if (orig_step > 0) {
- if (var < end) goto beg_label;
- } else {
- if (var > end) goto beg_label;
- }
- for each iterator, with inner iterators added to
- the ... above. */
- tree beg_label = create_artificial_label (loc);
- tree cond_label = NULL_TREE;
- tem = build2_loc (loc, MODIFY_EXPR, void_type_node,
- var, begin);
- append_to_statement_list_force (tem, p);
- tem = build_and_jump (&cond_label);
- append_to_statement_list_force (tem, p);
- tem = build1 (LABEL_EXPR, void_type_node, beg_label);
- append_to_statement_list (tem, p);
- tree bind = build3 (BIND_EXPR, void_type_node, NULL_TREE,
- NULL_TREE, NULL_TREE);
- TREE_SIDE_EFFECTS (bind) = 1;
- SET_EXPR_LOCATION (bind, loc);
- append_to_statement_list_force (bind, p);
- if (POINTER_TYPE_P (type))
- tem = build2_loc (loc, POINTER_PLUS_EXPR, type,
- var, fold_convert_loc (loc, sizetype,
- step));
- else
- tem = build2_loc (loc, PLUS_EXPR, type, var, step);
- tem = build2_loc (loc, MODIFY_EXPR, void_type_node,
- var, tem);
- append_to_statement_list_force (tem, p);
- tem = build1 (LABEL_EXPR, void_type_node, cond_label);
- append_to_statement_list (tem, p);
- tree cond = fold_build2_loc (loc, LT_EXPR,
- boolean_type_node,
- var, end);
- tree pos
- = fold_build3_loc (loc, COND_EXPR, void_type_node,
- cond, build_and_jump (&beg_label),
- void_node);
- cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node,
- var, end);
- tree neg
- = fold_build3_loc (loc, COND_EXPR, void_type_node,
- cond, build_and_jump (&beg_label),
- void_node);
- tree osteptype = TREE_TYPE (orig_step);
- cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node,
- orig_step,
- build_int_cst (osteptype, 0));
- tem = fold_build3_loc (loc, COND_EXPR, void_type_node,
- cond, pos, neg);
- append_to_statement_list_force (tem, p);
- p = &BIND_EXPR_BODY (bind);
- }
- last_body = p;
}
last_iter = TREE_PURPOSE (t);
if (TREE_CODE (TREE_VALUE (t)) == COMPOUND_EXPR)
@@ -10163,6 +10981,26 @@ omp_map_clause_descriptor_p (tree c)
return false;
}
+/* Try to find a (Fortran) array descriptor given a data pointer PTR, i.e.
+ return "foo.descr" from "foo.descr.data". */
+
+static tree
+omp_maybe_get_descriptor_from_ptr (tree ptr)
+{
+ struct array_descr_info info;
+
+ if (TREE_CODE (ptr) != COMPONENT_REF)
+ return NULL_TREE;
+
+ ptr = TREE_OPERAND (ptr, 0);
+
+ if (lang_hooks.types.get_array_descr_info
+ && lang_hooks.types.get_array_descr_info (TREE_TYPE (ptr), &info))
+ return ptr;
+
+ return NULL_TREE;
+}
+
/* For a set of mappings describing an array section pointed to by a struct
(or derived type, etc.) component, create an "alloc" or "release" node to
insert into a list following a GOMP_MAP_STRUCT node. For some types of
@@ -10182,16 +11020,26 @@ omp_map_clause_descriptor_p (tree c)
static tree
build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
- tree *extra_node)
+ tree *extra_node, gimple_seq *loops_seq_p)
{
+ tree descr = omp_maybe_get_descriptor_from_ptr (OMP_CLAUSE_DECL (grp_end));
enum gomp_map_kind mkind
= (code == OMP_TARGET_EXIT_DATA || code == OACC_EXIT_DATA)
- ? GOMP_MAP_RELEASE : GOMP_MAP_ALLOC;
+ ? GOMP_MAP_RELEASE : descr ? GOMP_MAP_ALWAYS_TO : GOMP_MAP_ALLOC;
gcc_assert (grp_start != grp_end);
tree c2 = build_omp_clause (OMP_CLAUSE_LOCATION (grp_end), OMP_CLAUSE_MAP);
OMP_CLAUSE_SET_MAP_KIND (c2, mkind);
+ OMP_CLAUSE_ITERATORS (c2) = OMP_CLAUSE_ITERATORS (grp_end);
+ add_new_omp_iterators_clause (c2, loops_seq_p);
+ if (descr)
+ {
+ OMP_CLAUSE_DECL (c2) = unshare_expr (descr);
+ OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (TREE_TYPE (descr));
+ *extra_node = NULL_TREE;
+ return c2;
+ }
OMP_CLAUSE_DECL (c2) = unshare_expr (OMP_CLAUSE_DECL (grp_end));
OMP_CLAUSE_CHAIN (c2) = NULL_TREE;
tree grp_mid = NULL_TREE;
@@ -10210,6 +11058,8 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
tree c3
= build_omp_clause (OMP_CLAUSE_LOCATION (grp_end), OMP_CLAUSE_MAP);
OMP_CLAUSE_SET_MAP_KIND (c3, mkind);
+ OMP_CLAUSE_ITERATORS (c3) = OMP_CLAUSE_ITERATORS (grp_end);
+ add_new_omp_iterators_clause (c3, loops_seq_p);
OMP_CLAUSE_DECL (c3) = unshare_expr (OMP_CLAUSE_DECL (grp_mid));
OMP_CLAUSE_SIZE (c3) = TYPE_SIZE_UNIT (ptr_type_node);
OMP_CLAUSE_CHAIN (c3) = NULL_TREE;
@@ -10222,6 +11072,27 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
return c2;
}
+/* Callback for walk_tree. Return any VAR_DECLS found. */
+
+static tree
+contains_vars_1 (tree* tp, int *, void *)
+{
+ tree t = *tp;
+
+ if (TREE_CODE (t) != VAR_DECL)
+ return NULL_TREE;
+
+ return t;
+}
+
+/* Return true if there are any variables present in EXPR. */
+
+static bool
+contains_vars (tree expr)
+{
+ return walk_tree (&expr, contains_vars_1, NULL, NULL);
+}
+
/* Strip ARRAY_REFS or an indirect ref off BASE, find the containing object,
and set *BITPOSP and *POFFSETP to the bit offset of the access.
If BASE_REF is non-NULL and the containing object is a reference, set
@@ -10232,7 +11103,8 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
static tree
extract_base_bit_offset (tree base, poly_int64 *bitposp,
poly_offset_int *poffsetp,
- bool *variable_offset)
+ bool *variable_offset,
+ tree iterator)
{
tree offset;
poly_int64 bitsize, bitpos;
@@ -10242,6 +11114,19 @@ extract_base_bit_offset (tree base, poly_int64 *bitposp,
STRIP_NOPS (base);
+ if (iterator)
+ {
+ /* Replace any iterator variables with constant zero. This will give us
+ the nominal offset and bit position of the first element, which is
+ all we should need to lay out the mappings. The actual locations
+ of the iterated mappings are elsewhere.
+ E.g. "array[i].field" gives "16" (say), not "i * 32 + 16". */
+ tree it;
+ for (it = iterator; it; it = TREE_CHAIN (it))
+ base = simplify_replace_tree (base, OMP_ITERATORS_VAR (it),
+ OMP_ITERATORS_BEGIN (it));
+ }
+
base = get_inner_reference (base, &bitsize, &bitpos, &offset, &mode,
&unsignedp, &reversep, &volatilep);
@@ -10256,6 +11141,8 @@ extract_base_bit_offset (tree base, poly_int64 *bitposp,
{
poffset = 0;
*variable_offset = (offset != NULL_TREE);
+ if (iterator && *variable_offset)
+ *variable_offset = contains_vars (offset);
}
if (maybe_ne (bitpos, 0))
@@ -10267,18 +11154,6 @@ extract_base_bit_offset (tree base, poly_int64 *bitposp,
return base;
}
-/* Used for topological sorting of mapping groups. UNVISITED means we haven't
- started processing the group yet. The TEMPORARY mark is used when we first
- encounter a group on a depth-first traversal, and the PERMANENT mark is used
- when we have processed all the group's children (i.e. all the base pointers
- referred to by the group's mapping nodes, recursively). */
-
-enum omp_tsort_mark {
- UNVISITED,
- TEMPORARY,
- PERMANENT
-};
-
/* Hash for trees based on operand_equal_p. Like tree_operand_hash
but ignores side effects in the equality comparisons. */
@@ -10295,26 +11170,6 @@ tree_operand_hash_no_se::equal (const value_type &t1,
return operand_equal_p (t1, t2, OEP_MATCH_SIDE_EFFECTS);
}
-/* A group of OMP_CLAUSE_MAP nodes that correspond to a single "map"
- clause. */
-
-struct omp_mapping_group {
- tree *grp_start;
- tree grp_end;
- omp_tsort_mark mark;
- /* If we've removed the group but need to reindex, mark the group as
- deleted. */
- bool deleted;
- /* The group points to an already-created "GOMP_MAP_STRUCT
- GOMP_MAP_ATTACH_DETACH" pair. */
- bool reprocess_struct;
- /* The group should use "zero-length" allocations for pointers that are not
- mapped "to" on the same directive. */
- bool fragile;
- struct omp_mapping_group *sibling;
- struct omp_mapping_group *next;
-};
-
DEBUG_FUNCTION void
debug_mapping_group (omp_mapping_group *grp)
{
@@ -10541,6 +11396,19 @@ omp_group_last (tree *start_p)
grp_last_p = &OMP_CLAUSE_CHAIN (c);
break;
+ case GOMP_MAP_TO_GRID:
+ case GOMP_MAP_FROM_GRID:
+ while (nc
+ && OMP_CLAUSE_CODE (nc) == OMP_CLAUSE_MAP
+ && (OMP_CLAUSE_MAP_KIND (nc) == GOMP_MAP_GRID_DIM
+ || OMP_CLAUSE_MAP_KIND (nc) == GOMP_MAP_GRID_STRIDE))
+ {
+ grp_last_p = &OMP_CLAUSE_CHAIN (c);
+ c = nc;
+ nc = OMP_CLAUSE_CHAIN (c);
+ }
+ break;
+
case GOMP_MAP_STRUCT:
case GOMP_MAP_STRUCT_UNORD:
{
@@ -10576,16 +11444,7 @@ omp_gather_mapping_groups_1 (tree *list_p, vec<omp_mapping_group> *groups,
continue;
tree *grp_last_p = omp_group_last (cp);
- omp_mapping_group grp;
-
- grp.grp_start = cp;
- grp.grp_end = *grp_last_p;
- grp.mark = UNVISITED;
- grp.sibling = NULL;
- grp.deleted = false;
- grp.reprocess_struct = false;
- grp.fragile = false;
- grp.next = NULL;
+ omp_mapping_group grp (cp, *grp_last_p);
groups->safe_push (grp);
cp = grp_last_p;
@@ -10643,6 +11502,14 @@ omp_group_base (omp_mapping_group *grp, unsigned int *chained,
case GOMP_MAP_ALWAYS_PRESENT_FROM:
case GOMP_MAP_ALWAYS_PRESENT_TO:
case GOMP_MAP_ALWAYS_PRESENT_TOFROM:
+ case GOMP_MAP_NONCONTIG_ARRAY_ALLOC:
+ case GOMP_MAP_NONCONTIG_ARRAY_FROM:
+ case GOMP_MAP_NONCONTIG_ARRAY_TO:
+ case GOMP_MAP_NONCONTIG_ARRAY_TOFROM:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_ALLOC:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_FROM:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_TO:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_TOFROM:
case GOMP_MAP_ALLOC:
case GOMP_MAP_RELEASE:
case GOMP_MAP_DELETE:
@@ -10690,6 +11557,10 @@ omp_group_base (omp_mapping_group *grp, unsigned int *chained,
internal_error ("unexpected mapping node");
return error_mark_node;
+ case GOMP_MAP_TO_GRID:
+ case GOMP_MAP_FROM_GRID:
+ return *grp->grp_start;
+
case GOMP_MAP_ATTACH:
case GOMP_MAP_DETACH:
node = OMP_CLAUSE_CHAIN (node);
@@ -10733,6 +11604,8 @@ omp_group_base (omp_mapping_group *grp, unsigned int *chained,
case GOMP_MAP_FIRSTPRIVATE_INT:
case GOMP_MAP_USE_DEVICE_PTR:
case GOMP_MAP_ATTACH_ZERO_LENGTH_ARRAY_SECTION:
+ case GOMP_MAP_DECLARE_ALLOCATE:
+ case GOMP_MAP_DECLARE_DEALLOCATE:
return NULL_TREE;
case GOMP_MAP_FIRSTPRIVATE_POINTER:
@@ -12017,7 +12890,8 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
tree *grp_start_p, tree grp_end,
vec<omp_addr_token *> &addr_tokens, tree **inner,
bool *fragile_p, bool reprocessing_struct,
- tree **added_tail)
+ tree **added_tail,
+ gimple_seq *loops_seq_p)
{
using namespace omp_addr_tokenizer;
poly_offset_int coffset;
@@ -12061,8 +12935,11 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
}
bool variable_offset;
+ tree iterators = OMP_CLAUSE_HAS_ITERATORS (grp_end)
+ ? OMP_CLAUSE_ITERATORS (grp_end) : NULL_TREE;
tree base
- = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset);
+ = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset,
+ iterators);
int base_token;
for (base_token = addr_tokens.length () - 1; base_token >= 0; base_token--)
@@ -12137,7 +13014,7 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
tree extra_node;
tree alloc_node
= build_omp_struct_comp_nodes (code, *grp_start_p, grp_end,
- &extra_node);
+ &extra_node, loops_seq_p);
tree *tail;
OMP_CLAUSE_CHAIN (l) = alloc_node;
@@ -12320,6 +13197,8 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
OMP_CLAUSE_SIZE (c2)
= fold_build2_loc (OMP_CLAUSE_LOCATION (grp_end), MINUS_EXPR,
ptrdiff_type_node, baddr, decladdr);
+ OMP_CLAUSE_ITERATORS (c2) = iterators;
+ add_new_omp_iterators_clause (c2, loops_seq_p);
/* Insert after struct node. */
OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (l);
OMP_CLAUSE_CHAIN (l) = c2;
@@ -12395,8 +13274,12 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
sc_decl = TREE_OPERAND (sc_decl, 0);
bool variable_offset2;
+ tree iterators2 = OMP_CLAUSE_HAS_ITERATORS (*sc)
+ ? OMP_CLAUSE_ITERATORS (*sc) : NULL_TREE;
+
tree base2 = extract_base_bit_offset (sc_decl, &bitpos, &offset,
- &variable_offset2);
+ &variable_offset2,
+ iterators2);
if (!base2 || !operand_equal_p (base2, base, 0))
break;
if (scp)
@@ -12461,7 +13344,8 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
gcc_unreachable ();
else if (attach_detach)
alloc_node = build_omp_struct_comp_nodes (code, *grp_start_p,
- grp_end, &extra_node);
+ grp_end, &extra_node,
+ loops_seq_p);
else
{
/* If we don't have an attach/detach node, this is a
@@ -12506,7 +13390,8 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
{
tree cl = NULL_TREE, extra_node;
tree alloc_node = build_omp_struct_comp_nodes (code, *grp_start_p,
- grp_end, &extra_node);
+ grp_end, &extra_node,
+ loops_seq_p);
tree *tail_chain = NULL;
if (*fragile_p
@@ -12604,7 +13489,8 @@ omp_build_struct_sibling_lists (enum tree_code code,
vec<omp_mapping_group> *groups,
hash_map<tree_operand_hash_no_se,
omp_mapping_group *> **grpmap,
- tree *list_p)
+ tree *list_p,
+ gimple_seq *loops_seq_p = NULL)
{
using namespace omp_addr_tokenizer;
unsigned i;
@@ -12748,7 +13634,8 @@ omp_build_struct_sibling_lists (enum tree_code code,
struct_map_to_clause, *grpmap,
grp_start_p, grp_end, addr_tokens,
&inner, &fragile_p,
- grp->reprocess_struct, &added_tail);
+ grp->reprocess_struct, &added_tail,
+ loops_seq_p);
if (inner)
{
@@ -12892,13 +13779,489 @@ error_out:
return success;
}
+struct instantiate_mapper_info
+{
+ tree *mapper_clauses_p;
+ struct gimplify_omp_ctx *omp_ctx;
+ gimple_seq *pre_p;
+};
+
+/* Helper function for omp_instantiate_mapper. */
+
+static tree
+remap_mapper_decl_1 (tree *tp, int *walk_subtrees, void *data)
+{
+ copy_body_data *id = (copy_body_data *) data;
+
+ if (DECL_P (*tp))
+ {
+ tree replacement = remap_decl (*tp, id);
+ if (*tp != replacement)
+ {
+ *tp = unshare_expr (replacement);
+ *walk_subtrees = 0;
+ }
+ }
+
+ return NULL_TREE;
+}
+
+/* A copy_decl implementation (for use with tree-inline.cc functions) that
+ only transform decls or SSA names that are part of a map we already
+ prepared. */
+
+static tree
+omp_mapper_copy_decl (tree var, copy_body_data *cb)
+{
+ tree *repl = cb->decl_map->get (var);
+
+ if (repl)
+ return *repl;
+
+ return var;
+}
+
+/* If we have a TREE_LIST representing an unprocessed mapping group (e.g. from
+ a "declare mapper" definition emitted by the Fortran FE), return the node
+ for the data being mapped. */
+
+static tree
+omp_mapping_group_data (tree group)
+{
+ gcc_assert (TREE_CODE (group) == TREE_LIST);
+ /* Use the first member of the group for substitution. */
+ return TREE_PURPOSE (group);
+}
+
+/* Return the final node of a mapping_group GROUP (represented as a tree list),
+ or NULL_TREE if it's not an attach_detach node. */
+
+static tree
+omp_mapping_group_ptr (tree group)
+{
+ gcc_assert (TREE_CODE (group) == TREE_LIST);
+
+ while (TREE_CHAIN (group))
+ group = TREE_CHAIN (group);
+
+ tree node = TREE_PURPOSE (group);
+
+ gcc_assert (OMP_CLAUSE_CODE (node) == OMP_CLAUSE_MAP);
+
+ if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_ATTACH_DETACH)
+ return node;
+
+ return NULL_TREE;
+}
+
+/* Return the pointer set (GOMP_MAP_TO_PSET) of a mapping_group node GROUP,
+ represented by a tree list, or NULL_TREE if there isn't one. */
+
+static tree
+omp_mapping_group_pset (tree group)
+{
+ gcc_assert (TREE_CODE (group) == TREE_LIST);
+
+ if (!TREE_CHAIN (group))
+ return NULL_TREE;
+
+ group = TREE_CHAIN (group);
+
+ tree node = TREE_PURPOSE (group);
+
+ if (omp_map_clause_descriptor_p (node))
+ return node;
+
+ return NULL_TREE;
+}
+
+static tree *
+omp_instantiate_mapper (gimple_seq *pre_p,
+ hash_map<omp_name_type<tree>, tree> *implicit_mappers,
+ tree mapperfn, tree expr, enum gomp_map_kind outer_kind,
+ tree *mapper_clauses_p)
+{
+ tree mapper_name = NULL_TREE;
+ tree mapper = lang_hooks.decls.omp_extract_mapper_directive (mapperfn);
+ gcc_assert (TREE_CODE (mapper) == OMP_DECLARE_MAPPER);
+
+ tree clause = OMP_DECLARE_MAPPER_CLAUSES (mapper);
+ tree dummy_var = OMP_DECLARE_MAPPER_DECL (mapper);
+
+ /* The "extraction map" is used to map the mapper variable in the "declare
+ mapper" directive, and also any temporary variables that have been created
+ as part of expanding the mapper function's body (which are expanded as a
+ "bind" expression in the pre_p sequence). */
+ hash_map<tree, tree> extraction_map;
+
+ if (TREE_CODE (mapperfn) == FUNCTION_DECL
+ && TREE_CODE (DECL_SAVED_TREE (mapperfn)) == BIND_EXPR)
+ {
+ tree body = NULL_TREE, bind = DECL_SAVED_TREE (mapperfn);
+ copy_body_data id;
+ hash_map<tree, tree> decl_map;
+
+ /* The "decl map" maps declarations in the definition of the mapper
+ function into new declarations in the current function. These are
+ local to the bind in which they are expanded, so we copy them out to
+ temporaries in the enclosing function scope, and use those temporaries
+ in the mapper expansion (see "extraction_map" above). (This also
+ allows a mapper to be invoked for multiple variables). */
+
+ memset (&id, 0, sizeof (id));
+ /* The source function isn't always mapperfn: e.g. for C++ mappers
+ defined within functions, the mapper decl is created in a scope
+ within that function, rather than in mapperfn. So, that containing
+ function is the one we need to copy from. */
+ id.src_fn = DECL_CONTEXT (dummy_var);
+ id.dst_fn = current_function_decl;
+ id.src_cfun = DECL_STRUCT_FUNCTION (mapperfn);
+ id.decl_map = &decl_map;
+ id.copy_decl = copy_decl_no_change;
+ id.transform_call_graph_edges = CB_CGE_DUPLICATE;
+ id.transform_new_cfg = true;
+
+ walk_tree (&bind, copy_tree_body_r, &id, NULL);
+
+ body = BIND_EXPR_BODY (bind);
+
+ extraction_map.put (dummy_var, expr);
+ extraction_map.put (expr, expr);
+
+ if (DECL_P (expr))
+ mark_addressable (expr);
+
+ tree dummy_var_remapped, *remapped_var_p = decl_map.get (dummy_var);
+ if (remapped_var_p)
+ dummy_var_remapped = *remapped_var_p;
+ else
+ internal_error ("failed to remap mapper variable");
+
+ hash_map<tree, tree> mapper_map;
+ mapper_map.put (dummy_var_remapped, expr);
+
+ /* Now we need to make two adjustments to the inlined bind: we have to
+ substitute the dummy variable for the expression in the clause
+ triggering this mapper instantiation, and we need to remove the
+ (remapped) decl from the bind's decl list. */
+
+ if (TREE_CODE (body) == STATEMENT_LIST)
+ {
+ copy_body_data id2;
+ memset (&id2, 0, sizeof (id2));
+ id2.src_fn = current_function_decl;
+ id2.dst_fn = current_function_decl;
+ id2.src_cfun = cfun;
+ id2.decl_map = &mapper_map;
+ id2.copy_decl = omp_mapper_copy_decl;
+ id2.transform_call_graph_edges = CB_CGE_DUPLICATE;
+ id2.transform_new_cfg = true;
+
+ tree_stmt_iterator tsi;
+ for (tsi = tsi_start (body); !tsi_end_p (tsi); tsi_next (&tsi))
+ {
+ tree* stmtp = tsi_stmt_ptr (tsi);
+ if (TREE_CODE (*stmtp) == OMP_DECLARE_MAPPER)
+ *stmtp = NULL_TREE;
+ else if (TREE_CODE (*stmtp) == DECL_EXPR
+ && DECL_EXPR_DECL (*stmtp) == dummy_var_remapped)
+ *stmtp = NULL_TREE;
+ else
+ walk_tree (stmtp, remap_mapper_decl_1, &id2, NULL);
+ }
+
+ tsi = tsi_last (body);
+
+ for (hash_map<tree, tree>::iterator ti = decl_map.begin ();
+ ti != decl_map.end ();
+ ++ti)
+ {
+ tree tmp, var = (*ti).first, inlined = (*ti).second;
+
+ if (var == dummy_var || var == inlined || !DECL_P (var))
+ continue;
+
+ if (!is_gimple_reg (var))
+ {
+ const char *decl_name
+ = IDENTIFIER_POINTER (DECL_NAME (var));
+ tmp = create_tmp_var (TREE_TYPE (var), decl_name);
+ }
+ else
+ tmp = create_tmp_var (TREE_TYPE (var));
+
+ /* We have three versions of the decl here. VAR is the version
+ as represented in the function defining the "declare mapper",
+ and in the clause list attached to the OMP_DECLARE_MAPPER
+ directive within that function. INLINED is the variable that
+ has been localised to a bind within the function where the
+ mapper is being instantiated (i.e. current_function_decl).
+ TMP is the variable that we copy the values created in that
+ block to. */
+
+ extraction_map.put (var, tmp);
+ extraction_map.put (tmp, tmp);
+
+ tree asgn = build2 (MODIFY_EXPR, TREE_TYPE (tmp), tmp, inlined);
+ tsi_link_after (&tsi, asgn, TSI_CONTINUE_LINKING);
+ }
+ }
+
+ /* We've replaced the "dummy variable" of the declare mapper definition
+ with a localised version in a bind expr in the current function. We
+ have just rewritten all references to that, so remove the decl. */
+
+ for (tree *decl = &BIND_EXPR_VARS (bind); *decl;)
+ {
+ if (*decl == dummy_var_remapped)
+ *decl = DECL_CHAIN (*decl);
+ else
+ decl = &DECL_CHAIN (*decl);
+ }
+
+ gimplify_bind_expr (&bind, pre_p);
+ }
+ else
+ {
+ extraction_map.put (dummy_var, expr);
+ extraction_map.put (expr, expr);
+ }
+
+ /* This copy_body_data is only used to remap the decls in the
+ OMP_DECLARE_MAPPER tree node expansion itself. All relevant decls should
+ already be in the current function. */
+ copy_body_data id;
+ memset (&id, 0, sizeof (id));
+ id.src_fn = current_function_decl;
+ id.dst_fn = current_function_decl;
+ id.src_cfun = cfun;
+ id.decl_map = &extraction_map;
+ id.copy_decl = omp_mapper_copy_decl;
+ id.transform_call_graph_edges = CB_CGE_DUPLICATE; // ???
+ id.transform_new_cfg = true; // ???
+
+ for (; clause; clause = OMP_CLAUSE_CHAIN (clause))
+ {
+ enum gomp_map_kind map_kind = OMP_CLAUSE_MAP_KIND (clause);
+ tree *nested_mapper_p = NULL;
+
+ if (map_kind == GOMP_MAP_PUSH_MAPPER_NAME)
+ {
+ mapper_name = OMP_CLAUSE_DECL (clause);
+ continue;
+ }
+ else if (map_kind == GOMP_MAP_POP_MAPPER_NAME)
+ {
+ mapper_name = NULL_TREE;
+ continue;
+ }
+
+ tree decl = OMP_CLAUSE_DECL (clause);
+
+ if (map_kind == GOMP_MAP_MAPPING_GROUP)
+ {
+ tree data = omp_mapping_group_data (decl);
+ tree group_type = TREE_TYPE (OMP_CLAUSE_DECL (data));
+
+ group_type = TYPE_MAIN_VARIANT (group_type);
+
+ nested_mapper_p = implicit_mappers->get ({ mapper_name, group_type });
+
+ if (nested_mapper_p && *nested_mapper_p != mapperfn)
+ {
+ tree unshared = unshare_expr (data);
+ map_kind = OMP_CLAUSE_MAP_KIND (data);
+ walk_tree (&unshared, remap_mapper_decl_1, &id, NULL);
+ tree ptr = omp_mapping_group_ptr (decl);
+
+ /* !!! When ptr is NULL, we're discarding the other nodes in the
+ mapping group. Is that always OK? */
+
+ if (ptr)
+ {
+ /* This behaviour is Fortran-specific. That's fine for now
+ because only Fortran is using GOMP_MAP_MAPPING_GROUP, but
+ may need revisiting if that ever changes. */
+ gcc_assert (lang_GNU_Fortran ());
+
+ /* We're invoking a (nested) mapper from CLAUSE, which was a
+ pointer to a derived type. The elements of the derived
+ type are handled by the mapper, but we need to map the
+ actual pointer as well. Create an ALLOC node to do
+ that.
+ If we have an array descriptor, we want to copy it to the
+ target, so instead use an ALWAYS_TO mapping and copy the
+ descriptor itself rather than the data pointer. */
+
+ tree pset = omp_mapping_group_pset (decl);
+ tree ptr_unshared = unshare_expr (pset ? pset : ptr);
+ walk_tree (&ptr_unshared, remap_mapper_decl_1, &id, NULL);
+
+ tree node = build_omp_clause (OMP_CLAUSE_LOCATION (clause),
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (node, pset ? GOMP_MAP_ALWAYS_TO
+ : GOMP_MAP_ALLOC);
+ OMP_CLAUSE_DECL (node) = OMP_CLAUSE_DECL (ptr_unshared);
+ OMP_CLAUSE_SIZE (node)
+ = TYPE_SIZE_UNIT (TREE_TYPE (OMP_CLAUSE_DECL (node)));
+
+ *mapper_clauses_p = node;
+ mapper_clauses_p = &OMP_CLAUSE_CHAIN (node);
+ }
+
+ if (map_kind == GOMP_MAP_UNSET)
+ map_kind = outer_kind;
+
+ mapper_clauses_p
+ = omp_instantiate_mapper (pre_p, implicit_mappers,
+ *nested_mapper_p,
+ OMP_CLAUSE_DECL (unshared), map_kind,
+ mapper_clauses_p);
+ }
+ else
+ /* No nested mapper, so process each element of the mapping
+ group. */
+ for (tree cp = OMP_CLAUSE_DECL (clause); cp; cp = TREE_CHAIN (cp))
+ {
+ tree node = unshare_expr (TREE_PURPOSE (cp));
+ walk_tree (&node, remap_mapper_decl_1, &id, NULL);
+
+ if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_UNSET)
+ OMP_CLAUSE_SET_MAP_KIND (node, outer_kind);
+
+ *mapper_clauses_p = node;
+ mapper_clauses_p = &OMP_CLAUSE_CHAIN (node);
+ }
+
+ continue;
+ }
+
+ tree unshared, type;
+ bool nonunit_array_with_mapper = false;
+
+ if (TREE_CODE (decl) == OMP_ARRAY_SECTION)
+ {
+ location_t loc = OMP_CLAUSE_LOCATION (clause);
+ tree tmp = lang_hooks.decls.omp_map_array_section (loc, decl);
+ if (tmp == decl)
+ {
+ unshared = unshare_expr (clause);
+ nonunit_array_with_mapper = true;
+ type = TREE_TYPE (TREE_TYPE (decl));
+ }
+ else
+ {
+ unshared = build_omp_clause (OMP_CLAUSE_LOCATION (clause),
+ OMP_CLAUSE_CODE (clause));
+ OMP_CLAUSE_DECL (unshared) = tmp;
+ OMP_CLAUSE_SIZE (unshared)
+ = DECL_P (tmp) ? DECL_SIZE_UNIT (tmp)
+ : TYPE_SIZE_UNIT (TREE_TYPE (tmp));
+ type = TREE_TYPE (tmp);
+ }
+ }
+ else
+ {
+ unshared = unshare_expr (clause);
+ type = TREE_TYPE (decl);
+ }
+
+ walk_tree (&unshared, remap_mapper_decl_1, &id, NULL);
+
+ if (OMP_CLAUSE_MAP_KIND (unshared) == GOMP_MAP_UNSET)
+ OMP_CLAUSE_SET_MAP_KIND (unshared, outer_kind);
+
+ decl = OMP_CLAUSE_DECL (unshared);
+ type = TYPE_MAIN_VARIANT (type);
+
+ nested_mapper_p = implicit_mappers->get ({ mapper_name, type });
+
+ if (nested_mapper_p && *nested_mapper_p != mapperfn)
+ {
+ if (nonunit_array_with_mapper)
+ {
+ sorry ("user-defined mapper with non-unit length array section");
+ continue;
+ }
+
+ if (map_kind == GOMP_MAP_UNSET)
+ map_kind = outer_kind;
+
+ mapper_clauses_p
+ = omp_instantiate_mapper (pre_p, implicit_mappers,
+ *nested_mapper_p, decl, map_kind,
+ mapper_clauses_p);
+ continue;
+ }
+
+ *mapper_clauses_p = unshared;
+ mapper_clauses_p = &OMP_CLAUSE_CHAIN (unshared);
+ }
+
+ return mapper_clauses_p;
+}
+
+static int
+omp_instantiate_implicit_mappers (splay_tree_node n, void *data)
+{
+ tree decl = (tree) n->key;
+ instantiate_mapper_info *im_info = (instantiate_mapper_info *) data;
+ gimplify_omp_ctx *ctx = im_info->omp_ctx;
+ tree *mapper_p = NULL;
+ tree type = TREE_TYPE (decl);
+ bool ref_p = false;
+ unsigned flags = n->value;
+
+ if (flags & (GOVD_EXPLICIT | GOVD_LOCAL))
+ return 0;
+ if ((flags & GOVD_SEEN) == 0)
+ return 0;
+ /* If we already have clauses pertaining to a struct variable, then we don't
+ want to implicitly invoke a user-defined mapper. */
+ if ((flags & GOVD_EXPLICIT) != 0 && AGGREGATE_TYPE_P (TREE_TYPE (decl)))
+ return 0;
+
+ if (TREE_CODE (type) == REFERENCE_TYPE)
+ {
+ ref_p = true;
+ type = TREE_TYPE (type);
+ }
+
+ type = TYPE_MAIN_VARIANT (type);
+
+ if (DECL_P (decl) && type && AGGREGATE_TYPE_P (type))
+ {
+ gcc_assert (ctx);
+ mapper_p = ctx->implicit_mappers->get ({ NULL_TREE, type });
+ }
+
+ if (mapper_p)
+ {
+ /* If we have a reference, map the pointed-to object rather than the
+ reference itself. */
+ if (ref_p)
+ decl = build_fold_indirect_ref (decl);
+
+ im_info->mapper_clauses_p
+ = omp_instantiate_mapper (im_info->pre_p, ctx->implicit_mappers,
+ *mapper_p, decl, GOMP_MAP_TOFROM,
+ im_info->mapper_clauses_p);
+ /* Make sure we don't map the same variable implicitly in
+ gimplify_adjust_omp_clauses_1 also. */
+ n->value |= GOVD_EXPLICIT;
+ }
+
+ return 0;
+}
+
/* Scan the OMP clauses in *LIST_P, installing mappings into a new
and previous omp contexts. */
static void
gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
enum omp_region_type region_type,
- enum tree_code code)
+ enum tree_code code,
+ gimple_seq *loops_seq_p = NULL)
{
using namespace omp_addr_tokenizer;
struct gimplify_omp_ctx *ctx, *outer_ctx;
@@ -12943,6 +14306,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
|| code == OMP_TARGET_DATA
|| code == OMP_TARGET_ENTER_DATA
|| code == OMP_TARGET_EXIT_DATA
+ || code == OMP_TARGET_UPDATE
|| code == OACC_DATA
|| code == OACC_KERNELS
|| code == OACC_PARALLEL
@@ -13161,6 +14525,20 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
omp_firstprivatize_variable (ctx, v);
omp_notice_variable (ctx, v, true);
}
+ if (TREE_CODE (TREE_OPERAND (decl, 0)) == COMPONENT_REF
+ || CONVERT_EXPR_CODE_P (TREE_CODE (TREE_OPERAND (decl, 0))))
+ {
+ gimplify_ctxp->into_ssa = false;
+ if (gimplify_expr (&TREE_OPERAND (decl, 0), pre_p,
+ NULL, is_gimple_val, fb_rvalue, false)
+ == GS_ERROR)
+ {
+ gimplify_ctxp->into_ssa = saved_into_ssa;
+ remove = true;
+ break;
+ }
+ gimplify_ctxp->into_ssa = saved_into_ssa;
+ }
decl = TREE_OPERAND (decl, 0);
if (TREE_CODE (decl) == POINTER_PLUS_EXPR)
{
@@ -13592,6 +14970,18 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
&& TREE_CODE (TREE_TYPE (basetype)) == POINTER_TYPE)
break;
}
+ if (code == OACC_DATA && *grp_start_p != grp_end)
+ {
+ if (!ctx->decl_data_clause)
+ ctx->decl_data_clause = new hash_map<tree, omp_mapping_group *>;
+
+ omp_mapping_group *grp
+ = new omp_mapping_group (grp_start_p, grp_end);
+
+ gcc_assert (DECL_P (decl));
+
+ ctx->decl_data_clause->put (decl, grp);
+ }
flags = GOVD_MAP | GOVD_EXPLICIT;
if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_TO
@@ -13599,6 +14989,8 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
|| OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_PRESENT_TO
|| OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_PRESENT_TOFROM)
flags |= GOVD_MAP_ALWAYS_TO;
+ else if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FORCE_DEVICEPTR)
+ flags |= GOVD_DEVICEPTR;
goto do_add;
@@ -13669,25 +15061,37 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
OMP_CLAUSE_SIZE (c) = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
: TYPE_SIZE_UNIT (TREE_TYPE (decl));
- if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p,
- NULL, is_gimple_val, fb_rvalue) == GS_ERROR)
+ gimple_seq *seq_p;
+ seq_p = enter_omp_iterator_loop_context (c, loops_seq_p, pre_p);
+ if (gimplify_expr (&OMP_CLAUSE_SIZE (c), seq_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR)
{
remove = true;
+ exit_omp_iterator_loop_context (c);
break;
}
if (!DECL_P (decl))
{
- if (gimplify_expr (&OMP_CLAUSE_DECL (c), pre_p,
- NULL, is_gimple_lvalue, fb_lvalue)
- == GS_ERROR)
- {
- remove = true;
- break;
- }
+ if (gimplify_expr (&OMP_CLAUSE_DECL (c), seq_p, NULL,
+ is_gimple_lvalue, fb_lvalue) == GS_ERROR)
+ remove = true;
+ exit_omp_iterator_loop_context (c);
break;
}
+ exit_omp_iterator_loop_context (c);
goto do_notice;
+ case OMP_CLAUSE__MAPPER_BINDING_:
+ {
+ tree name = OMP_CLAUSE__MAPPER_BINDING__ID (c);
+ tree var = OMP_CLAUSE__MAPPER_BINDING__DECL (c);
+ tree type = TYPE_MAIN_VARIANT (TREE_TYPE (var));
+ tree fndecl = OMP_CLAUSE__MAPPER_BINDING__MAPPER (c);
+ ctx->implicit_mappers->put ({ name, type }, fndecl);
+ remove = true;
+ break;
+ }
+
case OMP_CLAUSE_USE_DEVICE_PTR:
case OMP_CLAUSE_USE_DEVICE_ADDR:
flags = GOVD_EXPLICIT;
@@ -13713,7 +15117,8 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
remove = true;
break;
}
- if (DECL_NAME (decl) == NULL_TREE && (flags & GOVD_SHARED) == 0)
+ if (DECL_P (decl) && DECL_NAME (decl) == NULL_TREE
+ && (flags & GOVD_SHARED) == 0)
{
tree t = omp_member_access_dummy_var (decl);
if (t)
@@ -14053,6 +15458,21 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
nowait = 1;
break;
+ case OMP_CLAUSE_USES_ALLOCATORS:
+ if (TREE_CODE (OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c))
+ != INTEGER_CST)
+ {
+ decl = OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c);
+ omp_add_variable (ctx, decl, GOVD_SEEN | GOVD_PRIVATE);
+
+ decl = OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c);
+ if (decl && !DECL_INITIAL (decl))
+ omp_add_variable (ctx, decl, GOVD_SEEN | GOVD_FIRSTPRIVATE);
+ }
+ else
+ remove = true;
+ break;
+
case OMP_CLAUSE_ORDERED:
case OMP_CLAUSE_UNTIED:
case OMP_CLAUSE_COLLAPSE:
@@ -14076,6 +15496,10 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
case OMP_CLAUSE_DESTROY:
break;
+ case OMP_CLAUSE__OMPACC_:
+ ctx->ompacc = true;
+ break;
+
case OMP_CLAUSE_ORDER:
ctx->order_concurrent = true;
break;
@@ -14203,6 +15627,49 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
remove = true;
break;
}
+ if ((omp_requires_mask & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0
+ && OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)
+ && TREE_CODE (OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)) != INTEGER_CST)
+ {
+ tree allocator = OMP_CLAUSE_ALLOCATE_ALLOCATOR (c);
+ tree clauses = NULL_TREE;
+
+ /* Get clause list of the nearest enclosing target construct. */
+ if (ctx->code == OMP_TARGET)
+ clauses = *orig_list_p;
+ else
+ {
+ struct gimplify_omp_ctx *tctx = ctx->outer_context;
+ while (tctx && tctx->code != OMP_TARGET)
+ tctx = tctx->outer_context;
+ if (tctx)
+ clauses = tctx->clauses;
+ }
+
+ if (clauses)
+ {
+ tree uc;
+ if (TREE_CODE (allocator) == MEM_REF
+ || TREE_CODE (allocator) == INDIRECT_REF)
+ allocator = TREE_OPERAND (allocator, 0);
+ for (uc = clauses; uc; uc = OMP_CLAUSE_CHAIN (uc))
+ if (OMP_CLAUSE_CODE (uc) == OMP_CLAUSE_USES_ALLOCATORS)
+ {
+ tree uc_allocator
+ = OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (uc);
+ if (operand_equal_p (allocator, uc_allocator))
+ break;
+ }
+ if (uc == NULL_TREE)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c), "allocator %qE "
+ "requires %<uses_allocators(%E)%> clause in "
+ "target region", allocator, allocator);
+ remove = true;
+ break;
+ }
+ }
+ }
if (gimplify_expr (&OMP_CLAUSE_ALLOCATE_ALLOCATOR (c), pre_p, NULL,
is_gimple_val, fb_rvalue) == GS_ERROR)
{
@@ -14267,11 +15734,6 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
gcc_unreachable ();
}
- if (code == OACC_DATA
- && OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
- && (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_POINTER
- || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_REFERENCE))
- remove = true;
if (remove)
*list_p = OMP_CLAUSE_CHAIN (c);
else
@@ -14412,6 +15874,52 @@ struct gimplify_adjust_omp_clauses_data
gimple_seq *pre_p;
};
+/* For OpenACC offload regions, the implicit data mappings for arrays must
+ respect explicit data clauses set by a containing acc data region.
+ Specifically, an array section on the data clause must be transformed into
+ an equivalent PRESENT mapping on the inner offload region.
+ This function returns a pointer to a mapping group if an array slice of DECL
+ is specified on a lexically-enclosing data construct, or returns NULL
+ otherwise. */
+
+static omp_mapping_group *
+gomp_oacc_needs_data_present (tree decl)
+{
+ gimplify_omp_ctx *ctx = NULL;
+
+ if (gimplify_omp_ctxp->region_type != ORT_ACC_PARALLEL
+ && gimplify_omp_ctxp->region_type != ORT_ACC_SERIAL
+ && gimplify_omp_ctxp->region_type != ORT_ACC_KERNELS)
+ return NULL;
+
+ if (TREE_CODE (TREE_TYPE (decl)) != ARRAY_TYPE
+ && TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (decl)) != RECORD_TYPE
+ && (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
+ || TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) != ARRAY_TYPE))
+ return NULL;
+
+ decl = get_base_address (decl);
+
+ for (ctx = gimplify_omp_ctxp->outer_context; ctx; ctx = ctx->outer_context)
+ {
+ splay_tree_node on
+ = splay_tree_lookup (ctx->variables, (splay_tree_key) decl);
+
+ if (ctx->region_type == ORT_ACC_DATA
+ && on
+ && (((int) on->value) & GOVD_EXPLICIT)
+ && ctx->decl_data_clause != NULL)
+ {
+ omp_mapping_group **pgrp = ctx->decl_data_clause->get (decl);
+ if (pgrp)
+ return *pgrp;
+ }
+ }
+
+ return NULL;
+}
+
/* For all variables that were not actually used within the context,
remove PRIVATE, SHARED, and FIRSTPRIVATE clauses. */
@@ -14472,6 +15980,8 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data)
g->have_offload = true;
}
}
+ if (lookup_attribute ("oacc declare create", DECL_ATTRIBUTES (decl)))
+ flags |= GOVD_MAP_FORCE_PRESENT;
}
else if (flags & GOVD_SHARED)
{
@@ -14511,6 +16021,12 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data)
"%<target%> construct", decl);
return 0;
}
+ if (lookup_attribute ("oacc declare create", DECL_ATTRIBUTES (decl)))
+ {
+ code = OMP_CLAUSE_MAP;
+ flags &= ~GOVD_FIRSTPRIVATE;
+ flags |= GOVD_MAP | GOVD_MAP_FORCE_PRESENT;
+ }
}
else if (flags & GOVD_LASTPRIVATE)
code = OMP_CLAUSE_LASTPRIVATE;
@@ -14533,6 +16049,7 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data)
clause = build_omp_clause (input_location, code);
OMP_CLAUSE_DECL (clause) = decl;
OMP_CLAUSE_CHAIN (clause) = chain;
+ omp_mapping_group *outer_grp;
if (private_debug)
OMP_CLAUSE_PRIVATE_DEBUG (clause) = 1;
else if (code == OMP_CLAUSE_PRIVATE && (flags & GOVD_PRIVATE_OUTER_REF))
@@ -14541,6 +16058,58 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data)
&& (flags & GOVD_WRITTEN) == 0
&& omp_shared_to_firstprivate_optimizable_decl_p (decl))
OMP_CLAUSE_SHARED_READONLY (clause) = 1;
+ else if ((gimplify_omp_ctxp->region_type & ORT_ACC) != 0
+ && (code == OMP_CLAUSE_MAP || code == OMP_CLAUSE_FIRSTPRIVATE)
+ && (outer_grp = gomp_oacc_needs_data_present (decl)))
+ {
+ if (code == OMP_CLAUSE_FIRSTPRIVATE)
+ /* Oops, we have the wrong type of clause. Rebuild it. */
+ clause = build_omp_clause (OMP_CLAUSE_LOCATION (clause),
+ OMP_CLAUSE_MAP);
+
+ tree mapping = *outer_grp->grp_start;
+
+ OMP_CLAUSE_SET_MAP_KIND (clause, GOMP_MAP_FORCE_PRESENT);
+ OMP_CLAUSE_DECL (clause) = unshare_expr (OMP_CLAUSE_DECL (mapping));
+ OMP_CLAUSE_SIZE (clause) = unshare_expr (OMP_CLAUSE_SIZE (mapping));
+
+ /* Copy subsequent nodes (that are part of the mapping group) after the
+ initial one from the outer "acc data" directive -- "pointer" nodes,
+ including firstprivate_reference, pointer sets, etc. */
+
+ tree ptr = OMP_CLAUSE_CHAIN (mapping);
+ tree *ins = &OMP_CLAUSE_CHAIN (clause);
+ tree sentinel = OMP_CLAUSE_CHAIN (outer_grp->grp_end);
+ for (; ptr && ptr != sentinel; ptr = OMP_CLAUSE_CHAIN (ptr))
+ {
+ tree nc = build_omp_clause (OMP_CLAUSE_LOCATION (clause),
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (nc, OMP_CLAUSE_MAP_KIND (ptr));
+ OMP_CLAUSE_DECL (nc) = unshare_expr (OMP_CLAUSE_DECL (ptr));
+ OMP_CLAUSE_SIZE (nc) = unshare_expr (OMP_CLAUSE_SIZE (ptr));
+ *ins = nc;
+ ins = &OMP_CLAUSE_CHAIN (nc);
+ }
+
+ *ins = chain;
+
+ gimplify_omp_ctx *ctx = gimplify_omp_ctxp;
+ gimplify_omp_ctxp = ctx->outer_context;
+ for (ptr = clause; ptr != chain; ptr = OMP_CLAUSE_CHAIN (ptr))
+ {
+ /* The condition is specifically to not gimplify here if we have a
+ DECL_P with a DECL_VALUE_EXPR -- i.e. a VLA, or variable-sized
+ array section. If we do, omp-low.cc does not see the DECL_P it
+ expects here for e.g. firstprivate_pointer or
+ firstprivate_reference. */
+ if (!DECL_P (OMP_CLAUSE_DECL (ptr)))
+ gimplify_expr (&OMP_CLAUSE_DECL (ptr), pre_p, NULL,
+ is_gimple_lvalue, fb_lvalue);
+ gimplify_expr (&OMP_CLAUSE_SIZE (ptr), pre_p, NULL,
+ is_gimple_val, fb_rvalue);
+ }
+ gimplify_omp_ctxp = ctx;
+ }
else if (code == OMP_CLAUSE_FIRSTPRIVATE && (flags & GOVD_EXPLICIT) == 0)
OMP_CLAUSE_FIRSTPRIVATE_IMPLICIT (clause) = 1;
else if (code == OMP_CLAUSE_MAP && (flags & GOVD_MAP_0LEN_ARRAY) != 0)
@@ -14588,7 +16157,8 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data)
| GOVD_MAP_FORCE
| GOVD_MAP_FORCE_PRESENT
| GOVD_MAP_ALLOC_ONLY
- | GOVD_MAP_FROM_ONLY))
+ | GOVD_MAP_FROM_ONLY
+ | GOVD_DEVICEPTR))
{
case 0:
kind = GOMP_MAP_TOFROM;
@@ -14614,14 +16184,14 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data)
case GOVD_MAP_FORCE_PRESENT | GOVD_MAP_ALLOC_ONLY:
kind = GOMP_MAP_FORCE_PRESENT;
break;
+ case GOVD_DEVICEPTR:
+ kind = GOMP_MAP_FORCE_DEVICEPTR;
+ break;
default:
gcc_unreachable ();
}
OMP_CLAUSE_SET_MAP_KIND (clause, kind);
- /* Setting of the implicit flag for the runtime is currently disabled for
- OpenACC. */
- if ((gimplify_omp_ctxp->region_type & ORT_ACC) == 0)
- OMP_CLAUSE_MAP_RUNTIME_IMPLICIT_P (clause) = 1;
+ OMP_CLAUSE_MAP_RUNTIME_IMPLICIT_P (clause) = 1;
if (DECL_SIZE (decl)
&& !poly_int_tree_p (DECL_SIZE (decl)))
{
@@ -14705,10 +16275,11 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data)
static void
gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
- enum tree_code code)
+ enum tree_code code,
+ gimple_seq *loops_seq_p = NULL)
{
struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp;
- tree *orig_list_p = list_p;
+ tree *prev_list_p = NULL, *orig_list_p = list_p;
tree c, decl;
bool has_inscan_reductions = false;
@@ -14772,6 +16343,30 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
|| code == OMP_TARGET_ENTER_DATA
|| code == OMP_TARGET_EXIT_DATA)
{
+ tree mapper_clauses = NULL_TREE;
+ instantiate_mapper_info im_info;
+
+ im_info.mapper_clauses_p = &mapper_clauses;
+ im_info.omp_ctx = ctx;
+ im_info.pre_p = pre_p;
+
+ splay_tree_foreach (ctx->variables,
+ omp_instantiate_implicit_mappers,
+ (void *) &im_info);
+
+ if (mapper_clauses)
+ {
+ mapper_clauses
+ = lang_hooks.decls.omp_finish_mapper_clauses (mapper_clauses);
+
+ /* Stick the implicitly-expanded mapper clauses at the end of the
+ clause list. */
+ tree *tail = list_p;
+ while (*tail)
+ tail = &OMP_CLAUSE_CHAIN (*tail);
+ *tail = mapper_clauses;
+ }
+
vec<omp_mapping_group> *groups;
groups = omp_gather_mapping_groups (list_p);
hash_map<tree_operand_hash_no_se, omp_mapping_group *> *grpmap = NULL;
@@ -14782,7 +16377,7 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
omp_resolve_clause_dependencies (code, groups, grpmap);
omp_build_struct_sibling_lists (code, ctx->region_type, groups,
- &grpmap, list_p);
+ &grpmap, list_p, loops_seq_p);
omp_mapping_group *outlist = NULL;
@@ -15010,18 +16605,21 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
switch (code)
{
case OACC_DATA:
- if (TREE_CODE (TREE_TYPE (decl)) != ARRAY_TYPE)
- break;
- /* Fallthrough. */
case OACC_HOST_DATA:
case OACC_ENTER_DATA:
case OACC_EXIT_DATA:
case OMP_TARGET_DATA:
case OMP_TARGET_ENTER_DATA:
case OMP_TARGET_EXIT_DATA:
- if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_POINTER
- || (OMP_CLAUSE_MAP_KIND (c)
- == GOMP_MAP_FIRSTPRIVATE_REFERENCE))
+ if ((OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_POINTER
+ || (OMP_CLAUSE_MAP_KIND (c)
+ == GOMP_MAP_FIRSTPRIVATE_REFERENCE))
+ && !(prev_list_p
+ && OMP_CLAUSE_CODE (*prev_list_p) == OMP_CLAUSE_MAP
+ && ((OMP_CLAUSE_MAP_KIND (*prev_list_p)
+ == GOMP_MAP_DECLARE_ALLOCATE)
+ || (OMP_CLAUSE_MAP_KIND (*prev_list_p)
+ == GOMP_MAP_DECLARE_DEALLOCATE))))
/* For target {,enter ,exit }data only the array slice is
mapped, but not the pointer to it. */
remove = true;
@@ -15037,7 +16635,9 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
}
if (remove)
break;
- if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
+ if (OMP_CLAUSE_SIZE (c) == NULL_TREE
+ && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_GRID_DIM
+ && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_GRID_STRIDE)
{
/* Sanity check: attach/detach map kinds use the size as a bias,
and it's never right to use the decl size for such
@@ -15052,21 +16652,33 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
: TYPE_SIZE_UNIT (TREE_TYPE (decl));
}
gimplify_omp_ctxp = ctx->outer_context;
- if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p, NULL,
+ gimple_seq *seq_p;
+ seq_p = enter_omp_iterator_loop_context (c, loops_seq_p, pre_p);
+ if (GOMP_MAP_NONCONTIG_ARRAY_P (OMP_CLAUSE_MAP_KIND (c)))
+ {
+ gcc_assert (OMP_CLAUSE_SIZE (c)
+ && TREE_CODE (OMP_CLAUSE_SIZE (c)) == TREE_LIST);
+ /* For non-contiguous array maps, OMP_CLAUSE_SIZE is a TREE_LIST
+ of the individual array dimensions, which gimplify_expr doesn't
+ handle, so skip the call to gimplify_expr here. */
+ }
+ else if (gimplify_expr (&OMP_CLAUSE_SIZE (c), seq_p, NULL,
is_gimple_val, fb_rvalue) == GS_ERROR)
{
gimplify_omp_ctxp = ctx;
remove = true;
- break;
+ goto end_adjust_omp_map_clause;
}
else if ((OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_POINTER
|| (OMP_CLAUSE_MAP_KIND (c)
== GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+ || (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER
+ && ctx->region_type != ORT_ACC_KERNELS)
|| OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH)
&& TREE_CODE (OMP_CLAUSE_SIZE (c)) != INTEGER_CST)
{
OMP_CLAUSE_SIZE (c)
- = get_initialized_tmp_var (OMP_CLAUSE_SIZE (c), pre_p, NULL,
+ = get_initialized_tmp_var (OMP_CLAUSE_SIZE (c), seq_p, NULL,
false);
if ((ctx->region_type & ORT_TARGET) != 0)
omp_add_variable (ctx, OMP_CLAUSE_SIZE (c),
@@ -15107,7 +16719,7 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
&& (code == OMP_TARGET_EXIT_DATA || code == OACC_EXIT_DATA))
{
remove = true;
- break;
+ goto end_adjust_omp_map_clause;
}
/* If we have a DECL_VALUE_EXPR (e.g. this is a class member and/or
a variable captured in a lambda closure), look through that now
@@ -15123,10 +16735,24 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
decl = OMP_CLAUSE_DECL (c) = DECL_VALUE_EXPR (decl);
if (TREE_CODE (decl) == TARGET_EXPR)
{
- if (gimplify_expr (&OMP_CLAUSE_DECL (c), pre_p, NULL,
+ if (gimplify_expr (&OMP_CLAUSE_DECL (c), seq_p, NULL,
is_gimple_lvalue, fb_lvalue) == GS_ERROR)
remove = true;
}
+ else if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_GRID_DIM
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_GRID_STRIDE)
+ {
+ /* The OMP_CLAUSE_DECL for GRID_DIM/GRID_STRIDE isn't necessarily
+ an lvalue -- e.g. it might be a constant. So handle it
+ specially here. */
+ if (gimplify_expr (&OMP_CLAUSE_DECL (c), seq_p, NULL,
+ is_gimple_val, fb_rvalue) == GS_ERROR)
+ {
+ gimplify_omp_ctxp = ctx;
+ remove = true;
+ }
+ break;
+ }
else if (!DECL_P (decl))
{
if ((ctx->region_type & ORT_TARGET) != 0
@@ -15210,19 +16836,43 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
/* If we have e.g. map(struct: *var), don't gimplify the
argument since omp-low.cc wants to see the decl itself. */
if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_STRUCT)
- break;
+ goto end_adjust_omp_map_clause;
+
+ /* If we have a non-contiguous (strided/rectangular) update
+ operation with a VIEW_CONVERT_EXPR, we need to be careful not
+ to gimplify the conversion away, because we need it during
+ omp-low.cc in order to retrieve the array's dimensions. Just
+ gimplify partially instead. */
+ if ((OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_TO_GRID
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FROM_GRID)
+ && TREE_CODE (*pd) == VIEW_CONVERT_EXPR)
+ pd = &TREE_OPERAND (*pd, 0);
/* We've already partly gimplified this in
gimplify_scan_omp_clauses. Don't do any more. */
if (code == OMP_TARGET && OMP_CLAUSE_MAP_IN_REDUCTION (c))
- break;
+ goto end_adjust_omp_map_clause;
gimplify_omp_ctxp = ctx->outer_context;
- if (gimplify_expr (pd, pre_p, NULL, is_gimple_lvalue,
- fb_lvalue) == GS_ERROR)
- remove = true;
+ if (gimplify_expr (pd, seq_p, NULL, is_gimple_lvalue,
+ fb_lvalue | fb_mayfail) == GS_ERROR)
+ {
+ sorry_at (OMP_CLAUSE_LOCATION (c),
+ "unsupported map expression %qE",
+ OMP_CLAUSE_DECL (c));
+ remove = true;
+ }
+
+ if (TREE_CODE (*pd) == ARRAY_REF
+ && DECL_P (TREE_OPERAND (*pd, 1))
+ && (ctx->region_type & ORT_TARGET) != 0
+ && (ctx->region_type & ORT_ACC) != 0
+ && ctx->region_type != ORT_ACC_KERNELS)
+ omp_add_variable (ctx, TREE_OPERAND (*pd, 1),
+ GOVD_FIRSTPRIVATE | GOVD_SEEN);
+
gimplify_omp_ctxp = ctx;
- break;
+ goto end_adjust_omp_map_clause;
}
if ((code == OMP_TARGET
@@ -15355,6 +17005,21 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
== GOMP_MAP_ATTACH_ZERO_LENGTH_ARRAY_SECTION)))
move_attach = true;
+ if (!remove && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ALWAYS_POINTER
+ && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ATTACH_DETACH
+ && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_TO_PSET
+ && OMP_CLAUSE_CHAIN (c)
+ && OMP_CLAUSE_CODE (OMP_CLAUSE_CHAIN (c)) == OMP_CLAUSE_MAP
+ && ((OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (c))
+ == GOMP_MAP_ALWAYS_POINTER)
+ || (OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (c))
+ == GOMP_MAP_ATTACH_DETACH)
+ || (OMP_CLAUSE_MAP_KIND (OMP_CLAUSE_CHAIN (c))
+ == GOMP_MAP_TO_PSET)))
+ prev_list_p = list_p;
+
+end_adjust_omp_map_clause:
+ exit_omp_iterator_loop_context (c);
break;
case OMP_CLAUSE_TO:
@@ -15404,10 +17069,22 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
case OMP_CLAUSE_TASK_REDUCTION:
decl = OMP_CLAUSE_DECL (c);
/* OpenACC reductions need a present_or_copy data clause.
- Add one if necessary. Emit error when the reduction is private. */
+ Add one if necessary. Emit error when the reduction is
+ private. */
if (ctx->region_type == ORT_ACC_PARALLEL
|| ctx->region_type == ORT_ACC_SERIAL)
{
+ if (TREE_CODE (decl) == MEM_REF
+ && TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
+ {
+ tree addr = TREE_OPERAND (decl, 0);
+ if (TREE_CODE (addr) == POINTER_PLUS_EXPR)
+ addr = TREE_OPERAND (addr, 0);
+ if (TREE_CODE (addr) == ADDR_EXPR
+ && DECL_P (TREE_OPERAND (addr, 0)))
+ decl = TREE_OPERAND (addr, 0);
+ }
+
n = splay_tree_lookup (ctx->variables, (splay_tree_key) decl);
if (n->value & (GOVD_PRIVATE | GOVD_FIRSTPRIVATE))
{
@@ -15527,6 +17204,8 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p,
case OMP_CLAUSE_FINALIZE:
case OMP_CLAUSE_INCLUSIVE:
case OMP_CLAUSE_EXCLUSIVE:
+ case OMP_CLAUSE_USES_ALLOCATORS:
+ case OMP_CLAUSE__OMPACC_:
break;
case OMP_CLAUSE_NOHOST:
@@ -16133,6 +17812,111 @@ gimplify_omp_loop_xform (tree *expr_p, gimple_seq *pre_p)
return GS_ALL_DONE;
}
+/* Helper function for localize_reductions. Replace all uses of REF_VAR with
+ LOCAL_VAR. */
+
+static tree
+localize_reductions_r (tree *tp, int *walk_subtrees, void *data)
+{
+ enum tree_code tc = TREE_CODE (*tp);
+ struct privatize_reduction *pr = (struct privatize_reduction *) data;
+
+ if (TYPE_P (*tp))
+ *walk_subtrees = 0;
+
+ switch (tc)
+ {
+ case INDIRECT_REF:
+ case MEM_REF:
+ if (TREE_OPERAND (*tp, 0) == pr->ref_var)
+ *tp = pr->local_var;
+
+ *walk_subtrees = 0;
+ break;
+
+ case VAR_DECL:
+ case PARM_DECL:
+ case RESULT_DECL:
+ if (*tp == pr->ref_var)
+ *tp = pr->local_var;
+
+ *walk_subtrees = 0;
+ break;
+
+ default:
+ break;
+ }
+
+ return NULL_TREE;
+}
+
+/* OpenACC worker and vector loop state propagation requires reductions
+ to be inside local variables. This function replaces all reference-type
+ reductions variables associated with the loop with a local copy. It is
+ also used to create private copies of reduction variables for those
+ which are not associated with acc loops. */
+
+static void
+localize_reductions (tree clauses, tree body)
+{
+ tree c, var, type, new_var;
+ struct privatize_reduction pr;
+
+ for (c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION)
+ {
+ var = OMP_CLAUSE_DECL (c);
+
+ if (!lang_hooks.decls.omp_privatize_by_reference (var))
+ {
+ OMP_CLAUSE_REDUCTION_PRIVATE_DECL (c) = NULL;
+ continue;
+ }
+
+ type = TREE_TYPE (TREE_TYPE (var));
+ new_var = create_tmp_var (type, IDENTIFIER_POINTER (DECL_NAME (var)));
+
+ pr.ref_var = var;
+ pr.local_var = new_var;
+
+ walk_tree (&body, localize_reductions_r, &pr, NULL);
+
+ OMP_CLAUSE_REDUCTION_PRIVATE_DECL (c) = new_var;
+ }
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_PRIVATE)
+ {
+ var = OMP_CLAUSE_DECL (c);
+
+ if (!lang_hooks.decls.omp_privatize_by_reference (var))
+ continue;
+ type = TREE_TYPE (TREE_TYPE (var));
+ if (TREE_CODE (type) == ARRAY_TYPE)
+ continue;
+ new_var = create_tmp_var (type, IDENTIFIER_POINTER (DECL_NAME (var)));
+
+ pr.ref_var = var;
+ pr.local_var = new_var;
+
+ walk_tree (&body, localize_reductions_r, &pr, NULL);
+ }
+}
+
+
+/* Return true if in an omp_context in OMPACC mode. */
+static bool
+gimplify_omp_ctx_ompacc_p (void)
+{
+ if (cgraph_node::get (current_function_decl)->offloadable
+ && lookup_attribute ("ompacc",
+ DECL_ATTRIBUTES (current_function_decl)))
+ return true;
+ struct gimplify_omp_ctx *ctx;
+ for (ctx = gimplify_omp_ctxp; ctx; ctx = ctx->outer_context)
+ if (ctx->ompacc)
+ return true;
+ return false;
+}
+
/* Gimplify the gross structure of an OMP_FOR statement. */
static enum gimplify_status
@@ -16164,6 +17948,18 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
*expr_p = NULL_TREE;
return GS_ERROR;
}
+
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && gimplify_omp_ctx_ompacc_p ())
+ {
+ gcc_assert (inner_for_stmt && TREE_CODE (for_stmt) == OMP_DISTRIBUTE);
+ *expr_p = OMP_FOR_BODY (for_stmt);
+ tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_GANG);
+ OMP_CLAUSE_CHAIN (c) = OMP_FOR_CLAUSES (inner_for_stmt);
+ OMP_FOR_CLAUSES (inner_for_stmt) = c;
+ return GS_OK;
+ }
+
gcc_assert (inner_for_stmt == *data[3]);
omp_maybe_apply_loop_xforms (data[3],
data[2]
@@ -16392,6 +18188,24 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p)
gcc_unreachable ();
}
+ if (ort == ORT_ACC)
+ {
+ gimplify_omp_ctx *outer = gimplify_omp_ctxp;
+
+ while (outer
+ && outer->region_type != ORT_ACC_PARALLEL
+ && outer->region_type != ORT_ACC_KERNELS)
+ outer = outer->outer_context;
+
+ /* FIXME: Reductions only work in parallel regions at present. We avoid
+ doing the reduction localization transformation in kernels regions
+ here, because the code to remove reductions in kernels regions cannot
+ handle that. */
+ if (outer && outer->region_type == ORT_ACC_PARALLEL)
+ localize_reductions (OMP_FOR_CLAUSES (for_stmt),
+ OMP_FOR_BODY (for_stmt));
+ }
+
/* Set OMP_CLAUSE_LINEAR_NO_COPYIN flag on explicit linear
clause for the IV. */
if (ort == ORT_SIMD && TREE_VEC_LENGTH (OMP_FOR_INIT (for_stmt)) == 1)
@@ -17993,17 +19807,29 @@ gimplify_omp_workshare (tree *expr_p, gimple_seq *pre_p)
gcc_unreachable ();
}
+ gimple_seq iterator_loops_seq = NULL;
+ if (TREE_CODE (expr) == OMP_TARGET)
+ {
+ remove_unused_omp_iterator_vars (&OMP_CLAUSES (expr));
+ build_omp_iterators_loops (&OMP_CLAUSES (expr), &iterator_loops_seq);
+ }
+
bool save_in_omp_construct = in_omp_construct;
if ((ort & ORT_ACC) == 0)
in_omp_construct = false;
gimplify_scan_omp_clauses (&OMP_CLAUSES (expr), pre_p, ort,
- TREE_CODE (expr));
+ TREE_CODE (expr), &iterator_loops_seq);
if (TREE_CODE (expr) == OMP_TARGET)
optimize_target_teams (expr, pre_p);
if ((ort & (ORT_TARGET | ORT_TARGET_DATA)) != 0
|| (ort & ORT_HOST_TEAMS) == ORT_HOST_TEAMS)
{
push_gimplify_context ();
+
+ /* FIXME: Reductions are not supported in kernels regions yet. */
+ if (/*ort == ORT_ACC_KERNELS ||*/ ort == ORT_ACC_PARALLEL)
+ localize_reductions (OMP_CLAUSES (expr), OMP_BODY (expr));
+
gimple *g = gimplify_and_return_first (OMP_BODY (expr), &body);
if (gimple_code (g) == GIMPLE_BIND)
pop_gimplify_context (g);
@@ -18032,11 +19858,97 @@ gimplify_omp_workshare (tree *expr_p, gimple_seq *pre_p)
body = NULL;
gimple_seq_add_stmt (&body, g);
}
+ else if ((ort & ORT_TARGET) != 0 && (ort & ORT_ACC) == 0)
+ {
+ gimple_seq init_seq = NULL;
+ gimple_seq fini_seq = NULL;
+
+ tree omp_init_allocator_fn = NULL_TREE;
+ tree omp_destroy_allocator_fn = NULL_TREE;
+
+ for (tree *cp = &OMP_CLAUSES (expr); *cp != NULL;
+ cp = &OMP_CLAUSE_CHAIN (*cp))
+ if (OMP_CLAUSE_CODE (*cp) == OMP_CLAUSE_USES_ALLOCATORS)
+ {
+ tree c = *cp;
+ tree allocator = OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c);
+ tree memspace = OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (c);
+ tree traits = OMP_CLAUSE_USES_ALLOCATORS_TRAITS (c);
+
+ if (omp_init_allocator_fn == NULL_TREE)
+ {
+ omp_init_allocator_fn
+ = builtin_decl_explicit (BUILT_IN_OMP_INIT_ALLOCATOR);
+ omp_destroy_allocator_fn
+ = builtin_decl_explicit (BUILT_IN_OMP_DESTROY_ALLOCATOR);
+ }
+ tree ntraits, traits_var;
+ if (traits == NULL_TREE)
+ {
+ ntraits = integer_zero_node;
+ traits_var = null_pointer_node;
+ }
+ else if (DECL_INITIAL (traits))
+ {
+ location_t loc = OMP_CLAUSE_LOCATION (c);
+ tree t = DECL_INITIAL (traits);
+ gcc_assert (TREE_CODE (t) == CONSTRUCTOR);
+ ntraits = build_int_cst (integer_type_node,
+ CONSTRUCTOR_NELTS (t));
+ t = get_initialized_tmp_var (t, &init_seq, NULL);
+ traits_var = build_fold_addr_expr_loc (loc, t);
+ }
+ else
+ {
+ location_t loc = OMP_CLAUSE_LOCATION (c);
+ gcc_assert (TREE_CODE (TREE_TYPE (traits)) == ARRAY_TYPE);
+ tree t = TYPE_DOMAIN (TREE_TYPE (traits));
+ tree min = TYPE_MIN_VALUE (t);
+ tree max = TYPE_MAX_VALUE (t);
+ gcc_assert (TREE_CODE (min) == INTEGER_CST
+ && TREE_CODE (max) == INTEGER_CST);
+ t = fold_build2_loc (loc, MINUS_EXPR, TREE_TYPE (min),
+ max, min);
+ t = fold_build2_loc (loc, PLUS_EXPR, TREE_TYPE (min),
+ t, build_int_cst (TREE_TYPE (min), 1));
+ ntraits = t;
+ traits_var = build_fold_addr_expr_loc (loc, traits);
+ }
+
+ if (memspace == NULL_TREE)
+ memspace = build_int_cst (pointer_sized_int_node, 0);
+ else
+ memspace = fold_convert (pointer_sized_int_node,
+ memspace);
+
+ tree call = build_call_expr_loc (OMP_CLAUSE_LOCATION (c),
+ omp_init_allocator_fn, 3,
+ memspace, ntraits,
+ traits_var);
+ call = fold_convert (TREE_TYPE (allocator), call);
+ gimplify_assign (allocator, call, &init_seq);
+
+ call = build_call_expr_loc (OMP_CLAUSE_LOCATION (c),
+ omp_destroy_allocator_fn, 1,
+ allocator);
+ gimplify_and_add (call, &fini_seq);
+ }
+
+ if (fini_seq)
+ {
+ gbind *bind = as_a<gbind *> (gimple_seq_first_stmt (body));
+ g = gimple_build_try (gimple_bind_body (bind),
+ fini_seq, GIMPLE_TRY_FINALLY);
+ gimple_seq_add_stmt (&init_seq, g);
+ gimple_bind_set_body (bind, init_seq);
+ body = bind;
+ }
+ }
}
else
gimplify_and_add (OMP_BODY (expr), &body);
gimplify_adjust_omp_clauses (pre_p, body, &OMP_CLAUSES (expr),
- TREE_CODE (expr));
+ TREE_CODE (expr), &iterator_loops_seq);
in_omp_construct = save_in_omp_construct;
switch (TREE_CODE (expr))
@@ -18079,7 +19991,7 @@ gimplify_omp_workshare (tree *expr_p, gimple_seq *pre_p)
break;
case OMP_TARGET:
stmt = gimple_build_omp_target (body, GF_OMP_TARGET_KIND_REGION,
- OMP_CLAUSES (expr));
+ OMP_CLAUSES (expr), iterator_loops_seq);
break;
case OMP_TARGET_DATA:
/* Put use_device_{ptr,addr} clauses last, as map clauses are supposed
@@ -18154,10 +20066,16 @@ gimplify_omp_target_update (tree *expr_p, gimple_seq *pre_p)
default:
gcc_unreachable ();
}
+
+ gimple_seq iterator_loops_seq = NULL;
+ remove_unused_omp_iterator_vars (&OMP_STANDALONE_CLAUSES (expr));
+ build_omp_iterators_loops (&OMP_STANDALONE_CLAUSES (expr),
+ &iterator_loops_seq);
+
gimplify_scan_omp_clauses (&OMP_STANDALONE_CLAUSES (expr), pre_p,
- ort, TREE_CODE (expr));
+ ort, TREE_CODE (expr), &iterator_loops_seq);
gimplify_adjust_omp_clauses (pre_p, NULL, &OMP_STANDALONE_CLAUSES (expr),
- TREE_CODE (expr));
+ TREE_CODE (expr), &iterator_loops_seq);
if (TREE_CODE (expr) == OACC_UPDATE
&& omp_find_clause (OMP_STANDALONE_CLAUSES (expr),
OMP_CLAUSE_IF_PRESENT))
@@ -18221,7 +20139,8 @@ gimplify_omp_target_update (tree *expr_p, gimple_seq *pre_p)
gcc_unreachable ();
}
}
- stmt = gimple_build_omp_target (NULL, kind, OMP_STANDALONE_CLAUSES (expr));
+ stmt = gimple_build_omp_target (NULL, kind, OMP_STANDALONE_CLAUSES (expr),
+ iterator_loops_seq);
gimplify_seq_add_stmt (pre_p, stmt);
*expr_p = NULL_TREE;
@@ -19257,6 +21176,15 @@ gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *,
return GS_OK;
}
+/* Gimplify an OMP_DECLARE_MAPPER node (by just removing it). */
+
+static enum gimplify_status
+gimplify_omp_declare_mapper (tree *expr_p)
+{
+ *expr_p = NULL_TREE;
+ return GS_ALL_DONE;
+}
+
/* Convert the GENERIC expression tree *EXPR_P to GIMPLE. If the
expression produces a value to be used as an operand inside a GIMPLE
statement, the value will be stored back in *EXPR_P. This value will
@@ -20218,6 +22146,10 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
ret = GS_ALL_DONE;
break;
+ case OMP_DECLARE_MAPPER:
+ ret = gimplify_omp_declare_mapper (expr_p);
+ break;
+
case TRANSACTION_EXPR:
ret = gimplify_transaction (expr_p, pre_p);
break;
diff --git a/gcc/gimplify.h b/gcc/gimplify.h
index b66ceb3..1400215 100644
--- a/gcc/gimplify.h
+++ b/gcc/gimplify.h
@@ -79,6 +79,15 @@ extern enum gimplify_status gimplify_expr (tree *, gimple_seq *, gimple_seq *,
extern tree omp_get_construct_context (void);
int omp_has_novariants (void);
+extern tree omp_iterator_elems_length (tree count);
+extern gimple_seq *enter_omp_iterator_loop_context (tree, gimple_seq *);
+extern gimple_seq *enter_omp_iterator_loop_context (tree, gomp_target *,
+ gimple_seq *);
+extern void exit_omp_iterator_loop_context (void);
+extern void assign_to_iterator_elems_array (tree, tree, gomp_target *, int = 0);
+extern tree add_new_omp_iterators_entry (tree, gimple_seq *);
+extern void add_new_omp_iterators_clause (tree c, gimple_seq *);
+
extern void gimplify_type_sizes (tree, gimple_seq *);
extern void gimplify_one_sizepos (tree *, gimple_seq *);
extern gbind *gimplify_body (tree, bool);
diff --git a/gcc/gsstruct.def b/gcc/gsstruct.def
index bfe0901..34adc86 100644
--- a/gcc/gsstruct.def
+++ b/gcc/gsstruct.def
@@ -44,6 +44,7 @@ DEFGSSTRUCT(GSS_OMP, gimple_statement_omp, false)
DEFGSSTRUCT(GSS_OMP_CRITICAL, gomp_critical, false)
DEFGSSTRUCT(GSS_OMP_FOR, gomp_for, false)
DEFGSSTRUCT(GSS_OMP_PARALLEL_LAYOUT, gimple_statement_omp_parallel_layout, false)
+DEFGSSTRUCT(GSS_OMP_TARGET, gomp_target, false)
DEFGSSTRUCT(GSS_OMP_TASK, gomp_task, false)
DEFGSSTRUCT(GSS_OMP_SECTIONS, gomp_sections, false)
DEFGSSTRUCT(GSS_OMP_SINGLE_LAYOUT, gimple_statement_omp_single_layout, false)
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index 6b34d32..c80a8ee 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -87,9 +87,14 @@ extern tree lhd_omp_assignment (tree, tree, tree);
extern void lhd_omp_finish_clause (tree, gimple_seq *, bool);
extern tree lhd_omp_array_size (tree, gimple_seq *);
extern bool lhd_omp_deep_mapping_p (const gimple *, tree);
-extern tree lhd_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *);
-extern void lhd_omp_deep_mapping (const gimple *, tree, unsigned HOST_WIDE_INT,
- tree, tree, tree, tree, tree, gimple_seq *);
+extern tree lhd_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *);
+extern void lhd_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT,
+ tree, tree, tree, tree, tree, gimple_seq *,
+ vec<tree> *);
+extern tree lhd_omp_finish_mapper_clauses (tree);
+extern tree lhd_omp_mapper_lookup (tree, tree);
+extern tree lhd_omp_extract_mapper_directive (tree);
+extern tree lhd_omp_map_array_section (location_t, tree);
struct gimplify_omp_ctx;
extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *,
tree);
@@ -279,6 +284,11 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
#define LANG_HOOKS_OMP_DEEP_MAPPING_P lhd_omp_deep_mapping_p
#define LANG_HOOKS_OMP_DEEP_MAPPING_CNT lhd_omp_deep_mapping_cnt
#define LANG_HOOKS_OMP_DEEP_MAPPING lhd_omp_deep_mapping
+#define LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES lhd_omp_finish_mapper_clauses
+#define LANG_HOOKS_OMP_MAPPER_LOOKUP lhd_omp_mapper_lookup
+#define LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE \
+ lhd_omp_extract_mapper_directive
+#define LANG_HOOKS_OMP_MAP_ARRAY_SECTION lhd_omp_map_array_section
#define LANG_HOOKS_OMP_ALLOCATABLE_P hook_bool_tree_false
#define LANG_HOOKS_OMP_SCALAR_P lhd_omp_scalar_p
#define LANG_HOOKS_OMP_SCALAR_TARGET_P hook_bool_tree_false
@@ -316,6 +326,10 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
LANG_HOOKS_OMP_DEEP_MAPPING_P, \
LANG_HOOKS_OMP_DEEP_MAPPING_CNT, \
LANG_HOOKS_OMP_DEEP_MAPPING, \
+ LANG_HOOKS_OMP_FINISH_MAPPER_CLAUSES, \
+ LANG_HOOKS_OMP_MAPPER_LOOKUP, \
+ LANG_HOOKS_OMP_EXTRACT_MAPPER_DIRECTIVE, \
+ LANG_HOOKS_OMP_MAP_ARRAY_SECTION, \
LANG_HOOKS_OMP_ALLOCATABLE_P, \
LANG_HOOKS_OMP_SCALAR_P, \
LANG_HOOKS_OMP_SCALAR_TARGET_P, \
diff --git a/gcc/langhooks.cc b/gcc/langhooks.cc
index 77d5a42..3db87bd 100644
--- a/gcc/langhooks.cc
+++ b/gcc/langhooks.cc
@@ -656,7 +656,7 @@ lhd_omp_deep_mapping_p (const gimple *, tree)
/* Returns number of additional mappings for a decl. */
tree
-lhd_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *)
+lhd_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *)
{
return NULL_TREE;
}
@@ -664,11 +664,46 @@ lhd_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *)
/* Do the additional mappings. */
void
-lhd_omp_deep_mapping (const gimple *, tree, unsigned HOST_WIDE_INT, tree, tree,
- tree, tree, tree, gimple_seq *)
+lhd_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT, tree, tree,
+ tree, tree, tree, gimple_seq *, vec<tree> *)
{
}
+/* Finalize clause list C after expanding custom mappers for implicitly-mapped
+ variables. */
+
+tree
+lhd_omp_finish_mapper_clauses (tree c)
+{
+ return c;
+}
+
+/* Look up an OpenMP "declare mapper" mapper. */
+
+tree
+lhd_omp_mapper_lookup (tree, tree)
+{
+ return NULL_TREE;
+}
+
+/* Given the representation used by the front-end to contain a mapper
+ directive, return the statement for the directive itself. */
+
+tree
+lhd_omp_extract_mapper_directive (tree)
+{
+ return error_mark_node;
+}
+
+/* Return a simplified form for OMP_ARRAY_SECTION argument, or
+ error_mark_node if impossible. */
+
+tree
+lhd_omp_map_array_section (location_t, tree)
+{
+ return error_mark_node;
+}
+
/* Return true if DECL is a scalar variable (for the purpose of
implicit firstprivatization & mapping). Only if alloc_ptr_ok
are allocatables and pointers accepted. */
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index dc8d878..d95e5cb 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -319,14 +319,31 @@ struct lang_hooks_for_decls
/* Additional language-specific mappings for a decl; returns the
number of additional mappings needed. */
- tree (*omp_deep_mapping_cnt) (const gimple *ctx_stmt, tree clause,
+ tree (*omp_deep_mapping_cnt) (gimple *ctx_stmt, tree clause,
gimple_seq *seq);
/* Do the actual additional language-specific mappings for a decl. */
- void (*omp_deep_mapping) (const gimple *stmt, tree clause,
+ void (*omp_deep_mapping) (gimple *stmt, tree clause,
unsigned HOST_WIDE_INT tkind,
tree data, tree sizes, tree kinds,
- tree offset_data, tree offset, gimple_seq *seq);
+ tree offset_data, tree offset, gimple_seq *seq,
+ vec<tree> *);
+
+ /* Finish language-specific processing on mapping nodes after expanding
+ user-defined mappers. */
+ tree (*omp_finish_mapper_clauses) (tree clauses);
+
+ /* Find a mapper in the current parsing context, given a NAME (or
+ NULL_TREE) and TYPE. */
+ tree (*omp_mapper_lookup) (tree name, tree type);
+
+ /* Return the statement for the mapper directive definition, from the
+ representation used to contain it (e.g. an inline function
+ declaration). */
+ tree (*omp_extract_mapper_directive) (tree fndecl);
+
+ /* Return a simplified form for OMP_ARRAY_SECTION argument. */
+ tree (*omp_map_array_section) (location_t, tree t);
/* Return true if DECL is an allocatable variable (for the purpose of
implicit mapping). */
diff --git a/gcc/lto-wrapper.cc b/gcc/lto-wrapper.cc
index a980b20..b38ce91 100644
--- a/gcc/lto-wrapper.cc
+++ b/gcc/lto-wrapper.cc
@@ -748,6 +748,7 @@ append_compiler_options (obstack *argv_obstack, vec<cl_decoded_option> opts)
case OPT_fcommon:
case OPT_fgnu_tm:
case OPT_fopenmp:
+ case OPT_fopenmp_target_:
case OPT_fopenacc:
case OPT_fopenacc_dim_:
case OPT_foffload_abi_:
diff --git a/gcc/omp-builtins.def b/gcc/omp-builtins.def
index f73fb7b..97e8b6a 100644
--- a/gcc/omp-builtins.def
+++ b/gcc/omp-builtins.def
@@ -31,7 +31,7 @@ along with GCC; see the file COPYING3. If not see
doesn't source those. */
DEF_GOACC_BUILTIN (BUILT_IN_GOACC_DATA_START, "GOACC_data_start",
- BT_FN_VOID_INT_SIZE_PTR_PTR_PTR, ATTR_NOTHROW_LIST)
+ BT_FN_VOID_INT_SIZE_PTR_PTR_PTR_VAR, ATTR_NOTHROW_LIST)
DEF_GOACC_BUILTIN (BUILT_IN_GOACC_DATA_END, "GOACC_data_end",
BT_FN_VOID, ATTR_NOTHROW_LIST)
DEF_GOACC_BUILTIN (BUILT_IN_GOACC_ENTER_DATA, "GOACC_enter_data",
@@ -73,9 +73,9 @@ DEF_GOMP_BUILTIN_COMPILER (BUILT_IN_OMP_IS_INITIAL_DEVICE,
"omp_is_initial_device", BT_FN_INT,
ATTR_CONST_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_THREAD_NUM, "omp_get_thread_num",
- BT_FN_INT, ATTR_CONST_NOTHROW_LEAF_LIST)
+ BT_FN_INT, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_NUM_THREADS, "omp_get_num_threads",
- BT_FN_INT, ATTR_CONST_NOTHROW_LEAF_LIST)
+ BT_FN_INT, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_TEAM_NUM, "omp_get_team_num",
BT_FN_INT, ATTR_CONST_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_NUM_TEAMS, "omp_get_num_teams",
@@ -90,6 +90,10 @@ DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_INTEROP_INT, "omp_get_interop_int",
BT_FN_PTRMODE_PTR_INT_PTR, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_OMP_GET_NUM_DEVICES, "omp_get_num_devices",
BT_FN_INT, ATTR_NOTHROW_LEAF_LIST)
+DEF_GOMP_BUILTIN (BUILT_IN_OMP_INIT_ALLOCATOR, "omp_init_allocator",
+ BT_FN_PTRMODE_PTRMODE_INT_PTR, ATTR_NOTHROW_LEAF_LIST)
+DEF_GOMP_BUILTIN (BUILT_IN_OMP_DESTROY_ALLOCATOR, "omp_destroy_allocator",
+ BT_FN_VOID_PTRMODE, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_GOMP_ATOMIC_START, "GOMP_atomic_start",
BT_FN_VOID, ATTR_NOTHROW_LEAF_LIST)
@@ -493,3 +497,6 @@ DEF_GOMP_BUILTIN (BUILT_IN_GOMP_WARNING, "GOMP_warning",
BT_FN_VOID_CONST_PTR_SIZE, ATTR_NOTHROW_LEAF_LIST)
DEF_GOMP_BUILTIN (BUILT_IN_GOMP_ERROR, "GOMP_error",
BT_FN_VOID_CONST_PTR_SIZE, ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST)
+DEF_GOMP_BUILTIN (BUILT_IN_GOMP_ENABLE_PINNED_MODE,
+ "GOMP_enable_pinned_mode",
+ BT_FN_VOID, ATTR_NOTHROW_LIST)
diff --git a/gcc/omp-expand.cc b/gcc/omp-expand.cc
index 648ede2..48f57cb 100644
--- a/gcc/omp-expand.cc
+++ b/gcc/omp-expand.cc
@@ -1079,11 +1079,16 @@ remove_exit_barrier (struct omp_region *region)
from within current function (this would be easy to check)
or from some function it calls and gets passed an address
of such a variable. */
+ gomp_parallel *parallel_stmt
+ = as_a <gomp_parallel *> (last_nondebug_stmt (region->entry));
+ tree child_fun = gimple_omp_parallel_child_fn (parallel_stmt);
+
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && child_fun == NULL_TREE)
+ any_addressable_vars = 0;
+
if (any_addressable_vars < 0)
{
- gomp_parallel *parallel_stmt
- = as_a <gomp_parallel *> (last_nondebug_stmt (region->entry));
- tree child_fun = gimple_omp_parallel_child_fn (parallel_stmt);
tree local_decls, block, decl;
unsigned ix;
@@ -7768,6 +7773,17 @@ expand_oacc_for (struct omp_region *region, struct omp_for_data *fd)
/* The SSA parallelizer does gang parallelism. */
gwv = build_int_cst (integer_type_node, GOMP_DIM_MASK (GOMP_DIM_GANG));
}
+ else if (flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ {
+ tree clauses = gimple_omp_for_clauses (for_stmt);
+ int omp_mask = 0;
+ if (omp_find_clause (clauses, OMP_CLAUSE_GANG))
+ omp_mask |= GOMP_DIM_MASK (GOMP_DIM_GANG);
+ if (omp_find_clause (clauses, OMP_CLAUSE_VECTOR))
+ omp_mask |= GOMP_DIM_MASK (GOMP_DIM_VECTOR);
+ gcc_assert (omp_mask);
+ gwv = build_int_cst (integer_type_node, omp_mask);
+ }
if (fd->collapse > 1 || fd->tiling)
{
@@ -7814,7 +7830,10 @@ expand_oacc_for (struct omp_region *region, struct omp_for_data *fd)
tile_size = create_tmp_var (diff_type, ".tile_size");
expr = build_int_cst (diff_type, 1);
for (int ix = 0; ix < fd->collapse; ix++)
- expr = fold_build2 (MULT_EXPR, diff_type, counts[ix].tile, expr);
+ {
+ tree tile = fold_convert (diff_type, counts[ix].tile);
+ expr = fold_build2 (MULT_EXPR, diff_type, tile, expr);
+ }
expr = force_gimple_operand_gsi (&gsi, expr, true,
NULL_TREE, true, GSI_SAME_STMT);
ass = gimple_build_assign (tile_size, expr);
@@ -9792,6 +9811,13 @@ get_target_arguments (gimple_stmt_iterator *gsi, gomp_target *tgt_stmt)
t = OMP_CLAUSE_THREAD_LIMIT_EXPR (c);
else
t = integer_minus_one_node;
+
+ /* Currently, OMPACC mode has a limitation of only one warp thread. */
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && lookup_attribute
+ ("ompacc", DECL_ATTRIBUTES (gimple_omp_target_child_fn (tgt_stmt))))
+ t = integer_one_node;
+
push_target_argument_according_to_value (gsi, GOMP_TARGET_ARG_DEVICE_ALL,
GOMP_TARGET_ARG_THREAD_LIMIT, t,
&args);
@@ -10633,6 +10659,19 @@ expand_omp_target (struct omp_region *region)
gsi_insert_before (&gsi, g, GSI_SAME_STMT);
}
+ /* We assume index >= 3 in gimple_omp_target_data_arg are non-contiguous
+ array descriptor pointer arguments. */
+ if (t != NULL
+ && TREE_VEC_LENGTH (t) > 3
+ && (start_ix == BUILT_IN_GOACC_DATA_START
+ || start_ix == BUILT_IN_GOACC_PARALLEL))
+ {
+ gcc_assert ((c = omp_find_clause (clauses, OMP_CLAUSE_MAP))
+ && GOMP_MAP_NONCONTIG_ARRAY_P (OMP_CLAUSE_MAP_KIND (c)));
+ for (int i = 3; i < TREE_VEC_LENGTH (t); i++)
+ args.safe_push (TREE_VEC_ELT (t, i));
+ }
+
g = gimple_build_call_vec (builtin_decl_explicit (start_ix), args);
gimple_set_location (g, gimple_location (entry_stmt));
gsi_insert_before (&gsi, g, GSI_SAME_STMT);
@@ -10678,6 +10717,44 @@ expand_omp (struct omp_region *region)
switch (region->type)
{
case GIMPLE_OMP_PARALLEL:
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ {
+ struct omp_region *r;
+ for (r = region->outer; r; r = r->outer)
+ if (r->type == GIMPLE_OMP_TARGET)
+ {
+ gomp_target *tgt
+ = as_a <gomp_target *> (last_nondebug_stmt (r->entry));
+ tree tgtfn_attrs
+ = DECL_ATTRIBUTES (gimple_omp_target_child_fn (tgt));
+ if (!lookup_attribute ("ompacc", tgtfn_attrs))
+ r = NULL;
+ break;
+ }
+ if (r != NULL
+ || (lookup_attribute
+ ("ompacc", DECL_ATTRIBUTES (current_function_decl))))
+ {
+ gimple_stmt_iterator gsi;
+ gsi = gsi_last_nondebug_bb (region->entry);
+ gcc_assert (!gsi_end_p (gsi)
+ && gimple_code
+ (gsi_stmt (gsi)) == GIMPLE_OMP_PARALLEL);
+ gsi_remove (&gsi, true);
+
+ if (region->exit)
+ {
+ gsi = gsi_last_nondebug_bb (region->exit);
+ gcc_assert (!gsi_end_p (gsi)
+ && gimple_code
+ (gsi_stmt (gsi)) == GIMPLE_OMP_RETURN);
+ gsi_remove (&gsi, true);
+ }
+ break;
+ }
+ }
+ /* Fallthrough. */
+
case GIMPLE_OMP_TASK:
expand_omp_taskreg (region);
break;
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 0b7c3b9..0eaa431 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -213,8 +213,12 @@ omp_extract_for_data (gomp_for *for_stmt, struct omp_for_data *fd,
struct omp_for_data_loop dummy_loop;
location_t loc = gimple_location (for_stmt);
bool simd = gimple_omp_for_kind (for_stmt) == GF_OMP_FOR_KIND_SIMD;
- bool distribute = gimple_omp_for_kind (for_stmt)
- == GF_OMP_FOR_KIND_DISTRIBUTE;
+ bool distribute =
+ (gimple_omp_for_kind (for_stmt) == GF_OMP_FOR_KIND_DISTRIBUTE
+ || (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && gimple_omp_for_kind (for_stmt) == GF_OMP_FOR_KIND_OACC_LOOP
+ && omp_find_clause (gimple_omp_for_clauses (for_stmt),
+ OMP_CLAUSE_GANG)));
bool taskloop = gimple_omp_for_kind (for_stmt)
== GF_OMP_FOR_KIND_TASKLOOP;
bool order_reproducible = false;
@@ -406,6 +410,7 @@ omp_extract_for_data (gomp_for *for_stmt, struct omp_for_data *fd,
fd->non_rect = true;
}
}
+ int accum_iter_precision = 0;
for (i = 0; i < cnt; i++)
{
if (i == 0
@@ -452,7 +457,8 @@ omp_extract_for_data (gomp_for *for_stmt, struct omp_for_data *fd,
loop->n2 = gimple_omp_for_final (for_stmt, i);
gcc_assert (loop->cond_code != NE_EXPR
|| (gimple_omp_for_kind (for_stmt)
- != GF_OMP_FOR_KIND_OACC_LOOP));
+ != GF_OMP_FOR_KIND_OACC_LOOP)
+ || flag_openmp_target == OMP_TARGET_MODE_OMPACC);
if (TREE_CODE (loop->n2) == TREE_VEC)
{
if (loop->outer)
@@ -489,19 +495,33 @@ omp_extract_for_data (gomp_for *for_stmt, struct omp_for_data *fd,
{
if (fd->collapse == 1 && !fd->tiling)
iter_type = TREE_TYPE (loop->v);
- else if (i == 0
- || TYPE_PRECISION (iter_type)
- < TYPE_PRECISION (TREE_TYPE (loop->v)))
+ else
{
- if (TREE_CODE (iter_type) == BITINT_TYPE
- || TREE_CODE (TREE_TYPE (loop->v)) == BITINT_TYPE)
- iter_type
- = build_bitint_type (TYPE_PRECISION (TREE_TYPE (loop->v)),
- 1);
- else
- iter_type
- = build_nonstandard_integer_type
- (TYPE_PRECISION (TREE_TYPE (loop->v)), 1);
+ int loop_precision = TYPE_PRECISION (TREE_TYPE (loop->v));
+ int iter_type_precision = 0;
+ const int max_accum_precision
+ = TYPE_PRECISION (long_long_unsigned_type_node);
+
+ accum_iter_precision += loop_precision;
+
+ if (i == 0
+ || (loop_precision >= max_accum_precision
+ && loop_precision >= TYPE_PRECISION (iter_type)))
+ iter_type_precision = loop_precision;
+ else if (TYPE_PRECISION (iter_type) < max_accum_precision)
+ iter_type_precision
+ = MIN (1 << ceil_log2 (accum_iter_precision),
+ max_accum_precision);
+
+ if (iter_type_precision)
+ {
+ if (TREE_CODE (iter_type) == BITINT_TYPE
+ || TREE_CODE (TREE_TYPE (loop->v)) == BITINT_TYPE)
+ iter_type = build_bitint_type (iter_type_precision, 1);
+ else
+ iter_type
+ = build_nonstandard_integer_type (iter_type_precision, 1);
+ }
}
}
else if (iter_type != long_long_unsigned_type_node)
@@ -1501,6 +1521,66 @@ omp_check_context_selector (location_t loc, tree ctx,
return ctx;
}
+/* Produce a mangled version of BASE_ID for the name of the variant
+ function with context selector CTX. SEP is a separator string.
+ The return value is an IDENTIFIER_NODE.
+
+ Per the OpenMP spec, "the symbol names of two definitions of a function are
+ considered to be equal if and only if their effective context selectors are
+ equivalent". However, if we did have two such definitions, we'd get an ODR
+ violation. We already take steps in the front ends to make variant
+ functions internal to the compilation unit, since there is no (portable) way
+ to reference them directly by name or declare them as extern in another
+ compilation unit. So, we can diagnose the would-be ODR violations by
+ checking that there is not already a variant for the same function with an
+ equivalent context selector, and otherwise just use a simple counter to name
+ the variant functions instead of any complicated scheme to encode the
+ context selector in the name. */
+
+tree
+omp_mangle_variant_name (tree base_id, tree ctx ATTRIBUTE_UNUSED,
+ const char *sep)
+{
+ const char *base_name = IDENTIFIER_POINTER (base_id);
+
+ /* Now do the actual mangling. */
+ static int variant_counter;
+ /* The numeric suffix and terminating byte ought to need way less than
+ 32 bytes extra, that's just a magic number. */
+ size_t buflen = (strlen (base_name) + strlen (sep) + strlen ("ompvariant")
+ + 32);
+ char *buffer = (char *) alloca (buflen);
+ snprintf (buffer, buflen, "%s%sompvariant%d", base_name, sep,
+ ++variant_counter);
+ return get_identifier (buffer);
+}
+
+/* Forward declaration. */
+static int omp_context_selector_compare (tree ctx1, tree ctx2);
+
+/* Diagnose an error if there is already a variant with CTX registered
+ for BASE_DECL. Returns true if OK, false otherwise. */
+bool
+omp_check_for_duplicate_variant (location_t loc, tree base_decl, tree ctx)
+{
+ for (tree attr = DECL_ATTRIBUTES (base_decl); attr; attr = TREE_CHAIN (attr))
+ {
+ attr = lookup_attribute ("omp declare variant base", attr);
+ if (attr == NULL_TREE)
+ break;
+
+ tree selector = TREE_VALUE (TREE_VALUE (attr));
+ if (omp_context_selector_compare (ctx, selector) == 0)
+ {
+ error_at (loc,
+ "Multiple definitions of variants with the same "
+ "context selector violate the one-definition rule");
+ return false;
+ }
+ }
+ return true;
+}
+
/* Forward declarations. */
static int omp_context_selector_set_compare (enum omp_tss_code, tree, tree);
static int omp_construct_simd_compare (tree, tree, bool);
@@ -1675,13 +1755,19 @@ omp_construct_traits_match (tree selector_traits, tree context_traits,
CONSTRUCT_CONTEXT is known to be complete and not missing constructs
filled in later during compilation.
+ If DECLARE_VARIANT_ELISION_P is true, the function implements the test
+ for elision of preprocessed code in "begin declare variant" constructs,
+ and returns 0 only for failure to match traits in the device and
+ implementation sets.
+
Dynamic properties (which are evaluated at run-time) should always
return 1. */
int
omp_context_selector_matches (tree ctx,
tree construct_context,
- bool complete_p)
+ bool complete_p,
+ bool declare_variant_elision_p)
{
int ret = 1;
bool maybe_offloaded = omp_maybe_offloaded (construct_context);
@@ -1693,9 +1779,12 @@ omp_context_selector_matches (tree ctx,
/* Immediately reject the match if there are any ignored
selectors present. */
- for (tree ts = selectors; ts; ts = TREE_CHAIN (ts))
- if (OMP_TS_CODE (ts) == OMP_TRAIT_INVALID)
- return 0;
+ if (!declare_variant_elision_p
+ || set == OMP_TRAIT_SET_DEVICE
+ || set == OMP_TRAIT_SET_IMPLEMENTATION)
+ for (tree ts = selectors; ts; ts = TREE_CHAIN (ts))
+ if (OMP_TS_CODE (ts) == OMP_TRAIT_INVALID)
+ return 0;
if (set == OMP_TRAIT_SET_CONSTRUCT)
{
@@ -2049,6 +2138,13 @@ omp_context_selector_matches (tree ctx,
break;
case OMP_TRAIT_USER_CONDITION:
gcc_assert (set == OMP_TRAIT_SET_USER);
+ /* The spec does not include the "user" set in the things that
+ can trigger code elision in "begin declare variant". */
+ if (declare_variant_elision_p)
+ {
+ ret = -1;
+ break;
+ }
for (tree p = OMP_TS_PROPERTIES (ts); p; p = TREE_CHAIN (p))
if (OMP_TP_NAME (p) == NULL_TREE)
{
@@ -2064,6 +2160,10 @@ omp_context_selector_matches (tree ctx,
ret = -1;
}
break;
+ case OMP_TRAIT_INVALID:
+ /* This is only for the declare_variant_elision_p case. */
+ ret = -1;
+ break;
default:
break;
}
@@ -4095,6 +4195,32 @@ omp_addr_token::omp_addr_token (token_type t, structure_base_kinds k, tree e)
}
static bool
+omp_parse_noncontiguous_array (tree *expr0)
+{
+ tree expr = *expr0;
+ bool noncontig = false;
+
+ while (TREE_CODE (expr) == OMP_ARRAY_SECTION
+ || TREE_CODE (expr) == ARRAY_REF)
+ {
+ /* Contiguous arrays use ARRAY_REF. By the time we reach here,
+ OMP_ARRAY_SECTION is only used for noncontiguous arrays. */
+ if (TREE_CODE (expr) == OMP_ARRAY_SECTION)
+ noncontig = true;
+
+ expr = TREE_OPERAND (expr, 0);
+ }
+
+ if (noncontig)
+ {
+ *expr0 = expr;
+ return true;
+ }
+
+ return false;
+}
+
+static bool
omp_parse_component_selector (tree *expr0)
{
tree expr = *expr0;
@@ -4193,6 +4319,13 @@ omp_parse_access_method (tree *expr0, enum access_method_kinds *kind)
if (omp_parse_ref (&expr))
*kind = ACCESS_REF;
+ else if (omp_parse_noncontiguous_array (&expr))
+ {
+ if (omp_parse_ref (&expr))
+ *kind = ACCESS_NONCONTIG_REF_TO_ARRAY;
+ else
+ *kind = ACCESS_NONCONTIG_ARRAY;
+ }
else if (omp_parse_pointer (&expr, &has_offset))
{
if (omp_parse_ref (&expr))
@@ -4264,6 +4397,14 @@ omp_parse_structure_base (vec<omp_addr_token *> &addr_tokens,
return true;
}
+ if (TREE_CODE (expr) == VIEW_CONVERT_EXPR
+ && TREE_CODE (TREE_TYPE (expr)) == ARRAY_TYPE)
+ {
+ *kind = BASE_DECL;
+ *expr0 = TREE_OPERAND (expr, 0);
+ return true;
+ }
+
*kind = BASE_ARBITRARY_EXPR;
*expr0 = expr;
return true;
@@ -4412,6 +4553,12 @@ debug_omp_tokenized_addr (vec<omp_addr_token *> &addr_tokens,
case ACCESS_INDEXED_REF_TO_ARRAY:
fputs ("access_indexed_ref_to_array", stderr);
break;
+ case ACCESS_NONCONTIG_ARRAY:
+ fputs ("access_noncontig_array", stderr);
+ break;
+ case ACCESS_NONCONTIG_REF_TO_ARRAY:
+ fputs ("access_noncontig_ref_to_array", stderr);
+ break;
}
break;
case ARRAY_BASE:
@@ -4922,3 +5069,137 @@ omp_maybe_apply_loop_xforms (tree *expr_p, tree for_clauses)
}
}
+/* The next group of functions support merging of context selectors for
+ nested "begin declare variant" directives. The spec says:
+
+ ...the effective context selectors of the outer directive are
+ appended to the context selector of the inner directive to form the
+ effective context selector of the inner directive. If a
+ trait-set-selector is present on both directives, the trait-selector
+ list of the outer directive is appended to the trait-selector list
+ of the inner directive after equivalent trait-selectors have been
+ removed from the outer list.
+
+ In other words, there is no requirement to combine non-equivalent
+ trait-selectors according to their peculiar semantics, such as allowing
+ "any" as a wildcard, ANDing trait-property-expressions of "condition" trait
+ property expressions together, etc. Also there is no special provision for
+ treating the "construct" selector as an ordered list.
+
+ Note that the spec does not explicitly say what "equivalent" means;
+ whether the properties and score of the trait-selectors must be identical,
+ or only the name of the trait-selector. This code assumes the former
+ except for the construct trait set where the order of selectors
+ is significant (so that it is *not* equivalent to have the same
+ trait-selector appearing in a different order in the list). */
+
+/* Copy traits from FROM_TS and push them onto TAIL. */
+
+static tree
+omp_copy_trait_set (tree from_ts, tree tail)
+{
+ for (tree ts = from_ts; ts; ts = TREE_CHAIN (ts))
+ tail = make_trait_selector (OMP_TS_CODE (ts), OMP_TS_SCORE (ts),
+ OMP_TS_PROPERTIES (ts), tail);
+ return nreverse (tail);
+}
+
+/* Return true if trait selectors TS1 and TS2 for set TSS are "equivalent". */
+
+static bool
+omp_trait_selectors_equivalent (tree ts1, tree ts2, enum omp_tss_code tss)
+{
+ if (OMP_TS_CODE (ts1) != OMP_TS_CODE (ts2))
+ return false;
+
+ tree score1 = OMP_TS_SCORE (ts1);
+ tree score2 = OMP_TS_SCORE (ts2);
+ if ((score1 && score2 && !simple_cst_equal (score1, score2))
+ || (score1 && !score2)
+ || (!score1 && score2))
+ return false;
+
+ return (omp_context_selector_props_compare (tss, OMP_TS_CODE (ts1),
+ OMP_TS_PROPERTIES (ts1),
+ OMP_TS_PROPERTIES (ts2))
+ == 0);
+}
+
+/* Merge lists of the trait selectors OUTER_TS and INNER_TS for selector set
+ TSS: "the trait-selector list of the outer directive is appended to the
+ trait-selector list of the inner directive after equivalent trait-selectors
+ have been removed from the outer list". */
+
+static tree
+omp_combine_trait_sets (tree outer_ts, tree inner_ts, enum omp_tss_code tss)
+{
+ unsigned HOST_WIDE_INT inner_traits = 0;
+ tree to_list = NULL_TREE;
+
+ for (tree inner = inner_ts; inner; inner = TREE_CHAIN (inner))
+ {
+ omp_ts_code ts_code = OMP_TS_CODE (inner);
+ inner_traits |= 1 << ts_code;
+ to_list
+ = make_trait_selector (ts_code, OMP_TS_SCORE (inner),
+ unshare_expr (OMP_TS_PROPERTIES (inner)),
+ to_list);
+ }
+
+ for (tree outer = outer_ts; outer; outer = TREE_CHAIN (outer))
+ {
+ omp_ts_code ts_code = OMP_TS_CODE (outer);
+ bool remove = false;
+ if (inner_traits & (1 << ts_code))
+ for (tree inner = inner_ts; inner; inner = TREE_CHAIN (inner))
+ if (OMP_TS_CODE (inner) == ts_code)
+ {
+ if (omp_trait_selectors_equivalent (inner, outer, tss))
+ remove = true;
+ break;
+ }
+ if (!remove)
+ to_list
+ = make_trait_selector (ts_code, OMP_TS_SCORE (outer),
+ unshare_expr (OMP_TS_PROPERTIES (outer)),
+ to_list);
+ }
+
+ return nreverse (to_list);
+}
+
+/* Merge context selector INNER_CTX with OUTER_CTX. LOC and DIRECTIVE are
+ used for error checking. Returns the merged context, or error_mark_node
+ if the contexts cannot be merged. */
+
+tree
+omp_merge_context_selectors (location_t loc, tree outer_ctx, tree inner_ctx,
+ enum omp_ctx_directive directive)
+{
+ tree merged_ctx = NULL_TREE;
+
+ if (inner_ctx == error_mark_node || outer_ctx == error_mark_node)
+ return error_mark_node;
+
+ for (unsigned i = OMP_TRAIT_SET_CONSTRUCT; i != OMP_TRAIT_SET_LAST; i++)
+ {
+ omp_tss_code tss_code = static_cast<omp_tss_code>(i);
+ tree outer_ts = omp_get_context_selector_list (outer_ctx, tss_code);
+ tree inner_ts = omp_get_context_selector_list (inner_ctx, tss_code);
+ tree merged_ts = NULL_TREE;
+
+ if (inner_ts && outer_ts)
+ merged_ts = omp_combine_trait_sets (outer_ts, inner_ts, tss_code);
+ else if (inner_ts)
+ merged_ts = omp_copy_trait_set (inner_ts, NULL_TREE);
+ else if (outer_ts)
+ merged_ts = omp_copy_trait_set (outer_ts, NULL_TREE);
+
+ if (merged_ts)
+ merged_ctx = make_trait_set_selector (tss_code, merged_ts,
+ merged_ctx);
+ }
+
+ merged_ctx = nreverse (merged_ctx);
+ return omp_check_context_selector (loc, merged_ctx, directive);
+}
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 5d44ff9..1468cdd 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -200,9 +200,14 @@ enum omp_ctx_directive
OMP_CTX_METADIRECTIVE };
extern tree omp_check_context_selector (location_t loc, tree ctx,
enum omp_ctx_directive directive);
+extern tree omp_mangle_variant_name (tree base_id, tree ctx, const char *sep);
+extern bool omp_check_for_duplicate_variant (location_t loc,
+ tree base_decl, tree ctx);
extern void omp_mark_declare_variant (location_t loc, tree variant,
tree construct);
-extern int omp_context_selector_matches (tree, tree, bool);
+extern int omp_context_selector_matches (tree, tree, bool, bool = false);
+extern tree omp_merge_context_selectors (location_t, tree, tree,
+ enum omp_ctx_directive);
extern tree resolve_omp_target_device_matches (tree node);
extern tree omp_get_context_selector (tree, enum omp_tss_code,
enum omp_ts_code);
@@ -254,6 +259,92 @@ get_openacc_privatization_dump_flags ()
extern tree omp_build_component_ref (tree obj, tree field);
+template <typename T>
+struct omp_name_type
+{
+ tree name;
+ T type;
+};
+
+template <>
+struct default_hash_traits <omp_name_type<tree> >
+ : typed_noop_remove <omp_name_type<tree> >
+{
+ GTY((skip)) typedef omp_name_type<tree> value_type;
+ GTY((skip)) typedef omp_name_type<tree> compare_type;
+
+ static hashval_t
+ hash (omp_name_type<tree> p)
+ {
+ return p.name ? iterative_hash_expr (p.name, TYPE_UID (p.type))
+ : TYPE_UID (p.type);
+ }
+
+ static const bool empty_zero_p = true;
+
+ static bool
+ is_empty (omp_name_type<tree> p)
+ {
+ return p.type == NULL;
+ }
+
+ static bool
+ is_deleted (omp_name_type<tree>)
+ {
+ return false;
+ }
+
+ static bool
+ equal (const omp_name_type<tree> &a, const omp_name_type<tree> &b)
+ {
+ if (a.name == NULL_TREE && b.name == NULL_TREE)
+ return a.type == b.type;
+ else if (a.name == NULL_TREE || b.name == NULL_TREE)
+ return false;
+ else
+ return a.name == b.name && a.type == b.type;
+ }
+
+ static void
+ mark_empty (omp_name_type<tree> &e)
+ {
+ e.type = NULL;
+ }
+};
+
+template <typename T>
+struct omp_mapper_list
+{
+ hash_set<omp_name_type<T>> *seen_types;
+ vec<tree> *mappers;
+
+ omp_mapper_list (hash_set<omp_name_type<T>> *s, vec<tree> *m)
+ : seen_types (s), mappers (m) { }
+
+ void add_mapper (tree name, T type, tree mapperfn)
+ {
+ /* We can't hash a NULL_TREE... */
+ if (!name)
+ name = void_node;
+
+ omp_name_type<T> n_t = { name, type };
+
+ if (seen_types->contains (n_t))
+ return;
+
+ seen_types->add (n_t);
+ mappers->safe_push (mapperfn);
+ }
+
+ bool contains (tree name, T type)
+ {
+ if (!name)
+ name = void_node;
+
+ return seen_types->contains ({ name, type });
+ }
+};
+
namespace omp_addr_tokenizer {
/* These are the ways of accessing a variable that have special-case handling
@@ -270,7 +361,9 @@ enum access_method_kinds
ACCESS_POINTER_OFFSET,
ACCESS_REF_TO_POINTER_OFFSET,
ACCESS_INDEXED_ARRAY,
- ACCESS_INDEXED_REF_TO_ARRAY
+ ACCESS_INDEXED_REF_TO_ARRAY,
+ ACCESS_NONCONTIG_ARRAY,
+ ACCESS_NONCONTIG_REF_TO_ARRAY
};
/* These are the kinds that a STRUCTURE_BASE or ARRAY_BASE (except
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index e1036ad..2141b4a 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -106,6 +106,11 @@ struct omp_context
construct. In the case of a parallel, this is in the child function. */
tree block_vars;
+ /* A hash map to track variables added through omp_copy_decl_*, to ensure
+ repeated calls of install_var_local on sam DECL do not get duplicated
+ local versions. */
+ hash_map<tree, tree> *block_vars_map;
+
/* Label to which GOMP_cancel{,llation_point} and explicit and implicit
barriers should jump to during omplower pass. */
tree cancel_label;
@@ -181,6 +186,10 @@ struct omp_context
than teams is strictly nested in it. */
bool nonteams_nested_p;
+ /* Indicates that context is in OMPACC mode, set after _ompacc_ internal
+ clauses are removed. */
+ bool ompacc_p;
+
/* Candidates for adjusting OpenACC privatization level. */
vec<tree> oacc_privatization_candidates;
};
@@ -592,12 +601,26 @@ use_pointer_for_field (tree decl, omp_context *shared_ctx)
static tree
omp_copy_decl_2 (tree var, tree name, tree type, omp_context *ctx)
{
+ if (ctx)
+ {
+ if (!ctx->block_vars_map)
+ ctx->block_vars_map = new hash_map<tree, tree> ();
+ else
+ {
+ tree *tp = ctx->block_vars_map->get (var);
+ if (tp)
+ return *tp;
+ }
+ }
+
tree copy = copy_var_decl (var, name, type);
DECL_CONTEXT (copy) = current_function_decl;
if (ctx)
{
+ ctx->block_vars_map->put (var, copy);
+
DECL_CHAIN (copy) = ctx->block_vars;
ctx->block_vars = copy;
}
@@ -780,29 +803,33 @@ build_sender_ref (tree var, omp_context *ctx)
return build_sender_ref ((splay_tree_key) var, ctx);
}
-/* Add a new field for VAR inside the structure CTX->SENDER_DECL. If
- BASE_POINTERS_RESTRICT, declare the field with restrict. */
-
static void
-install_var_field (tree var, bool by_ref, int mask, omp_context *ctx)
+install_var_field (tree var, bool by_ref, int mask, omp_context *ctx,
+ tree key_expr = NULL_TREE, bool field_may_exist = false)
{
tree field, type, sfield = NULL_TREE;
splay_tree_key key = (splay_tree_key) var;
- if ((mask & 16) != 0)
- {
- key = (splay_tree_key) &DECL_NAME (var);
- gcc_checking_assert (key != (splay_tree_key) var);
- }
- if ((mask & 8) != 0)
+ if (key_expr)
+ /* Allow user to explicitly set the expression used as the key. */
+ key = (splay_tree_key) key_expr;
+ else
{
- key = (splay_tree_key) &DECL_UID (var);
- gcc_checking_assert (key != (splay_tree_key) var);
+ if ((mask & 16) != 0)
+ {
+ key = (splay_tree_key) &DECL_NAME (var);
+ gcc_checking_assert (key != (splay_tree_key) var);
+ }
+ if ((mask & 8) != 0)
+ {
+ key = (splay_tree_key) &DECL_UID (var);
+ gcc_checking_assert (key != (splay_tree_key) var);
+ }
}
gcc_assert ((mask & 1) == 0
- || !splay_tree_lookup (ctx->field_map, key));
+ || !splay_tree_lookup (ctx->field_map, key) || field_may_exist);
gcc_assert ((mask & 2) == 0 || !ctx->sfield_map
- || !splay_tree_lookup (ctx->sfield_map, key));
+ || !splay_tree_lookup (ctx->sfield_map, key) || field_may_exist);
gcc_assert ((mask & 3) == 3
|| !is_gimple_omp_oacc (ctx->stmt));
@@ -968,6 +995,123 @@ omp_copy_decl (tree var, copy_body_data *cb)
return error_mark_node;
}
+/* Helper function for create_noncontig_array_descr_type(), to append a new field
+ to a record type. */
+
+static void
+append_field_to_record_type (tree record_type, tree fld_ident, tree fld_type)
+{
+ tree *p, fld = build_decl (UNKNOWN_LOCATION, FIELD_DECL, fld_ident, fld_type);
+ DECL_CONTEXT (fld) = record_type;
+
+ for (p = &TYPE_FIELDS (record_type); *p; p = &DECL_CHAIN (*p))
+ ;
+ *p = fld;
+}
+
+/* Create type for non-contiguous array descriptor. Returns created type, and
+ returns the number of dimensions in *DIM_NUM. */
+
+static tree
+create_noncontig_array_descr_type (tree dims, int *dim_num)
+{
+ int n = 0;
+ tree array_descr_type, name, x;
+ gcc_assert (TREE_CODE (dims) == TREE_LIST);
+
+ array_descr_type = lang_hooks.types.make_type (RECORD_TYPE);
+ name = create_tmp_var_name (".omp_noncontig_array_descr_type");
+ name = build_decl (UNKNOWN_LOCATION, TYPE_DECL, name, array_descr_type);
+ DECL_ARTIFICIAL (name) = 1;
+ DECL_NAMELESS (name) = 1;
+ TYPE_NAME (array_descr_type) = name;
+ TYPE_ARTIFICIAL (array_descr_type) = 1;
+
+ /* Number of dimensions. */
+ append_field_to_record_type (array_descr_type, get_identifier ("__dim_num"),
+ sizetype);
+
+ for (x = dims; x; x = TREE_CHAIN (x), n++)
+ {
+ char *fldname;
+ /* One for the start index. */
+ ASM_FORMAT_PRIVATE_NAME (fldname, "__dim_base", n);
+ append_field_to_record_type (array_descr_type, get_identifier (fldname),
+ sizetype);
+ /* One for the length. */
+ ASM_FORMAT_PRIVATE_NAME (fldname, "__dim_length", n);
+ append_field_to_record_type (array_descr_type, get_identifier (fldname),
+ sizetype);
+ /* One for the element size. */
+ ASM_FORMAT_PRIVATE_NAME (fldname, "__dim_elem_size", n);
+ append_field_to_record_type (array_descr_type, get_identifier (fldname),
+ sizetype);
+ /* One for is_array flag. */
+ ASM_FORMAT_PRIVATE_NAME (fldname, "__dim_is_array", n);
+ append_field_to_record_type (array_descr_type, get_identifier (fldname),
+ sizetype);
+ }
+
+ layout_type (array_descr_type);
+ *dim_num = n;
+ return array_descr_type;
+}
+
+/* Generate code sequence for initializing non-contiguous array descriptor. */
+
+static void
+create_noncontig_array_descr_init_code (tree array_descr, tree array_var,
+ tree dimensions, int dim_num,
+ gimple_seq *ilist)
+{
+ tree fld, fldref;
+ tree array_descr_type = TREE_TYPE (array_descr);
+ tree dim_type = TREE_TYPE (array_var);
+
+ if (TREE_CODE (dim_type) == REFERENCE_TYPE)
+ dim_type = TREE_TYPE (dim_type);
+
+ fld = TYPE_FIELDS (array_descr_type);
+ fldref = omp_build_component_ref (array_descr, fld);
+ gimplify_assign (fldref, build_int_cst (sizetype, dim_num), ilist);
+
+ while (dimensions)
+ {
+ tree dim_base = fold_convert (sizetype, TREE_PURPOSE (dimensions));
+ tree dim_length = fold_convert (sizetype, TREE_VALUE (dimensions));
+ tree dim_elem_size = TYPE_SIZE_UNIT (TREE_TYPE (dim_type));
+ tree dim_is_array = (TREE_CODE (dim_type) == ARRAY_TYPE
+ ? integer_one_node : integer_zero_node);
+ /* Set base. */
+ fld = TREE_CHAIN (fld);
+ fldref = omp_build_component_ref (array_descr, fld);
+ dim_base = fold_build2 (MULT_EXPR, sizetype, dim_base, dim_elem_size);
+ gimplify_assign (fldref, dim_base, ilist);
+
+ /* Set length. */
+ fld = TREE_CHAIN (fld);
+ fldref = omp_build_component_ref (array_descr, fld);
+ dim_length = fold_build2 (MULT_EXPR, sizetype, dim_length, dim_elem_size);
+ gimplify_assign (fldref, dim_length, ilist);
+
+ /* Set elem_size. */
+ fld = TREE_CHAIN (fld);
+ fldref = omp_build_component_ref (array_descr, fld);
+ dim_elem_size = fold_convert (sizetype, dim_elem_size);
+ gimplify_assign (fldref, dim_elem_size, ilist);
+
+ /* Set is_array flag. */
+ fld = TREE_CHAIN (fld);
+ fldref = omp_build_component_ref (array_descr, fld);
+ dim_is_array = fold_convert (sizetype, dim_is_array);
+ gimplify_assign (fldref, dim_is_array, ilist);
+
+ dimensions = TREE_CHAIN (dimensions);
+ dim_type = TREE_TYPE (dim_type);
+ }
+ gcc_assert (TREE_CHAIN (fld) == NULL_TREE);
+}
+
/* Create a new context, with OUTER_CTX being the surrounding context. */
static omp_context *
@@ -1081,6 +1225,7 @@ delete_omp_context (splay_tree_value value)
delete ctx->task_reduction_map;
}
+ delete ctx->block_vars_map;
delete ctx->lastprivate_conditional_map;
delete ctx->allocate_map;
@@ -1147,6 +1292,60 @@ fixup_child_record_type (omp_context *ctx)
: build_reference_type (type), TYPE_QUAL_RESTRICT);
}
+/* Build record type for noncontiguous target update operations. Must be kept
+ in sync with libgomp/libgomp.h omp_noncontig_array_desc. */
+
+static tree
+omp_noncontig_descriptor_type (location_t loc)
+{
+ static tree cached = NULL_TREE;
+
+ if (cached)
+ return cached;
+
+ tree t = make_node (RECORD_TYPE);
+
+ tree fields = build_decl (loc, FIELD_DECL, get_identifier ("__ndims"),
+ size_type_node);
+
+ tree field = build_decl (loc, FIELD_DECL, get_identifier ("__elemsize"),
+ size_type_node);
+ TREE_CHAIN (field) = fields;
+ fields = field;
+
+ field = build_decl (loc, FIELD_DECL, get_identifier ("__span"),
+ size_type_node);
+ TREE_CHAIN (field) = fields;
+ fields = field;
+
+ tree ptr_size_type = build_pointer_type (size_type_node);
+
+ field = build_decl (loc, FIELD_DECL, get_identifier ("__dim"), ptr_size_type);
+ TREE_CHAIN (field) = fields;
+ fields = field;
+
+ field = build_decl (loc, FIELD_DECL, get_identifier ("__index"),
+ ptr_size_type);
+ TREE_CHAIN (field) = fields;
+ fields = field;
+
+ field = build_decl (loc, FIELD_DECL, get_identifier ("__length"),
+ ptr_size_type);
+ TREE_CHAIN (field) = fields;
+ fields = field;
+
+ field = build_decl (loc, FIELD_DECL, get_identifier ("__stride"),
+ ptr_size_type);
+ TREE_CHAIN (field) = fields;
+ fields = field;
+
+ finish_builtin_struct (t, "__omp_noncontig_desc_type", fields, ptr_type_node);
+
+ cached = t;
+
+ return t;
+}
+
/* Instantiate decls as necessary in CTX to satisfy the data sharing
specified by CLAUSES. */
@@ -1173,6 +1372,36 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
&& omp_maybe_offloaded_ctx (ctx))
error_at (OMP_CLAUSE_LOCATION (c), "%<allocate%> clause must"
" specify an allocator here");
+ if ((omp_requires_mask & OMP_REQUIRES_DYNAMIC_ALLOCATORS) == 0
+ && OMP_CLAUSE_ALLOCATE_ALLOCATOR (c) != NULL_TREE
+ && DECL_P (OMP_CLAUSE_ALLOCATE_ALLOCATOR (c))
+ && !DECL_ARTIFICIAL (OMP_CLAUSE_ALLOCATE_ALLOCATOR (c)))
+ {
+ tree alloc2 = OMP_CLAUSE_ALLOCATE_ALLOCATOR (c);
+ if (TREE_CODE (alloc2) == MEM_REF
+ || TREE_CODE (alloc2) == INDIRECT_REF)
+ alloc2 = TREE_OPERAND (alloc2, 0);
+ omp_context *ctx2 = ctx;
+ for (; ctx2; ctx2 = ctx2->outer)
+ if (is_gimple_omp_offloaded (ctx2->stmt))
+ break;
+ if (ctx2 != NULL)
+ {
+ tree c2 = gimple_omp_target_clauses (ctx2->stmt);
+ for (; c2; c2 = OMP_CLAUSE_CHAIN (c2))
+ if (OMP_CLAUSE_CODE (c2) == OMP_CLAUSE_USES_ALLOCATORS
+ && operand_equal_p (
+ alloc2, OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (c2)))
+ break;
+ if (c2 == NULL_TREE)
+ error_at (EXPR_LOC_OR_LOC (OMP_CLAUSE_ALLOCATE_ALLOCATOR (c),
+ OMP_CLAUSE_LOCATION (c)),
+ "allocator %qE in %<allocate%> clause inside a "
+ "target region must be specified in an "
+ "%<uses_allocators%> clause on the %<target%> "
+ "directive", alloc2);
+ }
+ }
if (ctx->allocate_map == NULL)
ctx->allocate_map = new hash_map<tree, tree>;
tree val = integer_zero_node;
@@ -1385,8 +1614,13 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
|| (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR
&& lang_hooks.decls.omp_array_data (decl, true)))
{
+ /* OpenACC firstprivate clauses are later processed with same
+ code path as map clauses in lower_omp_target, so follow
+ the same convention of using the whole clause expression
+ as splay-tree key. */
+ tree k = (is_oacc_parallel_or_serial (ctx) ? c : NULL_TREE);
by_ref = !omp_privatize_by_reference (decl);
- install_var_field (decl, by_ref, 3, ctx);
+ install_var_field (decl, by_ref, 3, ctx, k);
}
else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR)
{
@@ -1591,7 +1825,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
&& is_global_var (maybe_lookup_decl_in_outer_ctx (decl, ctx))
&& varpool_node::get_create (decl)->offloadable
&& !lookup_attribute ("omp declare target link",
- DECL_ATTRIBUTES (decl)))
+ DECL_ATTRIBUTES (decl))
+ && !is_gimple_omp_oacc (ctx->stmt))
break;
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
&& OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER)
@@ -1670,7 +1905,104 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
install_var_local (decl, ctx);
break;
}
- if (DECL_P (decl))
+
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && GOMP_MAP_NONCONTIG_ARRAY_P (OMP_CLAUSE_MAP_KIND (c)))
+ {
+ tree array_decl = OMP_CLAUSE_DECL (c);
+ tree array_type = TREE_TYPE (array_decl);
+ bool by_ref = (TREE_CODE (array_type) == ARRAY_TYPE
+ ? true : false);
+
+ /* Checking code to ensure we only have arrays at top dimension.
+ This limitation might be lifted in the future. See PR76639. */
+ if (TREE_CODE (array_type) == REFERENCE_TYPE)
+ array_type = TREE_TYPE (array_type);
+ tree t = array_type, prev_t = NULL_TREE;
+ while (t)
+ {
+ if (TREE_CODE (t) == ARRAY_TYPE && prev_t)
+ {
+ error_at (gimple_location (ctx->stmt), "array types are"
+ " only allowed at outermost dimension of"
+ " non-contiguous array");
+ break;
+ }
+ prev_t = t;
+ t = TREE_TYPE (t);
+ }
+
+ install_var_field (array_decl, by_ref, 3, ctx, c);
+ install_var_local (array_decl, ctx);
+ break;
+ }
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_TO_GRID
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FROM_GRID))
+ {
+ tree desc_type = omp_noncontig_descriptor_type (UNKNOWN_LOCATION);
+
+ tree bare = decl;
+ if (TREE_CODE (bare) == VIEW_CONVERT_EXPR)
+ bare = TREE_OPERAND (bare, 0);
+
+ const char *desc_name = ".omp_noncontig_desc";
+ /* Try (but not too hard) to make a friendly name for the
+ descriptor. */
+ if (DECL_P (bare))
+ desc_name = ACONCAT ((".omp_nc_desc_",
+ IDENTIFIER_POINTER (DECL_NAME (bare)),
+ NULL));
+ tree desc = create_tmp_var (desc_type, desc_name);
+ DECL_NAMELESS (desc) = 1;
+ TREE_ADDRESSABLE (desc) = 1;
+
+ /* Adjust DECL so it refers to the first element of the array:
+ either by indirecting a pointer, or by selecting the zero'th
+ index of each dimension of an array. (We don't have a "bias"
+ as such for this type of noncontiguous update operation, just
+ the volume specified in the descriptor we build in
+ lower_omp_target.) */
+
+ if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE)
+ {
+ decl = build_fold_indirect_ref (decl);
+ OMP_CLAUSE_DECL (c) = decl;
+ }
+
+ tree field
+ = build_decl (OMP_CLAUSE_LOCATION (c), FIELD_DECL, NULL_TREE,
+ ptr_type_node);
+ SET_DECL_ALIGN (field, TYPE_ALIGN (ptr_type_node));
+ insert_field_into_struct (ctx->record_type, field);
+ splay_tree_insert (ctx->field_map, (splay_tree_key) c,
+ (splay_tree_value) field);
+
+ tree dn = build_omp_clause (OMP_CLAUSE_LOCATION (c),
+ OMP_CLAUSE_MAP);
+ OMP_CLAUSE_SET_MAP_KIND (dn, GOMP_MAP_TO_PSET);
+ OMP_CLAUSE_DECL (dn) = desc;
+
+ OMP_CLAUSE_CHAIN (dn) = OMP_CLAUSE_CHAIN (c);
+ OMP_CLAUSE_CHAIN (c) = dn;
+
+ field = build_decl (OMP_CLAUSE_LOCATION (c), FIELD_DECL,
+ NULL_TREE, ptr_type_node);
+ SET_DECL_ALIGN (field, TYPE_ALIGN (ptr_type_node));
+ insert_field_into_struct (ctx->record_type, field);
+ splay_tree_insert (ctx->field_map, (splay_tree_key) dn,
+ (splay_tree_value) field);
+
+ c = dn;
+ tree nc;
+
+ while ((nc = OMP_CLAUSE_CHAIN (c))
+ && OMP_CLAUSE_CODE (nc) == OMP_CLAUSE_MAP
+ && (OMP_CLAUSE_MAP_KIND (nc) == GOMP_MAP_GRID_DIM
+ || OMP_CLAUSE_MAP_KIND (nc) == GOMP_MAP_GRID_STRIDE))
+ c = nc;
+ }
+ else if (DECL_P (decl))
{
if (DECL_SIZE (decl)
&& !poly_int_tree_p (DECL_SIZE (decl)))
@@ -1679,7 +2011,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
gcc_assert (INDIRECT_REF_P (decl2));
decl2 = TREE_OPERAND (decl2, 0);
gcc_assert (DECL_P (decl2));
- install_var_field (decl2, true, 3, ctx);
+ install_var_field (decl2, true, 3, ctx, c);
install_var_local (decl2, ctx);
install_var_local (decl, ctx);
}
@@ -1689,9 +2021,9 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
&& OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER
&& !OMP_CLAUSE_MAP_ZERO_BIAS_ARRAY_SECTION (c)
&& TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
- install_var_field (decl, true, 7, ctx);
+ install_var_field (decl, true, 7, ctx, c, true);
else
- install_var_field (decl, true, 3, ctx);
+ install_var_field (decl, true, 3, ctx, c, true);
if (is_gimple_omp_offloaded (ctx->stmt)
&& !(is_gimple_omp_oacc (ctx->stmt)
&& OMP_CLAUSE_MAP_IN_REDUCTION (c)))
@@ -1721,13 +2053,26 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
}
gcc_assert (!splay_tree_lookup (ctx->field_map,
(splay_tree_key) decl));
+ tree ptr_type = ptr_type_node;
+ if (TREE_CODE (decl) == ARRAY_REF)
+ {
+ tree array_type = TREE_TYPE (TREE_OPERAND (decl, 0));
+ ptr_type = build_pointer_type (array_type);
+ }
tree field
= build_decl (OMP_CLAUSE_LOCATION (c),
- FIELD_DECL, NULL_TREE, ptr_type_node);
- SET_DECL_ALIGN (field, TYPE_ALIGN (ptr_type_node));
+ FIELD_DECL, NULL_TREE, ptr_type);
+ SET_DECL_ALIGN (field, TYPE_ALIGN (ptr_type));
insert_field_into_struct (ctx->record_type, field);
- splay_tree_insert (ctx->field_map, (splay_tree_key) decl,
+ splay_tree_insert (ctx->field_map, (splay_tree_key) /*decl,xxx*/ c,
(splay_tree_value) field);
+
+ if (TREE_CODE (decl) == ARRAY_REF
+ && is_gimple_omp_offloaded (ctx->stmt)
+ && !splay_tree_lookup (ctx->field_map,
+ (splay_tree_key) base))
+ splay_tree_insert (ctx->field_map, (splay_tree_key) base,
+ (splay_tree_value) field);
}
}
break;
@@ -1768,6 +2113,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_FINALIZE:
case OMP_CLAUSE_TASK_REDUCTION:
case OMP_CLAUSE_ALLOCATE:
+ case OMP_CLAUSE_USES_ALLOCATORS:
+ case OMP_CLAUSE__OMPACC_:
break;
case OMP_CLAUSE_ALIGNED:
@@ -1908,6 +2255,11 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
&& is_omp_target (ctx->stmt)
&& !is_gimple_omp_offloaded (ctx->stmt))
break;
+ if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_TO_GRID
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FROM_GRID
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_GRID_DIM
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_GRID_STRIDE)
+ break;
if (DECL_P (decl))
{
if ((OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER
@@ -1994,6 +2346,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_INIT:
case OMP_CLAUSE_USE:
case OMP_CLAUSE_DESTROY:
+ case OMP_CLAUSE_USES_ALLOCATORS:
+ case OMP_CLAUSE__OMPACC_:
break;
case OMP_CLAUSE__CACHE_:
@@ -2063,6 +2417,21 @@ omp_maybe_offloaded_ctx (omp_context *ctx)
return false;
}
+static bool
+ompacc_ctx_p (omp_context *ctx)
+{
+ if (cgraph_node::get (current_function_decl)->offloadable
+ && lookup_attribute ("ompacc",
+ DECL_ATTRIBUTES (current_function_decl)))
+ return true;
+ for (; ctx; ctx = ctx->outer)
+ if (is_gimple_omp_offloaded (ctx->stmt))
+ return (ctx->ompacc_p
+ || omp_find_clause (gimple_omp_target_clauses (ctx->stmt),
+ OMP_CLAUSE__OMPACC_));
+ return false;
+}
+
/* Build a decl for the omp child function. It'll not contain a body
yet, just the bare decl. */
@@ -2368,8 +2737,28 @@ scan_omp_parallel (gimple_stmt_iterator *gsi, omp_context *outer_ctx)
DECL_NAMELESS (name) = 1;
TYPE_NAME (ctx->record_type) = name;
TYPE_ARTIFICIAL (ctx->record_type) = 1;
- create_omp_child_function (ctx, false);
- gimple_omp_parallel_set_child_fn (stmt, ctx->cb.dst_fn);
+
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && ompacc_ctx_p (ctx))
+ {
+ tree data_name = get_identifier (".omp_data_i_par");
+ tree t = build_decl (gimple_location (stmt), VAR_DECL, data_name,
+ ptr_type_node);
+ DECL_ARTIFICIAL (t) = 1;
+ DECL_NAMELESS (t) = 1;
+ DECL_CONTEXT (t) = current_function_decl;
+ DECL_SEEN_IN_BIND_EXPR_P (t) = 1;
+ DECL_CHAIN (t) = ctx->block_vars;
+ ctx->block_vars = t;
+ TREE_USED (t) = 1;
+ TREE_READONLY (t) = 1;
+ ctx->receiver_decl = t;
+ }
+ else
+ {
+ create_omp_child_function (ctx, false);
+ gimple_omp_parallel_set_child_fn (stmt, ctx->cb.dst_fn);
+ }
scan_sharing_clauses (gimple_omp_parallel_clauses (stmt), ctx);
scan_omp (gimple_omp_body_ptr (stmt), ctx);
@@ -3119,6 +3508,50 @@ scan_omp_single (gomp_single *stmt, omp_context *outer_ctx)
layout_type (ctx->record_type);
}
+/* Reorder clauses so that non-contiguous array map clauses are placed at the very
+ front of the chain. */
+
+static void
+reorder_noncontig_array_clauses (tree *clauses_ptr)
+{
+ tree c, clauses = *clauses_ptr;
+ tree prev_clause = NULL_TREE, next_clause;
+ tree array_clauses = NULL_TREE, array_clauses_tail = NULL_TREE;
+
+ for (c = clauses; c; c = next_clause)
+ {
+ next_clause = OMP_CLAUSE_CHAIN (c);
+
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && GOMP_MAP_NONCONTIG_ARRAY_P (OMP_CLAUSE_MAP_KIND (c)))
+ {
+ /* Unchain c from clauses. */
+ if (c == clauses)
+ clauses = next_clause;
+
+ /* Link on to array_clauses. */
+ if (array_clauses_tail)
+ OMP_CLAUSE_CHAIN (array_clauses_tail) = c;
+ else
+ array_clauses = c;
+ array_clauses_tail = c;
+
+ if (prev_clause)
+ OMP_CLAUSE_CHAIN (prev_clause) = next_clause;
+ continue;
+ }
+
+ prev_clause = c;
+ }
+
+ /* Place non-contiguous array clauses at the start of the clause list. */
+ if (array_clauses)
+ {
+ OMP_CLAUSE_CHAIN (array_clauses_tail) = clauses;
+ *clauses_ptr = array_clauses;
+ }
+}
+
/* Scan a GIMPLE_OMP_TARGET. */
static void
@@ -3127,7 +3560,6 @@ scan_omp_target (gomp_target *stmt, omp_context *outer_ctx)
omp_context *ctx;
tree name;
bool offloaded = is_gimple_omp_offloaded (stmt);
- tree clauses = gimple_omp_target_clauses (stmt);
ctx = new_omp_context (stmt, outer_ctx);
ctx->field_map = splay_tree_new (splay_tree_compare_pointers, 0, 0);
@@ -3140,6 +3572,14 @@ scan_omp_target (gomp_target *stmt, omp_context *outer_ctx)
TYPE_NAME (ctx->record_type) = name;
TYPE_ARTIFICIAL (ctx->record_type) = 1;
+ /* If is OpenACC construct, put non-contiguous array clauses (if any)
+ in front of clause chain. The runtime can then test the first to see
+ if the additional map processing for them is required. */
+ if (is_gimple_omp_oacc (stmt))
+ reorder_noncontig_array_clauses (gimple_omp_target_clauses_ptr (stmt));
+
+ tree clauses = gimple_omp_target_clauses (stmt);
+
if (offloaded)
{
create_omp_child_function (ctx, false);
@@ -3149,6 +3589,24 @@ scan_omp_target (gomp_target *stmt, omp_context *outer_ctx)
scan_sharing_clauses (clauses, ctx);
scan_omp (gimple_omp_body_ptr (stmt), ctx);
+ if (offloaded && flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ {
+ for (tree *cp = gimple_omp_target_clauses_ptr (stmt); *cp;
+ cp = &OMP_CLAUSE_CHAIN (*cp))
+ if (OMP_CLAUSE_CODE (*cp) == OMP_CLAUSE__OMPACC_)
+ {
+ DECL_ATTRIBUTES (gimple_omp_target_child_fn (stmt))
+ = tree_cons (get_identifier ("ompacc"), NULL_TREE,
+ DECL_ATTRIBUTES (gimple_omp_target_child_fn (stmt)));
+ /* Unlink and remove. */
+ *cp = OMP_CLAUSE_CHAIN (*cp);
+
+ /* Set to true. */
+ ctx->ompacc_p = true;
+ break;
+ }
+ }
+
if (TYPE_FIELDS (ctx->record_type) == NULL)
ctx->record_type = ctx->receiver_decl = NULL;
else
@@ -4452,12 +4910,63 @@ maybe_lookup_decl_in_outer_ctx (tree decl, omp_context *ctx)
return t ? t : decl;
}
+/* Returns true if DECL is present inside a field that encloses CTX. */
+
+static bool
+maybe_lookup_field_in_outer_ctx (tree decl, omp_context *ctx)
+{
+ omp_context *up;
+
+ for (up = ctx->outer; up; up = up->outer)
+ {
+ for (tree c = gimple_omp_target_clauses (up->stmt);
+ c != NULL_TREE; c = OMP_CLAUSE_CHAIN (c))
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM
+ || (is_oacc_parallel_or_serial (up)
+ && OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE))
+ && OMP_CLAUSE_DECL (c) == decl)
+ return true;
+ if (maybe_lookup_field (decl, up))
+ return true;
+ }
+
+ return false;
+}
/* Construct the initialization value for reduction operation OP. */
tree
omp_reduction_init_op (location_t loc, enum tree_code op, tree type)
{
+ if (TREE_CODE (type) == ARRAY_TYPE)
+ {
+ tree max = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+ if (TREE_CONSTANT (max))
+ {
+ vec<constructor_elt, va_gc> *v = NULL;
+ HOST_WIDE_INT max_val = tree_to_shwi (max);
+ tree t = omp_reduction_init_op (loc, op, TREE_TYPE (type));
+ for (HOST_WIDE_INT i = 0; i <= max_val; i++)
+ CONSTRUCTOR_APPEND_ELT (v, size_int (i), t);
+ return build_constructor (type, v);
+ }
+ else
+ gcc_unreachable ();
+ }
+ else if (TREE_CODE (type) == RECORD_TYPE)
+ {
+ vec<constructor_elt, va_gc> *v = NULL;
+ for (tree fld = TYPE_FIELDS (type); fld; fld = TREE_CHAIN (fld))
+ if (TREE_CODE (fld) == FIELD_DECL)
+ {
+ tree t = omp_reduction_init_op (loc, op, TREE_TYPE (fld));
+ CONSTRUCTOR_APPEND_ELT (v, fld, t);
+ }
+ return build_constructor (type, v);
+ }
+
switch (op)
{
case PLUS_EXPR:
@@ -7407,6 +7916,76 @@ lower_lastprivate_clauses (tree clauses, tree predicate, gimple_seq *body_p,
gimple_seq_add_seq (stmt_list, post_stmt_list);
}
+/* Give an array reduction clause, and the surrounding map clause that mapped
+ the array (section), calculate the actual bias for the reduction inside
+ the OpenACC region, generally just: reduction_bias - map_bias, but
+ encapsulate the hairy details. */
+
+static tree
+oacc_array_reduction_bias (location_t loc, tree reduction_clause,
+ omp_context *ctx, tree map_clause,
+ omp_context *outer)
+{
+ tree bias = TREE_OPERAND (OMP_CLAUSE_DECL (reduction_clause), 1);
+ tree orig_var = TREE_OPERAND (OMP_CLAUSE_DECL (reduction_clause), 0);
+ if (TREE_CODE (orig_var) == POINTER_PLUS_EXPR)
+ {
+ tree b = TREE_OPERAND (orig_var, 1);
+ b = maybe_lookup_decl (b, ctx);
+ if (b == NULL)
+ {
+ b = TREE_OPERAND (orig_var, 1);
+ b = maybe_lookup_decl_in_outer_ctx (b, ctx);
+ }
+ if (integer_zerop (bias))
+ bias = b;
+ else
+ {
+ bias = fold_convert_loc (loc, TREE_TYPE (b), bias);
+ bias = fold_build2_loc (loc, PLUS_EXPR, TREE_TYPE (b), b, bias);
+ }
+ orig_var = TREE_OPERAND (orig_var, 0);
+ }
+
+ if (TREE_CODE (orig_var) == INDIRECT_REF
+ || TREE_CODE (orig_var) == ADDR_EXPR)
+ orig_var = TREE_OPERAND (orig_var, 0);
+
+ tree map_decl = OMP_CLAUSE_DECL (map_clause);
+ tree next = OMP_CLAUSE_CHAIN (map_clause);
+
+ tree orig_bias = integer_zero_node;
+ if (TREE_CODE (map_decl) == ARRAY_REF)
+ {
+ if (next && OMP_CLAUSE_CODE (next) == OMP_CLAUSE_MAP
+ && OMP_CLAUSE_DECL (next) == orig_var
+ && (OMP_CLAUSE_MAP_KIND (next) == GOMP_MAP_FIRSTPRIVATE_POINTER
+ || OMP_CLAUSE_MAP_KIND (next) == GOMP_MAP_POINTER))
+ {
+ orig_bias = OMP_CLAUSE_SIZE (next);
+ if (DECL_P (orig_bias))
+ orig_bias = lookup_decl (orig_bias, outer);
+ orig_bias = fold_convert_loc (loc, pointer_sized_int_node,
+ orig_bias);
+ }
+ else
+ {
+ tree idx = TREE_OPERAND (map_decl, 1);
+ idx = lookup_decl (idx, outer);
+ idx = fold_convert_loc (loc, pointer_sized_int_node, idx);
+ orig_bias = fold_build2_loc (loc, MULT_EXPR,
+ pointer_sized_int_node, idx,
+ TYPE_SIZE_UNIT (TREE_TYPE (map_decl)));
+ }
+ }
+
+ bias = fold_convert_loc (loc, pointer_sized_int_node, bias);
+ tree adjusted_bias = fold_build2_loc (loc, MINUS_EXPR,
+ pointer_sized_int_node,
+ bias, orig_bias);
+ return adjusted_bias;
+}
+
/* Lower the OpenACC reductions of CLAUSES for compute axis LEVEL
(which might be a placeholder). INNER is true if this is an inner
axis of a multi-axis loop. FORK and JOIN are (optional) fork and
@@ -7445,10 +8024,110 @@ lower_oacc_reductions (location_t loc, tree clauses, tree level, bool inner,
gcc_checking_assert (!is_oacc_kernels_decomposed_part (ctx));
tree orig = OMP_CLAUSE_DECL (c);
- tree var = maybe_lookup_decl (orig, ctx);
+ tree orig_clause;
+ tree array_type = NULL_TREE;
+ tree array_addr = NULL_TREE, array_max_idx = NULL_TREE;
+ tree array_bias = NULL_TREE;
+ tree var;
+ if (TREE_CODE (orig) == MEM_REF)
+ {
+ array_type = TREE_TYPE (orig);
+
+ tree bias = TREE_OPERAND (OMP_CLAUSE_DECL (c), 1);
+ tree orig_var = TREE_OPERAND (OMP_CLAUSE_DECL (c), 0);
+
+ if (TREE_CODE (orig_var) == POINTER_PLUS_EXPR)
+ {
+ tree b = TREE_OPERAND (orig_var, 1);
+ if (is_omp_target (ctx->stmt))
+ b = NULL_TREE;
+ else
+ b = maybe_lookup_decl (b, ctx);
+ if (b == NULL)
+ {
+ b = TREE_OPERAND (orig_var, 1);
+ b = maybe_lookup_decl_in_outer_ctx (b, ctx);
+ }
+ if (integer_zerop (bias))
+ bias = b;
+ else
+ {
+ bias = fold_convert_loc (loc,
+ TREE_TYPE (b), bias);
+ bias = fold_build2_loc (loc, PLUS_EXPR,
+ TREE_TYPE (b), b, bias);
+ }
+ orig_var = TREE_OPERAND (orig_var, 0);
+ }
+ if (TREE_CODE (orig_var) == INDIRECT_REF
+ || TREE_CODE (orig_var) == ADDR_EXPR)
+ orig_var = TREE_OPERAND (orig_var, 0);
+
+ gcc_assert (DECL_P (orig_var));
+
+ tree local_orig_var = lookup_decl (orig_var, ctx);
+ tree priv_addr = local_orig_var;
+ if (TREE_CODE (TREE_TYPE (priv_addr)) == ARRAY_TYPE)
+ priv_addr = build_fold_addr_expr (priv_addr);
+
+ tree priv_addr_type = build_pointer_type (array_type);
+
+ /* Peel away MEM_REF to get at base array VAR_DECL. */
+ tree addr = TREE_OPERAND (orig, 0);
+ if (TREE_CODE (addr) == POINTER_PLUS_EXPR)
+ addr = TREE_OPERAND (addr, 0);
+ if (TREE_CODE (addr) == ADDR_EXPR)
+ addr = TREE_OPERAND (addr, 0);
+ else if (INDIRECT_REF_P (addr))
+ addr = TREE_OPERAND (addr, 0);
+ orig = addr;
+
+ if (omp_privatize_by_reference (orig))
+ {
+ gcc_assert (DECL_HAS_VALUE_EXPR_P (priv_addr)
+ && (TREE_CODE (DECL_VALUE_EXPR (priv_addr))
+ == MEM_REF));
+ priv_addr = TREE_OPERAND (DECL_VALUE_EXPR (priv_addr), 0);
+ }
+
+ tree tmp = fold_build2 (POINTER_PLUS_EXPR, ptr_type_node,
+ fold_convert (ptr_type_node, priv_addr),
+ fold_convert (sizetype, bias));
+ priv_addr = fold_convert (priv_addr_type, tmp);
+
+ tree addr_var = create_tmp_var (priv_addr_type,
+ ".array_reduction_addr");
+
+ gimple_seq s = NULL;
+ gimplify_assign (addr_var, priv_addr, &s);
+ gimple_seq_add_seq (&before_fork, s);
+
+ var = create_tmp_var (integer_type_node,
+ ".array_reduction_data_dep");
+ gimple_seq_add_stmt (&before_fork,
+ gimple_build_assign (var, integer_zero_node));
+
+ array_addr = addr_var;
+ array_bias = bias;
+ array_max_idx
+ = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (OMP_CLAUSE_DECL (c))));
+ tree t = maybe_lookup_decl (array_max_idx, ctx);
+ if (t)
+ array_max_idx = t;
+ }
+ else
+ {
+ var = OMP_CLAUSE_REDUCTION_PRIVATE_DECL (c);
+ if (!var)
+ var = maybe_lookup_decl (orig, ctx);
+ if (!var)
+ var = orig;
+ }
+
+ tree incoming, outgoing;
tree ref_to_res = NULL_TREE;
- tree incoming, outgoing, v1, v2, v3;
bool is_private = false;
+ bool is_fpp = false;
enum tree_code rcode = OMP_CLAUSE_REDUCTION_CODE (c);
if (rcode == MINUS_EXPR)
@@ -7459,9 +8138,6 @@ lower_oacc_reductions (location_t loc, tree clauses, tree level, bool inner,
rcode = BIT_IOR_EXPR;
tree op = build_int_cst (unsigned_type_node, rcode);
- if (!var)
- var = orig;
-
incoming = outgoing = var;
if (!inner)
@@ -7510,19 +8186,92 @@ lower_oacc_reductions (location_t loc, tree clauses, tree level, bool inner,
is_private = true;
goto do_lookup;
}
+ else if (OMP_CLAUSE_CODE (cls) == OMP_CLAUSE_MAP
+ && (OMP_CLAUSE_MAP_KIND (cls)
+ == GOMP_MAP_FIRSTPRIVATE_POINTER)
+ && orig == OMP_CLAUSE_DECL (cls)
+ && !array_addr)
+ {
+ is_fpp = true;
+ goto do_lookup;
+ }
}
do_lookup:
/* This is the outermost construct with this reduction,
see if there's a mapping for it. */
+ orig_clause = NULL_TREE;
+ if (gimple_code (outer->stmt) == GIMPLE_OMP_TARGET)
+ for (tree cls = gimple_omp_target_clauses (outer->stmt);
+ cls; cls = OMP_CLAUSE_CHAIN (cls))
+ if (OMP_CLAUSE_CODE (cls) == OMP_CLAUSE_MAP
+ && orig == OMP_CLAUSE_DECL (cls)
+ && maybe_lookup_field (cls, outer))
+ {
+ orig_clause = cls;
+ break;
+ }
if (gimple_code (outer->stmt) == GIMPLE_OMP_TARGET
- && maybe_lookup_field (orig, outer) && !is_private)
+ && !orig_clause
+ && !is_private
+ && maybe_lookup_field (orig, outer))
+ orig_clause = orig;
+ if ((orig_clause != NULL_TREE || is_fpp) && !is_private)
{
- ref_to_res = build_receiver_ref (orig, false, outer);
- if (omp_privatize_by_reference (orig))
- ref_to_res = build_simple_mem_ref (ref_to_res);
-
tree type = TREE_TYPE (var);
+
+ if (is_fpp && !array_addr)
+ {
+ tree x = create_tmp_var (type);
+ gimplify_assign (x, lookup_decl (orig, outer), fork_seq);
+ ref_to_res = x;
+ }
+ else if (orig_clause)
+ {
+ ref_to_res = build_receiver_ref (orig_clause, false, outer);
+ if (omp_privatize_by_reference (orig))
+ ref_to_res = build_simple_mem_ref (ref_to_res);
+
+ bool ptr_ptr_array = false;
+ if (TREE_CODE (TREE_TYPE (orig)) == ARRAY_TYPE
+ && TREE_CODE (TREE_TYPE (ref_to_res)) == POINTER_TYPE
+ && (TREE_CODE (TREE_TYPE (TREE_TYPE (ref_to_res)))
+ == POINTER_TYPE))
+ {
+ ref_to_res = build_simple_mem_ref (ref_to_res);
+ ptr_ptr_array = true;
+ }
+
+ if (array_bias)
+ {
+ tree map_bias = integer_zero_node;
+ if (ptr_ptr_array)
+ map_bias = array_bias;
+ else
+ {
+ tree m = gimple_omp_target_clauses (outer->stmt);
+ for (; m; m = OMP_CLAUSE_CHAIN (m))
+ if (OMP_CLAUSE_CODE (m) == OMP_CLAUSE_MAP)
+ {
+ tree md = OMP_CLAUSE_DECL (m);
+ if (orig == md
+ || (TREE_CODE (md) == ARRAY_REF
+ && TREE_OPERAND (md, 0) == orig))
+ {
+ map_bias
+ = oacc_array_reduction_bias (loc, c, ctx,
+ m, outer);
+ break;
+ }
+ }
+ }
+ tree t = fold_convert (ptr_type_node, ref_to_res);
+ t = build2 (POINTER_PLUS_EXPR, ptr_type_node, t,
+ fold_convert (sizetype, map_bias));
+ ref_to_res = fold_convert (TREE_TYPE (ref_to_res), t);
+ }
+ }
+
if (POINTER_TYPE_P (type))
type = TREE_TYPE (type);
@@ -7534,13 +8283,91 @@ lower_oacc_reductions (location_t loc, tree clauses, tree level, bool inner,
/* Try to look at enclosing contexts for reduction var,
use original if no mapping found. */
tree t = NULL_TREE;
- omp_context *c = ctx->outer;
- while (c && !t)
+ omp_context *cp = ctx->outer;
+ while (cp)
+ {
+ t = maybe_lookup_decl (orig, cp);
+ if (t)
+ break;
+
+ cp = cp->outer;
+ }
+
+ if (array_addr)
{
- t = maybe_lookup_decl (orig, c);
- c = c->outer;
+ if (t)
+ {
+ if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE)
+ {
+ if (!is_private)
+ {
+ gcc_assert (DECL_SIZE (t)
+ && (TREE_CODE (DECL_SIZE (t))
+ != INTEGER_CST)
+ && DECL_HAS_VALUE_EXPR_P (t));
+ t = DECL_VALUE_EXPR (t);
+ }
+
+ t = fold_convert (ptr_type_node,
+ build_fold_addr_expr (t));
+ if (array_bias)
+ t = build2 (POINTER_PLUS_EXPR, ptr_type_node, t,
+ fold_convert (sizetype, array_bias));
+ ref_to_res
+ = fold_convert (build_pointer_type
+ (TREE_TYPE (orig)), t);
+ }
+ else if (TREE_CODE (TREE_TYPE (t)) == POINTER_TYPE)
+ {
+ if (array_bias)
+ t = build2 (POINTER_PLUS_EXPR, ptr_type_node, t,
+ fold_convert (sizetype, array_bias));
+ ref_to_res
+ = fold_convert (build_pointer_type
+ (array_type), t);
+ }
+ else
+ gcc_unreachable ();
+ }
+ else
+ {
+ gcc_assert (!cp && (gimple_code (ctx->stmt)
+ == GIMPLE_OMP_TARGET));
+
+ tree mem_ref = NULL_TREE;
+ tree mem_ref_clause = NULL_TREE;
+ tree m = gimple_omp_target_clauses (ctx->stmt);
+ tree orig_val = (DECL_HAS_VALUE_EXPR_P (orig)
+ ? DECL_VALUE_EXPR (orig) : orig);
+ for (; m; m = OMP_CLAUSE_CHAIN (m))
+ if (OMP_CLAUSE_CODE (m) == OMP_CLAUSE_MAP)
+ {
+ tree md = OMP_CLAUSE_DECL (m);
+ if (orig_val == md
+ || (TREE_CODE (md) == MEM_REF
+ && INDIRECT_REF_P (orig_val)
+ && (TREE_OPERAND (md, 0)
+ == TREE_OPERAND (orig_val, 0))))
+ {
+ mem_ref = md;
+ mem_ref_clause = m;
+ break;
+ }
+ }
+ gcc_assert (mem_ref);
+ mem_ref = build_receiver_ref (mem_ref_clause, false, ctx);
+
+ if (array_bias)
+ mem_ref = build2 (POINTER_PLUS_EXPR, ptr_type_node,
+ mem_ref, fold_convert (sizetype,
+ array_bias));
+ ref_to_res
+ = fold_convert (build_pointer_type (TREE_TYPE (orig)),
+ mem_ref);
+ }
}
- incoming = outgoing = (t ? t : orig);
+ else
+ incoming = outgoing = (t ? t : orig);
}
has_outer_reduction:;
@@ -7549,37 +8376,16 @@ lower_oacc_reductions (location_t loc, tree clauses, tree level, bool inner,
if (!ref_to_res)
ref_to_res = integer_zero_node;
- if (omp_privatize_by_reference (orig))
- {
- tree type = TREE_TYPE (var);
- const char *id = IDENTIFIER_POINTER (DECL_NAME (var));
-
- if (!inner)
- {
- tree x = create_tmp_var (TREE_TYPE (type), id);
- gimplify_assign (var, build_fold_addr_expr (x), fork_seq);
- }
-
- v1 = create_tmp_var (type, id);
- v2 = create_tmp_var (type, id);
- v3 = create_tmp_var (type, id);
-
- gimplify_assign (v1, var, fork_seq);
- gimplify_assign (v2, var, fork_seq);
- gimplify_assign (v3, var, fork_seq);
+ if (!array_addr)
+ array_addr = array_max_idx = integer_zero_node;
- var = build_simple_mem_ref (var);
- v1 = build_simple_mem_ref (v1);
- v2 = build_simple_mem_ref (v2);
- v3 = build_simple_mem_ref (v3);
+ if (omp_privatize_by_reference (outgoing))
+ {
outgoing = build_simple_mem_ref (outgoing);
if (!TREE_CONSTANT (incoming))
incoming = build_simple_mem_ref (incoming);
}
- else
- /* Note that 'var' might be a mem ref. */
- v1 = v2 = v3 = var;
/* Determine position in reduction buffer, which may be used
by target. The parser has ensured that this is not a
@@ -7605,29 +8411,33 @@ lower_oacc_reductions (location_t loc, tree clauses, tree level, bool inner,
tree setup_call
= build_call_expr_internal_loc (loc, IFN_GOACC_REDUCTION,
- TREE_TYPE (var), 6, setup_code,
+ TREE_TYPE (var), 8, setup_code,
unshare_expr (ref_to_res),
unshare_expr (incoming),
- level, op, off);
+ level, op, off,
+ array_addr, array_max_idx);
tree init_call
= build_call_expr_internal_loc (loc, IFN_GOACC_REDUCTION,
- TREE_TYPE (var), 6, init_code,
+ TREE_TYPE (var), 8, init_code,
unshare_expr (ref_to_res),
- unshare_expr (v1), level, op, off);
+ unshare_expr (var), level, op, off,
+ array_addr, array_max_idx);
tree fini_call
= build_call_expr_internal_loc (loc, IFN_GOACC_REDUCTION,
- TREE_TYPE (var), 6, fini_code,
+ TREE_TYPE (var), 8, fini_code,
unshare_expr (ref_to_res),
- unshare_expr (v2), level, op, off);
+ unshare_expr (var), level, op, off,
+ array_addr, array_max_idx);
tree teardown_call
= build_call_expr_internal_loc (loc, IFN_GOACC_REDUCTION,
- TREE_TYPE (var), 6, teardown_code,
- ref_to_res, unshare_expr (v3),
- level, op, off);
-
- gimplify_assign (unshare_expr (v1), setup_call, &before_fork);
- gimplify_assign (unshare_expr (v2), init_call, &after_fork);
- gimplify_assign (unshare_expr (v3), fini_call, &before_join);
+ TREE_TYPE (var), 8, teardown_code,
+ ref_to_res, unshare_expr (var),
+ level, op, off,
+ array_addr, array_max_idx);
+
+ gimplify_assign (unshare_expr (var), setup_call, &before_fork);
+ gimplify_assign (unshare_expr (var), init_call, &after_fork);
+ gimplify_assign (unshare_expr (var), fini_call, &before_join);
gimplify_assign (unshare_expr (outgoing), teardown_call, &after_join);
}
@@ -8349,11 +9159,16 @@ lower_oacc_head_mark (location_t loc, tree ddvar, tree clauses,
gcc_unreachable ();
else if (is_oacc_kernels_decomposed_part (tgt))
;
+ else if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && is_omp_target (tgt->stmt))
+ ;
else
gcc_unreachable ();
- /* In a parallel region, loops are implicitly INDEPENDENT. */
- if (!tgt || is_oacc_parallel_or_serial (tgt))
+ /* In a parallel region, loops without auto and seq clauses are
+ implicitly INDEPENDENT. */
+ if ((!tgt || is_oacc_parallel_or_serial (tgt))
+ && !(tag & (OLF_SEQ | OLF_AUTO)))
tag |= OLF_INDEPENDENT;
/* Loops inside OpenACC 'kernels' decomposed parts' regions are expected to
@@ -8364,7 +9179,12 @@ lower_oacc_head_mark (location_t loc, tree ddvar, tree clauses,
gcc_assert (!(tag & OLF_AUTO));
}
- if (tag & OLF_TILE)
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && gimple_code (ctx->stmt) == GIMPLE_OMP_PARALLEL
+ && tgt
+ && ompacc_ctx_p (tgt))
+ levels = 1;
+ else if (tag & OLF_TILE)
/* Tiling could use all 3 levels. */
levels = 3;
else
@@ -11653,6 +12473,23 @@ lower_omp_for (gimple_stmt_iterator *gsi_p, omp_context *ctx)
push_gimplify_context ();
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC && ompacc_ctx_p (ctx))
+ {
+ enum omp_clause_code code = OMP_CLAUSE_ERROR;
+ if (gimple_omp_for_kind (stmt) == GF_OMP_FOR_KIND_FOR)
+ code = OMP_CLAUSE_VECTOR;
+ else if (gimple_omp_for_kind (stmt) == GF_OMP_FOR_KIND_DISTRIBUTE)
+ code = OMP_CLAUSE_GANG;
+ if (code)
+ {
+ /* Adjust into OACC loop kind with vector/gang clause. */
+ gimple_omp_for_set_kind (stmt, GF_OMP_FOR_KIND_OACC_LOOP);
+ tree c = build_omp_clause (UNKNOWN_LOCATION, code);
+ OMP_CLAUSE_CHAIN (c) = gimple_omp_for_clauses (stmt);
+ gimple_omp_for_set_clauses (stmt, c);
+ }
+ }
+
if (is_gimple_omp_oacc (ctx->stmt))
oacc_privatization_scan_clause_chain (ctx, gimple_omp_for_clauses (stmt));
@@ -11674,7 +12511,9 @@ lower_omp_for (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gbind *inner_bind
= as_a <gbind *> (gimple_seq_first_stmt (omp_for_body));
tree vars = gimple_bind_vars (inner_bind);
- if (is_gimple_omp_oacc (ctx->stmt))
+ if (is_gimple_omp_oacc (ctx->stmt)
+ || (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && ompacc_ctx_p (ctx)))
oacc_privatization_scan_decl_chain (ctx, vars);
gimple_bind_append_vars (new_stmt, vars);
/* bind_vars/BLOCK_VARS are being moved to new_stmt/block, don't
@@ -11790,7 +12629,8 @@ lower_omp_for (gimple_stmt_iterator *gsi_p, omp_context *ctx)
lower_omp (gimple_omp_body_ptr (stmt), ctx);
gcall *private_marker = NULL;
- if (is_gimple_omp_oacc (ctx->stmt)
+ if ((is_gimple_omp_oacc (ctx->stmt)
+ || (flag_openmp_target == OMP_TARGET_MODE_OMPACC && ompacc_ctx_p (ctx)))
&& !gimple_seq_empty_p (omp_for_body))
private_marker = lower_oacc_private_marker (ctx);
@@ -11845,11 +12685,13 @@ lower_omp_for (gimple_stmt_iterator *gsi_p, omp_context *ctx)
/* Once lowered, extract the bounds and clauses. */
omp_extract_for_data (stmt, &fd, NULL);
- if (is_gimple_omp_oacc (ctx->stmt)
- && !ctx_in_oacc_kernels_region (ctx))
- lower_oacc_head_tail (gimple_location (stmt),
- gimple_omp_for_clauses (stmt), private_marker,
- &oacc_head, &oacc_tail, ctx);
+ if (flag_openacc)
+ {
+ if (is_gimple_omp_oacc (ctx->stmt) && !ctx_in_oacc_kernels_region (ctx))
+ lower_oacc_head_tail (gimple_location (stmt),
+ gimple_omp_for_clauses (stmt), private_marker,
+ &oacc_head, &oacc_tail, ctx);
+ }
/* Add OpenACC partitioning and reduction markers just before the loop. */
if (oacc_head)
@@ -12633,9 +13475,20 @@ lower_omp_taskreg (gimple_stmt_iterator *gsi_p, omp_context *ctx)
bind = gimple_build_bind (NULL, NULL, make_node (BLOCK));
else
bind = gimple_build_bind (NULL, NULL, gimple_bind_block (par_bind));
+
+ gimple_seq oacc_head = NULL, oacc_tail = NULL;
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && gimple_code (stmt) == GIMPLE_OMP_PARALLEL
+ && ompacc_ctx_p (ctx))
+ lower_oacc_head_tail (gimple_location (stmt), clauses,
+ NULL, &oacc_head, &oacc_tail,
+ ctx);
+
gsi_replace (gsi_p, dep_bind ? dep_bind : bind, true);
gimple_bind_add_seq (bind, ilist);
+ gimple_bind_add_seq (bind, oacc_head);
gimple_bind_add_stmt (bind, stmt);
+ gimple_bind_add_seq (bind, oacc_tail);
gimple_bind_add_seq (bind, olist);
pop_gimplify_context (NULL);
@@ -12651,6 +13504,171 @@ lower_omp_taskreg (gimple_stmt_iterator *gsi_p, omp_context *ctx)
}
}
+/* Helper function for lower_omp_target. Converts VAR to something that can
+ be represented by a POINTER_SIZED_INT_NODE. Any new instructions are
+ appended to GS. This is used to optimize firstprivate variables, so that
+ small types (less precision than POINTER_SIZE) do not require additional
+ data mappings. */
+
+static tree
+convert_to_firstprivate_int (tree var, gimple_seq *gs)
+{
+ tree type = TREE_TYPE (var), new_type = NULL_TREE;
+
+ if (omp_privatize_by_reference (var) || POINTER_TYPE_P (type))
+ {
+ type = TREE_TYPE (type);
+ tree tmp = create_tmp_var (type);
+ gimplify_assign (tmp, build_simple_mem_ref (var), gs);
+ var = tmp;
+ }
+
+ if (INTEGRAL_TYPE_P (type) || POINTER_TYPE_P (type))
+ return fold_convert (pointer_sized_int_node, var);
+
+ gcc_assert (tree_to_uhwi (TYPE_SIZE (type)) <= POINTER_SIZE);
+
+ new_type = lang_hooks.types.type_for_size (tree_to_uhwi (TYPE_SIZE (type)),
+ true);
+ tree tmp = create_tmp_var (new_type);
+ var = fold_build1 (VIEW_CONVERT_EXPR, new_type, var);
+ gimplify_assign (tmp, var, gs);
+
+ return fold_convert (pointer_sized_int_node, tmp);
+}
+
+/* Like convert_to_firstprivate_int, but restore the original type. */
+
+static tree
+convert_from_firstprivate_int (tree var, tree orig_type, bool is_ref,
+ gimple_seq *gs)
+{
+ tree type = TREE_TYPE (var);
+ tree new_type = NULL_TREE;
+ tree tmp = NULL_TREE;
+
+ gcc_assert (TREE_CODE (var) == MEM_REF);
+ var = TREE_OPERAND (var, 0);
+
+ if (is_ref || POINTER_TYPE_P (orig_type))
+ {
+ tree_code code = NOP_EXPR;
+
+ if (TREE_CODE (type) == REAL_TYPE || TREE_CODE (type) == COMPLEX_TYPE
+ || VECTOR_TYPE_P (type))
+ code = VIEW_CONVERT_EXPR;
+
+ if (code == VIEW_CONVERT_EXPR
+ && TYPE_SIZE (type) != TYPE_SIZE (orig_type))
+ {
+ tree ptype = build_pointer_type (type);
+ var = fold_build1 (code, ptype, build_fold_addr_expr (var));
+ var = build_simple_mem_ref (var);
+ }
+ else
+ var = fold_build1 (code, type, var);
+
+ tree inst = create_tmp_var (type);
+ gimplify_assign (inst, var, gs);
+ var = build_fold_addr_expr (inst);
+
+ return var;
+ }
+
+ if (INTEGRAL_TYPE_P (var))
+ return fold_convert (type, var);
+
+ gcc_assert (tree_to_uhwi (TYPE_SIZE (type)) <= POINTER_SIZE);
+
+ new_type = lang_hooks.types.type_for_size (tree_to_uhwi (TYPE_SIZE (type)),
+ true);
+
+ tmp = create_tmp_var (new_type);
+ var = fold_convert (new_type, var);
+ gimplify_assign (tmp, var, gs);
+
+ return fold_build1 (VIEW_CONVERT_EXPR, type, tmp);
+}
+
+ /* Set EXPR as the hostaddr expression that should result from the clause C.
+ LOOPS holds the intermediate loop info. Returns the tree that should be
+ passed as the hostaddr. */
+
+static tree
+lower_omp_map_iterator_expr (tree expr, tree c, gomp_target *stmt)
+{
+ if (!OMP_CLAUSE_HAS_ITERATORS (c))
+ return expr;
+
+ tree iterator = OMP_CLAUSE_ITERATORS (c);
+ assign_to_iterator_elems_array (expr, iterator, stmt);
+
+ tree elems = OMP_ITERATORS_ELEMS (iterator);
+ if (TREE_CODE (TREE_TYPE (elems)) == ARRAY_TYPE)
+ return build_fold_addr_expr_with_type (elems, ptr_type_node);
+ else
+ return elems;
+}
+
+/* Set SIZE as the size expression that should result from the clause C.
+ LOOPS holds the intermediate loop info. Returns the tree that should be
+ passed as the clause size. */
+
+static tree
+lower_omp_map_iterator_size (tree size, tree c, gomp_target *stmt)
+{
+ if (!OMP_CLAUSE_HAS_ITERATORS (c))
+ return size;
+
+ tree iterator = OMP_CLAUSE_ITERATORS (c);
+ assign_to_iterator_elems_array (size, iterator, stmt, 1);
+
+ return size_int (SIZE_MAX);
+}
+
+static void
+allocate_omp_iterator_elems (tree iters, gimple_seq loops_seq)
+{
+ tree elems = OMP_ITERATORS_ELEMS (iters);
+ if (!POINTER_TYPE_P (TREE_TYPE (elems)))
+ return;
+ tree arr_length = omp_iterator_elems_length (OMP_ITERATORS_COUNT (iters));
+ tree call = builtin_decl_explicit (BUILT_IN_MALLOC);
+ tree size = fold_build2 (MULT_EXPR, size_type_node, arr_length,
+ TYPE_SIZE_UNIT (ptr_type_node));
+ tree tmp = build_call_expr (call, 1, size);
+
+ /* Find the first statement '<index> = -1' in the pre-loop statements. */
+ tree index = OMP_ITERATORS_INDEX (iters);
+ gimple_stmt_iterator gsi;
+ for (gsi = gsi_start (loops_seq); !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ gimple *stmt = gsi_stmt (gsi);
+ if (gimple_code (stmt) == GIMPLE_ASSIGN
+ && gimple_assign_lhs (stmt) == index
+ && gimple_assign_rhs1 (stmt) == size_int (-1))
+ break;
+ }
+ gcc_assert (!gsi_end_p (gsi));
+
+ gimple_seq alloc_seq = NULL;
+ gimplify_assign (elems, tmp, &alloc_seq);
+ gsi_insert_seq_before (&gsi, alloc_seq, GSI_SAME_STMT);
+}
+
+static void
+free_omp_iterator_elems (tree iters, gimple_seq *seq)
+{
+ tree elems = OMP_ITERATORS_ELEMS (iters);
+ if (!POINTER_TYPE_P (TREE_TYPE (elems)))
+ return;
+ tree call = builtin_decl_explicit (BUILT_IN_FREE);
+ call = build_call_expr (call, 1, elems);
+ gimplify_and_add (call, seq);
+ tree clobber = build_clobber (TREE_TYPE (elems));
+ gimple_seq_add_stmt (seq, gimple_build_assign (elems, clobber));
+}
+
/* Lower the GIMPLE_OMP_TARGET in the current statement
in GSI_P. CTX holds context information for the directive. */
@@ -12789,6 +13807,10 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case GOMP_MAP_DETACH:
case GOMP_MAP_ATTACH_ZERO_LENGTH_ARRAY_SECTION:
case GOMP_MAP_POINTER_TO_ZERO_LENGTH_ARRAY_SECTION:
+ case GOMP_MAP_TO_GRID:
+ case GOMP_MAP_FROM_GRID:
+ case GOMP_MAP_GRID_DIM:
+ case GOMP_MAP_GRID_STRIDE:
break;
case GOMP_MAP_IF_PRESENT:
case GOMP_MAP_FORCE_ALLOC:
@@ -12797,6 +13819,17 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case GOMP_MAP_FORCE_TOFROM:
case GOMP_MAP_FORCE_DEVICEPTR:
case GOMP_MAP_DEVICE_RESIDENT:
+ case GOMP_MAP_NONCONTIG_ARRAY_TO:
+ case GOMP_MAP_NONCONTIG_ARRAY_FROM:
+ case GOMP_MAP_NONCONTIG_ARRAY_TOFROM:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_TO:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_FROM:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_TOFROM:
+ case GOMP_MAP_NONCONTIG_ARRAY_ALLOC:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_ALLOC:
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_PRESENT:
+ case GOMP_MAP_DECLARE_ALLOCATE:
+ case GOMP_MAP_DECLARE_DEALLOCATE:
case GOMP_MAP_LINK:
case GOMP_MAP_FORCE_DETACH:
gcc_assert (is_gimple_omp_oacc (stmt));
@@ -12805,6 +13838,21 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gcc_unreachable ();
}
#endif
+ if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_TO_GRID
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FROM_GRID)
+ {
+ tree nc = OMP_CLAUSE_CHAIN (c);
+ gcc_assert (OMP_CLAUSE_CODE (nc) == OMP_CLAUSE_MAP
+ && OMP_CLAUSE_MAP_KIND (nc) == GOMP_MAP_TO_PSET);
+ c = nc;
+ while ((nc = OMP_CLAUSE_CHAIN (c))
+ && OMP_CLAUSE_CODE (nc) == OMP_CLAUSE_MAP
+ && (OMP_CLAUSE_MAP_KIND (nc) == GOMP_MAP_GRID_DIM
+ || OMP_CLAUSE_MAP_KIND (nc) == GOMP_MAP_GRID_STRIDE))
+ c = nc;
+ map_cnt += 2;
+ continue;
+ }
/* FALLTHRU */
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
@@ -12872,7 +13920,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
continue;
}
- if (!maybe_lookup_field (var, ctx))
+ if (!maybe_lookup_field (c, ctx))
continue;
/* Don't remap compute constructs' reduction variables, because the
@@ -12881,27 +13929,58 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
&& is_gimple_omp_oacc (ctx->stmt)
&& OMP_CLAUSE_MAP_IN_REDUCTION (c)))
{
- x = build_receiver_ref (var, true, ctx);
+ tree var_type = TREE_TYPE (var);
tree new_var = lookup_decl (var, ctx);
+ tree inner_type
+ = omp_privatize_by_reference (new_var)
+ ? TREE_TYPE (var_type) : var_type;
+ bool rcv_by_ref =
+ (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && GOMP_MAP_NONCONTIG_ARRAY_P (OMP_CLAUSE_MAP_KIND (c))
+ && TREE_CODE (var_type) != ARRAY_TYPE
+ ? false : true);
+
+ x = build_receiver_ref (c, rcv_by_ref, ctx);
+
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
+ && (FLOAT_TYPE_P (inner_type)
+ || ANY_INTEGRAL_TYPE_P (inner_type))
+ && tree_to_uhwi (TYPE_SIZE (inner_type)) <= POINTER_SIZE
+ && !maybe_lookup_field_in_outer_ctx (var, ctx))
+ {
+ gcc_assert (is_gimple_omp_oacc (ctx->stmt));
+ x = convert_from_firstprivate_int (x, TREE_TYPE (new_var),
+ omp_privatize_by_reference (var),
+ &fplist);
+ gimplify_assign (new_var, x, &fplist);
+ map_cnt++;
+ break;
+ }
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
&& OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER
&& !OMP_CLAUSE_MAP_ZERO_BIAS_ARRAY_SECTION (c)
- && TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
+ && TREE_CODE (var_type) == ARRAY_TYPE)
x = build_simple_mem_ref (x);
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE)
{
gcc_assert (is_gimple_omp_oacc (ctx->stmt));
if (omp_privatize_by_reference (new_var)
- && (TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE
- || DECL_BY_REFERENCE (var)))
+ && (TREE_CODE (var_type) != POINTER_TYPE
+ || DECL_BY_REFERENCE (var))
+ /* Accelerators may not have alloca, so it's not
+ possible to privatize local storage for those
+ objects. */
+ && TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (var_type))))
{
/* Create a local object to hold the instance
value. */
- tree type = TREE_TYPE (TREE_TYPE (new_var));
const char *id = IDENTIFIER_POINTER (DECL_NAME (new_var));
- tree inst = create_tmp_var (type, id);
- gimplify_assign (inst, fold_indirect_ref (x), &fplist);
+ tree inst = create_tmp_var (TREE_TYPE (var_type), id);
+ if (TREE_CODE (var_type) == POINTER_TYPE)
+ gimplify_assign (inst, x, &fplist);
+ else
+ gimplify_assign (inst, fold_indirect_ref (x), &fplist);
x = build_fold_addr_expr (inst);
}
gimplify_assign (new_var, x, &fplist);
@@ -13054,6 +14133,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
record_vars_into (gimple_bind_vars (tgt_bind), child_fn);
}
+ auto_vec<tree> new_iterators;
+
if (ctx->record_type)
{
if (deep_map_cnt && TREE_CODE (deep_map_cnt) == INTEGER_CST)
@@ -13151,11 +14232,14 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
vec_alloc (vkind, map_cnt);
unsigned int map_idx = 0;
+ vec<tree> nca_descrs = vNULL;
+
for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
switch (OMP_CLAUSE_CODE (c))
{
tree ovar, nc, s, purpose, var, x, type;
unsigned int talign;
+ bool oacc_firstprivate_int;
default:
break;
@@ -13164,6 +14248,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case OMP_CLAUSE_TO:
case OMP_CLAUSE_FROM:
oacc_firstprivate_map:
+ oacc_firstprivate_int = false;
nc = c;
ovar = OMP_CLAUSE_DECL (c);
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
@@ -13187,9 +14272,337 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
TREE_VEC_ELT (t, 1),
TREE_VEC_ELT (t, 2),
deep_map_offset_data,
- deep_map_offset, &ilist);
+ deep_map_offset, &ilist,
+ &new_iterators);
+ }
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_TO_GRID
+ || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FROM_GRID))
+ {
+ tree decl = OMP_CLAUSE_DECL (c);
+ tree dn = OMP_CLAUSE_CHAIN (c);
+ gcc_assert (OMP_CLAUSE_CODE (dn) == OMP_CLAUSE_MAP
+ && OMP_CLAUSE_MAP_KIND (dn) == GOMP_MAP_TO_PSET);
+ tree desc = OMP_CLAUSE_DECL (dn);
+
+ tree oc, elsize = OMP_CLAUSE_SIZE (c);
+ tree type = TREE_TYPE (decl);
+ int i, dims = 0;
+ auto_vec<tree> tdims;
+ bool pointer_based = false, handled_pointer_section = false;
+ tree arrsize = size_one_node;
+
+ /* Allow a single (maybe strided) array section if we have a
+ pointer base. */
+ if (TREE_CODE (decl) == INDIRECT_REF
+ && (TREE_CODE (TREE_TYPE (TREE_OPERAND (decl, 0)))
+ == POINTER_TYPE))
+ {
+ pointer_based = true;
+ dims = 1;
+ }
+ else
+ /* NOTE: Don't treat (e.g. Fortran, fixed-length) strings as
+ array types here; array section syntax isn't applicable to
+ strings. */
+ for (tree itype = type;
+ TREE_CODE (itype) == ARRAY_TYPE
+ && !TYPE_STRING_FLAG (itype);
+ itype = TREE_TYPE (itype))
+ {
+ tdims.safe_push (itype);
+ dims++;
+ }
+
+ unsigned tdim = 0;
+
+ vec<constructor_elt, va_gc> *vdim;
+ vec<constructor_elt, va_gc> *vindex;
+ vec<constructor_elt, va_gc> *vlen;
+ vec<constructor_elt, va_gc> *vstride;
+ vec_alloc (vdim, dims);
+ vec_alloc (vindex, dims);
+ vec_alloc (vlen, dims);
+ vec_alloc (vstride, dims);
+
+ tree size_arr_type
+ = build_array_type_nelts (size_type_node, dims);
+
+ tree dim_tmp = create_tmp_var (size_arr_type, ".omp_dim");
+ DECL_NAMELESS (dim_tmp) = 1;
+ TREE_ADDRESSABLE (dim_tmp) = 1;
+ TREE_STATIC (dim_tmp) = 1;
+ tree index_tmp = create_tmp_var (size_arr_type, ".omp_index");
+ DECL_NAMELESS (index_tmp) = 1;
+ TREE_ADDRESSABLE (index_tmp) = 1;
+ TREE_STATIC (index_tmp) = 1;
+ tree len_tmp = create_tmp_var (size_arr_type, ".omp_len");
+ DECL_NAMELESS (len_tmp) = 1;
+ TREE_ADDRESSABLE (len_tmp) = 1;
+ TREE_STATIC (len_tmp) = 1;
+ tree stride_tmp = create_tmp_var (size_arr_type, ".omp_stride");
+ DECL_NAMELESS (stride_tmp) = 1;
+ TREE_ADDRESSABLE (stride_tmp) = 1;
+ TREE_STATIC (stride_tmp) = 1;
+
+ oc = c;
+ c = dn;
+
+ tree span = NULL_TREE;
+
+ for (i = 0; i < dims; i++)
+ {
+ nc = OMP_CLAUSE_CHAIN (c);
+ tree dim = NULL_TREE, index = NULL_TREE, len = NULL_TREE,
+ stride = size_one_node;
+
+ if (nc
+ && OMP_CLAUSE_CODE (nc) == OMP_CLAUSE_MAP
+ && OMP_CLAUSE_MAP_KIND (nc) == GOMP_MAP_GRID_DIM)
+ {
+ index = OMP_CLAUSE_DECL (nc);
+ len = OMP_CLAUSE_SIZE (nc);
+
+ index = fold_convert (sizetype, index);
+ len = fold_convert (sizetype, len);
+
+ tree nc2 = OMP_CLAUSE_CHAIN (nc);
+ if (nc2
+ && OMP_CLAUSE_CODE (nc2) == OMP_CLAUSE_MAP
+ && (OMP_CLAUSE_MAP_KIND (nc2)
+ == GOMP_MAP_GRID_STRIDE))
+ {
+ stride = OMP_CLAUSE_DECL (nc2);
+ stride = fold_convert (sizetype, stride);
+ if (OMP_CLAUSE_SIZE (nc2))
+ {
+ /* If the element size is not the same as the
+ distance between two adjacent array
+ elements (in the innermost dimension),
+ retrieve the latter value ("span") from the
+ size field of the stride. We only expect to
+ see one such field per array. */
+ gcc_assert (!span);
+ span = OMP_CLAUSE_SIZE (nc2);
+ span = fold_convert (sizetype, span);
+ }
+ nc = nc2;
+ }
+
+ if (tdim < tdims.length ())
+ {
+ /* We have an array shape -- use that to find the
+ total size of the data on the target to look up
+ in libgomp. */
+ tree dtype = TYPE_DOMAIN (tdims[tdim]);
+ tree minval = TYPE_MIN_VALUE (dtype);
+ tree maxval = TYPE_MAX_VALUE (dtype);
+ minval = fold_convert (sizetype, minval);
+ maxval = fold_convert (sizetype, maxval);
+ dim = size_binop (MINUS_EXPR, maxval, minval);
+ dim = size_binop (PLUS_EXPR, dim,
+ size_one_node);
+ arrsize = size_binop (MULT_EXPR, arrsize, dim);
+ }
+ else if (pointer_based && !handled_pointer_section)
+ {
+ /* Use the selected array section to determine the
+ size of the array. */
+ tree tmp = size_binop (MULT_EXPR, len, stride);
+ tmp = size_binop (MINUS_EXPR, tmp, stride);
+ tmp = size_binop (PLUS_EXPR, tmp, size_one_node);
+ dim = size_binop (PLUS_EXPR, index, tmp);
+ arrsize = size_binop (MULT_EXPR, arrsize, dim);
+ handled_pointer_section = true;
+ }
+ else
+ {
+ if (pointer_based)
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "too many array section specifiers "
+ "for pointer-based array");
+ else
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "too many array section specifiers "
+ "for array");
+ dim = index = len = stride = error_mark_node;
+ }
+ tdim++;
+
+ c = nc;
+ }
+ else
+ {
+ /* We have more array dimensions than array section
+ specifiers. Copy the whole span. */
+ tree dtype = TYPE_DOMAIN (tdims[tdim]);
+ tree minval = TYPE_MIN_VALUE (dtype);
+ tree maxval = TYPE_MAX_VALUE (dtype);
+ minval = fold_convert (sizetype, minval);
+ maxval = fold_convert (sizetype, maxval);
+ dim = size_binop (MINUS_EXPR, maxval, minval);
+ dim = size_binop (PLUS_EXPR, dim, size_one_node);
+ len = dim;
+ index = minval;
+ nc = c;
+ }
+
+ if (TREE_CODE (dim) != INTEGER_CST)
+ TREE_STATIC (dim_tmp) = 0;
+
+ if (TREE_CODE (index) != INTEGER_CST)
+ TREE_STATIC (index_tmp) = 0;
+
+ if (TREE_CODE (len) != INTEGER_CST)
+ TREE_STATIC (len_tmp) = 0;
+
+ if (TREE_CODE (stride) != INTEGER_CST)
+ TREE_STATIC (stride_tmp) = 0;
+
+ tree cidx = size_int (i);
+ CONSTRUCTOR_APPEND_ELT (vdim, cidx, dim);
+ CONSTRUCTOR_APPEND_ELT (vindex, cidx, index);
+ CONSTRUCTOR_APPEND_ELT (vlen, cidx, len);
+ CONSTRUCTOR_APPEND_ELT (vstride, cidx, stride);
+ }
+
+ tree bias = size_zero_node;
+ tree volume = size_one_node;
+ tree enclosure = size_one_node;
+ for (i = dims - 1; i >= 0; i--)
+ {
+ tree dim = (*vdim)[i].value;
+ tree index = (*vindex)[i].value;
+ tree stride = (*vstride)[i].value;
+ tree len = (*vlen)[i].value;
+
+ /* For the bias we want, e.g.:
+
+ index[0] * stride[0] * dim[1] * dim[2]
+ + index[1] * stride[1] * dim[2]
+ + index[2] * stride[2]
+
+ All multiplied by "span" (or "elsize"). */
+
+ tree index_stride = size_binop (MULT_EXPR, index, stride);
+ bias = size_binop (PLUS_EXPR, bias,
+ size_binop (MULT_EXPR, volume,
+ index_stride));
+ volume = size_binop (MULT_EXPR, volume, dim);
+
+ if (i == 0)
+ {
+ tree elems_covered = size_binop (MINUS_EXPR, len,
+ size_one_node);
+ elems_covered = size_binop (MULT_EXPR, elems_covered,
+ stride);
+ elems_covered = size_binop (PLUS_EXPR, elems_covered,
+ size_one_node);
+ enclosure = size_binop (MULT_EXPR, enclosure,
+ elems_covered);
+ }
+ else
+ enclosure = volume;
+ }
+
+ /* If we don't have a separate span size, use the element size
+ instead. */
+ if (!span)
+ span = fold_convert (sizetype, elsize);
+
+ /* The size of a volume enclosing the elements to be
+ transferred. */
+ OMP_CLAUSE_SIZE (oc) = size_binop (MULT_EXPR, enclosure, span);
+ /* And the bias of the first element we will update. */
+ OMP_CLAUSE_SIZE (dn) = size_binop (MULT_EXPR, bias, span);
+
+ tree cdim = build_constructor (size_arr_type, vdim);
+ tree cindex = build_constructor (size_arr_type, vindex);
+ tree clen = build_constructor (size_arr_type, vlen);
+ tree cstride = build_constructor (size_arr_type, vstride);
+
+ if (TREE_STATIC (dim_tmp))
+ DECL_INITIAL (dim_tmp) = cdim;
+ else
+ gimplify_assign (dim_tmp, cdim, &ilist);
+
+ if (TREE_STATIC (index_tmp))
+ DECL_INITIAL (index_tmp) = cindex;
+ else
+ gimplify_assign (index_tmp, cindex, &ilist);
+
+ if (TREE_STATIC (len_tmp))
+ DECL_INITIAL (len_tmp) = clen;
+ else
+ gimplify_assign (len_tmp, clen, &ilist);
+
+ if (TREE_STATIC (stride_tmp))
+ DECL_INITIAL (stride_tmp) = cstride;
+ else
+ gimplify_assign (stride_tmp, cstride, &ilist);
+
+ tree desc_type = TREE_TYPE (desc);
+
+ tree ndims_field = TYPE_FIELDS (desc_type);
+ tree elemsize_field = DECL_CHAIN (ndims_field);
+ tree span_field = DECL_CHAIN (elemsize_field);
+ tree dim_field = DECL_CHAIN (span_field);
+ tree index_field = DECL_CHAIN (dim_field);
+ tree len_field = DECL_CHAIN (index_field);
+ tree stride_field = DECL_CHAIN (len_field);
+
+ vec<constructor_elt, va_gc> *v;
+ vec_alloc (v, 7);
+
+ bool all_static = (TREE_STATIC (dim_tmp)
+ && TREE_STATIC (index_tmp)
+ && TREE_STATIC (len_tmp)
+ && TREE_STATIC (stride_tmp));
+
+ dim_tmp = build4 (ARRAY_REF, sizetype, dim_tmp, size_zero_node,
+ NULL_TREE, NULL_TREE);
+ dim_tmp = build_fold_addr_expr (dim_tmp);
+
+ /* TODO: we could skip all-zeros index. */
+ index_tmp = build4 (ARRAY_REF, sizetype, index_tmp,
+ size_zero_node, NULL_TREE, NULL_TREE);
+ index_tmp = build_fold_addr_expr (index_tmp);
+
+ len_tmp = build4 (ARRAY_REF, sizetype, len_tmp, size_zero_node,
+ NULL_TREE, NULL_TREE);
+ len_tmp = build_fold_addr_expr (len_tmp);
+
+ /* TODO: we could skip all-ones stride. */
+ stride_tmp = build4 (ARRAY_REF, sizetype, stride_tmp,
+ size_zero_node, NULL_TREE, NULL_TREE);
+ stride_tmp = build_fold_addr_expr (stride_tmp);
+
+ elsize = fold_convert (sizetype, elsize);
+ tree ndims = size_int (dims);
+
+ CONSTRUCTOR_APPEND_ELT (v, ndims_field, ndims);
+ CONSTRUCTOR_APPEND_ELT (v, elemsize_field, elsize);
+ CONSTRUCTOR_APPEND_ELT (v, span_field, span);
+ CONSTRUCTOR_APPEND_ELT (v, dim_field, dim_tmp);
+ CONSTRUCTOR_APPEND_ELT (v, index_field, index_tmp);
+ CONSTRUCTOR_APPEND_ELT (v, len_field, len_tmp);
+ CONSTRUCTOR_APPEND_ELT (v, stride_field, stride_tmp);
+
+ tree desc_ctor = build_constructor (desc_type, v);
+
+ if (all_static)
+ {
+ TREE_STATIC (desc) = 1;
+ DECL_INITIAL (desc) = desc_ctor;
+ }
+ else
+ gimplify_assign (desc, desc_ctor, &ilist);
+
+ OMP_CLAUSE_CHAIN (dn) = OMP_CLAUSE_CHAIN (nc);
+ c = oc;
+ nc = c;
}
- if (!DECL_P (ovar))
+ else if (!DECL_P (ovar))
{
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
&& OMP_CLAUSE_MAP_ZERO_BIAS_ARRAY_SECTION (c))
@@ -13201,7 +14614,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
}
else
{
- tree x = build_sender_ref (ovar, ctx);
+ tree x = build_sender_ref (c, ctx);
tree v = ovar;
if (in_reduction_clauses
&& OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
@@ -13234,6 +14647,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
*p = build_fold_indirect_ref (nd);
}
v = build_fold_addr_expr_with_type (v, ptr_type_node);
+ v = lower_omp_map_iterator_expr (v, c, stmt);
gimplify_assign (x, v, &ilist);
nc = NULL_TREE;
}
@@ -13249,7 +14663,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gcc_assert (DECL_P (ovar2));
ovar = ovar2;
}
- if (!maybe_lookup_field (ovar, ctx)
+ if (!maybe_lookup_field (c, ctx)
&& !(OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
&& (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH
|| OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_DETACH)))
@@ -13299,26 +14713,70 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
}
else if (nc)
{
- x = build_sender_ref (ovar, ctx);
+ x = build_sender_ref (nc, ctx);
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
&& OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER
&& !OMP_CLAUSE_MAP_ZERO_BIAS_ARRAY_SECTION (c)
- && TREE_CODE (TREE_TYPE (ovar)) == ARRAY_TYPE)
+ && TREE_CODE (TREE_TYPE (ovar)) == ARRAY_TYPE
+ && offloaded)
{
- gcc_assert (offloaded);
- tree avar
- = create_tmp_var (TREE_TYPE (TREE_TYPE (x)));
- mark_addressable (avar);
- gimplify_assign (avar, build_fold_addr_expr (var), &ilist);
- talign = DECL_ALIGN_UNIT (avar);
+ tree avar = build_fold_addr_expr (var);
+ if (!OMP_CLAUSE_ITERATORS (c))
+ {
+ tree tmp = create_tmp_var (TREE_TYPE (TREE_TYPE (x)));
+ mark_addressable (tmp);
+ gimplify_assign (tmp, avar, &ilist);
+ avar = tmp;
+ }
+ talign = TYPE_ALIGN_UNIT (TREE_TYPE (TREE_TYPE (x)));
avar = build_fold_addr_expr (avar);
+ avar = lower_omp_map_iterator_expr (avar, c, stmt);
gimplify_assign (x, avar, &ilist);
}
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && GOMP_MAP_NONCONTIG_ARRAY_P (OMP_CLAUSE_MAP_KIND (c)))
+ {
+ int dim_num;
+ tree dimensions = OMP_CLAUSE_SIZE (c);
+
+ tree array_descr_type =
+ create_noncontig_array_descr_type (dimensions, &dim_num);
+ tree array_descr =
+ create_tmp_var_raw (array_descr_type,
+ ".omp_noncontig_array_descr");
+ TREE_ADDRESSABLE (array_descr) = 1;
+ TREE_STATIC (array_descr) = 1;
+ gimple_add_tmp_var (array_descr);
+
+ create_noncontig_array_descr_init_code
+ (array_descr, ovar, dimensions, dim_num, &ilist);
+ nca_descrs.safe_push (build_fold_addr_expr (array_descr));
+
+ gimplify_assign (x, (TREE_CODE (TREE_TYPE (ovar)) == ARRAY_TYPE
+ ? build_fold_addr_expr (ovar) : ovar),
+ &ilist);
+ }
else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE)
{
- gcc_assert (is_gimple_omp_oacc (ctx->stmt));
- if (!omp_privatize_by_reference (var))
+ gcc_checking_assert (is_gimple_omp_oacc (ctx->stmt));
+ tree new_var = lookup_decl (var, ctx);
+ tree type = TREE_TYPE (var);
+ tree inner_type
+ = omp_privatize_by_reference (new_var)
+ ? TREE_TYPE (type) : type;
+ if ((FLOAT_TYPE_P (inner_type)
+ || ANY_INTEGRAL_TYPE_P (inner_type))
+ && tree_to_uhwi (TYPE_SIZE (inner_type)) <= POINTER_SIZE
+ && !maybe_lookup_field_in_outer_ctx (var, ctx))
+ {
+ oacc_firstprivate_int = true;
+ if (is_gimple_reg (var)
+ && OMP_CLAUSE_FIRSTPRIVATE_IMPLICIT (c))
+ TREE_NO_WARNING (var) = 1;
+ var = convert_to_firstprivate_int (var, &ilist);
+ }
+ else if (!omp_privatize_by_reference (var))
{
if (is_gimple_reg (var)
&& OMP_CLAUSE_FIRSTPRIVATE_IMPLICIT (c))
@@ -13381,17 +14839,26 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE)
{
gcc_checking_assert (is_gimple_omp_oacc (ctx->stmt));
- s = TREE_TYPE (ovar);
- if (TREE_CODE (s) == REFERENCE_TYPE
- || omp_check_optional_argument (ovar, false))
- s = TREE_TYPE (s);
- s = TYPE_SIZE_UNIT (s);
+ if (oacc_firstprivate_int)
+ s = size_int (0);
+ else
+ {
+ s = TREE_TYPE (ovar);
+ if (TREE_CODE (s) == REFERENCE_TYPE
+ || omp_check_optional_argument (ovar, false))
+ s = TREE_TYPE (s);
+ s = TYPE_SIZE_UNIT (s);
+ }
}
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
+ && GOMP_MAP_NONCONTIG_ARRAY_P (OMP_CLAUSE_MAP_KIND (c)))
+ s = NULL_TREE;
else
s = OMP_CLAUSE_SIZE (c);
if (s == NULL_TREE)
s = TYPE_SIZE_UNIT (TREE_TYPE (ovar));
s = fold_convert (size_type_node, s);
+ s = lower_omp_map_iterator_size (s, c, stmt);
purpose = size_int (map_idx++);
CONSTRUCTOR_APPEND_ELT (vsize, purpose, s);
if (TREE_CODE (s) != INTEGER_CST)
@@ -13452,7 +14919,10 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
break;
case OMP_CLAUSE_FIRSTPRIVATE:
gcc_checking_assert (is_gimple_omp_oacc (ctx->stmt));
- tkind = GOMP_MAP_TO;
+ if (oacc_firstprivate_int)
+ tkind = GOMP_MAP_FIRSTPRIVATE_INT;
+ else
+ tkind = GOMP_MAP_TO;
tkind_zero = tkind;
break;
case OMP_CLAUSE_TO:
@@ -13750,6 +15220,19 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gcc_assert (map_idx == map_cnt);
+ unsigned nca_num = nca_descrs.length ();
+ if (nca_num > 0)
+ {
+ tree nca, t = gimple_omp_target_data_arg (stmt);
+ int i, oldlen = TREE_VEC_LENGTH (t);
+ tree nt = make_tree_vec (oldlen + nca_num);
+ for (i = 0; i < oldlen; i++)
+ TREE_VEC_ELT (nt, i) = TREE_VEC_ELT (t, i);
+ for (i = 0; nca_descrs.iterate (i, &nca); i++)
+ TREE_VEC_ELT (nt, oldlen + i) = nca;
+ gimple_omp_target_set_data_arg (stmt, nt);
+ }
+
if (!deep_map_cnt)
{
DECL_INITIAL (TREE_VEC_ELT (t, 1))
@@ -14209,7 +15692,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
type = TREE_TYPE (type);
ref_to_ptr = true;
}
- x = build_receiver_ref (OMP_CLAUSE_DECL (prev), false, ctx);
+ x = build_receiver_ref (prev, false, ctx);
x = fold_convert_loc (clause_loc, type, x);
if (!integer_zerop (OMP_CLAUSE_SIZE (c)))
{
@@ -14225,6 +15708,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
if (ref_to_array)
x = fold_convert_loc (clause_loc, TREE_TYPE (new_var), x);
gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
+ if (OMP_CLAUSE_MAP_POINTS_TO_READONLY (c) && VAR_P (x))
+ VAR_POINTS_TO_READONLY (x) = 1;
if ((is_ref && !ref_to_array)
|| ref_to_ptr)
{
@@ -14235,8 +15720,29 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gimple_build_assign (t, x));
x = build_fold_addr_expr_loc (clause_loc, t);
}
- gimple_seq_add_stmt (&new_body,
- gimple_build_assign (new_var, x));
+ if (offloaded && is_gimple_omp_oacc (ctx->stmt)
+ && OMP_CLAUSE_MAP_IN_REDUCTION (prev)
+ && TREE_CODE (type) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE
+ && !TREE_CONSTANT (TYPE_SIZE_UNIT (TREE_TYPE (type))))
+ {
+ tree array_type = TREE_TYPE (type);
+ tree atmp
+ = builtin_decl_explicit (BUILT_IN_ALLOCA_WITH_ALIGN);
+ tree al = size_int (TYPE_ALIGN (array_type));
+ tree sz = TYPE_SIZE_UNIT (array_type);
+ tree call = build_call_expr_loc (OMP_CLAUSE_LOCATION (c),
+ atmp, 2, sz, al);
+ gimplify_assign (x, call, &new_body);
+
+ /* In some cases, we need to preserve the pointer to array
+ type, as it will be passed into OpenACC reduction
+ internal-fns, and we require the type for proper copy
+ generation. */
+ TREE_TYPE (x) = TREE_TYPE (new_var);
+ }
+ gimple *g = gimple_build_assign (new_var, x);
+ gimple_seq_add_stmt (&new_body, g);
prev = NULL_TREE;
}
else if (OMP_CLAUSE_CHAIN (c)
@@ -14296,7 +15802,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gimple_seq fork_seq = NULL;
gimple_seq join_seq = NULL;
- if (offloaded && is_gimple_omp_oacc (ctx->stmt))
+ if (offloaded && (is_gimple_omp_oacc (ctx->stmt)
+ || (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && ompacc_ctx_p (ctx))))
{
/* If there are reductions on the offloaded region itself, treat
them as a dummy GANG loop. */
@@ -14324,6 +15832,23 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gimple_omp_set_body (stmt, new_body);
}
+ for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_HAS_ITERATORS (c))
+ allocate_omp_iterator_elems (OMP_CLAUSE_ITERATORS (c),
+ gimple_omp_target_iterator_loops (stmt));
+ unsigned i;
+ tree it;
+ FOR_EACH_VEC_ELT (new_iterators, i, it)
+ allocate_omp_iterator_elems (it, gimple_omp_target_iterator_loops (stmt));
+ gsi_insert_seq_before (gsi_p, gimple_omp_target_iterator_loops (stmt),
+ GSI_SAME_STMT);
+ gimple_omp_target_set_iterator_loops (stmt, NULL);
+ for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_HAS_ITERATORS (c))
+ free_omp_iterator_elems (OMP_CLAUSE_ITERATORS (c), &olist);
+ FOR_EACH_VEC_ELT (new_iterators, i, it)
+ free_omp_iterator_elems (it, &olist);
+
bind = gimple_build_bind (NULL, NULL,
tgt_bind ? gimple_bind_block (tgt_bind)
: NULL_TREE);
@@ -14635,6 +16160,22 @@ lower_omp_teams (gimple_stmt_iterator *gsi_p, omp_context *ctx)
lower_omp (gimple_omp_body_ptr (teams_stmt), ctx);
lower_reduction_clauses (gimple_omp_teams_clauses (teams_stmt), &olist,
NULL, ctx);
+
+ if (flag_openmp_target == OMP_TARGET_MODE_OMPACC && ompacc_ctx_p (ctx))
+ {
+ /* Forward the team/gang-wide variables to outer target region. */
+ struct omp_context *tgt = ctx;
+ while (tgt && !is_gimple_omp_offloaded (tgt->stmt))
+ tgt = tgt->outer;
+ if (tgt)
+ {
+ int i;
+ tree decl;
+ FOR_EACH_VEC_ELT (ctx->oacc_privatization_candidates, i, decl)
+ tgt->oacc_privatization_candidates.safe_push (decl);
+ }
+ }
+
gimple_seq_add_stmt (&bind_body, teams_stmt);
gimple_seq_add_seq (&bind_body, gimple_omp_body (teams_stmt));
@@ -14802,7 +16343,9 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx)
ctx);
break;
case GIMPLE_BIND:
- if (ctx && is_gimple_omp_oacc (ctx->stmt))
+ if (ctx && (is_gimple_omp_oacc (ctx->stmt)
+ || (flag_openmp_target == OMP_TARGET_MODE_OMPACC
+ && ompacc_ctx_p (ctx))))
{
tree vars = gimple_bind_vars (as_a <gbind *> (stmt));
oacc_privatization_scan_decl_chain (ctx, vars);
@@ -15044,6 +16587,68 @@ lower_omp (gimple_seq *body, omp_context *ctx)
input_location = saved_location;
}
+/* Emit a constructor function to enable -foffload-memory=pinned
+ at runtime. Libgomp handles the OS mode setting, but we need to trigger
+ it by calling GOMP_enable_pinned mode before the program proper runs. */
+
+static void
+omp_enable_pinned_mode ()
+{
+ static bool visited = false;
+ if (visited)
+ return;
+ visited = true;
+
+ /* Create a new function like this:
+
+ static void __attribute__((constructor))
+ __set_pinned_mode ()
+ {
+ GOMP_enable_pinned_mode ();
+ }
+ */
+
+ tree name = get_identifier ("__set_pinned_mode");
+ tree voidfntype = build_function_type_list (void_type_node, NULL_TREE);
+ tree decl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL, name, voidfntype);
+
+ TREE_STATIC (decl) = 1;
+ TREE_USED (decl) = 1;
+ DECL_ARTIFICIAL (decl) = 1;
+ DECL_IGNORED_P (decl) = 0;
+ TREE_PUBLIC (decl) = 0;
+ DECL_UNINLINABLE (decl) = 1;
+ DECL_EXTERNAL (decl) = 0;
+ DECL_CONTEXT (decl) = NULL_TREE;
+ DECL_INITIAL (decl) = make_node (BLOCK);
+ BLOCK_SUPERCONTEXT (DECL_INITIAL (decl)) = decl;
+ DECL_STATIC_CONSTRUCTOR (decl) = 1;
+ DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("constructor"),
+ NULL_TREE, NULL_TREE);
+
+ tree t = build_decl (UNKNOWN_LOCATION, RESULT_DECL, NULL_TREE,
+ void_type_node);
+ DECL_ARTIFICIAL (t) = 1;
+ DECL_IGNORED_P (t) = 1;
+ DECL_CONTEXT (t) = decl;
+ DECL_RESULT (decl) = t;
+
+ push_struct_function (decl);
+ init_tree_ssa (cfun);
+
+ tree calldecl = builtin_decl_explicit (BUILT_IN_GOMP_ENABLE_PINNED_MODE);
+ gcall *call = gimple_build_call (calldecl, 0);
+
+ gimple_seq seq = NULL;
+ gimple_seq_add_stmt (&seq, call);
+ gimple_set_body (decl, gimple_build_bind (NULL_TREE, seq, NULL));
+
+ cfun->function_end_locus = UNKNOWN_LOCATION;
+ cfun->curr_properties |= PROP_gimple_any;
+ pop_cfun ();
+ cgraph_node::add_new_function (decl, true);
+}
+
/* Main entry point. */
static unsigned int
@@ -15100,6 +16705,10 @@ execute_lower_omp (void)
for (auto task_stmt : task_cpyfns)
finalize_task_copyfn (task_stmt);
task_cpyfns.release ();
+
+ if (flag_offload_memory == OFFLOAD_MEMORY_PINNED)
+ omp_enable_pinned_mode ();
+
return 0;
}
diff --git a/gcc/omp-oacc-kernels-decompose.cc b/gcc/omp-oacc-kernels-decompose.cc
index fc3a3b3..5d7289a 100644
--- a/gcc/omp-oacc-kernels-decompose.cc
+++ b/gcc/omp-oacc-kernels-decompose.cc
@@ -120,7 +120,8 @@ top_level_omp_for_in_stmt (gimple *stmt)
for (gsi = gsi_start (body); !gsi_end_p (gsi); gsi_next (&gsi))
{
gimple *body_stmt = gsi_stmt (gsi);
- if (gimple_code (body_stmt) == GIMPLE_ASSIGN)
+ if (gimple_code (body_stmt) == GIMPLE_ASSIGN
+ || gimple_code (body_stmt) == GIMPLE_DEBUG)
continue;
else if (gimple_code (body_stmt) == GIMPLE_OMP_FOR
&& gsi_one_before_end_p (gsi))
@@ -1363,7 +1364,7 @@ decompose_kernels_region_body (gimple *kernels_region, tree kernels_clauses)
= (gimple_code (stmt) == GIMPLE_ASSIGN
&& TREE_CODE (gimple_assign_lhs (stmt)) == VAR_DECL
&& DECL_ARTIFICIAL (gimple_assign_lhs (stmt)));
- if (!is_simple_assignment)
+ if (!is_simple_assignment && gimple_code (stmt) != GIMPLE_DEBUG)
only_simple_assignments = false;
}
}
diff --git a/gcc/omp-oacc-neuter-broadcast.cc b/gcc/omp-oacc-neuter-broadcast.cc
index 52addad..1336aa9 100644
--- a/gcc/omp-oacc-neuter-broadcast.cc
+++ b/gcc/omp-oacc-neuter-broadcast.cc
@@ -148,6 +148,34 @@ local_var_based_p (tree decl)
}
}
+static bool
+local_assignment_p (gimple *stmt, hash_set<tree> *array_reduction_base_vars)
+{
+ if (is_gimple_assign (stmt)
+ || gimple_call_builtin_p (stmt, BUILT_IN_ALLOCA_WITH_ALIGN))
+ {
+ tree lhs = (is_gimple_assign (stmt)
+ ? gimple_assign_lhs (stmt) : gimple_call_lhs (stmt));
+ if (TREE_CODE (lhs) == SSA_NAME
+ && array_reduction_base_vars->contains (lhs))
+ {
+ use_operand_p use_p;
+ ssa_op_iter iter;
+ FOR_EACH_SSA_USE_OPERAND (use_p, stmt, iter, SSA_OP_USE)
+ {
+ tree use = USE_FROM_PTR (use_p);
+ if (TREE_CODE (use) != SSA_NAME
+ || SSA_NAME_IS_DEFAULT_DEF (use))
+ continue;
+ if (!array_reduction_base_vars->contains (use))
+ return false;
+ }
+ return true;
+ }
+ }
+ return false;
+}
+
/* Map of basic blocks to gimple stmts. */
typedef hash_map<basic_block, gimple *> bb_stmt_map_t;
@@ -991,7 +1019,8 @@ worker_single_copy (basic_block from, basic_block to,
hash_set<tree> *worker_partitioned_uses,
tree record_type, record_field_map_t *record_field_map,
unsigned HOST_WIDE_INT placement,
- bool isolate_broadcasts, bool has_gang_private_write)
+ bool isolate_broadcasts, bool has_gang_private_write,
+ hash_set<tree> *array_reduction_base_vars)
{
/* If we only have virtual defs, we'll have no record type, but we still want
to emit single_copy_start and (particularly) single_copy_end to act as
@@ -1015,6 +1044,31 @@ worker_single_copy (basic_block from, basic_block to,
edge e = split_block (to, gsi_stmt (gsi));
basic_block barrier_block = e->dest;
+ gimple_seq local_asgns = NULL;
+
+ /* For accesses of variables used in array reductions, instead of
+ propagating the value for the main thread to all other worker threads
+ (which doesn't make sense as a reduction private var), move the defs
+ of such SSA_NAMEs to before the copy block and leave them alone (each
+ thread should access their own local copy). */
+ for (gimple_stmt_iterator i = gsi_after_labels (from); !gsi_end_p (i);)
+ {
+ gimple *stmt = gsi_stmt (i);
+ if (local_assignment_p (stmt, array_reduction_base_vars))
+ {
+ gsi_remove (&i, false);
+ gimple_seq_add_stmt (&local_asgns, stmt);
+ }
+ else
+ gsi_next (&i);
+ }
+
+ if (dump_file)
+ {
+ fprintf (dump_file, "Local assignments to be moved:\n");
+ print_gimple_seq (dump_file, local_asgns, 0, TDF_NONE);
+ }
+
gimple_stmt_iterator start = gsi_after_labels (from);
tree decl = builtin_decl_explicit (BUILT_IN_GOACC_SINGLE_COPY_START);
@@ -1029,6 +1083,9 @@ worker_single_copy (basic_block from, basic_block to,
gsi_insert_before (&start, call, GSI_NEW_STMT);
update_stmt (call);
+ if (local_asgns)
+ gsi_insert_seq_before (&start, local_asgns, GSI_SAME_STMT);
+
/* The shared-memory range for this block overflowed. Add a barrier before
the GOACC_single_copy_start call. */
if (isolate_broadcasts)
@@ -1128,6 +1185,12 @@ worker_single_copy (basic_block from, basic_block to,
if (gimple_nop_p (def_stmt))
continue;
+ /* For accesses of variables used in array reductions, skip creating
+ the barrier phi. Each thread runs same def_stmt to access
+ local variable, there is no main/worker divide here. */
+ if (local_assignment_p (def_stmt, array_reduction_base_vars))
+ continue;
+
/* The barrier phi takes one result from the actual work of the
block we're neutering, and the other result is constant zero of
the same type. */
@@ -1248,7 +1311,8 @@ neuter_worker_single (parallel_g *par, unsigned outer_mask,
hash_set<tree> *partitioned_var_uses,
record_field_map_t *record_field_map,
blk_offset_map_t *blk_offset_map,
- bitmap writes_gang_private)
+ bitmap writes_gang_private,
+ hash_set<tree> *array_reduction_base_vars)
{
unsigned mask = outer_mask | par->mask;
@@ -1398,7 +1462,8 @@ neuter_worker_single (parallel_g *par, unsigned outer_mask,
&worker_partitioned_uses, record_type,
record_field_map,
offset, !range_allocated,
- has_gang_private_write);
+ has_gang_private_write,
+ array_reduction_base_vars);
}
else
worker_single_simple (block, block, &def_escapes_block);
@@ -1436,11 +1501,13 @@ neuter_worker_single (parallel_g *par, unsigned outer_mask,
if (par->inner)
neuter_worker_single (par->inner, mask, worker_single, vector_single,
prop_set, partitioned_var_uses, record_field_map,
- blk_offset_map, writes_gang_private);
+ blk_offset_map, writes_gang_private,
+ array_reduction_base_vars);
if (par->next)
neuter_worker_single (par->next, outer_mask, worker_single, vector_single,
prop_set, partitioned_var_uses, record_field_map,
- blk_offset_map, writes_gang_private);
+ blk_offset_map, writes_gang_private,
+ array_reduction_base_vars);
}
static void
@@ -1587,7 +1654,8 @@ merge_ranges (splay_tree accum, splay_tree sp)
static void
oacc_do_neutering (unsigned HOST_WIDE_INT bounds_lo,
- unsigned HOST_WIDE_INT bounds_hi)
+ unsigned HOST_WIDE_INT bounds_hi,
+ hash_set<tree> *array_reduction_base_vars)
{
bb_stmt_map_t bb_stmt_map;
auto_bitmap worker_single, vector_single;
@@ -1792,7 +1860,8 @@ oacc_do_neutering (unsigned HOST_WIDE_INT bounds_lo,
neuter_worker_single (par, mask, worker_single, vector_single, &prop_set,
&partitioned_var_uses, &record_field_map,
- &blk_offset_map, writes_gang_private);
+ &blk_offset_map, writes_gang_private,
+ array_reduction_base_vars);
record_field_map.empty ();
@@ -1831,6 +1900,9 @@ execute_omp_oacc_neuter_broadcast ()
private_size[i] = 0;
}
+ /* Set of base variables referencing arrays used in array reductions. */
+ hash_set<tree> array_reduction_base_vars;
+
/* Calculate shared memory size required for reduction variables and
gang-private memory for this offloaded function. */
basic_block bb;
@@ -1869,6 +1941,42 @@ execute_omp_oacc_neuter_broadcast ()
+ tree_to_uhwi (TYPE_SIZE_UNIT (var_type)));
reduction_size[level]
= MAX (reduction_size[level], limit);
+
+ tree array_addr = gimple_call_arg (call, 6);
+ if (!integer_zerop (array_addr)
+ && TREE_CODE (array_addr) == SSA_NAME)
+ {
+ /* For array reductions, trace all dependent SSA names
+ and add to array_reduction_base_vars, which makes
+ them replicated private for each thread, instead
+ of being copied around. */
+ auto_vec<tree> ssa_name_queue;
+ ssa_name_queue.safe_push (array_addr);
+
+ tree array_max_idx = gimple_call_arg (call, 7);
+ if (TREE_CODE (array_max_idx) == SSA_NAME)
+ ssa_name_queue.safe_push (array_max_idx);
+
+ while (ssa_name_queue.length ())
+ {
+ tree t = ssa_name_queue.pop ();
+
+ array_reduction_base_vars.add (t);
+ gimple *g = SSA_NAME_DEF_STMT (t);
+
+ use_operand_p use_p;
+ ssa_op_iter iter;
+ FOR_EACH_SSA_USE_OPERAND (use_p, g, iter,
+ SSA_OP_USE)
+ {
+ tree use = USE_FROM_PTR (use_p);
+ if (TREE_CODE (use) != SSA_NAME
+ || SSA_NAME_IS_DEFAULT_DEF (use))
+ continue;
+ ssa_name_queue.safe_push (use);
+ }
+ }
+ }
}
}
break;
@@ -1917,7 +2025,7 @@ execute_omp_oacc_neuter_broadcast ()
/* Perform worker partitioning unless we know 'num_workers(1)'. */
if (dims[GOMP_DIM_WORKER] != 1)
- oacc_do_neutering (bounds_lo, bounds_hi);
+ oacc_do_neutering (bounds_lo, bounds_hi, &array_reduction_base_vars);
return 0;
}
diff --git a/gcc/omp-offload.cc b/gcc/omp-offload.cc
index da2b54b..3218f69 100644
--- a/gcc/omp-offload.cc
+++ b/gcc/omp-offload.cc
@@ -52,6 +52,7 @@ along with GCC; see the file COPYING3. If not see
#include "stringpool.h"
#include "attribs.h"
#include "cfgloop.h"
+#include "cfghooks.h"
#include "context.h"
#include "convert.h"
#include "opts.h"
@@ -391,6 +392,268 @@ omp_discover_implicit_declare_target (void)
lang_hooks.decls.omp_finish_decl_inits ();
}
+static bool ompacc_supported_clauses_p (tree clauses)
+{
+ for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
+ switch (OMP_CLAUSE_CODE (c))
+ {
+ case OMP_CLAUSE_COLLAPSE:
+ case OMP_CLAUSE_NOWAIT:
+ continue;
+ default:
+ return false;
+ }
+ return true;
+}
+
+struct target_region_data
+{
+ tree func_decl;
+ bool has_omp_for;
+ bool has_omp_parallel;
+ bool ompacc_invalid;
+ auto_vec<const char *> warning_msgs;
+ auto_vec<location_t> warning_locs;
+ target_region_data (void)
+ : func_decl (NULL_TREE),
+ has_omp_for (false), has_omp_parallel (false), ompacc_invalid (false),
+ warning_msgs (), warning_locs () {}
+};
+
+static tree scan_omp_target_region_r (tree *, int *, void *);
+
+static void
+scan_fndecl_for_ompacc (tree decl, target_region_data *tgtdata)
+{
+ target_region_data td;
+ td.func_decl = decl;
+ walk_tree_without_duplicates (&DECL_SAVED_TREE (decl),
+ scan_omp_target_region_r, &td);
+ tree v;
+ if ((v = lookup_attribute ("omp declare variant base",
+ DECL_ATTRIBUTES (decl)))
+ || (v = lookup_attribute ("omp declare variant variant",
+ DECL_ATTRIBUTES (decl))))
+ {
+ td.ompacc_invalid = true;
+ td.warning_msgs.safe_push ("declare variant not supported for OMPACC");
+ td.warning_locs.safe_push (EXPR_LOCATION (v));
+ }
+ if (tgtdata)
+ {
+ tgtdata->has_omp_for |= td.has_omp_for;
+ tgtdata->has_omp_parallel |= td.has_omp_parallel;
+ tgtdata->ompacc_invalid |= td.ompacc_invalid;
+ for (unsigned i = 0; i < td.warning_msgs.length (); i++)
+ tgtdata->warning_msgs.safe_push (td.warning_msgs[i]);
+ for (unsigned i = 0; i < td.warning_locs.length (); i++)
+ tgtdata->warning_locs.safe_push (td.warning_locs[i]);
+ }
+
+ if (!td.ompacc_invalid
+ && !lookup_attribute ("ompacc", DECL_ATTRIBUTES (decl)))
+ {
+ DECL_ATTRIBUTES (decl)
+ = tree_cons (get_identifier ("ompacc"), NULL_TREE,
+ DECL_ATTRIBUTES (decl));
+ if (!td.has_omp_parallel)
+ DECL_ATTRIBUTES (decl)
+ = tree_cons (get_identifier ("ompacc seq"), NULL_TREE,
+ DECL_ATTRIBUTES (decl));
+ }
+}
+
+static tree
+scan_omp_target_region_r (tree *tp, int *walk_subtrees, void *data)
+{
+ target_region_data *tgtdata = (target_region_data *) data;
+
+ if (TREE_CODE (*tp) == FUNCTION_DECL
+ && !(fndecl_built_in_p (*tp, BUILT_IN_OMP_GET_THREAD_NUM)
+ || fndecl_built_in_p (*tp, BUILT_IN_OMP_GET_NUM_THREADS)
+ || fndecl_built_in_p (*tp, BUILT_IN_OMP_GET_TEAM_NUM)
+ || fndecl_built_in_p (*tp, BUILT_IN_OMP_GET_NUM_TEAMS)
+ || id_equal (DECL_NAME (*tp), "omp_get_thread_num")
+ || id_equal (DECL_NAME (*tp), "omp_get_num_threads")
+ || id_equal (DECL_NAME (*tp), "omp_get_team_num")
+ || id_equal (DECL_NAME (*tp), "omp_get_num_teams"))
+ && *tp != tgtdata->func_decl)
+ {
+ tree decl = *tp;
+ symtab_node *node = symtab_node::get (*tp);
+ if (node)
+ {
+ node = node->ultimate_alias_target ();
+ decl = node->decl;
+ }
+
+ if (!DECL_EXTERNAL (decl) && DECL_SAVED_TREE (decl))
+ {
+ scan_fndecl_for_ompacc (decl, tgtdata);
+ }
+ else
+ {
+ tgtdata->warning_msgs.safe_push ("referencing external function");
+ tgtdata->warning_locs.safe_push (EXPR_LOCATION (*tp));
+ tgtdata->ompacc_invalid = true;
+ }
+ *walk_subtrees = 0;
+ return NULL_TREE;
+ }
+
+ switch (TREE_CODE (*tp))
+ {
+ case OMP_FOR:
+ if (!ompacc_supported_clauses_p (OMP_CLAUSES (*tp)))
+ {
+ tgtdata->ompacc_invalid = true;
+ tgtdata->warning_msgs.safe_push ("clauses not supported");
+ tgtdata->warning_locs.safe_push (EXPR_LOCATION (*tp));
+ }
+ else if (OMP_FOR_NON_RECTANGULAR (*tp))
+ {
+ tgtdata->ompacc_invalid = true;
+ tgtdata->warning_msgs.safe_push ("non-rectangular loops not supported");
+ tgtdata->warning_locs.safe_push (EXPR_LOCATION (*tp));
+ }
+ else
+ tgtdata->has_omp_for = true;
+ break;
+
+ case OMP_PARALLEL:
+ if (!ompacc_supported_clauses_p (OMP_CLAUSES (*tp)))
+ {
+ tgtdata->ompacc_invalid = true;
+ tgtdata->warning_msgs.safe_push ("clauses not supported");
+ tgtdata->warning_locs.safe_push (EXPR_LOCATION (*tp));
+ }
+ else
+ tgtdata->has_omp_parallel = true;
+ break;
+
+ case OMP_DISTRIBUTE:
+ case OMP_TEAMS:
+ if (!ompacc_supported_clauses_p (OMP_CLAUSES (*tp)))
+ {
+ tgtdata->ompacc_invalid = true;
+ tgtdata->warning_msgs.safe_push ("clauses not supported");
+ tgtdata->warning_locs.safe_push (EXPR_LOCATION (*tp));
+ }
+ /* Fallthru. */
+
+ case OMP_ATOMIC:
+ case OMP_ATOMIC_READ:
+ case OMP_ATOMIC_CAPTURE_OLD:
+ case OMP_ATOMIC_CAPTURE_NEW:
+ break;
+
+ case OMP_SIMD:
+ case OMP_TASK:
+ case OMP_LOOP:
+ case OMP_TASKLOOP:
+ case OMP_TASKGROUP:
+ case OMP_SECTION:
+ case OMP_MASTER:
+ case OMP_MASKED:
+ case OMP_ORDERED:
+ case OMP_CRITICAL:
+ case OMP_SCAN:
+ tgtdata->ompacc_invalid = true;
+ tgtdata->warning_msgs.safe_push ("construct not supported");
+ tgtdata->warning_locs.safe_push (EXPR_LOCATION (*tp));
+ *walk_subtrees = 0;
+ break;
+
+ case OMP_TARGET:
+ tgtdata->ompacc_invalid = true;
+ tgtdata->warning_msgs.safe_push ("nested target/reverse offload "
+ "not supported");
+ tgtdata->warning_locs.safe_push (EXPR_LOCATION (*tp));
+ *walk_subtrees = 0;
+ break;
+
+ default:
+ break;
+ }
+ return NULL_TREE;
+}
+
+static tree
+scan_omp_target_construct_r (tree *tp, int *walk_subtrees,
+ void *data)
+{
+ if (TREE_CODE (*tp) == OMP_TARGET)
+ {
+ target_region_data td;
+ td.func_decl = (tree) data;
+ walk_tree_without_duplicates (&OMP_TARGET_BODY (*tp),
+ scan_omp_target_region_r, &td);
+ for (tree c = OMP_TARGET_CLAUSES (*tp); c; c = OMP_CLAUSE_CHAIN (c))
+ {
+ switch (OMP_CLAUSE_CODE (c))
+ {
+ case OMP_CLAUSE_MAP:
+ continue;
+ default:
+ td.ompacc_invalid = true;
+ td.warning_msgs.safe_push ("clause not supported");
+ td.warning_locs.safe_push (EXPR_LOCATION (c));
+ break;
+ }
+ break;
+ }
+ if (!td.ompacc_invalid)
+ {
+ tree c = build_omp_clause (EXPR_LOCATION (*tp), OMP_CLAUSE__OMPACC_);
+ if (!td.has_omp_parallel)
+ OMP_CLAUSE__OMPACC__SEQ (c) = 1;
+ OMP_CLAUSE_CHAIN (c) = OMP_TARGET_CLAUSES (*tp);
+ OMP_TARGET_CLAUSES (*tp) = c;
+ }
+ else
+ {
+ warning_at (EXPR_LOCATION (*tp), 0, "Target region not suitable for "
+ "OMPACC mode");
+ for (unsigned i = 0; i < td.warning_locs.length (); i++)
+ warning_at (td.warning_locs[i], 0, td.warning_msgs[i]);
+ }
+ *walk_subtrees = 0;
+ }
+ return NULL_TREE;
+}
+
+void
+omp_ompacc_attribute_tagging (void)
+{
+ cgraph_node *node;
+ FOR_EACH_DEFINED_FUNCTION (node)
+ if (DECL_SAVED_TREE (node->decl))
+ {
+ if (DECL_STRUCT_FUNCTION (node->decl)
+ && DECL_STRUCT_FUNCTION (node->decl)->has_omp_target)
+ walk_tree_without_duplicates (&DECL_SAVED_TREE (node->decl),
+ scan_omp_target_construct_r,
+ node->decl);
+
+ for (cgraph_node *cgn = first_nested_function (node);
+ cgn; cgn = next_nested_function (cgn))
+ if (omp_declare_target_fn_p (cgn->decl))
+ {
+ scan_fndecl_for_ompacc (cgn->decl, NULL);
+
+ if (lookup_attribute ("ompacc", DECL_ATTRIBUTES (cgn->decl))
+ && !lookup_attribute ("noinline", DECL_ATTRIBUTES (cgn->decl)))
+ {
+ DECL_ATTRIBUTES (cgn->decl)
+ = tree_cons (get_identifier ("noinline"),
+ NULL, DECL_ATTRIBUTES (cgn->decl));
+ DECL_ATTRIBUTES (cgn->decl)
+ = tree_cons (get_identifier ("noipa"),
+ NULL, DECL_ATTRIBUTES (cgn->decl));
+ }
+ }
+ }
+}
/* Create new symbols containing (address, size) pairs for global variables,
marked with "omp declare target" attribute, as well as addresses for the
@@ -509,6 +772,22 @@ omp_finish_file (void)
static tree
oacc_dim_call (bool pos, int dim, gimple_seq *seq)
{
+ if (flag_openmp && flag_openmp_target == OMP_TARGET_MODE_OMPACC)
+ {
+ enum built_in_function fn;
+ if (dim == GOMP_DIM_VECTOR)
+ fn = pos ? BUILT_IN_OMP_GET_THREAD_NUM : BUILT_IN_OMP_GET_NUM_THREADS;
+ else if (dim == GOMP_DIM_GANG)
+ fn = pos ? BUILT_IN_OMP_GET_TEAM_NUM : BUILT_IN_OMP_GET_NUM_TEAMS;
+ else
+ gcc_unreachable ();
+ tree size = create_tmp_var (integer_type_node);
+ gimple *call = gimple_build_call (builtin_decl_explicit (fn), 0);
+ gimple_call_set_lhs (call, size);
+ gimple_seq_add_stmt (seq, call);
+ return size;
+ }
+
tree arg = build_int_cst (unsigned_type_node, dim);
tree size = create_tmp_var (integer_type_node);
enum internal_fn fn = pos ? IFN_GOACC_DIM_POS : IFN_GOACC_DIM_SIZE;
@@ -521,11 +800,13 @@ oacc_dim_call (bool pos, int dim, gimple_seq *seq)
}
/* Find the number of threads (POS = false), or thread number (POS =
- true) for an OpenACC region partitioned as MASK. Setup code
+ true) for an OpenACC region partitioned as MASK. If VF_BY_VECTORIZER is
+ true, use that as the vectorization factor for the auto-vectorized
+ dimension size, instead of calling the builtin function. Setup code
required for the calculation is added to SEQ. */
static tree
-oacc_thread_numbers (bool pos, int mask, gimple_seq *seq)
+oacc_thread_numbers (bool pos, int mask, tree vf_by_vectorizer, gimple_seq *seq)
{
tree res = pos ? NULL_TREE : build_int_cst (unsigned_type_node, 1);
unsigned ix;
@@ -538,13 +819,15 @@ oacc_thread_numbers (bool pos, int mask, gimple_seq *seq)
{
/* We had an outer index, so scale that by the size of
this dimension. */
- tree n = oacc_dim_call (false, ix, seq);
+ tree n = (ix == GOMP_DIM_VECTOR && vf_by_vectorizer)
+ ? vf_by_vectorizer : oacc_dim_call (false, ix, seq);
res = fold_build2 (MULT_EXPR, integer_type_node, res, n);
}
if (pos)
{
/* Determine index in this dimension. */
- tree id = oacc_dim_call (true, ix, seq);
+ tree id = (ix == GOMP_DIM_VECTOR && vf_by_vectorizer)
+ ? integer_zero_node : oacc_dim_call (true, ix, seq);
if (res)
res = fold_build2 (PLUS_EXPR, integer_type_node, res, id);
else
@@ -558,6 +841,12 @@ oacc_thread_numbers (bool pos, int mask, gimple_seq *seq)
return res;
}
+static tree
+oacc_thread_numbers (bool pos, int mask, gimple_seq *seq)
+{
+ return oacc_thread_numbers (pos, mask, NULL_TREE, seq);
+}
+
/* Transform IFN_GOACC_LOOP calls to actual code. See
expand_oacc_for for where these are generated. At the vector
level, we stride loops, such that each member of a warp will
@@ -585,6 +874,7 @@ oacc_xform_loop (gcall *call)
bool chunking = false, striding = true;
unsigned outer_mask = mask & (~mask + 1); // Outermost partitioning
unsigned inner_mask = mask & ~outer_mask; // Inner partitioning (if any)
+ tree vf_by_vectorizer = NULL_TREE;
/* Skip lowering if return value of IFN_GOACC_LOOP call is not used. */
if (!lhs)
@@ -612,16 +902,39 @@ oacc_xform_loop (gcall *call)
striding = integer_onep (chunk_size);
chunking = !striding;
}
+
+ if (!chunking
+ && !targetm.simt.vf
+ && (mask & GOMP_DIM_MASK (GOMP_DIM_VECTOR)))
+ {
+ poly_uint64 max_vf = omp_max_vf (false);
+ vf_by_vectorizer = build_int_cst (integer_type_node, max_vf);
+ }
+
#endif
- /* striding=true, chunking=true
+ /* For SIMT targets:
+
+ striding=true, chunking=true
-> invalid.
striding=true, chunking=false
-> chunks=1
striding=false,chunking=true
-> chunks=ceil (range/(chunksize*threads*step))
striding=false,chunking=false
- -> chunk_size=ceil(range/(threads*step)),chunks=1 */
+ -> chunk_size=ceil(range/(threads*step)),chunks=1
+
+ For non-SIMT targets:
+
+ striding=N/A, chunking=true
+ -> as above, for now.
+ striding=N/A, chunking=false
+ -> chunks=1
+ threads=gangs*workers*vf
+ chunk_size=ceil(range/(threads*step))
+ inner chunking loop steps by "step", vf*chunk_size times.
+ */
+
push_gimplify_context (true);
switch (code)
@@ -640,49 +953,83 @@ oacc_xform_loop (gcall *call)
chunk_size = fold_convert (type, chunk_size);
per = fold_build2 (MULT_EXPR, type, per, chunk_size);
per = fold_build2 (MULT_EXPR, type, per, step);
- r = build2 (MINUS_EXPR, type, range, dir);
- r = build2 (PLUS_EXPR, type, r, per);
+ r = fold_build2 (MINUS_EXPR, type, range, dir);
+ r = fold_build2 (PLUS_EXPR, type, r, per);
r = build2 (TRUNC_DIV_EXPR, type, r, per);
}
break;
case IFN_GOACC_LOOP_STEP:
{
- /* If striding, step by the entire compute volume, otherwise
- step by the inner volume. */
- unsigned volume = striding ? mask : inner_mask;
+ if (vf_by_vectorizer)
+ r = step;
+ else
+ {
+ /* If striding, step by the entire compute volume, otherwise
+ step by the inner volume. */
+ unsigned volume = striding ? mask : inner_mask;
- r = oacc_thread_numbers (false, volume, &seq);
- r = build2 (MULT_EXPR, type, fold_convert (type, r), step);
+ r = oacc_thread_numbers (false, volume, &seq);
+ r = build2 (MULT_EXPR, type, fold_convert (type, r), step);
+ }
}
break;
case IFN_GOACC_LOOP_OFFSET:
- /* Enable vectorization on non-SIMT targets. */
- if (!targetm.simt.vf
- && outer_mask == GOMP_DIM_MASK (GOMP_DIM_VECTOR)
+ if (vf_by_vectorizer)
+ {
/* If not -fno-tree-loop-vectorize, hint that we want to vectorize
the loop. */
- && (flag_tree_loop_vectorize
- || !OPTION_SET_P (flag_tree_loop_vectorize)))
- {
- basic_block bb = gsi_bb (gsi);
- class loop *parent = bb->loop_father;
- class loop *body = parent->inner;
-
- parent->force_vectorize = true;
- parent->safelen = INT_MAX;
-
- /* "Chunking loops" may have inner loops. */
- if (parent->inner)
+ if (flag_tree_loop_vectorize
+ || !OPTION_SET_P (flag_tree_loop_vectorize))
{
- body->force_vectorize = true;
- body->safelen = INT_MAX;
+ /* Enable vectorization on non-SIMT targets. */
+ basic_block bb = gsi_bb (gsi);
+ class loop *chunk_loop = bb->loop_father;
+ class loop *inner_loop = chunk_loop->inner;
+
+ /* Chunking isn't supported for VF_BY_VECTORIZER loops yet,
+ so we know that the outer chunking loop will be executed just
+ once and the inner loop is the one which must be
+ vectorized (unless it has been optimized out for some
+ reason). */
+ gcc_assert (!chunking);
+
+ if (inner_loop)
+ {
+ inner_loop->force_vectorize = true;
+ inner_loop->safelen = INT_MAX;
+
+ cfun->has_force_vectorize_loops = true;
+ }
}
- cfun->has_force_vectorize_loops = true;
+ /* ...and expand the abstract loops such that the vectorizer can
+ work on them more effectively.
+
+ It might be nicer to merge this code with the "!striding" case
+ below, particularly if chunking support is added. */
+ tree warppos
+ = oacc_thread_numbers (true, mask, vf_by_vectorizer, &seq);
+ warppos = fold_convert (diff_type, warppos);
+
+ tree volume
+ = oacc_thread_numbers (false, mask, vf_by_vectorizer, &seq);
+ volume = fold_convert (diff_type, volume);
+
+ tree per = fold_build2 (MULT_EXPR, diff_type, volume, step);
+ chunk_size = fold_build2 (PLUS_EXPR, diff_type, range, per);
+ chunk_size = fold_build2 (MINUS_EXPR, diff_type, chunk_size, dir);
+ chunk_size = fold_build2 (TRUNC_DIV_EXPR, diff_type, chunk_size,
+ per);
+
+ warppos = fold_build2 (MULT_EXPR, diff_type, warppos, chunk_size);
+
+ tree chunk = fold_convert (diff_type, gimple_call_arg (call, 6));
+ chunk = fold_build2 (MULT_EXPR, diff_type, chunk, volume);
+ r = fold_build2 (PLUS_EXPR, diff_type, chunk, warppos);
}
- if (striding)
+ else if (striding)
{
r = oacc_thread_numbers (true, mask, &seq);
r = fold_convert (diff_type, r);
@@ -700,7 +1047,7 @@ oacc_xform_loop (gcall *call)
else
{
tree per = fold_build2 (MULT_EXPR, diff_type, volume, step);
-
+ /* chunk_size = (range + per - 1) / per. */
chunk_size = build2 (MINUS_EXPR, diff_type, range, dir);
chunk_size = build2 (PLUS_EXPR, diff_type, chunk_size, per);
chunk_size = build2 (TRUNC_DIV_EXPR, diff_type, chunk_size, per);
@@ -732,7 +1079,28 @@ oacc_xform_loop (gcall *call)
break;
case IFN_GOACC_LOOP_BOUND:
- if (striding)
+ if (vf_by_vectorizer)
+ {
+ tree volume
+ = oacc_thread_numbers (false, mask, vf_by_vectorizer, &seq);
+ volume = fold_convert (diff_type, volume);
+
+ tree per = fold_build2 (MULT_EXPR, diff_type, volume, step);
+ chunk_size = fold_build2 (PLUS_EXPR, diff_type, range, per);
+ chunk_size = fold_build2 (MINUS_EXPR, diff_type, chunk_size, dir);
+ chunk_size = fold_build2 (TRUNC_DIV_EXPR, diff_type, chunk_size,
+ per);
+
+ vf_by_vectorizer = fold_convert (diff_type, vf_by_vectorizer);
+ tree vecsize = fold_build2 (MULT_EXPR, diff_type, chunk_size,
+ vf_by_vectorizer);
+ vecsize = fold_build2 (MULT_EXPR, diff_type, vecsize, step);
+ tree vecend = fold_convert (diff_type, gimple_call_arg (call, 6));
+ vecend = fold_build2 (PLUS_EXPR, diff_type, vecend, vecsize);
+ r = fold_build2 (integer_onep (dir) ? MIN_EXPR : MAX_EXPR, diff_type,
+ range, vecend);
+ }
+ else if (striding)
r = range;
else
{
@@ -747,7 +1115,7 @@ oacc_xform_loop (gcall *call)
else
{
tree per = fold_build2 (MULT_EXPR, diff_type, volume, step);
-
+ /* chunk_size = (range + per - 1) / per. */
chunk_size = build2 (MINUS_EXPR, diff_type, range, dir);
chunk_size = build2 (PLUS_EXPR, diff_type, chunk_size, per);
chunk_size = build2 (TRUNC_DIV_EXPR, diff_type, chunk_size, per);
@@ -875,8 +1243,9 @@ oacc_get_min_dim (int dim)
}
/* Parse the default dimension parameter. This is a set of
- :-separated optional compute dimensions. Each specified dimension
- is a positive integer. When device type support is added, it is
+ :-separated optional compute dimensions. Each dimension is either
+ a positive integer, or '-' for a dynamic value computed at
+ runtime. When device type support is added, it is
planned to be a comma separated list of such compute dimensions,
with all but the first prefixed by the colon-terminated device
type. */
@@ -911,14 +1280,20 @@ oacc_parse_default_dims (const char *dims)
if (*pos != ':')
{
- long val;
- const char *eptr;
+ long val = 0;
- errno = 0;
- val = strtol (pos, CONST_CAST (char **, &eptr), 10);
- if (errno || val <= 0 || (int) val != val)
- goto malformed;
- pos = eptr;
+ if (*pos == '-')
+ pos++;
+ else
+ {
+ const char *eptr;
+
+ errno = 0;
+ val = strtol (pos, CONST_CAST (char **, &eptr), 10);
+ if (errno || val <= 0 || (int) val != val)
+ goto malformed;
+ pos = eptr;
+ }
oacc_default_dims[ix] = (int) val;
}
}
@@ -1777,6 +2152,129 @@ default_goacc_fork_join (gcall *ARG_UNUSED (call),
return targetm.have_oacc_join ();
}
+void
+oacc_build_array_copy (tree dst, tree src, tree max_idx, gimple_seq *seq)
+{
+ push_gimplify_context (true);
+
+ tree len = fold_build2 (PLUS_EXPR, size_type_node, max_idx, size_int (1));
+ tree ptr_to_array = (TREE_TYPE (dst) == ptr_type_node ? src : dst);
+ tree elem_type;
+ if (TREE_CODE (TREE_TYPE (ptr_to_array)) == POINTER_TYPE
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (ptr_to_array))) == ARRAY_TYPE)
+ elem_type = TREE_TYPE (TREE_TYPE (TREE_TYPE (ptr_to_array)));
+ else
+ elem_type = TREE_TYPE (TREE_TYPE (ptr_to_array));
+ tree elem_size = TYPE_SIZE_UNIT (elem_type);
+ tree size = fold_build2 (MULT_EXPR, size_type_node, len, elem_size);
+
+ tree memcpy_decl = builtin_decl_implicit (BUILT_IN_MEMCPY);
+ tree call = build_call_expr (memcpy_decl, 3, dst, src, size);
+ gimplify_and_add (call, seq);
+ pop_gimplify_context (NULL);
+}
+
+void
+oacc_build_array_copy_loop (location_t loc, tree dst, tree src, tree max_idx,
+ gimple_stmt_iterator *gsi)
+{
+ push_gimplify_context (true);
+
+ tree loop_index;
+ gimple_stmt_iterator loop_body_gsi;
+ oacc_build_indexed_ssa_loop (loc, max_idx, gsi,
+ &loop_index, &loop_body_gsi);
+ gimple_seq copy_seq = NULL;
+
+ tree dst_array_type = TREE_TYPE (TREE_TYPE (dst));
+ tree dst_elem_type = build_qualified_type (TREE_TYPE (dst_array_type),
+ TYPE_QUALS (dst_array_type));
+ tree dst_elem_ptr_type = build_pointer_type (dst_elem_type);
+ tree dst_ptr = fold_convert (dst_elem_ptr_type, dst);
+
+ tree src_array_type = TREE_TYPE (TREE_TYPE (src));
+ tree src_elem_type = build_qualified_type (TREE_TYPE (src_array_type),
+ TYPE_QUALS (src_array_type));
+ tree src_elem_ptr_type = build_pointer_type (src_elem_type);
+ tree src_ptr = fold_convert (src_elem_ptr_type, src);
+
+ tree offset = build2 (MULT_EXPR, sizetype,
+ loop_index, TYPE_SIZE_UNIT (dst_elem_type));
+
+ dst_ptr = build2 (POINTER_PLUS_EXPR, dst_elem_ptr_type, dst_ptr, offset);
+ src_ptr = build2 (POINTER_PLUS_EXPR, src_elem_ptr_type, src_ptr, offset);
+
+ tree dst_mem_ref = build_simple_mem_ref (dst_ptr);
+ tree src_mem_ref = build_simple_mem_ref (src_ptr);
+
+ gimplify_assign (dst_mem_ref, src_mem_ref, &copy_seq);
+
+ gsi_insert_seq_before (&loop_body_gsi, copy_seq, GSI_SAME_STMT);
+ pop_gimplify_context (NULL);
+}
+
+void
+oacc_build_indexed_ssa_loop (location_t loc, tree max_index,
+ gimple_stmt_iterator *gsi, tree *out_loop_index,
+ gimple_stmt_iterator *out_loop_body_code_gsi)
+{
+ gimple *g;
+ gimple_seq seq = NULL;
+
+ tree init_index = make_ssa_name (TREE_TYPE (max_index));
+ tree loop_index = make_ssa_name (TREE_TYPE (max_index));
+ tree update_index = make_ssa_name (TREE_TYPE (max_index));
+
+ g = gimple_build_assign (init_index,
+ build_int_cst (TREE_TYPE (init_index), 0));
+ gimple_seq_add_stmt (&seq, g);
+
+ gimple *init_end = gimple_seq_last (seq);
+ gsi_insert_seq_before (gsi, seq, GSI_SAME_STMT);
+
+ basic_block init_bb = gsi_bb (*gsi);
+ edge init_edge = split_block (init_bb, init_end);
+ basic_block loop_bb = init_edge->dest;
+ /* Reset the iterator. */
+ *gsi = gsi_for_stmt (gsi_stmt (*gsi));
+
+ seq = NULL;
+ g = gimple_build_assign (update_index, PLUS_EXPR, loop_index,
+ build_int_cst (TREE_TYPE (loop_index), 1));
+ gimple_seq_add_stmt (&seq, g);
+
+ g = gimple_build_cond (LE_EXPR, update_index, max_index, NULL, NULL);
+ gimple_seq_add_stmt (&seq, g);
+ gsi_insert_seq_before (gsi, seq, GSI_SAME_STMT);
+
+ edge post_edge = split_block (loop_bb, g);
+ basic_block post_bb = post_edge->dest;
+ loop_bb = post_edge->src;
+ /* Reset the iterator. */
+ *gsi = gsi_for_stmt (gsi_stmt (*gsi));
+
+ /* Return place where we insert loop body code. */
+ gimple_stmt_iterator loop_body_code_gsi = gsi_start_bb (loop_bb);
+
+ post_edge->flags ^= EDGE_FALSE_VALUE | EDGE_FALLTHRU;
+ post_edge->probability = profile_probability::even ();
+ edge loop_edge = make_edge (loop_bb, loop_bb, EDGE_TRUE_VALUE);
+ loop_edge->probability = profile_probability::even ();
+ set_immediate_dominator (CDI_DOMINATORS, loop_bb, init_bb);
+ set_immediate_dominator (CDI_DOMINATORS, post_bb, loop_bb);
+ class loop *new_loop = alloc_loop ();
+ new_loop->header = loop_bb;
+ new_loop->latch = loop_bb;
+ add_loop (new_loop, loop_bb->loop_father);
+
+ gphi *phi = create_phi_node (loop_index, loop_bb);
+ add_phi_arg (phi, init_index, init_edge, loc);
+ add_phi_arg (phi, update_index, loop_edge, loc);
+
+ *out_loop_index = loop_index;
+ *out_loop_body_code_gsi = loop_body_code_gsi;
+}
+
/* Default goacc.reduction early expander.
LHS-opt = IFN_REDUCTION (KIND, RES_PTR, VAR, LEVEL, OP, OFFSET)
@@ -1802,18 +2300,44 @@ default_goacc_reduction (gcall *call)
if there is one. */
tree ref_to_res = gimple_call_arg (call, 1);
+ tree array_addr = gimple_call_arg (call, 6);
+ tree array_max_idx = gimple_call_arg (call, 7);
+
if (!integer_zerop (ref_to_res))
{
- tree dst = build_simple_mem_ref (ref_to_res);
- tree src = var;
-
- if (code == IFN_GOACC_REDUCTION_SETUP)
+ if (!integer_zerop (array_addr))
{
- src = dst;
- dst = lhs;
- lhs = NULL;
+ tree dst, src;
+ if (code == IFN_GOACC_REDUCTION_SETUP)
+ dst = array_addr, src = ref_to_res;
+ else
+ src = array_addr, dst = ref_to_res;
+ oacc_build_array_copy (dst, src, array_max_idx, &seq);
+ }
+ else
+ {
+ /* Dummy reduction vars that have GOMP_MAP_FIRSTPRIVATE_POINTER data
+ mappings gets retyped to (void *). Adjust the type of ref_to_res
+ as appropriate. */
+ if (TREE_TYPE (TREE_TYPE (ref_to_res)) != TREE_TYPE (var))
+ {
+ tree ptype = build_pointer_type (TREE_TYPE (var));
+ tree t = make_ssa_name (ptype);
+ tree expr = fold_build1 (NOP_EXPR, ptype, ref_to_res);
+ gimple_seq_add_stmt (&seq, gimple_build_assign (t, expr));
+ ref_to_res = t;
+ }
+ tree dst = build_simple_mem_ref (ref_to_res);
+ tree src = var;
+
+ if (code == IFN_GOACC_REDUCTION_SETUP)
+ {
+ src = dst;
+ dst = lhs;
+ lhs = NULL;
+ }
+ gimple_seq_add_stmt (&seq, gimple_build_assign (dst, src));
}
- gimple_seq_add_stmt (&seq, gimple_build_assign (dst, src));
}
}
@@ -2145,15 +2669,19 @@ execute_oacc_loop_designation ()
static unsigned int
execute_oacc_device_lower ()
{
- tree attrs = oacc_get_fn_attrib (current_function_decl);
+ tree attrs;
+ int dims[GOMP_DIM_MAX];
- if (!attrs)
- /* Not an offloaded function. */
- return 0;
+ if (flag_openacc)
+ {
+ attrs = oacc_get_fn_attrib (current_function_decl);
+ if (!attrs)
+ /* Not an offloaded function. */
+ return 0;
- int dims[GOMP_DIM_MAX];
- for (unsigned i = 0; i < GOMP_DIM_MAX; i++)
- dims[i] = oacc_get_fn_dim_size (current_function_decl, i);
+ for (unsigned i = 0; i < GOMP_DIM_MAX; i++)
+ dims[i] = oacc_get_fn_dim_size (current_function_decl, i);
+ }
hash_map<tree, tree> adjusted_vars;
@@ -2222,7 +2750,8 @@ execute_oacc_device_lower ()
case IFN_UNIQUE_OACC_FORK:
case IFN_UNIQUE_OACC_JOIN:
- if (integer_minus_onep (gimple_call_arg (call, 2)))
+ if (flag_openacc
+ && integer_minus_onep (gimple_call_arg (call, 2)))
remove = true;
else if (!targetm.goacc.fork_join
(call, dims, kind == IFN_UNIQUE_OACC_FORK))
@@ -2509,7 +3038,8 @@ public:
{}
/* opt_pass methods: */
- bool gate (function *) final override { return flag_openacc; };
+ bool gate (function *) final override
+ { return flag_openacc || (flag_openmp && flag_openmp_target == OMP_TARGET_MODE_OMPACC); };
unsigned int execute (function *) final override
{
diff --git a/gcc/omp-offload.h b/gcc/omp-offload.h
index a0b70ef..c8b697a 100644
--- a/gcc/omp-offload.h
+++ b/gcc/omp-offload.h
@@ -26,11 +26,22 @@ extern int oacc_get_default_dim (int dim);
extern int oacc_get_min_dim (int dim);
extern int oacc_fn_attrib_level (tree attr);
+/* Used by both NVPTX/GCN OpenACC code. */
+extern void oacc_build_indexed_ssa_loop (location_t loc, tree max_index,
+ gimple_stmt_iterator *gsi,
+ tree *out_loop_index,
+ gimple_stmt_iterator *out_loop_body_code_gsi);
+extern void oacc_build_array_copy (tree dst, tree src, tree max_idx, gimple_seq *seq);
+extern void oacc_build_array_copy_loop (location_t loc, tree dst, tree src,
+ tree max_idx,
+ gimple_stmt_iterator *gsi);
+
extern GTY(()) vec<tree, va_gc> *offload_funcs;
extern GTY(()) vec<tree, va_gc> *offload_vars;
extern GTY(()) vec<tree, va_gc> *offload_ind_funcs;
extern void omp_finish_file (void);
extern void omp_discover_implicit_declare_target (void);
+extern void omp_ompacc_attribute_tagging (void);
#endif /* GCC_OMP_DEVICE_H */
diff --git a/gcc/opts.cc b/gcc/opts.cc
index ffcbdfe..9a71fc1 100644
--- a/gcc/opts.cc
+++ b/gcc/opts.cc
@@ -1494,6 +1494,14 @@ finish_options (struct gcc_options *opts, struct gcc_options *opts_set,
" %<-fstrict-flex-arrays%> is not present");
}
+ if (opts_set->x_flag_openmp_target)
+ {
+ if (opts->x_flag_openacc)
+ error ("%<-fopenacc%> not compatible with %<-fopenmp-target=%>");
+ if (!opts->x_flag_openmp)
+ error ("%<-fopenmp-target=%> requires %<-fopenmp%> setting");
+ }
+
diagnose_options (opts, opts_set, loc);
}
diff --git a/gcc/target-insns.def b/gcc/target-insns.def
index 59025a2..f717949 100644
--- a/gcc/target-insns.def
+++ b/gcc/target-insns.def
@@ -68,6 +68,11 @@ DEF_TARGET_INSN (oacc_dim_pos, (rtx x0, rtx x1))
DEF_TARGET_INSN (oacc_dim_size, (rtx x0, rtx x1))
DEF_TARGET_INSN (oacc_fork, (rtx x0, rtx x1, rtx x2))
DEF_TARGET_INSN (oacc_join, (rtx x0, rtx x1, rtx x2))
+DEF_TARGET_INSN (gomp_barrier, (void))
+DEF_TARGET_INSN (omp_get_thread_num, (rtx x0))
+DEF_TARGET_INSN (omp_get_num_threads, (rtx x0))
+DEF_TARGET_INSN (omp_get_team_num, (rtx x0))
+DEF_TARGET_INSN (omp_get_num_teams, (rtx x0))
DEF_TARGET_INSN (omp_simt_enter, (rtx x0, rtx x1, rtx x2))
DEF_TARGET_INSN (omp_simt_exit, (rtx x0))
DEF_TARGET_INSN (omp_simt_lane, (rtx x0))
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
new file mode 100644
index 0000000..a2bb7f0
--- /dev/null
+++ b/gcc/testsuite/ChangeLog.omp
@@ -0,0 +1,435 @@
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ * c-c++-common/gomp/adjust-args-10.c: Ignore the new sorry since the
+ lack of proper diagnostic is already xfail'ed.
+ * g++.dg/gomp/adjust-args-1.C: Adjust output patterns.
+ * g++.dg/gomp/adjust-args-17.C: New.
+ * gcc.dg/gomp/adjust-args-3.c: New.
+ * gfortran.dg/gomp/adjust-args-14.f90: Don't expect this to fail now.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+
+ PR c++/119659
+ PR c++/118859
+ PR c++/119601
+ PR c++/119602
+ PR c++/119775
+ * c-c++-common/gomp/pr118579.c: Change error text.
+ * g++.dg/gomp/adjust-args-1.C: Fix error text, add dg-* directives.
+ * g++.dg/gomp/adjust-args-2.C: Add dg-* directives.
+ * g++.dg/gomp/append-args-1.C: Add dg-* directives.
+ * gcc.dg/gomp/adjust-args-1.c: Fix error text, add dg-* directives.
+ * gcc.dg/gomp/append-args-1.c: Fix error text, add dg-* directives.
+ * c-c++-common/gomp/adjust-args-7.c: New test.
+ * c-c++-common/gomp/adjust-args-8.c: New test.
+ * c-c++-common/gomp/adjust-args-9.c: New test.
+ * c-c++-common/gomp/adjust-args-10.c: New test.
+ * c-c++-common/gomp/adjust-args-11.c: New test.
+ * c-c++-common/gomp/adjust-args-12.c: New test.
+ * c-c++-common/gomp/adjust-args-13.c: New test.
+ * c-c++-common/gomp/adjust-args-14.c: New test.
+ * c-c++-common/gomp/adjust-args-15.c: New test.
+ * g++.dg/gomp/adjust-args-5.C: New test.
+ * g++.dg/gomp/adjust-args-6.C: New test.
+ * g++.dg/gomp/adjust-args-7.C: New test.
+ * g++.dg/gomp/adjust-args-8.C: New test.
+ * g++.dg/gomp/adjust-args-9.C: New test.
+ * g++.dg/gomp/adjust-args-10.C: New test.
+ * g++.dg/gomp/adjust-args-11.C: New test.
+ * g++.dg/gomp/adjust-args-12.C: New test.
+ * g++.dg/gomp/adjust-args-13.C: New test.
+ * g++.dg/gomp/adjust-args-14.C: New test.
+ * g++.dg/gomp/adjust-args-15.C: New test.
+ * g++.dg/gomp/adjust-args-16.C: New test.
+ * g++.dg/gomp/append-args-9.C: New test.
+ * g++.dg/gomp/append-args-10.C: New test.
+ * g++.dg/gomp/append-args-11.C: New test.
+ * g++.dg/gomp/append-args-omp-interop-t.h: New header.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * c-c++-common/gomp/target-map-iterators-3.c: Update expected Gimple
+ output.
+ * c-c++-common/gomp/target-map-iterators-5.c: New.
+ * c-c++-common/gomp/target-update-iterators-3.c: Update expected
+ Gimple output.
+ * gfortran.dg/gomp/target-map-iterators-3.f90: Likewise.
+ * gfortran.dg/gomp/target-map-iterators-5.f90: New.
+ * gfortran.dg/gomp/target-update-iterators-3.f90: Update expected
+ Gimple output.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * gfortran.dg/gomp/target-update-iterators-1.f90: New.
+ * gfortran.dg/gomp/target-update-iterators-2.f90: New.
+ * gfortran.dg/gomp/target-update-iterators-3.f90: New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * gfortran.dg/gomp/target-map-iterators-1.f90: New.
+ * gfortran.dg/gomp/target-map-iterators-2.f90: New.
+ * gfortran.dg/gomp/target-map-iterators-3.f90: New.
+ * gfortran.dg/gomp/target-map-iterators-4.f90: New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gfortran.dg/gomp/target-enter-exit-data.f90: Revert expected tree
+ dumps.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * c-c++-common/gomp/target-update-iterators-1.c: New.
+ * c-c++-common/gomp/target-update-iterators-2.c: New.
+ * c-c++-common/gomp/target-update-iterators-3.c: New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * c-c++-common/gomp/map-6.c (foo): Amend expected error message.
+ * c-c++-common/gomp/target-map-iterators-1.c: New.
+ * c-c++-common/gomp/target-map-iterators-2.c: New.
+ * c-c++-common/gomp/target-map-iterators-3.c: New.
+ * c-c++-common/gomp/target-map-iterators-4.c: New.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-c++-common/cpp/openacc-define-3.c: Adjust test.
+ * gfortran.dg/openacc-define-3.f90: Adjust test.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * c-c++-common/goacc/readonly-2.c: Adjust test.
+ * c-c++-common/goacc/reduction-9.c: Adjust test.
+ * c-c++-common/goacc/reduction-11.c: New test.
+ * c-c++-common/goacc/reduction-12.c: New test.
+ * c-c++-common/goacc/reduction-13.c: New test.
+ * c-c++-common/goacc/reduction-14.c: New test.
+ * c-c++-common/goacc/reduction-15.c: New test.
+ * c-c++-common/goacc/reduction-16.c: New test.
+ * g++.dg/goacc/reductions-1.C: Adjust test.
+ * gfortran.dg/goacc/array-reduction.f90: Adjust test.
+ * gfortran.dg/goacc/enter-exit-data-2.f90: Adjust test.
+ * gfortran.dg/goacc/finalize-1.f: Adjust test.
+ * gfortran.dg/goacc/kernels-decompose-1.f95: Adjust test.
+ * gfortran.dg/goacc/pr70828.f90: Adjust test.
+ * gfortran.dg/goacc/reduction.f95: Adjust test.
+ * gfortran.dg/gomp/target-enter-exit-data.f90: Adjust test.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-c++-common/gomp/delim-declare-variant-1.c: New.
+ * c-c++-common/gomp/delim-declare-variant-2.c: New.
+ * c-c++-common/gomp/delim-declare-variant-3.c: New.
+ * c-c++-common/gomp/delim-declare-variant-4.c: New.
+ * c-c++-common/gomp/delim-declare-variant-5.c: New.
+ * c-c++-common/gomp/delim-declare-variant-6.c: New.
+ * c-c++-common/gomp/delim-declare-variant-7.c: New.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Julian Brown <julian@codesourcery.com>
+ waffl3x <waffl3x@baylibre.com>
+
+ * g++.dg/gomp/delim-declare-variant-1.C: New.
+ * g++.dg/gomp/delim-declare-variant-2.C: New.
+ * g++.dg/gomp/delim-declare-variant-3.C: New.
+ * g++.dg/gomp/delim-declare-variant-4.C: New.
+ * g++.dg/gomp/delim-declare-variant-5.C: New.
+ * g++.dg/gomp/delim-declare-variant-6.C: New.
+ * g++.dg/gomp/delim-declare-variant-7.C: New.
+ * g++.dg/gomp/delim-declare-variant-40.C: New.
+ * g++.dg/gomp/delim-declare-variant-41.C: New.
+ * g++.dg/gomp/delim-declare-variant-50.C: New.
+ * g++.dg/gomp/delim-declare-variant-51.C: New.
+ * g++.dg/gomp/delim-declare-variant-52.C: New.
+ * g++.dg/gomp/delim-declare-variant-70.C: New.
+ * g++.dg/gomp/delim-declare-variant-71.C: New.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * c-c++-common/goacc/readonly-1.c: Adjust testcase.
+ * c-c++-common/goacc/readonly-2.c: New testcase.
+ * gfortran.dg/goacc/readonly-1.f90: Adjust testcase.
+ * gfortran.dg/pr67170.f90: Likewise.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-c++-common/gomp/uses_allocators-1.c: Adjust for this testcase
+ no longer failing with "sorry" in C++.
+ * g++.dg/gomp/allocate-15.C: Disable scan-assembler tests since
+ compilation fails with "sorry" before getting that far.
+ * g++.dg/gomp/allocate-16.C: Likewise.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+ Tobias Burnus <tobias@codesourcery.com>
+
+ * c-c++-common/gomp/allocate-allocator-handle.h: New header.
+ * c-c++-common/gomp/allocate-5.c: Remove dg-messages for 'sorry',
+ add dg-error for c++.
+ * c-c++-common/gomp/allocate-9.c: Include header, remove dg-messages
+ for 'sorry', add dg-notes for c++, minor refactoring.
+ * c-c++-common/gomp/allocate-10.c: Enable for c++.
+ * c-c++-common/gomp/allocate-11.c: Enable for c++, disable warning.
+ * c-c++-common/gomp/allocate-12.c: Enable for c++, add cases.
+ * c-c++-common/gomp/allocate-14.c: Enable for c++.
+ * c-c++-common/gomp/allocate-15.c: Enable for c++.
+ * c-c++-common/gomp/allocate-16.c: Enable for c++.
+ * c-c++-common/gomp/allocate-17.c: Remove dg-message for 'sorry'.
+ * c-c++-common/gomp/allocate-18.c: Include header, remove dg-message
+ for 'sorry'.
+ * c-c++-common/gomp/allocate-19.c: Remove xfails for c++, remove
+ dg-messages for 'sorry'.
+ * c-c++-common/gomp/allocate-20.c: New test.
+ * c-c++-common/gomp/directive-1.c: Remove dg-message for 'sorry'.
+ * g++.dg/gomp/allocate-allocator-handle.h: New header.
+ * g++.dg/gomp/allocate-5.C: New test.
+ * g++.dg/gomp/allocate-6.C: New test.
+ * g++.dg/gomp/allocate-7.C: New test.
+ * g++.dg/gomp/allocate-8.C: New test.
+ * g++.dg/gomp/allocate-9.C: New test.
+ * g++.dg/gomp/allocate-10.C: New test.
+ * g++.dg/gomp/allocate-11.C: New test.
+ * g++.dg/gomp/allocate-12.C: New test.
+ * g++.dg/gomp/allocate-13.C: New test.
+ * g++.dg/gomp/allocate-14.C: New test.
+ * g++.dg/gomp/allocate-15.C: New test.
+ * g++.dg/gomp/allocate-16.C: New test.
+ * g++.dg/gomp/allocate-17.C: New test.
+ * g++.dg/gomp/allocate-18.C: New test.
+ * g++.dg/gomp/allocate-19.C: New test.
+ * g++.dg/gomp/allocate-20.C: New test.
+ * g++.dg/gomp/allocate-21.C: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Andrew Stubbs <ams@baylibre.com>
+ Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-c++-common/gomp/declare-mapper-17.c: New test.
+ * c-c++-common/gomp/declare-mapper-19.c: New test.
+ * 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.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * gfortran.dg/gomp/noncontig-updates-1.f90: New test.
+ * gfortran.dg/gomp/noncontig-updates-2.f90: New test.
+ * gfortran.dg/gomp/noncontig-updates-3.f90: New test.
+ * gfortran.dg/gomp/noncontig-updates-4.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gcc.dg/gomp/bad-array-shaping-c-1.c: New test.
+ * gcc.dg/gomp/bad-array-shaping-c-2.c: New test.
+ * gcc.dg/gomp/bad-array-shaping-c-3.c: New test.
+ * gcc.dg/gomp/bad-array-shaping-c-4.c: New test.
+ * gcc.dg/gomp/bad-array-shaping-c-5.c: New test.
+ * gcc.dg/gomp/bad-array-shaping-c-6.c: New test.
+ * gcc.dg/gomp/bad-array-shaping-c-7.c: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * g++.dg/gomp/array-shaping-1.C: New test.
+ * g++.dg/gomp/array-shaping-2.C: New test.
+ * g++.dg/gomp/bad-array-shaping-1.C: New test.
+ * g++.dg/gomp/bad-array-shaping-2.C: New test.
+ * g++.dg/gomp/bad-array-shaping-3.C: New test.
+ * g++.dg/gomp/bad-array-shaping-4.C: New test.
+ * g++.dg/gomp/bad-array-shaping-5.C: New test.
+ * g++.dg/gomp/bad-array-shaping-6.C: New test.
+ * g++.dg/gomp/bad-array-shaping-7.C: New test.
+ * g++.dg/gomp/bad-array-shaping-8.C: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gfortran.dg/gomp/declare-mapper-31.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gfortran.dg/gomp/declare-mapper-26.f90: New test.
+ * gfortran.dg/gomp/declare-mapper-29.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-c++-common/gomp/declare-mapper-15.c: New test.
+ * c-c++-common/gomp/declare-mapper-16.c: New test.
+ * g++.dg/gomp/declare-mapper-1.C: Adjust expected scan output.
+ * gfortran.dg/gomp/declare-mapper-22.f90: New test.
+ * gfortran.dg/gomp/declare-mapper-23.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gfortran.dg/gomp/declare-mapper-1.f90: New test.
+ * gfortran.dg/gomp/declare-mapper-5.f90: New test.
+ * gfortran.dg/gomp/declare-mapper-14.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-c++-common/gomp/declare-mapper-3.c: Enable for C.
+ * c-c++-common/gomp/declare-mapper-4.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-5.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-6.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-7.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-8.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-9.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-12.c: Enable for C.
+ * gcc.dg/gomp/declare-mapper-10.c: New test.
+ * gcc.dg/gomp/declare-mapper-11.c: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-c++-common/gomp/map-6.c: Update error scan output.
+ * c-c++-common/gomp/declare-mapper-3.c: New test (only enabled for C++
+ for now).
+ * c-c++-common/gomp/declare-mapper-4.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-5.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-6.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-7.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-8.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-9.c: Likewise.
+ * c-c++-common/gomp/declare-mapper-12.c: Likewise.
+ * g++.dg/gomp/declare-mapper-1.C: New test.
+ * g++.dg/gomp/declare-mapper-2.C: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-c++-common/goacc/combined-reduction.c: Adjust scan output.
+ * c-c++-common/goacc/implied-copy-1.c: Likewise.
+ * c-c++-common/goacc/reduction-1.c: Adjust patterns.
+ * c-c++-common/goacc/reduction-2.c: Likewise.
+ * c-c++-common/goacc/reduction-3.c: Likewise.
+ * c-c++-common/goacc/reduction-4.c: Likewise.
+ * c-c++-common/goacc/reduction-10.c: Likewise.
+ * gfortran.dg/goacc/common-block-3.f90: Likewise.
+ * gfortran.dg/goacc/implied-copy-1.f90: Likewise.
+ * gfortran.dg/goacc/loop-tree-1.f90: Likewise.
+ * gfortran.dg/goacc/private-explicit-kernels-1.f95: Likewise.
+ * gfortran.dg/goacc/private-predetermined-kernels-1.f95: Likewise.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gfortran.dg/goacc/assumed-size.f90: Don't expect error.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+ Sandra Loosemore <sandra@baylibre.com>
+
+ * c-c++-common/goacc/readonly-1.c: Adjust patterns.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * c-c++-common/goacc/acc-data-chain.c: New test.
+ * gfortran.dg/goacc/pr70828.f90: Likewise.
+ * gfortran.dg/goacc/assumed-size.f90: Likewise.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * gfortran.dg/gomp/allocate-1.f90: Add uses_allocators.
+ * gfortran.dg/gomp/scope-6.f90: Update dg-scan-tree-dump.
+ * c-c++-common/gomp/uses_allocators-1.c: New test.
+ * c-c++-common/gomp/uses_allocators-2.c: New test.
+ * gfortran.dg/gomp/uses_allocators-1.f90: New test.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * c-c++-common/goacc/kernels-decompose-pr103836-1-2.c: Adjust xfails.
+ * c-c++-common/goacc/kernels-decompose-pr103836-1-3.c: Likewise.
+ * c-c++-common/goacc/kernels-decompose-pr103836-1-4.c: Likewise.
+ * c-c++-common/goacc/kernels-decompose-pr104061-1-2.c: Likewise.
+ * c-c++-common/goacc/kernels-decompose-pr104061-1-3.c: Likewise.
+ * c-c++-common/goacc/kernels-decompose-pr104061-1-4.c: Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * c-c++-common/gomp/clauses-2.c: Adjust testcase.
+ * c-c++-common/gomp/map-6.c: Adjust testcase.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <thomas@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * gfortran.dg/goacc/declare-allocatable-1.f90: New test.
+ * gfortran.dg/goacc/declare-3.f95: Adjust expected dump output.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Sandra Loosemore <sandra@baylibre.com>
+
+ * gfortran.dg/goacc/privatization-1-compute-loop.f90: Add xfails.
+ * gfortran.dg/goacc/privatization-1-compute.f90: Likewise.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * gfortran.dg/goacc/modules.f95: Remove xfail on bogus warnings.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Chung-Lin Tang <cltang@codesourcery.com>
+
+ * c-c++-common/goacc/reduction-10.c: New test.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+
+ * c-c++-common/goacc/loop-auto-1.c: Adjust test case to conform to
+ the new behavior of the auto clause in OpenACC 2.5.
+ * c-c++-common/goacc/loop-auto-2.c: Likewise.
+ * gcc.dg/goacc/loop-processing-1.c: Likewise.
+ * c-c++-common/goacc/loop-auto-3.c: New test.
+ * gfortran.dg/goacc/loop-auto-1.f90: New test.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ James Norris <jnorris@codesourcery.com>
+ Tom de Vries <tom@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ * g++.dg/goacc/loop-1.c: New test.
+ * g++.dg/goacc/loop-2.c: New test.
+ * g++.dg/goacc/loop-3.c: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+ Nathan Sidwell <nathan@acm.org>
+
+ * c-c++-common/goacc/reduction-9.c: New.
+ * g++.dg/goacc/reductions-1.C: New.
+ * gcc.dg/goacc/loop-processing-1.c: Update.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ James Norris <jnorris@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+
+ * c-c++-common/goacc/deviceptr-4.c: Update.
+ * gfortran.dg/goacc/loop-2-kernels-tile.f95: Update.
+ * gfortran.dg/goacc/loop-2-parallel-tile.f95: Update.
+ * gfortran.dg/goacc/loop-2-serial-tile.f95: Update.
+ * gfortran.dg/goacc/sie.f95: Update.
+ * gfortran.dg/goacc/tile-1.f90: Update.
+ * gfortran.dg/gomp/num-teams-2.f90: Update.
+ * gfortran.dg/gomp/pr67500.f90: Update.
+ * gfortran.dg/gomp/pr77516.f90: Update.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ PR other/76739
+ * c-c++-common/goacc/data-clause-1.c (foo): Remove expected message.
+ * c-c++-common/goacc/noncontig_array-1.c: New test.
+ * g++.dg/goacc/data-clause-1.C (foo): Remove expected message. \ No newline at end of file
diff --git a/gcc/testsuite/c-c++-common/cpp/openacc-define-3.c b/gcc/testsuite/c-c++-common/cpp/openacc-define-3.c
index f2122f5..51f0c69 100644
--- a/gcc/testsuite/c-c++-common/cpp/openacc-define-3.c
+++ b/gcc/testsuite/c-c++-common/cpp/openacc-define-3.c
@@ -6,6 +6,6 @@
# error _OPENACC not defined
#endif
-#if _OPENACC != 201711
+#if _OPENACC != 201811
# error _OPENACC defined to wrong value
#endif
diff --git a/gcc/testsuite/c-c++-common/goacc/acc-data-chain.c b/gcc/testsuite/c-c++-common/goacc/acc-data-chain.c
new file mode 100644
index 0000000..622f199
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/acc-data-chain.c
@@ -0,0 +1,24 @@
+/* Ensure that the gimplifier does not remove any existing clauses as
+ it inserts new implicit data clauses. */
+
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+static int a[N], b[N];
+
+int main(int argc, char *argv[])
+{
+ int i;
+
+#pragma acc data copyin(a[0:N]) copyout (b[0:N])
+ {
+#pragma acc parallel loop
+ for (i = 0; i < N; i++)
+ b[i] = a[i];
+ }
+
+ return 0;
+}
+
+// { dg-final { scan-tree-dump-times "omp target oacc_data map\\(from:b\\\[0\\\] \\\[len: 400\\\]\\) map\\(to:a\\\[0\\\] \\\[len: 400\\\]\\)" 1 "gimple" } }
+// { dg-final { scan-tree-dump-times "omp target oacc_parallel map\\(force_present:b\\\[0\\\] \\\[len: 400\\\]\\) map\\(firstprivate:b \\\[pointer assign, bias: 0\\\]\\) map\\(force_present:a\\\[0\\\] \\\[len: 400\\\]\\) map\\(firstprivate:a \\\[pointer assign, bias: 0\\\]\\)" 1 "gimple" } }
diff --git a/gcc/testsuite/c-c++-common/goacc/combined-reduction.c b/gcc/testsuite/c-c++-common/goacc/combined-reduction.c
index 0a54140..75fef98 100644
--- a/gcc/testsuite/c-c++-common/goacc/combined-reduction.c
+++ b/gcc/testsuite/c-c++-common/goacc/combined-reduction.c
@@ -33,7 +33,7 @@ main ()
/* { dg-final { scan-tree-dump-times "omp target oacc_parallel reduction.+:v1. map.tofrom:v1" 1 "gimple" } } */
/* { dg-final { scan-tree-dump-times "acc loop reduction.+:v1. private.i." 1 "gimple" } } */
-/* { dg-final { scan-tree-dump-times "omp target oacc_kernels map.force_tofrom:n .len: 4.. map.force_tofrom:v1 .len: 4.." 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "omp target oacc_kernels map.force_tofrom:n .len: 4. .runtime_implicit.. map.force_tofrom:v1 .len: 4. .runtime_implicit.." 1 "gimple" } } */
/* { dg-final { scan-tree-dump-times "acc loop reduction.+:v1. private.i." 1 "gimple" } } */
/* { dg-final { scan-tree-dump-times "omp target oacc_serial reduction.+:v1. map.tofrom:v1" 1 "gimple" } } */
/* { dg-final { scan-tree-dump-times "acc loop reduction.+:v1. private.i." 1 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/data-clause-1.c b/gcc/testsuite/c-c++-common/goacc/data-clause-1.c
index 9952ac4..b78f691 100644
--- a/gcc/testsuite/c-c++-common/goacc/data-clause-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/data-clause-1.c
@@ -98,7 +98,7 @@ foo (int g[3][10], int h[4][8], int i[2][10], int j[][9],
bar (&j2[0][0]);
#pragma acc parallel copy(q[1:2])
;
- #pragma acc parallel copy(q[3:5][:10]) /* { dg-error "array section is not contiguous" } */
+ #pragma acc parallel copy(q[3:5][:10])
;
#pragma acc parallel copy(r[3:][2:1][1:2])
;
diff --git a/gcc/testsuite/c-c++-common/goacc/deviceptr-4.c b/gcc/testsuite/c-c++-common/goacc/deviceptr-4.c
index db1b916..79a5162 100644
--- a/gcc/testsuite/c-c++-common/goacc/deviceptr-4.c
+++ b/gcc/testsuite/c-c++-common/goacc/deviceptr-4.c
@@ -8,4 +8,4 @@ subr (int *a)
a[0] += 1.0;
}
-/* { dg-final { scan-tree-dump-times "#pragma omp target oacc_parallel.*map\\(tofrom:a" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp target oacc_parallel.*map\\(force_deviceptr:a" 1 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/implied-copy-1.c b/gcc/testsuite/c-c++-common/goacc/implied-copy-1.c
index ae06339..34ce9b0 100644
--- a/gcc/testsuite/c-c++-common/goacc/implied-copy-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/implied-copy-1.c
@@ -27,7 +27,7 @@ void test1 (void)
}
}
-/* { dg-final { scan-tree-dump-times "map\\(force_tofrom:sum \\\[len: \[0-9\]+\\\]\\)" 1 "gimple" } } */
-/* { dg-final { scan-tree-dump-times "map\\(force_tofrom:prod \\\[len: \[0-9\]+\\\]\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(force_tofrom:sum \\\[len: \[0-9\]+\\\].*\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(force_tofrom:prod \\\[len: \[0-9\]+\\\].*\\)" 1 "gimple" } } */
/* { dg-final { scan-tree-dump-times "map\\(tofrom:sum \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } } */
/* { dg-final { scan-tree-dump-times "map\\(tofrom:prod \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-2.c b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-2.c
index 83690b6..a3afb79 100644
--- a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-2.c
+++ b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-2.c
@@ -16,7 +16,7 @@ f_acc_kernels (void)
#pragma acc kernels /* { dg-line l_compute1 } */
/* { dg-note {variable 'i\.0' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { xfail c++ } l_compute1 } */
{
- /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c++ } .-1 } */
+ /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target *-*-* } .-1 } */
/* { dg-note {forwarded loop nest in OpenACC 'kernels' region to 'parloops' for analysis} {} { target *-*-* } .+1 } */
#pragma acc loop /* { dg-line l_loop_i1 } */
diff --git a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-3.c b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-3.c
index 35892a0..8cbf69f 100644
--- a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-3.c
+++ b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-3.c
@@ -1,7 +1,7 @@
/* { dg-additional-options "--param openacc-kernels=decompose" } */
/* { dg-additional-options "-fcompare-debug" } -- w/o debug compiled first.
- { dg-bogus {error: [^\n\r]+: '-fcompare-debug' failure \(length\)} TODO { xfail c++ } 0 } */
+ { dg-bogus {error: [^\n\r]+: '-fcompare-debug' failure \(length\)} "" { target *-*-* } 0 } */
/* { dg-additional-options "-O1" } so that we may get some 'GIMPLE_DEBUG's. */
/* { dg-additional-options "-fopt-info-all-omp" } */
@@ -17,7 +17,7 @@ f_acc_kernels (void)
#pragma acc kernels /* { dg-line l_compute1 } */
/* { dg-note {variable 'i\.0' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l_compute1 } */
{
- /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c++ } .-1 } */
+ /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target *-*-* } .-1 } */
/* { dg-note {forwarded loop nest in OpenACC 'kernels' region to 'parloops' for analysis} {} { target *-*-* } .+1 } */
#pragma acc loop /* { dg-line l_loop_i1 } */
diff --git a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-4.c b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-4.c
index 549ad5d..507e73c 100644
--- a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-4.c
+++ b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr103836-1-4.c
@@ -1,7 +1,7 @@
/* { dg-additional-options "--param openacc-kernels=decompose" } */
/* { dg-additional-options "-g -fcompare-debug" } -- w/ debug compiled first.
- { dg-bogus {error: [^\n\r]+: '-fcompare-debug' failure \(length\)} TODO { xfail c++ } 0 } */
+ { dg-bogus {error: [^\n\r]+: '-fcompare-debug' failure \(length\)} "" { target *-*-* } 0 } */
/* { dg-additional-options "-O1" } so that we may get some 'GIMPLE_DEBUG's. */
/* { dg-additional-options "-fopt-info-all-omp" } */
@@ -17,7 +17,7 @@ f_acc_kernels (void)
#pragma acc kernels /* { dg-line l_compute1 } */
/* { dg-note {variable 'i\.0' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l_compute1 } */
{
- /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c++ } .-1 } */
+ /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target *-*-* } .-1 } */
/* { dg-note {forwarded loop nest in OpenACC 'kernels' region to 'parloops' for analysis} {} { target *-*-* } .+1 } */
#pragma acc loop /* { dg-line l_loop_i1 } */
diff --git a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-2.c b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-2.c
index 4d7cbb0..6865a5c 100644
--- a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-2.c
+++ b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-2.c
@@ -14,23 +14,23 @@ int arr_0;
void
foo (void)
{
- /* { dg-bogus {sorry, unimplemented: 'gimple_debug' not yet supported} TODO { xfail *-*-* } .+1 } */
+ /* { dg-bogus {sorry, unimplemented: 'gimple_debug' not yet supported} TODO { xfail c++ } .+1 } */
#pragma acc kernels /* { dg-line l_compute1 } */
/* { dg-note {OpenACC 'kernels' decomposition: variable 'arr_0' in 'copy' clause requested to be made addressable} {} { target *-*-* } l_compute1 }
{ dg-note {variable 'arr_0' made addressable} {} { target *-*-* } l_compute1 } */
- /* { dg-bogus {note: OpenACC 'kernels' decomposition: variable 'k' declared in block requested to be made addressable} {w/ debug} { xfail *-*-* } l_compute1 } */
- /* { dg-bogus {note: variable 'k' made addressable} {w/ debug} { xfail *-*-* } l_compute1 } */
- /* { dg-note {variable 'arr_0\.0' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { xfail *-*-* } l_compute1 } */
+ /* { dg-bogus {note: OpenACC 'kernels' decomposition: variable 'k' declared in block requested to be made addressable} {w/ debug} { target *-*-* } l_compute1 } */
+ /* { dg-bogus {note: variable 'k' made addressable} {w/ debug} { target *-*-* } l_compute1 } */
+ /* { dg-note {variable 'arr_0\.0' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { xfail c++ } l_compute1 } */
{
- /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c++ } .-1 }
- { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c } .+1 } */
+ /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target c++ } .-1 }
+ { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target c } .+1 } */
int k;
/* { dg-note {forwarded loop nest in OpenACC 'kernels' region to 'parloops' for analysis} {} { target *-*-* } .+1 } */
#pragma acc loop /* { dg-line l_loop_k1 } */
- /* { dg-note {variable 'k' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { xfail *-*-* } l_loop_k1 } */
- /* { dg-note {variable 'k' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { xfail *-*-* } l_loop_k1 } */
- /* { dg-optimized {assigned OpenACC seq loop parallelism} {} { xfail *-*-* } l_loop_k1 } */
+ /* { dg-note {variable 'k' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { xfail c++} l_loop_k1 } */
+ /* { dg-note {variable 'k' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { xfail c++ } l_loop_k1 } */
+ /* { dg-optimized {assigned OpenACC seq loop parallelism} {} { xfail c++ } l_loop_k1 } */
for (k = 0; k < 2; k++)
arr_0 += k;
}
diff --git a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-3.c b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-3.c
index 70c2ac5..197cee3 100644
--- a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-3.c
+++ b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-3.c
@@ -1,7 +1,7 @@
/* { dg-additional-options "--param openacc-kernels=decompose" } */
/* { dg-additional-options "-fcompare-debug" } -- w/o debug compiled first.
- { dg-bogus {error: [^\n\r]+: '-fcompare-debug' failure \(length\)} TODO { xfail *-*-* } 0 } */
+ { dg-bogus {error: [^\n\r]+: '-fcompare-debug' failure \(length\)} "" { target *-*-* } 0 } */
/* { dg-additional-options "-O1" } so that we may get some 'GIMPLE_DEBUG's. */
/* { dg-additional-options "-fopt-info-all-omp" } */
@@ -19,13 +19,13 @@ foo (void)
#pragma acc kernels /* { dg-line l_compute1 } */
/* { dg-note {OpenACC 'kernels' decomposition: variable 'arr_0' in 'copy' clause requested to be made addressable} {} { target *-*-* } l_compute1 }
{ dg-note {variable 'arr_0' made addressable} {} { target *-*-* } l_compute1 } */
- /* { dg-bogus {note: OpenACC 'kernels' decomposition: variable 'k' declared in block requested to be made addressable} {w/ debug} { xfail *-*-* } l_compute1 } */
- /* { dg-bogus {note: variable 'k' made addressable} {w/ debug} { xfail *-*-* } l_compute1 } */
- /* { dg-bogus {note: variable 'k' declared in block is candidate for adjusting OpenACC privatization level} {w/ debug} { xfail *-*-* } l_compute1 } */
+ /* { dg-bogus {note: OpenACC 'kernels' decomposition: variable 'k' declared in block requested to be made addressable} {w/ debug} { target *-*-* } l_compute1 } */
+ /* { dg-bogus {note: variable 'k' made addressable} {w/ debug} { target *-*-* } l_compute1 } */
+ /* { dg-bogus {note: variable 'k' declared in block is candidate for adjusting OpenACC privatization level} {w/ debug} { target *-*-* } l_compute1 } */
/* { dg-note {variable 'arr_0\.0' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l_compute1 } */
{
- /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c++ } .-1 }
- { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c } .+1 } */
+ /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target c++ } .-1 }
+ { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target c } .+1 } */
int k;
/* { dg-note {forwarded loop nest in OpenACC 'kernels' region to 'parloops' for analysis} {} { target *-*-* } .+1 } */
diff --git a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-4.c b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-4.c
index d1cc1a9..f82c1c7 100644
--- a/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-4.c
+++ b/gcc/testsuite/c-c++-common/goacc/kernels-decompose-pr104061-1-4.c
@@ -1,7 +1,7 @@
/* { dg-additional-options "--param openacc-kernels=decompose" } */
/* { dg-additional-options "-g -fcompare-debug" } -- w/ debug compiled first.
- { dg-bogus {error: [^\n\r]+: '-fcompare-debug' failure \(length\)} TODO { xfail *-*-* } 0 } */
+ { dg-bogus {error: [^\n\r]+: '-fcompare-debug' failure \(length\)} "" { target *-*-* } 0 } */
/* { dg-additional-options "-O1" } so that we may get some 'GIMPLE_DEBUG's. */
/* { dg-additional-options "-fopt-info-all-omp" } */
@@ -19,13 +19,13 @@ foo (void)
#pragma acc kernels /* { dg-line l_compute1 } */
/* { dg-note {OpenACC 'kernels' decomposition: variable 'arr_0' in 'copy' clause requested to be made addressable} {} { target *-*-* } l_compute1 }
{ dg-note {variable 'arr_0' made addressable} {} { target *-*-* } l_compute1 } */
- /* { dg-bogus {note: OpenACC 'kernels' decomposition: variable 'k' declared in block requested to be made addressable} {w/ debug} { xfail *-*-* } l_compute1 } */
- /* { dg-bogus {note: variable 'k' made addressable} {w/ debug} { xfail *-*-* } l_compute1 } */
- /* { dg-bogus {note: variable 'k' declared in block is candidate for adjusting OpenACC privatization level} {w/ debug} { xfail *-*-* } l_compute1 } */
+ /* { dg-bogus {note: OpenACC 'kernels' decomposition: variable 'k' declared in block requested to be made addressable} {w/ debug} { target *-*-* } l_compute1 } */
+ /* { dg-bogus {note: variable 'k' made addressable} {w/ debug} { target *-*-* } l_compute1 } */
+ /* { dg-bogus {note: variable 'k' declared in block is candidate for adjusting OpenACC privatization level} {w/ debug} { target *-*-* } l_compute1 } */
/* { dg-note {variable 'arr_0\.0' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l_compute1 } */
{
- /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c++ } .-1 }
- { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { xfail c } .+1 } */
+ /* { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target c++ } .-1 }
+ { dg-bogus {note: beginning 'gang-single' part in OpenACC 'kernels' region} {w/ debug} { target c } .+1 } */
int k;
/* { dg-note {forwarded loop nest in OpenACC 'kernels' region to 'parloops' for analysis} {} { target *-*-* } .+1 } */
diff --git a/gcc/testsuite/c-c++-common/goacc/loop-auto-1.c b/gcc/testsuite/c-c++-common/goacc/loop-auto-1.c
index 124befc..dcad07f 100644
--- a/gcc/testsuite/c-c++-common/goacc/loop-auto-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/loop-auto-1.c
@@ -10,7 +10,7 @@ void Foo ()
#pragma acc loop seq
for (int jx = 0; jx < 10; jx++) {}
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++) {}
}
@@ -20,7 +20,7 @@ void Foo ()
#pragma acc loop auto
for (int jx = 0; jx < 10; jx++) {}
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++)
{
#pragma acc loop vector
@@ -51,7 +51,7 @@ void Foo ()
#pragma acc loop vector
for (int jx = 0; jx < 10; jx++)
{
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int kx = 0; kx < 10; kx++) {}
}
@@ -64,27 +64,27 @@ void Foo ()
}
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int ix = 0; ix < 10; ix++)
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int jx = 0; jx < 10; jx++)
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int kx = 0; kx < 10; kx++) {}
}
}
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int ix = 0; ix < 10; ix++)
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int jx = 0; jx < 10; jx++)
{
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int kx = 0; kx < 10; kx++)
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int lx = 0; lx < 10; lx++) {}
}
}
@@ -101,7 +101,7 @@ void Gang (void)
#pragma acc loop seq
for (int jx = 0; jx < 10; jx++) {}
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++) {}
}
@@ -111,7 +111,7 @@ void Gang (void)
#pragma acc loop auto
for (int jx = 0; jx < 10; jx++) {}
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++)
{
#pragma acc loop vector
@@ -142,7 +142,7 @@ void Gang (void)
#pragma acc loop vector
for (int jx = 0; jx < 10; jx++)
{
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int kx = 0; kx < 10; kx++) {}
}
@@ -176,7 +176,7 @@ void Worker (void)
#pragma acc loop seq
for (int jx = 0; jx < 10; jx++) {}
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++) {}
}
@@ -186,7 +186,7 @@ void Worker (void)
#pragma acc loop auto
for (int jx = 0; jx < 10; jx++) {}
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++)
{
#pragma acc loop vector
@@ -194,20 +194,20 @@ void Worker (void)
}
}
-#pragma acc loop auto
+#pragma acc loop
for (int ix = 0; ix < 10; ix++)
{
-#pragma acc loop auto
+#pragma acc loop
for (int jx = 0; jx < 10; jx++) {}
}
-#pragma acc loop auto
+#pragma acc loop
for (int ix = 0; ix < 10; ix++)
{
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++)
{
-#pragma acc loop auto
+#pragma acc loop
for (int kx = 0; kx < 10; kx++) {}
}
}
@@ -222,17 +222,17 @@ void Vector (void)
#pragma acc loop seq
for (int jx = 0; jx < 10; jx++) {}
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++) {}
}
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int ix = 0; ix < 10; ix++) {}
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int ix = 0; ix < 10; ix++)
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int jx = 0; jx < 10; jx++) {}
}
}
@@ -240,6 +240,6 @@ void Vector (void)
#pragma acc routine seq
void Seq (void)
{
-#pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int ix = 0; ix < 10; ix++) {}
}
diff --git a/gcc/testsuite/c-c++-common/goacc/loop-auto-2.c b/gcc/testsuite/c-c++-common/goacc/loop-auto-2.c
index af3f0bd..5aa36e9 100644
--- a/gcc/testsuite/c-c++-common/goacc/loop-auto-2.c
+++ b/gcc/testsuite/c-c++-common/goacc/loop-auto-2.c
@@ -72,12 +72,12 @@ void Bad ()
#pragma acc loop tile(*) gang vector
for (int ix = 0; ix < 10; ix++)
{
- #pragma acc loop auto /* { dg-warning "insufficient partitioning" } */
+ #pragma acc loop auto independent /* { dg-warning "insufficient partitioning" } */
for (int jx = 0; jx < 10; jx++)
;
}
-#pragma acc loop tile(*) auto /* { dg-warning "insufficient partitioning" } */
+#pragma acc loop tile(*) auto independent /* { dg-warning "insufficient partitioning" } */
for (int ix = 0; ix < 10; ix++)
{
#pragma acc loop worker
diff --git a/gcc/testsuite/c-c++-common/goacc/loop-auto-3.c b/gcc/testsuite/c-c++-common/goacc/loop-auto-3.c
new file mode 100644
index 0000000..8f79ead
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/loop-auto-3.c
@@ -0,0 +1,78 @@
+/* Ensure that the auto clause falls back to seq parallelism when the
+ OpenACC loop is not explicitly independent. */
+
+/* { dg-additional-options "-fopt-info-optimized-omp" } */
+
+void
+test ()
+{
+ int i, j, k, l, n = 100;
+
+#pragma acc parallel loop auto /* { dg-message "optimized: assigned OpenACC seq loop parallelism" } */
+ for (i = 0; i < n; i++)
+#pragma acc loop auto independent /* { dg-message "optimized: assigned OpenACC gang loop parallelism" } */
+ for (j = 0; j < n; j++)
+#pragma acc loop worker vector /* { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } */
+ for (k = 0; k < n; k++)
+ ;
+
+#pragma acc parallel loop auto independent /* { dg-message "optimized: assigned OpenACC gang worker loop parallelism" } */
+ for (i = 0; i < n; i++)
+#pragma acc loop auto /* { dg-message "optimized: assigned OpenACC seq loop parallelism" } */
+ for (j = 0; j < n; j++)
+#pragma acc loop auto /* { dg-message "optimized: assigned OpenACC seq loop parallelism" } */
+ for (k = 0; k < n; k++)
+#pragma acc loop auto independent /* { dg-message "optimized: assigned OpenACC vector loop parallelism" } */
+ for (l = 0; l < n; l++)
+ ;
+
+#pragma acc parallel loop gang /* { dg-message "optimized: assigned OpenACC gang loop parallelism" } */
+ for (i = 0; i < n; i++)
+#pragma acc loop worker /* { dg-message "optimized: assigned OpenACC worker loop parallelism" } */
+ for (j = 0; j < n; j++)
+#pragma acc loop vector /* { dg-message "optimized: assigned OpenACC vector loop parallelism" } */
+ for (k = 0; k < n; k++)
+ {
+#pragma acc loop auto independent /* { dg-message "optimized: assigned OpenACC seq loop parallelism" } */
+ /* { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } */
+ for (l = 0; l < n; l++)
+ ;
+#pragma acc loop auto /* { dg-message "optimized: assigned OpenACC seq loop parallelism" } */
+ for (l = 0; l < n; l++)
+ ;
+ }
+
+#pragma acc parallel loop /* { dg-message "optimized: assigned OpenACC seq loop parallelism" } */
+ /* { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } */
+ for (i = 0; i < n; i++)
+ {
+#pragma acc loop gang worker /* { dg-message "optimized: assigned OpenACC gang worker loop parallelism" } */
+ for (j = 0; j < n; j++)
+#pragma acc loop auto /* { dg-message "optimized: assigned OpenACC seq loop parallelism" } */
+ for (k = 0; k < n; k++)
+ {
+#pragma acc loop vector /* { dg-message "optimized: assigned OpenACC vector loop parallelism" } */
+ for (l = 0; l < n; l++)
+ ;
+#pragma acc loop auto independent /* { dg-message "optimized: assigned OpenACC vector loop parallelism" } */
+ for (l = 0; l < n; l++)
+ ;
+ }
+#pragma acc loop worker /* { dg-message "optimized: assigned OpenACC worker loop parallelism" } */
+ for (j = 0; j < n; j++)
+#pragma acc loop vector /* { dg-message "optimized: assigned OpenACC vector loop parallelism" } */
+ for (k = 0; k < n; k++)
+ ;
+ }
+
+#pragma acc parallel loop /* { dg-message "optimized: assigned OpenACC gang loop parallelism" } */
+ for (i = 0; i < n; i++)
+#pragma acc loop /* { dg-message "optimized: assigned OpenACC worker loop parallelism" } */
+ for (j = 0; j < n; j++)
+#pragma acc loop /* { dg-message "optimized: assigned OpenACC seq loop parallelism" } */
+ /* { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } */
+ for (k = 0; k < n; k++)
+#pragma acc loop /* { dg-message "optimized: assigned OpenACC vector loop parallelism" } */
+ for (l = 0; l < n; l++)
+ ;
+}
diff --git a/gcc/testsuite/c-c++-common/goacc/noncontig_array-1.c b/gcc/testsuite/c-c++-common/goacc/noncontig_array-1.c
new file mode 100644
index 0000000..fe7480a
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/noncontig_array-1.c
@@ -0,0 +1,26 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+void foo (void)
+{
+ int array_of_array[10][10];
+ int **ptr_to_ptr;
+ int *array_of_ptr[10];
+ int (*ptr_to_array)[10];
+
+ #pragma acc parallel copy (array_of_array[2:4][0:10])
+ array_of_array[5][5] = 1;
+
+ #pragma acc parallel copy (ptr_to_ptr[2:4][1:7])
+ ptr_to_ptr[5][5] = 1;
+
+ #pragma acc parallel copy (array_of_ptr[2:4][1:7])
+ array_of_ptr[5][5] = 1;
+
+ #pragma acc parallel copy (ptr_to_array[2:4][1:7]) /* { dg-error "array section is not contiguous in 'map' clause" } */
+ ptr_to_array[5][5] = 1;
+}
+/* { dg-final { scan-tree-dump-times {#pragma omp target oacc_parallel map\(tofrom:array_of_array} 1 gimple } } */
+/* { dg-final { scan-tree-dump-times {#pragma omp target oacc_parallel map\(tofrom,noncontig_array:ptr_to_ptr \[dimensions: 2 4, 1 7\]} 1 gimple } } */
+/* { dg-final { scan-tree-dump-times {#pragma omp target oacc_parallel map\(tofrom,noncontig_array:array_of_ptr \[dimensions: 2 4, 1 7\]} 1 gimple } } */
+/* { dg-final { scan-tree-dump-times {#pragma omp target oacc_parallel map\(tofrom,noncontig_array:ptr_to_array \[dimensions: 2 4, 1 7\]} 1 gimple { xfail *-*-* } } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/readonly-1.c b/gcc/testsuite/c-c++-common/goacc/readonly-1.c
index 300464c..aeb8e0e 100644
--- a/gcc/testsuite/c-c++-common/goacc/readonly-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/readonly-1.c
@@ -48,17 +48,17 @@ int main (void)
/* { dg-final { scan-tree-dump-times "(?n)#pragma acc declare map\\(to:y\\) map\\(readonly,to:s\\) map\\(readonly,to:x\\)" 1 "original" } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc parallel map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc kernels map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc serial map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc enter data map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc parallel map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,firstprivate:x \\\[pointer assign, bias: 0\\\]\\)" 1 "original" { target { c } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc kernels map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,firstprivate:x \\\[pointer assign, bias: 0\\\]\\)" 1 "original" { target { c } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc serial map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,firstprivate:x \\\[pointer assign, bias: 0\\\]\\)" 1 "original" { target { c } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc enter data map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*s.ptr \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc parallel map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c++ } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc kernels map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c++ } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc serial map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c++ } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c++ } } } } */
-/* { dg-final { scan-tree-dump-times "(?n)#pragma acc enter data map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c++ } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc parallel map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,firstprivate:x \\\[pointer assign, bias: 0\\\]\\)" 1 "original" { target { c++ } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc kernels map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,firstprivate:x \\\[pointer assign, bias: 0\\\]\\)" 1 "original" { target { c++ } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc serial map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,firstprivate:x \\\[pointer assign, bias: 0\\\]\\)" 1 "original" { target { c++ } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c++ } } } } */
+/* { dg-final { scan-tree-dump-times "(?n)#pragma acc enter data map\\(to:y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\) .+ map\\(readonly,to:\\*NON_LVALUE_EXPR <s.ptr> \\\[len: \[0-9\]+\\\]\\) map\\(pt_readonly,attach_detach:s.ptr \\\[bias: 0\\\]\\) map\\(readonly,to:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\)" 1 "original" { target { c++ } } } } */
/* { dg-final { scan-tree-dump-times "(?n)#pragma acc cache \\(readonly:x\\\[0\\\] \\\[len: \[0-9\]+\\\]\\);$" 4 "original" } } */
/* { dg-final { scan-tree-dump-times "(?n)#pragma acc cache \\(y\\\[0\\\] \\\[len: \[0-9\]+\\\]\\);$" 4 "original" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/readonly-2.c b/gcc/testsuite/c-c++-common/goacc/readonly-2.c
new file mode 100644
index 0000000..def81c2
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/readonly-2.c
@@ -0,0 +1,16 @@
+/* { dg-additional-options "-O -fdump-tree-phiprop -fdump-tree-fre" } */
+
+#pragma acc routine
+extern void foo (int *ptr, int val);
+
+int main (void)
+{
+ int r, a[32];
+ #pragma acc parallel copyin(readonly: a[:32]) copyout(r)
+ {
+ foo (a, a[8]);
+ r = a[8];
+ }
+}
+/* { dg-final { scan-tree-dump-times "r\.\[_0-9\]+ = \\(\\*_\[0-9\]+\\(ptro\\)\\)\\\[8\\\];" 2 "phiprop1" } } */
+/* { dg-final { scan-tree-dump-times "r\.\[_0-9\]+ = \\(\\*_\[0-9\]+\\(ptro\\)\\)\\\[8\\\];" 1 "fre1" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-1.c b/gcc/testsuite/c-c++-common/goacc/reduction-1.c
index 35bfc86..7f3e3e3 100644
--- a/gcc/testsuite/c-c++-common/goacc/reduction-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-1.c
@@ -68,5 +68,5 @@ main(void)
}
/* Check that default copy maps are generated for loop reductions. */
-/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\]\\)" 7 "gimple" } } */
-/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 7 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-10.c b/gcc/testsuite/c-c++-common/goacc/reduction-10.c
new file mode 100644
index 0000000..cd0d58f
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-10.c
@@ -0,0 +1,94 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define n 1000
+
+int
+main(void)
+{
+ int i, j;
+ int result, array[n];
+
+#pragma acc parallel loop reduction (+:result)
+ for (i = 0; i < n; i++)
+ result ++;
+
+#pragma acc parallel
+#pragma acc loop reduction (+:result)
+ for (i = 0; i < n; i++)
+ result ++;
+
+#pragma acc parallel
+#pragma acc loop
+ for (i = 0; i < n; i++)
+ {
+ result = i;
+
+#pragma acc loop reduction(+:result)
+ for (j = 0; j < n; j++)
+ result ++;
+
+ array[i] = result;
+ }
+
+#pragma acc parallel
+#pragma acc loop
+ for (i = 0; i < n; i++)
+ {
+ result = i;
+
+#pragma acc loop worker vector reduction(+:result)
+ for (j = 0; j < n; j++)
+ result ++;
+
+ array[i] = result;
+ }
+
+#pragma acc parallel
+#pragma acc loop // { dg-warning "insufficient partitioning" }
+ for (i = 0; i < n; i++)
+ {
+ result = i;
+
+#pragma acc loop gang reduction(+:result)
+ for (j = 0; j < n; j++)
+ result ++;
+
+ array[i] = result;
+ }
+
+#pragma acc parallel copy(result)
+#pragma acc loop // { dg-warning "insufficient partitioning" }
+ for (i = 0; i < n; i++)
+ {
+ result = i;
+
+#pragma acc loop gang reduction(+:result)
+ for (j = 0; j < n; j++)
+ result ++;
+
+ array[i] = result;
+ }
+
+#pragma acc kernels
+#pragma acc loop
+ for (i = 0; i < n; i++)
+ {
+ result = i;
+
+#pragma acc loop reduction(+:result)
+ for (j = 0; j < n; j++)
+ result ++;
+
+ array[i] = result;
+ }
+
+ return 0;
+}
+
+/* Check that default copy maps are generated for loop reductions. */
+/* { dg-final { scan-tree-dump-times "reduction..:result. map.tofrom:result .len: 4.." 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times {oacc_parallel map\(tofrom:result \[len: 4\]\)} 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "oacc_parallel map.tofrom:result .len: 4. .runtime_implicit.." 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map.tofrom:array .len: 4000. .runtime_implicit.. firstprivate.result." 3 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map.tofrom:result .len: 4.. map.tofrom:array .len: 4000. .runtime_implicit.." 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map.tofrom:array .len: 4000. .runtime_implicit.. map.force_tofrom:result .len: 4. .runtime_implicit.." 1 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-11.c b/gcc/testsuite/c-c++-common/goacc/reduction-11.c
new file mode 100644
index 0000000..29eb4b5
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-11.c
@@ -0,0 +1,81 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* Integer array reductions. */
+
+#define n 1000
+
+int
+main(void)
+{
+ int i, j;
+ int result[n], array[n];
+ int lresult[n];
+
+ /* '+' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (+:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] += array[i];
+
+ /* '*' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (*:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] *= array[i];
+
+ /* 'max' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (max:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] = result[j] > array[i] ? result[j] : array[i];
+
+ /* 'min' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (min:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] = result[j] < array[i] ? result[j] : array[i];
+
+ /* '&' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (&:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] &= array[i];
+
+ /* '|' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (|:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] |= array[i];
+
+ /* '^' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (^:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] ^= array[i];
+
+ /* '&&' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (&&:lresult)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ lresult[j] = lresult[j] && (result[j] > array[i]);
+
+ /* '||' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (||:lresult)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ lresult[j] = lresult[j] || (result[j] > array[i]);
+
+ return 0;
+}
+
+/* Check that default copy maps are generated for loop reductions. */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 9 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-12.c b/gcc/testsuite/c-c++-common/goacc/reduction-12.c
new file mode 100644
index 0000000..e9dcc1c
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-12.c
@@ -0,0 +1,60 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* float array reductions. */
+
+#define n 1000
+
+int
+main(void)
+{
+ int i, j;
+ float result[n], array[n];
+ int lresult[n];
+
+ /* '+' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (+:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] += array[i];
+
+ /* '*' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (*:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] *= array[i];
+
+ /* 'max' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (max:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] = result[j] > array[i] ? result[j] : array[i];
+
+ /* 'min' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (min:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] = result[j] < array[i] ? result[j] : array[i];
+
+ /* '&&' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (&&:lresult)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ lresult[j] = lresult[j] && (result[j] > array[i]);
+
+ /* '||' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (||:lresult)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ lresult[j] = lresult[j] || (result[j] > array[i]);
+
+ return 0;
+}
+
+/* Check that default copy maps are generated for loop reductions. */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 6 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-13.c b/gcc/testsuite/c-c++-common/goacc/reduction-13.c
new file mode 100644
index 0000000..8800b44
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-13.c
@@ -0,0 +1,60 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* double array reductions. */
+
+#define n 1000
+
+int
+main(void)
+{
+ int i, j;
+ double result[n], array[n];
+ int lresult[n];
+
+ /* '+' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (+:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] += array[i];
+
+ /* '*' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (*:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] *= array[i];
+
+ /* 'max' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (max:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] = result[j] > array[i] ? result[j] : array[i];
+
+ /* 'min' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (min:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] = result[j] < array[i] ? result[j] : array[i];
+
+ /* '&&' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (&&:lresult)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ lresult[j] = lresult[j] && (result[j] > array[i]);
+
+ /* '||' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (||:lresult)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ lresult[j] = lresult[j] || (result[j] > array[i]);
+
+ return 0;
+}
+
+/* Check that default copy maps are generated for loop reductions. */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 6 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-14.c b/gcc/testsuite/c-c++-common/goacc/reduction-14.c
new file mode 100644
index 0000000..48117a3
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-14.c
@@ -0,0 +1,46 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* complex array reductions. */
+
+#define n 1000
+
+int
+main(void)
+{
+ int i, j;
+ __complex__ double result[n], array[n];
+ int lresult[n];
+
+ /* '+' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (+:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] += array[i];
+
+ /* '*' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (*:result)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ result[j] *= array[i];
+
+ /* '&&' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (&&:lresult)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ lresult[j] = lresult[j] && (__real__(result[j]) > __real__(array[i]));
+
+ /* '||' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (||:lresult)
+ for (i = 0; i < n; i++)
+ for (j = 0; j < n; j++)
+ lresult[j] = lresult[j] || (__real__(result[j]) > __real__(array[i]));
+
+ return 0;
+}
+
+/* Check that default copy maps are generated for loop reductions. */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 4 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-15.c b/gcc/testsuite/c-c++-common/goacc/reduction-15.c
new file mode 100644
index 0000000..f01d988
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-15.c
@@ -0,0 +1,51 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* struct reductions. */
+
+typedef struct { int x, y; } int_pair;
+typedef struct { float m, n; } flt_pair;
+typedef struct
+{
+ int i;
+ double d;
+ float f;
+ int a[4];
+ int_pair ip;
+ flt_pair fp;
+} rectype;
+
+#define n 1000
+
+int
+main(void)
+{
+ int i;
+ rectype result, array[n];
+
+ /* '+' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (+:result)
+ for (i = 0; i < n; i++)
+ {
+ result.i += array[i].i;
+ result.f += array[i].f;
+ result.ip.x += array[i].ip.x;
+ result.ip.y += array[i].ip.y;
+ }
+
+ /* '*' reductions. */
+#pragma acc parallel
+#pragma acc loop gang worker vector reduction (*:result)
+ for (i = 0; i < n; i++)
+ {
+ result.i *= array[i].i;
+ result.f *= array[i].f;
+ result.ip.x *= array[i].ip.x;
+ result.ip.y *= array[i].ip.y;
+ }
+
+ return 0;
+}
+
+/* Check that default copy maps are generated for loop reductions. */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
+
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-16.c b/gcc/testsuite/c-c++-common/goacc/reduction-16.c
new file mode 100644
index 0000000..6fb7054
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-16.c
@@ -0,0 +1,30 @@
+/* { dg-compile } */
+#include <stdlib.h>
+
+int foo (int n)
+{
+ int x[5][5];
+ int y[n];
+ int *z = (int *) malloc (5 * sizeof (int));
+
+ #pragma acc parallel
+ {
+ #pragma acc loop reduction(+:x)
+ for (int i = 0; i < 5; i++) ;
+ #pragma acc loop reduction(+:y)
+ for (int i = 0; i < 5; i++) ;
+
+ #pragma acc loop reduction(+:x[2:1][0:5])
+ for (int i = 0; i < 5; i++) ;
+ #pragma acc loop reduction(+:x[0:5][2:1]) /* { dg-error "array section is not contiguous in 'reduction' clause" } */
+ for (int i = 0; i < 5; i++) ;
+
+ #pragma acc loop reduction(+:y[0:5])
+ for (int i = 0; i < 5; i++) ;
+
+ #pragma acc loop reduction(+:z[0:5])
+ for (int i = 0; i < 5; i++) ;
+ }
+
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-2.c b/gcc/testsuite/c-c++-common/goacc/reduction-2.c
index 9dba035..89bc164 100644
--- a/gcc/testsuite/c-c++-common/goacc/reduction-2.c
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-2.c
@@ -50,5 +50,5 @@ main(void)
}
/* Check that default copy maps are generated for loop reductions. */
-/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\]\\)" 4 "gimple" } } */
-/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 4 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-3.c b/gcc/testsuite/c-c++-common/goacc/reduction-3.c
index 669cd43..9cca625 100644
--- a/gcc/testsuite/c-c++-common/goacc/reduction-3.c
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-3.c
@@ -50,5 +50,5 @@ main(void)
}
/* Check that default copy maps are generated for loop reductions. */
-/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\]\\)" 4 "gimple" } } */
-/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 4 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-4.c b/gcc/testsuite/c-c++-common/goacc/reduction-4.c
index 5c3dfb1..80b3247 100644
--- a/gcc/testsuite/c-c++-common/goacc/reduction-4.c
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-4.c
@@ -38,5 +38,5 @@ main(void)
}
/* Check that default copy maps are generated for loop reductions. */
-/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } } */
-/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:result \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(tofrom:lresult \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/goacc/reduction-9.c b/gcc/testsuite/c-c++-common/goacc/reduction-9.c
new file mode 100644
index 0000000..72b2f07
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/goacc/reduction-9.c
@@ -0,0 +1,111 @@
+/* Exercise invalid reductions on array and struct members. */
+
+void
+test_parallel ()
+{
+ struct {
+ int a;
+ float b[5];
+ } s1, s2[10];
+
+ int i;
+ double z[100];
+
+#pragma acc parallel reduction(+:s1.a) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s1.a += 1;
+
+#pragma acc parallel reduction(+:s1.b[3]) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s1.b[3] += 1;
+
+#pragma acc parallel reduction(+:s2[2].a) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s2[2].a += 1;
+
+#pragma acc parallel reduction(+:s2[3].b[4]) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s2[3].b[4] += 1;
+
+#pragma acc parallel reduction(+:z[5])
+ for (i = 0; i < 10; i++)
+ z[5] += 1;
+}
+
+void
+test_combined ()
+{
+ struct {
+ int a;
+ float b[5];
+ } s1, s2[10];
+
+ int i;
+ double z[100];
+
+#pragma acc parallel loop reduction(+:s1.a) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s1.a += 1;
+
+#pragma acc parallel loop reduction(+:s1.b[3]) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s1.b[3] += 1;
+
+#pragma acc parallel loop reduction(+:s2[2].a) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s2[2].a += 1;
+
+#pragma acc parallel loop reduction(+:s2[3].b[4]) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s2[3].b[4] += 1;
+
+#pragma acc parallel loop reduction(+:z[5])
+ for (i = 0; i < 10; i++)
+ z[5] += 1;
+
+}
+
+void
+test_loops ()
+{
+ struct {
+ int a;
+ float b[5];
+ } s1, s2[10];
+
+ int i;
+ double z[100];
+
+#pragma acc parallel
+ {
+#pragma acc loop reduction(+:s1.a) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s1.a += 1;
+
+#pragma acc loop reduction(+:s1.b[3]) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s1.b[3] += 1;
+
+#pragma acc loop reduction(+:s2[2].a) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s2[2].a += 1;
+
+#pragma acc loop reduction(+:s2[3].b[4]) /* { dg-error "expected '\\\)' before '\\\.' token" } */
+ for (i = 0; i < 10; i++)
+ s2[3].b[4] += 1;
+
+#pragma acc loop reduction(+:z[5])
+ for (i = 0; i < 10; i++)
+ z[5] += 1;
+ }
+}
+
+int
+main ()
+{
+ test_parallel ();
+ test_combined ();
+ test_loops ();
+
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-10.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-10.c
new file mode 100644
index 0000000..6730dfe
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-10.c
@@ -0,0 +1,15 @@
+/* Diagnose invalid type in variadic arguments. */
+
+void v0(int *, ...) {}
+
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1:omp_num_args)
+void b0(int *, ...) {}
+
+void f0(int *p0, int *p1, int *p2, int *p3, int *p4)
+{
+ #pragma omp dispatch
+ b0(p0, p1, p2, p3, p4, 42); /* { dg-error "variadic argument 5 specified in an 'append_args' clause with the 'need_device_ptr' modifier must be of pointer type" "" { xfail *-*-* } } */
+}
+
+/* { dg-prune-output "sorry, unimplemented: Invalid non-pointer/reference argument not diagnosed properly earlier" } */
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-11.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-11.c
new file mode 100644
index 0000000..eabf124
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-11.c
@@ -0,0 +1,58 @@
+/* Reject expressions outside of a numeric range. */
+
+void v_0(int, int, int) {}
+void v_1(int, int, int) {}
+void v_2(int, int, int) {}
+void v_3(int, int, int) {}
+
+enum {constant_expression = 1};
+
+/* { dg-error "expected ':' before '\\)' token" "" { target *-*-* } .+2 } */
+/* { dg-note "an expression is only allowed in a numeric range" "" { target *-*-* } .+1 } */
+#pragma omp declare variant (v_0) match (construct={dispatch}) adjust_args (nothing: 0+1)
+void b0 (int, int, int) {}
+
+/* { dg-error "'constant_expression' is not a function parameter" "" { target *-*-* } .+2 } */
+/* { dg-note "an expression is only allowed in a numeric range" "" { xfail *-*-* } .+1 } */
+#pragma omp declare variant (v_1) match (construct={dispatch}) adjust_args (nothing: constant_expression)
+void b1 (int, int, int) {}
+
+/* { dg-error "expected ':' before '\\)' token" "" { target *-*-* } .+2 } */
+/* { dg-note "an expression is only allowed in a numeric range" "" { target *-*-* } .+1 } */
+#pragma omp declare variant (v_2) match (construct={dispatch}) adjust_args (nothing: constant_expression + 0)
+void b2 (int, int, int) {}
+
+/* { dg-error "expected ':' before '\\)' token" "" { target *-*-* } .+2 } */
+/* { dg-note "an expression is only allowed in a numeric range" "" { target *-*-* } .+1 } */
+#pragma omp declare variant (v_3) match (construct={dispatch}) adjust_args (nothing: 0 + constant_expression)
+void b3 (int, int, int) {}
+
+
+/* Invalid uses of omp_num_args. */
+
+void ona_v0 (int, int, int) {}
+void ona_v1 (int, int, int) {}
+void ona_v2 (int, int, int) {}
+void ona_v3 (int, int, int) {}
+
+/* { dg-error "'omp_num_args' may only be used at the start of a numeric range bound" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(ona_v0) match(construct={dispatch}) \
+ adjust_args(nothing: omp_num_args)
+void ona_b0 (int, int, int) {}
+
+/* { dg-error "'omp_num_args' may only be used at the start of a numeric range bound" "" { target *-*-* } .+3 } */
+/* { dg-error "'omp_num_args' may only be used at the start of a numeric range bound" "" { target *-*-* } .+3 } */
+#pragma omp declare variant(ona_v1) match(construct={dispatch}) \
+ adjust_args(nothing: omp_num_args, \
+ omp_num_args)
+void ona_b1 (int, int, int) {}
+
+/* { dg-error "'omp_num_args' may only be used at the start of a numeric range bound" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(ona_v2) match(construct={dispatch}) \
+ adjust_args(nothing: omp_num_args, 1)
+void ona_b2 (int, int, int) {}
+
+/* { dg-error "'omp_num_args' may only be used at the start of a numeric range bound" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(ona_v3) match(construct={dispatch}) \
+ adjust_args(nothing: 1, omp_num_args)
+void ona_b3 (int, int, int) {}
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-12.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-12.c
new file mode 100644
index 0000000..3a283ac
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-12.c
@@ -0,0 +1,20 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Valid constant-expressions in numeric ranges. */
+
+void v (int *, int *, int *, int *, int *) {}
+
+#pragma omp declare variant(v) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 5-4:6-4, 4)
+void b (int *, int *, int *, int *, int *) {}
+
+void f (int *p0, int *p1, int *p2, int *p3, int *p4)
+{
+ #pragma omp dispatch
+ b (p0, p1, p2, p3, p4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p0, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p1, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p3, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v \\(D\.\[0-9\]+, D\.\[0-9\]+, p2, D\.\[0-9\]+, p4\\);" "gimple" } } */
+}
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 1 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-13.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-13.c
new file mode 100644
index 0000000..dd18594
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-13.c
@@ -0,0 +1,53 @@
+/* Depending on how the variable is looked up, such as by using undeclared_variable
+ to emit a diagnostic in the c front end, we might accidently prevent diagnostics
+ later in the file.
+ Note, the names specified in the adjust_args clause are important for this test. */
+
+/* No parameters. */
+
+void v00();
+#pragma omp declare variant(v00) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: w) /* { dg-error "'w' is not a function parameter" } */
+void b00();
+
+void v01() {}
+#pragma omp declare variant(v01) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: w) /* { dg-error "'w' is not a function parameter" } */
+void b01() {}
+
+/* No parameters, specified with void. */
+
+void v10(void);
+#pragma omp declare variant(v10) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: x) /* { dg-error "'x' is not a function parameter" } */
+void b10(void);
+
+void v11(void) {}
+#pragma omp declare variant(v11) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: x) /* { dg-error "'x' is not a function parameter" } */
+void b11(void) {}
+
+/* Variadic. */
+
+void v20(...);
+#pragma omp declare variant(v20) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: y) /* { dg-error "'y' is not a function parameter" } */
+void b20(...);
+
+void v21(...) {}
+#pragma omp declare variant(v21) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: y) /* { dg-error "'y' is not a function parameter" } */
+void b21(...) {}
+
+/* With non-empty parameter list. */
+
+void v30(int a);
+#pragma omp declare variant(v30) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: z) /* { dg-error "'z' is not a function parameter" } */
+void b30(int a);
+
+void v31(int a) { (void)a; }
+#pragma omp declare variant(v31) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: z) /* { dg-error "'z' is not a function parameter" } */
+void b31(int a) { (void)a; }
+
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-14.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-14.c
new file mode 100644
index 0000000..039f439
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-14.c
@@ -0,0 +1,57 @@
+/* Multiple uses of the same name should not be diagnosed multiple times. */
+
+/* No parameters. */
+
+void v00();
+#pragma omp declare variant(v00) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: w, /* { dg-error "'w' is not a function parameter" } */ \
+ w) /* { dg-bogus "'w' is not a function parameter" "" { xfail *-*-* } } */
+void b00();
+
+void v01() {}
+#pragma omp declare variant(v01) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: ww, /* { dg-error "'ww' is not a function parameter" } */ \
+ ww) /* { dg-bogus "'ww' is not a function parameter" "" { xfail *-*-* } } */
+void b01() {}
+
+/* No parameters, specified with void. */
+
+void v10(void);
+#pragma omp declare variant(v10) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: x, /* { dg-error "'x' is not a function parameter" } */ \
+ x) /* { dg-bogus "'x' is not a function parameter" "" { xfail *-*-* } } */
+void b10(void);
+
+void v11(void) {}
+#pragma omp declare variant(v11) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: xx, /* { dg-error "'xx' is not a function parameter" } */ \
+ xx) /* { dg-bogus "'xx' is not a function parameter" "" { xfail *-*-* } } */
+void b11(void) {}
+
+/* Variadic. */
+
+void v20(...);
+#pragma omp declare variant(v20) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: y, /* { dg-error "'y' is not a function parameter" } */ \
+ y) /* { dg-bogus "'y' is not a function parameter" "" { xfail *-*-* } } */
+void b20(...);
+
+void v21(...) {}
+#pragma omp declare variant(v21) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: yy, /* { dg-error "'yy' is not a function parameter" } */ \
+ yy) /* { dg-bogus "'yy' is not a function parameter" "" { xfail *-*-* } } */
+void b21(...) {}
+
+/* With non-empty parameter list. */
+
+void v30(int a);
+#pragma omp declare variant(v30) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: z, /* { dg-error "'z' is not a function parameter" } */ \
+ z) /* { dg-bogus "'z' is not a function parameter" "" { xfail *-*-* } } */
+void b30(int a);
+
+void v31(int a) { (void)a; }
+#pragma omp declare variant(v31) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: zz, /* { dg-error "'zz' is not a function parameter" } */ \
+ zz) /* { dg-bogus "'zz' is not a function parameter" "" { xfail *-*-* } } */
+void b31(int a) { (void)a; } \ No newline at end of file
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-15.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-15.c
new file mode 100644
index 0000000..6347891
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-15.c
@@ -0,0 +1,15 @@
+/* Technically a bug, won't fix, probably.
+
+ OpenMP 6.0 (158:18)
+ In all cases, white space in clause-argument-list is optional.
+
+ The lexer obviously doesn't like this very much, but technically it is
+ correct OpenMP syntax, the first colon is a part of the
+ modifier-specification-list, the second is a numeric range with both
+ lb and ub not specified. */
+
+void v (int) {}
+
+#pragma omp declare variant(v) match(construct={dispatch}) \
+ adjust_args(nothing::) /* { dg-bogus "" "" { xfail *-*-* } } */
+void b (int) {}
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-7.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-7.c
new file mode 100644
index 0000000..e4b0930
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-7.c
@@ -0,0 +1,529 @@
+/* Test uses of omp_num_args. */
+
+void v_1_arg_0(int) {}
+void v_1_arg_1(int) {}
+void v_1_arg_2(int) {}
+void v_1_arg_3(int) {}
+void v_1_arg_4(int) {}
+void v_1_arg_5(int) {}
+void v_1_arg_6(int) {}
+void v_1_arg_7(int) {}
+void v_1_arg_8(int) {}
+void v_1_arg_9(int) {}
+void v_1_arg_10(int) {}
+void v_1_arg_11(int) {}
+void v_1_arg_12(int) {}
+void v_1_arg_13(int) {}
+void v_1_arg_14(int) {}
+void v_1_arg_15(int) {}
+void v_1_arg_16(int) {}
+void v_1_arg_17(int) {}
+void v_1_arg_18(int) {}
+void v_1_arg_19(int) {}
+void v_1_arg_20(int) {}
+void v_1_arg_21(int) {}
+void v_1_arg_22(int) {}
+void v_1_arg_23(int) {}
+void v_1_arg_24(int) {}
+
+
+// literal
+
+#pragma omp declare variant (v_1_arg_0) match (construct={dispatch}) adjust_args (nothing: 1:1)
+void b_1_arg_literal_literal_0 (int) {}
+
+// defaults (lb default is 1, ub default is omp_num_args)
+
+#pragma omp declare variant (v_1_arg_1) match (construct={dispatch}) adjust_args (nothing: :)
+void b_1_arg_default_default (int) {}
+
+#pragma omp declare variant (v_1_arg_2) match (construct={dispatch}) adjust_args (nothing: :1)
+void b_1_arg_default_literal_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_3) match (construct={dispatch}) adjust_args (nothing: :omp_num_args)
+void b_1_arg_default_numargs_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_4) match (construct={dispatch}) adjust_args (nothing: :omp_num_args+0)
+void b_1_arg_default_numargs_1 (int) {}
+
+#pragma omp declare variant (v_1_arg_5) match (construct={dispatch}) adjust_args (nothing: :omp_num_args-0)
+void b_1_arg_default_numargs_2 (int) {}
+
+#pragma omp declare variant (v_1_arg_6) match (construct={dispatch}) adjust_args (nothing: 1:)
+void b_1_arg_literal_default_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_7) match (construct={dispatch}) adjust_args (nothing: omp_num_args:)
+void b_1_arg_numargs_default_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_8) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:)
+void b_1_arg_numargs_default_1 (int) {}
+
+#pragma omp declare variant (v_1_arg_9) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:)
+void b_1_arg_numargs_default_2 (int) {}
+
+
+// literal : omp_num_args+/-
+
+#pragma omp declare variant (v_1_arg_10) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args)
+void b_1_arg_literal_numargs_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_11) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args+0)
+void b_1_arg_literal_numargs_1 (int) {}
+
+#pragma omp declare variant (v_1_arg_12) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-0)
+void b_1_arg_literal_numargs_2 (int) {}
+
+// omp_num_args+/- : literal
+
+#pragma omp declare variant (v_1_arg_13) match (construct={dispatch}) adjust_args (nothing: omp_num_args:1)
+void b_1_arg_numargs_literal_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_14) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:1)
+void b_1_arg_numargs_literal_1 (int) {}
+
+#pragma omp declare variant (v_1_arg_15) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:1)
+void b_1_arg_numargs_literal_2 (int) {}
+
+// omp_num_args+/- : omp_num_args+/-
+// we need to avoid combinatorial explosion here...
+
+#pragma omp declare variant (v_1_arg_16) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args)
+void b_1_arg_numargs_numargs_0_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_17) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args+0)
+void b_1_arg_numargs_numargs_0_1 (int) {}
+
+#pragma omp declare variant (v_1_arg_18) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args-0)
+void b_1_arg_numargs_numargs_0_2 (int) {}
+
+#pragma omp declare variant (v_1_arg_19) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args)
+void b_1_arg_numargs_numargs_1_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_20) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args+0)
+void b_1_arg_numargs_numargs_1_1 (int) {}
+
+#pragma omp declare variant (v_1_arg_21) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args-0)
+void b_1_arg_numargs_numargs_1_2 (int) {}
+
+#pragma omp declare variant (v_1_arg_22) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args)
+void b_1_arg_numargs_numargs_2_0 (int) {}
+
+#pragma omp declare variant (v_1_arg_23) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args+0)
+void b_1_arg_numargs_numargs_2_1 (int) {}
+
+#pragma omp declare variant (v_1_arg_24) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args-0)
+void b_1_arg_numargs_numargs_2_2 (int) {}
+
+
+
+void v_2_arg(int, int) {}
+
+// literal
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 1:1)
+void b_2_arg_literal_literal_0_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 1:2)
+void b_2_arg_literal_literal_0_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 2:2)
+void b_2_arg_literal_literal_1_1 (int, int) {}
+
+// defaults (lb default is 1, ub default is omp_num_args)
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: :)
+void b_2_arg_default_default (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: :1)
+void b_2_arg_default_literal_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: :2)
+void b_2_arg_default_literal_2 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args)
+void b_2_arg_default_numargs_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args+0)
+void b_2_arg_default_numargs_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args-0)
+void b_2_arg_default_numargs_2 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args-1)
+void b_2_arg_default_numargs_3 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 1:)
+void b_2_arg_literal_default_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 2:)
+void b_2_arg_literal_default_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:)
+void b_2_arg_numargs_default_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:)
+void b_2_arg_numargs_default_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:)
+void b_2_arg_numargs_default_2 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:)
+void b_2_arg_numargs_default_3 (int, int) {}
+
+// literal : omp_num_args+/-
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args)
+void b_2_arg_literal_numargs_0_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args+0)
+void b_2_arg_literal_numargs_0_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-0)
+void b_2_arg_literal_numargs_0_2 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1)
+void b_2_arg_literal_numargs_0_3 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args)
+void b_2_arg_literal_numargs_1_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args+0)
+void b_2_arg_literal_numargs_1_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args-0)
+void b_2_arg_literal_numargs_1_2 (int, int) {}
+
+/* Out of range
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args-1)
+void b_2_arg_literal_numargs_1_3 (int, int) {} */
+
+
+// omp_num_args+/- : literal
+
+/* Out of range
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:1)
+void b_2_arg_numargs_literal_0_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:1)
+void b_2_arg_numargs_literal_1_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:1)
+void b_2_arg_numargs_literal_2_0 (int, int) {} */
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:1)
+void b_2_arg_numargs_literal_3_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:2)
+void b_2_arg_numargs_literal_0_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:2)
+void b_2_arg_numargs_literal_1_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:2)
+void b_2_arg_numargs_literal_2_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:2)
+void b_2_arg_numargs_literal_3_1 (int, int) {}
+
+// omp_num_args+/- : omp_num_args+/-
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args)
+void b_2_arg_numargs_numargs_0_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args+0)
+void b_2_arg_numargs_numargs_0_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args-0)
+void b_2_arg_numargs_numargs_0_2 (int, int) {}
+/* Out of range
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args-1)
+void b_2_arg_numargs_numargs_0_3 (int, int) {} */
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args)
+void b_2_arg_numargs_numargs_1_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args+0)
+void b_2_arg_numargs_numargs_1_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args-0)
+void b_2_arg_numargs_numargs_1_2 (int, int) {}
+/* Out of range
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args-1)
+void b_2_arg_numargs_numargs_1_3 (int, int) {} */
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args)
+void b_2_arg_numargs_numargs_2_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args+0)
+void b_2_arg_numargs_numargs_2_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args-0)
+void b_2_arg_numargs_numargs_2_2 (int, int) {}
+/* Out of range
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args-1)
+void b_2_arg_numargs_numargs_2_3 (int, int) {} */
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args)
+void b_2_arg_numargs_numargs_3_0 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args+0)
+void b_2_arg_numargs_numargs_3_1 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args-0)
+void b_2_arg_numargs_numargs_3_2 (int, int) {}
+
+#pragma omp declare variant (v_2_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args-1)
+void b_2_arg_numargs_numargs_3_3 (int, int) {}
+
+
+
+void v_3_arg(int, int, int) {}
+
+// literal
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:1)
+void b_3_arg_literal_literal_0_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:2)
+void b_3_arg_literal_literal_0_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:3)
+void b_3_arg_literal_literal_0_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 2:2)
+void b_3_arg_literal_literal_1_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 2:3)
+void b_3_arg_literal_literal_1_2 (int, int, int) {}
+
+// defaults (lb default is 1, ub default is omp_num_args)
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :)
+void b_3_arg_default_default (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :1)
+void b_3_arg_default_literal_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :2)
+void b_3_arg_default_literal_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :3)
+void b_3_arg_default_literal_3 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args)
+void b_3_arg_default_numargs_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args+0)
+void b_3_arg_default_numargs_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args-0)
+void b_3_arg_default_numargs_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args-1)
+void b_3_arg_default_numargs_3 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: :omp_num_args-2)
+void b_3_arg_default_numargs_4 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:)
+void b_3_arg_literal_default_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 2:)
+void b_3_arg_literal_default_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 3:)
+void b_3_arg_literal_default_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:)
+void b_3_arg_numargs_default_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:)
+void b_3_arg_numargs_default_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:)
+void b_3_arg_numargs_default_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:)
+void b_3_arg_numargs_default_3 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:)
+void b_3_arg_numargs_default_4 (int, int, int) {}
+
+// literal : omp_num_args+/-
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args)
+void b_3_arg_literal_numargs_0_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args+0)
+void b_3_arg_literal_numargs_0_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-0)
+void b_3_arg_literal_numargs_0_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1)
+void b_3_arg_literal_numargs_0_3 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-2)
+void b_3_arg_literal_numargs_0_4 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args)
+void b_3_arg_literal_numargs_1_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args+0)
+void b_3_arg_literal_numargs_1_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args-0)
+void b_3_arg_literal_numargs_1_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args-1)
+void b_3_arg_literal_numargs_1_3 (int, int, int) {}
+/* Out of range
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args-2)
+void b_3_arg_literal_numargs_1_4 (int, int, int) {} */
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 3:omp_num_args)
+void b_3_arg_literal_numargs_2_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 3:omp_num_args+0)
+void b_3_arg_literal_numargs_2_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 3:omp_num_args-0)
+void b_3_arg_literal_numargs_2_2 (int, int, int) {}
+/* Out of range
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 3:omp_num_args-1)
+void b_3_arg_literal_numargs_2_3 (int, int, int) {}
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: 3:omp_num_args-2)
+void b_3_arg_literal_numargs_2_4 (int, int, int) {} */
+
+
+// omp_num_args+/- : literal
+
+/* Out of range
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:1)
+void b_3_arg_numargs_literal_0_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:1)
+void b_3_arg_numargs_literal_1_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:1)
+void b_3_arg_numargs_literal_2_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:1)
+void b_3_arg_numargs_literal_3_0 (int, int, int) {} */
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:1)
+void b_3_arg_numargs_literal_4_0 (int, int, int) {}
+
+/* Out of range
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:2)
+void b_3_arg_numargs_literal_0_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:2)
+void b_3_arg_numargs_literal_1_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:2)
+void b_3_arg_numargs_literal_2_1 (int, int, int) {} */
+
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:2)
+void b_3_arg_numargs_literal_3_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:2)
+void b_3_arg_numargs_literal_4_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:3)
+void b_3_arg_numargs_literal_0_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:3)
+void b_3_arg_numargs_literal_1_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:3)
+void b_3_arg_numargs_literal_2_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:3)
+void b_3_arg_numargs_literal_3_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:3)
+void b_3_arg_numargs_literal_4_2 (int, int, int) {}
+
+// omp_num_args+/- : omp_num_args+/-
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args)
+void b_3_arg_numargs_numargs_0_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args+0)
+void b_3_arg_numargs_numargs_0_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args-0)
+void b_3_arg_numargs_numargs_0_2 (int, int, int) {}
+/* Out of range
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args-1)
+void b_3_arg_numargs_numargs_0_3 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args:omp_num_args-2)
+void b_3_arg_numargs_numargs_0_4 (int, int, int) {} */
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args)
+void b_3_arg_numargs_numargs_1_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args+0)
+void b_3_arg_numargs_numargs_1_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args-0)
+void b_3_arg_numargs_numargs_1_2 (int, int, int) {}
+/* Out of range
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args-1)
+void b_3_arg_numargs_numargs_1_3 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args+0:omp_num_args-2)
+void b_3_arg_numargs_numargs_1_4 (int, int, int) {} */
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args)
+void b_3_arg_numargs_numargs_2_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args+0)
+void b_3_arg_numargs_numargs_2_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args-0)
+void b_3_arg_numargs_numargs_2_2 (int, int, int) {}
+/* Out of range
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args-1)
+void b_3_arg_numargs_numargs_2_3 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-0:omp_num_args-2)
+void b_3_arg_numargs_numargs_2_4 (int, int, int) {} */
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args)
+void b_3_arg_numargs_numargs_3_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args+0)
+void b_3_arg_numargs_numargs_3_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args-0)
+void b_3_arg_numargs_numargs_3_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args-1)
+void b_3_arg_numargs_numargs_3_3 (int, int, int) {}
+/* Out of range
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-1:omp_num_args-2)
+void b_3_arg_numargs_numargs_3_4 (int, int, int) {} */
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:omp_num_args)
+void b_3_arg_numargs_numargs_4_0 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:omp_num_args+0)
+void b_3_arg_numargs_numargs_4_1 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:omp_num_args-0)
+void b_3_arg_numargs_numargs_4_2 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:omp_num_args-1)
+void b_3_arg_numargs_numargs_4_3 (int, int, int) {}
+
+#pragma omp declare variant (v_3_arg) match (construct={dispatch}) adjust_args (nothing: omp_num_args-2:omp_num_args-2)
+void b_3_arg_numargs_numargs_4_4 (int, int, int) {}
+
+
+/* 1-3 args should be fine for now.
+void v_4_arg(int, int, int, int) {}
+void v_5_arg(int, int, int, int, int) {} */
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-8.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-8.c
new file mode 100644
index 0000000..a791ed3
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-8.c
@@ -0,0 +1,405 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Test uses of omp_num_args in a variadic function. */
+
+/* NOTE: Make sure the arguments passed to the functions have unique names to
+ not interfere with the dg-final checks. */
+
+void v0_0_arg_vari_0(...) {}
+void v0_0_arg_vari_1(...) {}
+void v0_0_arg_vari_2(...) {}
+void v0_0_arg_vari_3(...) {}
+void v0_0_arg_vari_4(...) {}
+void v0_0_arg_vari_5(...) {}
+void v0_0_arg_vari_6(...) {}
+void v0_0_arg_vari_7(...) {}
+
+/* All args adjusted. */
+
+// defaults
+
+#pragma omp declare variant (v0_0_arg_vari_0) match (construct={dispatch}) adjust_args (need_device_ptr: :)
+void b_default_default (...) {}
+
+#pragma omp declare variant (v0_0_arg_vari_1) match (construct={dispatch}) adjust_args (need_device_ptr: :omp_num_args)
+void b_default_numargs_0 (...) {}
+
+#pragma omp declare variant (v0_0_arg_vari_2) match (construct={dispatch}) adjust_args (need_device_ptr: :omp_num_args+0)
+void b_default_numargs_1 (...) {}
+
+#pragma omp declare variant (v0_0_arg_vari_3) match (construct={dispatch}) adjust_args (need_device_ptr: :omp_num_args-0)
+void b_default_numargs_2 (...) {}
+
+#pragma omp declare variant (v0_0_arg_vari_4) match (construct={dispatch}) adjust_args (need_device_ptr: 1:)
+void b_literal_default_0 (...) {}
+
+// literal : omp_num_args+/-
+
+#pragma omp declare variant (v0_0_arg_vari_5) match (construct={dispatch}) adjust_args (need_device_ptr: 1:omp_num_args)
+void b_literal_numargs_0 (...) {}
+
+#pragma omp declare variant (v0_0_arg_vari_6) match (construct={dispatch}) adjust_args (need_device_ptr: 1:omp_num_args+0)
+void b_literal_numargs_1 (...) {}
+
+#pragma omp declare variant (v0_0_arg_vari_7) match (construct={dispatch}) adjust_args (need_device_ptr: 1:omp_num_args-0)
+void b_literal_numargs_2 (...) {}
+
+/* 8 function calls. */
+#define PASS_ARGS_TO_ALL(...) \
+ do { \
+ _Pragma("omp dispatch") \
+ b_default_default(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_default_numargs_0(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_default_numargs_1(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_default_numargs_2(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_literal_default_0(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_literal_numargs_0(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_literal_numargs_1(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_literal_numargs_2(__VA_ARGS__); \
+ } while (0);
+
+void do_all_args(int *p0)
+{
+ /* 6 uses of p0, times 8, 6*8=48. */
+ /* 3 expansions, times 8, 3*8=24 uses of omp dispatch. */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p0, D\.\[0-9\]+\\);" 48 "gimple" } } */
+ PASS_ARGS_TO_ALL (p0);
+/* { dg-final { scan-tree-dump-times "v0_0_arg_vari_\[0-7\] \\(D\.\[0-9\]+\\);" 8 "gimple" } } */
+ PASS_ARGS_TO_ALL (p0, p0);
+/* { dg-final { scan-tree-dump-times "v0_0_arg_vari_\[0-7\] \\(D\.\[0-9\]+, D\.\[0-9\]+\\);" 8 "gimple" } } */
+ PASS_ARGS_TO_ALL (p0, p0, p0);
+/* { dg-final { scan-tree-dump-times "v0_0_arg_vari_\[0-7\] \\(D\.\[0-9\]+, D\.\[0-9\]+, D\.\[0-9\]+\\);" 8 "gimple" } } */
+}
+#undef PASS_ARGS_TO_ALL
+
+void v1_0_arg_vari_8(...) {}
+void v1_0_arg_vari_9(...) {}
+void v1_0_arg_vari_10(...) {}
+
+/* First arg adjusted. */
+
+#pragma omp declare variant (v1_0_arg_vari_8) match (construct={dispatch}) adjust_args (need_device_ptr: 1:1)
+void b_firstarg_needptr_literal_literal(...) {}
+
+#pragma omp declare variant (v1_0_arg_vari_9) match (construct={dispatch}) adjust_args (need_device_ptr: 1:1) adjust_args (nothing: 2:omp_num_args)
+void b_firstarg_needptr_literal_literal_rest_nothing_literal_numargs(...) {}
+
+#pragma omp declare variant (v1_0_arg_vari_10) match (construct={dispatch}) adjust_args (nothing: 2:omp_num_args) adjust_args (need_device_ptr: 1:1)
+void b_rest_nothing_literal_numargs_firstarg_needptr_literal_literal(...) {}
+
+void do_first_arg(int *p1)
+{
+ int a = 42;
+ /* 7 uses of p1. */
+ /* 7 uses of omp dispatch. */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p1, D\.\[0-9\]+\\);" 7 "gimple" } } */
+ #pragma omp dispatch
+ b_firstarg_needptr_literal_literal(p1);
+ #pragma omp dispatch
+ b_firstarg_needptr_literal_literal(p1, a);
+ #pragma omp dispatch
+ b_firstarg_needptr_literal_literal(p1, a, a);
+
+ #pragma omp dispatch
+ b_firstarg_needptr_literal_literal_rest_nothing_literal_numargs(p1, a);
+ #pragma omp dispatch
+ b_firstarg_needptr_literal_literal_rest_nothing_literal_numargs(p1, a, a);
+
+ #pragma omp dispatch
+ b_rest_nothing_literal_numargs_firstarg_needptr_literal_literal(p1, a);
+ #pragma omp dispatch
+ b_rest_nothing_literal_numargs_firstarg_needptr_literal_literal(p1, a, a);
+/* { dg-final { scan-tree-dump-times "v1_0_arg_vari_1?\[089\] \\(D\.\[0-9\]+(?:, a){0,2}\\);" 7 "gimple" } } */
+}
+
+/* Last arg adjusted. */
+
+void v2_0_arg_vari_11(...) {}
+void v2_0_arg_vari_12(...) {}
+void v2_0_arg_vari_13(...) {}
+void v2_0_arg_vari_14(...) {}
+void v2_0_arg_vari_15(...) {}
+void v2_0_arg_vari_16(...) {}
+void v2_0_arg_vari_17(...) {}
+void v2_0_arg_vari_18(...) {}
+void v2_0_arg_vari_19(...) {}
+void v2_0_arg_vari_20(...) {}
+void v2_0_arg_vari_21(...) {}
+void v2_0_arg_vari_22(...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_11) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:)
+void b_lastarg_needptr_numargs_default_0 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_12) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:)
+void b_lastarg_needptr_numargs_default_1 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_13) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:)
+void b_lastarg_needptr_numargs_default_2 (...) {}
+
+// omp_num_args+/- : omp_num_args+/-
+
+#pragma omp declare variant (v2_0_arg_vari_14) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:omp_num_args)
+void b_lastarg_needptr_numargs_numargs_0_0 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_15) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:omp_num_args+0)
+void b_lastarg_needptr_numargs_numargs_0_1 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_16) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:omp_num_args-0)
+void b_lastarg_needptr_numargs_numargs_0_2 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_17) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args)
+void b_lastarg_needptr_numargs_numargs_1_0 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_18) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args+0)
+void b_lastarg_needptr_numargs_numargs_1_1 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_19) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args-0)
+void b_lastarg_needptr_numargs_numargs_1_2 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_20) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args)
+void b_lastarg_needptr_numargs_numargs_2_0 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_21) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args+0)
+void b_lastarg_needptr_numargs_numargs_2_1 (...) {}
+
+#pragma omp declare variant (v2_0_arg_vari_22) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args-0)
+void b_lastarg_needptr_numargs_numargs_2_2 (...) {}
+
+/* 12 function calls. */
+#define PASS_ARGS_TO_ALL(...) \
+ do { \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_default_0(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_default_1(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_default_2(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_0_0(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_0_1(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_0_2(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_1_0(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_1_1(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_1_2(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_2_0(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_2_1(__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_2_2(__VA_ARGS__); \
+ } while (0)
+
+void do_lastarg_0(int *p2)
+{
+ int a = 42;
+ /* 3 uses of p2, times 12, 3*12=36. */
+ /* 3 expansions, times 12, 3*12=36 uses of omp dispatch. */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p2, D\.\[0-9\]+\\);" 36 "gimple" } } */
+ PASS_ARGS_TO_ALL (p2);
+ PASS_ARGS_TO_ALL (a, p2);
+ PASS_ARGS_TO_ALL (a, a, p2);
+/* { dg-final { scan-tree-dump-times "v2_0_arg_vari_\[12\]\[0-9\] \\((?:a, ){0,2}D\.\[0-9\]+\\);" 36 "gimple" } } */
+}
+
+#undef PASS_ARGS_TO_ALL
+
+void v3_0_arg_vari_23(...) {}
+void v3_0_arg_vari_24(...) {}
+void v3_0_arg_vari_25(...) {}
+void v3_0_arg_vari_26(...) {}
+void v3_0_arg_vari_27(...) {}
+void v3_0_arg_vari_28(...) {}
+void v3_0_arg_vari_29(...) {}
+void v3_0_arg_vari_30(...) {}
+void v3_0_arg_vari_31(...) {}
+void v3_0_arg_vari_32(...) {}
+void v3_0_arg_vari_33(...) {}
+void v3_0_arg_vari_34(...) {}
+void v3_0_arg_vari_35(...) {}
+void v3_0_arg_vari_36(...) {}
+void v3_0_arg_vari_37(...) {}
+void v3_0_arg_vari_38(...) {}
+void v3_0_arg_vari_39(...) {}
+void v3_0_arg_vari_40(...) {}
+void v3_0_arg_vari_41(...) {}
+void v3_0_arg_vari_42(...) {}
+void v3_0_arg_vari_43(...) {}
+void v3_0_arg_vari_44(...) {}
+void v3_0_arg_vari_45(...) {}
+void v3_0_arg_vari_46(...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_23) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_default_rest_nothing_literal_numargs_0 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_24) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_default_rest_nothing_literal_numargs_1 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_25) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_default_rest_nothing_literal_numargs_2 (...) {}
+
+// omp_num_args+/- : omp_num_args+/-
+
+#pragma omp declare variant (v3_0_arg_vari_26) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:omp_num_args) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_0_0 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_27) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:omp_num_args+0) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_0_1 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_28) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:omp_num_args-0) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_0_2 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_29) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_1_0 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_30) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args+0) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_1_1 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_31) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args-0) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_1_2 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_32) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_2_0 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_33) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args+0) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_2_1 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_34) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args-0) adjust_args (nothing: 1:omp_num_args-1)
+void b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_2_2 (...) {}
+
+
+/* same as above section with clauses reversed */
+
+#pragma omp declare variant (v3_0_arg_vari_35) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args:)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_default_0 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_36) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args+0:)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_default_1 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_37) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args-0:)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_default_2 (...) {}
+
+// omp_num_args+/- : omp_num_args+/-
+
+#pragma omp declare variant (v3_0_arg_vari_38) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args:omp_num_args)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_0_0 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_39) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args:omp_num_args+0)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_0_1 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_40) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args:omp_num_args-0)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_0_2 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_41) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_1_0 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_42) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args+0)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_1_1 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_43) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args+0:omp_num_args-0)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_1_2 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_44) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_2_0 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_45) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args+0)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_2_1 (...) {}
+
+#pragma omp declare variant (v3_0_arg_vari_46) match (construct={dispatch}) adjust_args (nothing: 1:omp_num_args-1) adjust_args (need_device_ptr: omp_num_args-0:omp_num_args-0)
+void b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_2_2 (...) {}
+
+/* 24 function calls. */
+#define PASS_ARGS_TO_ALL(...) \
+ do { \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_default_rest_nothing_literal_numargs_0 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_default_rest_nothing_literal_numargs_1 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_default_rest_nothing_literal_numargs_2 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_0_0 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_0_1 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_0_2 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_1_0 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_1_1 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_1_2 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_2_0 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_2_1 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_lastarg_needptr_numargs_numargs_rest_nothing_literal_numargs_2_2 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_default_0 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_default_1 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_default_2 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_0_0 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_0_1 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_0_2 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_1_0 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_1_1 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_1_2 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_2_0 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_2_1 (__VA_ARGS__); \
+ _Pragma("omp dispatch") \
+ b_rest_nothing_literal_numargs_lastarg_needptr_numargs_numargs_2_2 (__VA_ARGS__); \
+ } while (0)
+
+void do_lastarg_1(int *p3)
+{
+ int a = 42;
+ /* 3 uses of p3, times 24, 3*24=72. */
+ /* 3 expansions, times 24, 3*24=72 uses of omp dispatch. */
+ /* Can't pass a single arg to this one. */
+ PASS_ARGS_TO_ALL (a, p3);
+ PASS_ARGS_TO_ALL (a, a, p3);
+ PASS_ARGS_TO_ALL (a, a, a, p3);
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p3, D\.\[0-9\]+\\);" 72 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "v3_0_arg_vari_\[2-4\]\[0-9\] \\((?:a, ){1,3}D\.\[0-9\]+\\);" 72 "gimple" } } */
+}
+#undef PASS_ARGS_TO_ALL
+
+/* 24 + 7 + 36 + 72 = 139. */
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 139 "gimple" } } */
+
+
+/* Lots of these cases are invalid (depending on the value of the literal),
+ thus they go somewhere else. */
+
+// omp_num_args+/- : literal
+
+// #pragma omp declare variant (N/A) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args:1)
+// void b_numargs_literal_0 (...) {}
+
+// #pragma omp declare variant (N/A) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args+0:1)
+// void b_numargs_literal_1 (...) {}
+
+// #pragma omp declare variant (N/A) match (construct={dispatch}) adjust_args (need_device_ptr: omp_num_args-0:1)
+// void b_numargs_literal_2 (...) {}
diff --git a/gcc/testsuite/c-c++-common/gomp/adjust-args-9.c b/gcc/testsuite/c-c++-common/gomp/adjust-args-9.c
new file mode 100644
index 0000000..8b3aa24
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/adjust-args-9.c
@@ -0,0 +1,125 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Test uses of parameter index in a function.
+ TODO: cases with variadic functions,
+ cases referring to variadic arguments. */
+
+#define NUMBER_ONE 1
+#define NUMBER_TWO 2
+#define NUMBER_THREE 3
+
+void v_ptr(int *) {}
+void macro_v_ptr(int *) {}
+
+#pragma omp declare variant (v_ptr) match (construct={dispatch}) adjust_args (need_device_ptr: 1)
+void b_ptr (int *) {}
+
+#pragma omp declare variant (macro_v_ptr) match (construct={dispatch}) adjust_args (need_device_ptr: NUMBER_ONE)
+void macro_b_ptr (int *) {}
+
+
+void v_ptr_val(int *, int) {}
+void macro_v_ptr_val(int *, int) {}
+
+#pragma omp declare variant (v_ptr_val) match (construct={dispatch}) adjust_args (need_device_ptr: 1)
+void b_ptr_val (int *, int) {}
+
+#pragma omp declare variant (macro_v_ptr_val) match (construct={dispatch}) adjust_args (need_device_ptr: NUMBER_ONE)
+void macro_b_ptr_val (int *, int) {}
+
+
+void v_val_ptr(int, int *) {}
+void macro_v_val_ptr(int, int *) {}
+
+#pragma omp declare variant (v_val_ptr) match (construct={dispatch}) adjust_args (need_device_ptr: 2)
+void b_val_ptr (int, int *) {}
+
+#pragma omp declare variant (macro_v_val_ptr) match (construct={dispatch}) adjust_args (need_device_ptr: NUMBER_TWO)
+void macro_b_val_ptr (int, int *) {}
+
+
+void v_ptr_val_val(int *, int, int) {}
+void macro_v_ptr_val_val(int *, int, int) {}
+
+#pragma omp declare variant (v_ptr_val_val) match (construct={dispatch}) adjust_args (need_device_ptr: 1)
+void b_ptr_val_val (int *, int, int) {}
+
+#pragma omp declare variant (macro_v_ptr_val_val) match (construct={dispatch}) adjust_args (need_device_ptr: NUMBER_ONE)
+void macro_b_ptr_val_val (int *, int, int) {}
+
+
+void v_val_ptr_val(int, int *, int) {}
+void macro_v_val_ptr_val(int, int *, int) {}
+
+#pragma omp declare variant (v_val_ptr_val) match (construct={dispatch}) adjust_args (need_device_ptr: 2)
+void b_val_ptr_val (int, int *, int) {}
+
+#pragma omp declare variant (macro_v_val_ptr_val) match (construct={dispatch}) adjust_args (need_device_ptr: NUMBER_TWO)
+void macro_b_val_ptr_val (int, int *, int) {}
+
+
+void v_val_val_ptr(int, int, int *) {}
+void macro_v_val_val_ptr(int, int, int *) {}
+
+#pragma omp declare variant (v_val_val_ptr) match (construct={dispatch}) adjust_args (need_device_ptr: 3)
+void b_val_val_ptr (int, int, int *) {}
+
+#pragma omp declare variant (macro_v_val_val_ptr) match (construct={dispatch}) adjust_args (need_device_ptr: NUMBER_THREE)
+void macro_b_val_val_ptr (int, int, int *) {}
+
+
+void f(int *p0, int *p1, int *p2, int *p3, int *p4,
+ int *p5, int *p6, int *p7, int *p8, int *p9,
+ int *pA, int *pB)
+{
+ #pragma omp dispatch
+ b_ptr (p0);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p0, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v_ptr \\(D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b_ptr_val (p1, 4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p1, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v_ptr_val \\(D\.\[0-9\]+, 4\\);" "gimple" } } */
+ #pragma omp dispatch
+ b_val_ptr (4, p2);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p2, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v_val_ptr \\(4, D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b_ptr_val_val (p3, 4, 4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p3, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v_ptr_val_val \\(D\.\[0-9\]+, 4, 4\\);" "gimple" } } */
+ #pragma omp dispatch
+ b_val_ptr_val (4, p4, 4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p4, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v_val_ptr_val \\(4, D\.\[0-9\]+, 4\\);" "gimple" } } */
+ #pragma omp dispatch
+ b_val_val_ptr (4, 4, p5);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p5, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v_val_val_ptr \\(4, 4, D\.\[0-9\]+\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ macro_b_ptr (p6);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p6, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "macro_v_ptr \\(D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ macro_b_ptr_val (p7, 4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p7, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "macro_v_ptr_val \\(D\.\[0-9\]+, 4\\);" "gimple" } } */
+ #pragma omp dispatch
+ macro_b_val_ptr (4, p8);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p8, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "macro_v_val_ptr \\(4, D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ macro_b_ptr_val_val (p9, 4, 4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p9, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "macro_v_ptr_val_val \\(D\.\[0-9\]+, 4, 4\\);" "gimple" } } */
+ #pragma omp dispatch
+ macro_b_val_ptr_val (4, pA, 4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(pA, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "macro_v_val_ptr_val \\(4, D\.\[0-9\]+, 4\\);" "gimple" } } */
+ #pragma omp dispatch
+ macro_b_val_val_ptr (4, 4, pB);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(pB, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "macro_v_val_val_ptr \\(4, 4, D\.\[0-9\]+\\);" "gimple" } } */
+}
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 12 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-10.c b/gcc/testsuite/c-c++-common/gomp/allocate-10.c
index 7e8f579..2d93ea0 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-10.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-10.c
@@ -1,5 +1,3 @@
-/* TODO: enable for C++ once implemented. */
-/* { dg-do compile { target c } } */
/* { dg-additional-options "-Wall -fdump-tree-gimple" } */
typedef enum omp_allocator_handle_t
@@ -22,9 +20,10 @@ f()
void
h1()
{
- omp_allocator_handle_t my_handle;
+ omp_allocator_handle_t my_handle; /* { dg-line h1_my_handle_decl } */
int B1[3]; /* { dg-warning "'my_handle' is used uninitialized" } */
/* { dg-warning "variable 'B1' set but not used" "" { target *-*-* } .-1 } */
+ /* { dg-bogus "variable 'my_handle' set but not used" "" { xfail c++ } h1_my_handle_decl } */
#pragma omp allocate(B1) allocator(my_handle)
B1[0] = 5;
/* { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc" 1 "gimple" } } */
@@ -35,15 +34,17 @@ h1()
void
h2()
{
- omp_allocator_handle_t my_handle;
+ omp_allocator_handle_t my_handle; /* { dg-line h2_my_handle_decl } */
int B2[3]; /* { dg-warning "unused variable 'B2'" } */
+ /* { dg-bogus "variable 'my_handle' set but not used" "" { xfail c++ } h2_my_handle_decl } */
#pragma omp allocate(B2) allocator(my_handle) /* No warning as 'B2' is unused */
}
void
h3()
{
- omp_allocator_handle_t my_handle;
+ omp_allocator_handle_t my_handle; /* { dg-line h3_my_handle_decl } */
int B3[3] = {1,2,3}; /* { dg-warning "unused variable 'B3'" } */
+ /* { dg-bogus "variable 'my_handle' set but not used" "" { xfail c++ } h3_my_handle_decl } */
#pragma omp allocate(B3) allocator(my_handle) /* No warning as 'B3' is unused */
}
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-11.c b/gcc/testsuite/c-c++-common/gomp/allocate-11.c
index dceb97f..dd1bcd9 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-11.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-11.c
@@ -1,5 +1,9 @@
-/* TODO: enable for C++ once implemented. */
-/* { dg-do compile { target c } } */
+/* This warning is effectively bogus, it appears to only trigger after UB(?)
+ triggers an optimization that removes the case labels. We don't actually
+ want to check for this behavior. If anything we might want to ensure it
+ doesn't trigger when jumping over a variable found in an allocate directive,
+ as we are supposed to already diagnose an error for that case. */
+/* { dg-additional-options -Wno-switch-unreachable } */
void bar();
void use (int*);
@@ -7,15 +11,14 @@ void use (int*);
void
f (int i)
{
- switch (i) /* { dg-note "switch starts here" } */
+ switch (i) /* { dg-note "switch starts here" "" { xfail c++ } } */
{
- int j; /* { dg-note "'j' declared here" } */
+ int j; /* { dg-note "'j' declared here" "" { xfail c++ } } */
#pragma omp allocate(j)
- case 42: /* { dg-error "switch jumps over OpenMP 'allocate' allocation" } */
+ case 42: /* { dg-error "switch jumps over OpenMP 'allocate' allocation" "" { xfail c++ } } */
bar ();
- /* { dg-warning "statement will never be executed \\\[-Wswitch-unreachable\\\]" "" { target *-*-* } .-1 } */
break;
- case 51: /* { dg-error "switch jumps over OpenMP 'allocate' allocation" } */
+ case 51: /* { dg-error "switch jumps over OpenMP 'allocate' allocation" "" { xfail c++ } } */
use (&j);
break;
}
@@ -25,13 +28,17 @@ int
h (int i2)
{
if (i2 == 5)
- goto label; /* { dg-error "jump skips OpenMP 'allocate' allocation" } */
+ goto label; /* { dg-error "jump skips OpenMP 'allocate' allocation" "" { xfail c++ } } */
+ /* { dg-note "from here" "" { target c++ } .-1 } */
return 5;
- int k2; /* { dg-note "'k2' declared here" } */
- int j2 = 4; /* { dg-note "'j2' declared here" } */
+ int k2; /* { dg-note "'k2' declared here" "" { xfail c++ } } */
+ int j2 = 4; /* { dg-note "'j2' declared here" "" { xfail c++ } } */
+ /* { dg-note "crosses initialization of 'int j2'" "" { target c++ } .-1 } */
#pragma omp allocate(k2, j2)
-label: /* { dg-note "label 'label' defined here" } */
+label: /* { dg-note "label 'label' defined here" "" { xfail c++ } } */
+// It might make sense to make this bogus, as semantically it's assigning to the pointed at value.
+/* { dg-error "jump to label 'label'" "" { target c++ } .-2 } */
k2 = 4;
return j2 + k2;
}
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-12.c b/gcc/testsuite/c-c++-common/gomp/allocate-12.c
index 1b77db9..6f3ddd3 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-12.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-12.c
@@ -1,6 +1,3 @@
-/* TODO: enable for C++ once implemented. */
-/* { dg-do compile { target c } } */
-
typedef enum omp_allocator_handle_t
#if __cplusplus >= 201103L
: __UINTPTR_TYPE__
@@ -15,9 +12,33 @@ int
f ()
{
omp_allocator_handle_t my_allocator;
- int n = 5; /* { dg-note "to be allocated variable declared here" } */
- my_allocator = omp_default_mem_alloc; /* { dg-note "modified here" } */
- #pragma omp allocate(n) allocator(my_allocator) /* { dg-error "variable 'my_allocator' used in the 'allocator' clause must not be modified between declaration of 'n' and its 'allocate' directive" } */
+ int n = 5; /* { dg-note "to be allocated variable declared here" "" { xfail c++ } } */
+ my_allocator = omp_default_mem_alloc; /* { dg-note "modified here" "" { xfail c++ } } */
+ #pragma omp allocate(n) allocator(my_allocator) /* { dg-error "variable 'my_allocator' used in the 'allocator' clause must not be modified between declaration of 'n' and its 'allocate' directive" "" { xfail c++ } } */
+ n = 7;
+ return n;
+}
+
+int
+f1 ()
+{
+ omp_allocator_handle_t alloc;
+ {
+ int n = 42; /* { dg-note "to be allocated variable declared here" "" { xfail *-*-* } } */
+ alloc = omp_default_mem_alloc; /* { dg-note "modified here" "" { xfail *-*-* } } */
+ #pragma omp allocate(n) allocator(alloc) /* { dg-error "variable 'alloc' used in the 'allocator' clause must not be modified between declaration of 'n' and its 'allocate' directive" "" { xfail *-*-* } } */
+ n = 7;
+ return n;
+ }
+}
+
+int
+f2 ()
+{
+ omp_allocator_handle_t my_allocator;
+ int n = 5; /* { dg-note "to be allocated variable declared here" "" { xfail *-*-* } } */
+ int hide_mutation = my_allocator = omp_default_mem_alloc; /* { dg-note "modified here" "" { xfail *-*-* } } */
+ #pragma omp allocate(n) allocator(my_allocator) /* { dg-error "variable 'my_allocator' used in the 'allocator' clause must not be modified between declaration of 'n' and its 'allocate' directive" "" { xfail *-*-* } } */
n = 7;
return n;
}
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-14.c b/gcc/testsuite/c-c++-common/gomp/allocate-14.c
index 894921a..55f3739 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-14.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-14.c
@@ -1,6 +1,3 @@
-/* TODO: enable for C++ once implemented. */
-/* { dg-do compile { target c } } */
-
#pragma omp begin declare target
void
f ()
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-15.c b/gcc/testsuite/c-c++-common/gomp/allocate-15.c
index 52cb768..b448714 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-15.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-15.c
@@ -1,6 +1,3 @@
-/* TODO: enable for C++ once implemented. */
-/* { dg-do compile { target c } } */
-
#pragma omp requires dynamic_allocators
#pragma omp begin declare target
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-16.c b/gcc/testsuite/c-c++-common/gomp/allocate-16.c
index 0873803..198fe32 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-16.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-16.c
@@ -1,6 +1,3 @@
-/* TODO: enable for C++ once implemented. */
-/* { dg-do compile { target c } } */
-
typedef enum omp_allocator_handle_t
#if __cplusplus >= 201103L
: __UINTPTR_TYPE__
@@ -32,7 +29,7 @@ g ()
int a = 1;
int b[n];
b[a] = 5;
- int v; /* { dg-note "to be allocated variable declared here" } */
- a = 2; /* { dg-note "modified here" } */
- #pragma omp allocate (v) allocator (foo (a, &b[a])) /* { dg-error "variable 'a' used in the 'allocator' clause must not be modified between declaration of 'v' and its 'allocate' directive" } */
+ int v; /* { dg-note "to be allocated variable declared here" "" { xfail c++ } } */
+ a = 2; /* { dg-note "modified here" "" { xfail c++ } } */
+ #pragma omp allocate (v) allocator (foo (a, &b[a])) /* { dg-error "variable 'a' used in the 'allocator' clause must not be modified between declaration of 'v' and its 'allocate' directive" "" { xfail c++ } } */
}
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-17.c b/gcc/testsuite/c-c++-common/gomp/allocate-17.c
index f75af0c..2a896cc 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-17.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-17.c
@@ -20,7 +20,7 @@ one ()
#pragma omp target map(tofrom: result) firstprivate(n)
{
int var = 5; //, var2[n];
- #pragma omp allocate(var) align(128) allocator(omp_low_lat_mem_alloc) /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } } */
+ #pragma omp allocate(var) align(128) allocator(omp_low_lat_mem_alloc)
var = 7;
}
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-18.c b/gcc/testsuite/c-c++-common/gomp/allocate-18.c
index 49dc60f..e6ae69f 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-18.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-18.c
@@ -1,25 +1,9 @@
-typedef enum omp_allocator_handle_t
-#if __cplusplus >= 201103L
-: __UINTPTR_TYPE__
-#endif
-{
- omp_null_allocator = 0,
- omp_default_mem_alloc = 1,
- omp_large_cap_mem_alloc = 2,
- omp_const_mem_alloc = 3,
- omp_high_bw_mem_alloc = 4,
- omp_low_lat_mem_alloc = 5,
- omp_cgroup_mem_alloc = 6,
- omp_pteam_mem_alloc = 7,
- omp_thread_mem_alloc = 8,
- __omp_allocator_handle_t_max__ = __UINTPTR_MAX__
-} omp_allocator_handle_t;
+#include "allocate-allocator-handle.h"
void test0 ()
{
int A1[5], B1[5];
#pragma omp allocate(A1) align(128) allocator(omp_default_mem_alloc)
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#ifndef __cplusplus
_Static_assert (_Alignof(A1) == _Alignof(B1), "wrong alignment");
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-19.c b/gcc/testsuite/c-c++-common/gomp/allocate-19.c
index 5c5fc00..8bf8e27 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-19.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-19.c
@@ -1,3 +1,4 @@
+/* Does not include allocate-allocator-handle.h due to extra values being added. */
typedef enum omp_allocator_handle_t
#if __cplusplus >= 201103L
: __UINTPTR_TYPE__
@@ -21,7 +22,6 @@ typedef enum omp_allocator_handle_t
static int A1[5] = {1,2,3,4,5}, B1[5];
#pragma omp allocate(A1) align(128) allocator(omp_default_mem_alloc)
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#ifndef __cplusplus
_Static_assert (_Alignof(A1) == _Alignof(B1), "wrong alignment");
@@ -32,7 +32,6 @@ static_assert (alignof(A1) == alignof(B1), "wrong alignment");
static int *ptr;
#pragma omp allocate(ptr) align(2) allocator(omp_default_mem_alloc)
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#ifndef __cplusplus
_Static_assert (_Alignof(ptr) == _Alignof(int*), "wrong alignment");
@@ -46,7 +45,6 @@ get ()
{
static int q = 0;
#pragma omp allocate(q) align(1024) allocator(omp_default_mem_alloc)
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#ifndef __cplusplus
_Static_assert (_Alignof(q) == _Alignof(int), "wrong alignment");
@@ -59,11 +57,8 @@ get ()
}
static int invalid1, okay1, invalid2, invalid3;
-#pragma omp allocate(invalid1) align(128) allocator(ompx_gnu_pinned_bogus_1) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid1' is static" "" { xfail c++ } } */
+#pragma omp allocate(invalid1) align(128) allocator(ompx_gnu_pinned_bogus_1) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid1' is static" } */
#pragma omp allocate(okay1) align(128) allocator(ompx_gnu_pinned_mem_alloc) /* Okay */
-#pragma omp allocate(invalid2) align(128) allocator(ompx_gnu_pinned_bogus_2) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid2' is static" "" { xfail c++ } } */
-#pragma omp allocate(invalid3) align(128) allocator(ompx_gnu_pinned_bogus_3) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid3' is static" "" { xfail c++ } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
+#pragma omp allocate(invalid2) align(128) allocator(ompx_gnu_pinned_bogus_2) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid2' is static" } */
+#pragma omp allocate(invalid3) align(128) allocator(ompx_gnu_pinned_bogus_3) /* { dg-error "'allocator' clause requires a predefined allocator as 'invalid3' is static" } */
+
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-20.c b/gcc/testsuite/c-c++-common/gomp/allocate-20.c
new file mode 100644
index 0000000..f65af70
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-20.c
@@ -0,0 +1,337 @@
+#include "allocate-allocator-handle.h"
+
+#pragma omp allocate() allocator(omp_default_mem_alloc)
+/* { dg-error "expected identifier before '\\\)' token" "" { target c } .-1 } */
+/* { dg-error "expected unqualified-id before '\\\)' token" "" { target c++ } .-2 } */
+
+/* The following tests are broken up into multiple lines to verify they refer
+ to the correct use of the variable, this seems to be the easiest way.
+ C does not currently refer to the correct line. */
+int g;
+/* { dg-error "'g' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+#pragma omp allocate(\
+g,\
+g,\
+g,\
+g,\
+g) allocator(omp_default_mem_alloc)
+/* { dg-note "appeared first here" "" { target c++ } .-5 } */
+/* { dg-error "'g' already appeared as list item in this directive" "" { target c++ } .-5 } */
+/* { dg-error "'g' already appeared as list item in this directive" "" { target c++ } .-5 } */
+/* { dg-error "'g' already appeared as list item in this directive" "" { target c++ } .-5 } */
+/* { dg-error "'g' already appeared as list item in this directive" "" { target c++ } .-5 } */
+
+int g0_0;
+int g0_1;
+/* { dg-error "'g0_0' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+#pragma omp allocate(\
+g0_0,\
+g0_1,\
+g0_0,\
+g0_0) allocator(omp_default_mem_alloc)
+/* { dg-note "appeared first here" "" { target c++ } .-4 } */
+/* { dg-error "'g0_0' already appeared as list item in this directive" "" { target c++ } .-3 } */
+/* { dg-error "'g0_0' already appeared as list item in this directive" "" { target c++ } .-3 } */
+
+int g1_0;
+int g1_1;
+/* { dg-error "'g1_0' already appeared as list item in an 'allocate' directive" "" { target c } .+2 } */
+/* { dg-error "'g1_1' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+#pragma omp allocate(\
+g1_1,\
+g1_0,\
+g1_1,\
+g1_0,\
+g1_0,\
+g1_1) allocator(omp_default_mem_alloc)
+/* { dg-note "appeared first here" "" { target c++ } .-6 } */
+/* { dg-note "appeared first here" "" { target c++ } .-6 } */
+/* { dg-error "'g1_1' already appeared as list item in this directive" "" { target c++ } .-6 } */
+/* { dg-error "'g1_0' already appeared as list item in this directive" "" { target c++ } .-6 } */
+/* { dg-error "'g1_0' already appeared as list item in this directive" "" { target c++ } .-6 } */
+/* { dg-error "'g1_1' already appeared as list item in this directive" "" { target c++ } .-6 } */
+
+void f()
+{
+ int v;
+ /* { dg-error "'v' already appeared as list item in an 'allocate' directive" "" { target c} .+1 } */
+ #pragma omp allocate(\
+ v,\
+ v,\
+ v,\
+ v,\
+ v)
+ /* { dg-note "appeared first here" "" { target c++ } .-5 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-5 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-5 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-5 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-5 } */
+
+ int v0_0;
+ int v0_1;
+ /* { dg-error "'v0_0' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v0_0,\
+ v0_1,\
+ v0_0,\
+ v0_0)
+ /* { dg-note "appeared first here" "" { target c++ } .-4 } */
+ /* { dg-error "'v0_0' already appeared as list item in this directive" "" { target c++ } .-3 } */
+ /* { dg-error "'v0_0' already appeared as list item in this directive" "" { target c++ } .-3 } */
+
+ int v1_0;
+ int v1_1;
+ /* { dg-error "'v1_0' already appeared as list item in an 'allocate' directive" "" { target c } .+2 } */
+ /* { dg-error "'v1_1' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v1_1,\
+ v1_0,\
+ v1_1,\
+ v1_0,\
+ v1_0,\
+ v1_1)
+ /* { dg-note "appeared first here" "" { target c++ } .-6 } */
+ /* { dg-note "appeared first here" "" { target c++ } .-6 } */
+ /* { dg-error "'v1_1' already appeared as list item in this directive" "" { target c++ } .-6 } */
+ /* { dg-error "'v1_0' already appeared as list item in this directive" "" { target c++ } .-6 } */
+ /* { dg-error "'v1_0' already appeared as list item in this directive" "" { target c++ } .-6 } */
+ /* { dg-error "'v1_1' already appeared as list item in this directive" "" { target c++ } .-6 } */
+}
+
+void f_with_parm(int p) /* { dg-note "parameter 'p' declared here" "" { target c++ } } */
+{
+ #pragma omp allocate(p)
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ p,\
+ p,\
+ p)
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-3 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-3 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-3 } */
+
+ int v;
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+2 } */
+ /* { dg-error "'v' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v,\
+ p,\
+ v,\
+ v,\
+ p,\
+ v,\
+ v)
+ /* { dg-note "appeared first here" "" { target c++ } .-7 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-7 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-7 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-7 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-7 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-7 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-7 } */
+
+ int v0_0;
+ int v0_1;
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+2 } */
+ /* { dg-error "'v0_0' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ p,\
+ v0_0,\
+ v0_1,\
+ v0_0,\
+ v0_0)
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-5 } */
+ /* { dg-note "appeared first here" "" { target c++ } .-5 } */
+ /* { dg-error "'v0_0' already appeared as list item in this directive" "" { target c++ } .-4 } */
+ /* { dg-error "'v0_0' already appeared as list item in this directive" "" { target c++ } .-4 } */
+
+ int v1_0;
+ int v1_1;
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+3 } */
+ /* { dg-error "'v1_0' already appeared as list item in an 'allocate' directive" "" { target c } .+2 } */
+ /* { dg-error "'v1_1' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v1_1,\
+ p,\
+ v1_0,\
+ v1_1,\
+ v1_0,\
+ p,\
+ v1_0,\
+ v1_1,\
+ p)
+ /* { dg-note "appeared first here" "" { target c++ } .-9 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-9 } */
+ /* { dg-note "appeared first here" "" { target c++ } .-9 } */
+ /* { dg-error "'v1_1' already appeared as list item in this directive" "" { target c++ } .-9 } */
+ /* { dg-error "'v1_0' already appeared as list item in this directive" "" { target c++ } .-9 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-9 } */
+ /* { dg-error "'v1_0' already appeared as list item in this directive" "" { target c++ } .-9 } */
+ /* { dg-error "'v1_1' already appeared as list item in this directive" "" { target c++ } .-9 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-9 } */
+}
+
+/* Valid var used in allocator clause diagnostics.
+ (No diagnostic should be emitted related to 'alloc') */
+
+void f_with_parm_and_allocator0(int p) /* { dg-note "parameter 'p' declared here" "" { target c++ } } */
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ #pragma omp allocate(p) allocator(alloc)
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ p,\
+ p,\
+ p) allocator(alloc)
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-3 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-3 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-3 } */
+
+ int v;
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+2 } */
+ /* { dg-error "'v' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v,\
+ p,\
+ v,\
+ v,\
+ p,\
+ v,\
+ v) allocator(alloc)
+ /* { dg-note "appeared first here" "" { target c++ } .-7 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-7 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-7 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-7 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-7 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-7 } */
+ /* { dg-error "'v' already appeared as list item in this directive" "" { target c++ } .-7 } */
+
+ int v0_0;
+ int v0_1;
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+2 } */
+ /* { dg-error "'v0_0' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ p,\
+ v0_0,\
+ v0_1,\
+ v0_0,\
+ v0_0) allocator(alloc)
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-5 } */
+ /* { dg-note "appeared first here" "" { target c++ } .-5 } */
+ /* { dg-error "'v0_0' already appeared as list item in this directive" "" { target c++ } .-4 } */
+ /* { dg-error "'v0_0' already appeared as list item in this directive" "" { target c++ } .-4 } */
+
+ int v1_0;
+ int v1_1;
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+3 } */
+ /* { dg-error "'v1_0' already appeared as list item in an 'allocate' directive" "" { target c } .+2 } */
+ /* { dg-error "'v1_1' already appeared as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v1_1,\
+ p,\
+ v1_0,\
+ v1_1,\
+ v1_0,\
+ p,\
+ v1_0,\
+ v1_1,\
+ p) allocator(alloc)
+ /* { dg-note "appeared first here" "" { target c++ } .-9 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-9 } */
+ /* { dg-note "appeared first here" "" { target c++ } .-9 } */
+ /* { dg-error "'v1_1' already appeared as list item in this directive" "" { target c++ } .-9 } */
+ /* { dg-error "'v1_0' already appeared as list item in this directive" "" { target c++ } .-9 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-9 } */
+ /* { dg-error "'v1_0' already appeared as list item in this directive" "" { target c++ } .-9 } */
+ /* { dg-error "'v1_1' already appeared as list item in this directive" "" { target c++ } .-9 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-9 } */
+}
+
+/* Var used in allocator clause diagnostics. Tests that invalid vars passed
+ into the allocate directive are not considered and bogus/repeat diagnostics
+ are not emitted. */
+
+void f_with_parm_and_allocator1(int p) /* { dg-note "parameter 'p' declared here" "" { target c++ } } */
+{
+ int v0; /* { dg-note "to be allocated variable declared here" } */
+ omp_allocator_handle_t alloc0 = omp_default_mem_alloc; /* { dg-note "declared here" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+2 } */
+ /* { dg-error "variable 'alloc0' used in the 'allocator' clause must be declared before 'v0'" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ p,\
+ v0)\
+ allocator(alloc0)
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-3 } */
+ /* { dg-error "variable 'alloc0' used in the 'allocator' clause must be declared before 'v0'" "" { target c++ } .-2 } */
+
+ int v1; /* { dg-note "declared here" } */
+ {
+ omp_allocator_handle_t alloc1 = omp_default_mem_alloc;
+ int v2;
+ /* { dg-error "'allocate' directive must be in the same scope as 'v1'" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v1,\
+ v2\
+ ) allocator(alloc1)
+ /* { dg-error "'allocate' directive must be in the same scope as 'v1'" "" { target c++ } .-3 } */
+ }
+ {
+ int v3; /* { dg-note "to be allocated variable declared here" } */
+ omp_allocator_handle_t alloc2 = omp_default_mem_alloc; /* { dg-note "declared here" } */
+ /* { dg-error "variable 'alloc2' used in the 'allocator' clause must be declared before 'v3'" "" { target c } .+2 } */
+ /* { dg-error "'allocate' directive must be in the same scope as 'v1'" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v1,\
+ v3\
+ ) allocator(alloc2)
+ /* { dg-error "'allocate' directive must be in the same scope as 'v1'" "" { target c++ } .-3 } */
+ /* { dg-error "variable 'alloc2' used in the 'allocator' clause must be declared before 'v3'" "" { target c++ } .-2 } */
+ }
+}
+
+/* First argument valid.
+ These cases could still be fleshed out a bit more, there was original a typo
+ that caused diagnostics to always refer to the first argument of the
+ directive in the C++ front end, these tests are for that case. */
+
+void first_valid0()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ int v;
+ /* { dg-error "'allocate' directive must be in the same scope as 'a'" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v,\
+ a) /* { dg-error "'allocate' directive must be in the same scope as 'a'" "" { target c++ } } */
+ }
+}
+
+void first_valid1(int p) /* { dg-note "parameter 'p' declared here" "" { target c++ } } */
+{
+ int v;
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v,\
+ p) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } } */
+}
+
+void first_valid2(int p) /* { dg-note "parameter 'p' declared here" "" { target c++ } } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ int v;
+ /* { dg-error "'allocate' directive must be in the same scope as 'a'" "" { target c } .+2 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c } .+1 } */
+ #pragma omp allocate(\
+ v,\
+ a,\
+ p)
+ /* { dg-error "'allocate' directive must be in the same scope as 'a'" "" { target c++ } .-2 } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target c++ } .-2 } */
+ }
+}
+
+/* Missing cases that contain undeclared variables. */
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-5.c b/gcc/testsuite/c-c++-common/gomp/allocate-5.c
index 2ca4786..bd10b6f 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-5.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-5.c
@@ -21,11 +21,10 @@ foo ()
omp_allocator_handle_t my_allocator = omp_default_mem_alloc;
int a, b;
static int c;
-#pragma omp allocate (a) /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } } */
-#pragma omp allocate (b) allocator(my_allocator) /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } } */
+#pragma omp allocate (a)
+#pragma omp allocate (b) allocator(my_allocator)
#pragma omp allocate(c) align(32)
- /* { dg-message "'allocator' clause required for static variable 'c'" "" { target c } .-1 } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-2 } */
+ /* { dg-message "'allocator' clause required for static variable 'c'" "" { target *-*-* } .-1 } */
}
void
@@ -34,14 +33,14 @@ bar ()
int a, a2, b;
omp_allocator_handle_t my_allocator;
#pragma omp allocate /* { dg-error "expected '\\(' before end of line" } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate allocator(my_allocator) /* { dg-error "expected '\\(' before 'allocator'" } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate(a) foo(my_allocator) /* { dg-error "expected 'allocator'" } */
/* { dg-error "expected end of line before '\\(' token" "" { target *-*-* } .-1 } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-2 } */
-#pragma omp allocate(a2) allocator(b) /* { dg-error "'allocator' clause allocator expression has type 'int' rather than 'omp_allocator_handle_t'" "todo: cp/semantics.c" { xfail c++ } } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+#pragma omp allocate(a2) allocator(b)
+ /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" "" { target c } .-1 } */
+ /* { dg-error "variable 'b' used in the 'allocator' clause must be declared before 'a2'" "" { target c++ } .-2 } */
+ /* We have diverging behavior here between c and c++ due to a difference in
+ order of diagnostics, this should probably be unified. */
}
@@ -50,22 +49,16 @@ align_test ()
{
int i1,i2,i3,i4,i5,i6;
#pragma omp allocate(i1) allocator(omp_default_mem_alloc), align(32)
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate(i2) align ( 32 ),allocator(omp_default_mem_alloc)
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate(i3),allocator(omp_default_mem_alloc) align(32)
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate(i4) align ( 32 ) allocator(omp_default_mem_alloc)
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate(i5) allocator ( omp_high_bw_mem_alloc ), align ( 32 ) allocator(omp_default_mem_alloc)
/* { dg-error "too many 'allocator' clauses" "" { target *-*-* } .-1 } */
/* { dg-error "expected end of line before '\\)' token" "" { target *-*-* } .-2 } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-3 } */
#pragma omp allocate(i6) align ( 32 ), align(32) allocator(omp_default_mem_alloc)
/* { dg-error "too many 'align' clauses" "" { target *-*-* } .-1 } */
/* { dg-error "expected end of line before '\\)' token" "" { target *-*-* } .-2 } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-3 } */
}
void
@@ -73,9 +66,6 @@ align_test2 ()
{
int i, i2,i3;
#pragma omp allocate(i) align (32.0) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate(i2) align ( 31 ) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate(i3) align ( -32 ) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
- /* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
}
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-9.c b/gcc/testsuite/c-c++-common/gomp/allocate-9.c
index f37a111..feab8c7 100644
--- a/gcc/testsuite/c-c++-common/gomp/allocate-9.c
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-9.c
@@ -1,101 +1,75 @@
-typedef enum omp_allocator_handle_t
-#if __cplusplus >= 201103L
-: __UINTPTR_TYPE__
-#endif
-{
- omp_null_allocator = 0,
- omp_default_mem_alloc = 1,
- omp_large_cap_mem_alloc = 2,
- omp_const_mem_alloc = 3,
- omp_high_bw_mem_alloc = 4,
- omp_low_lat_mem_alloc = 5,
- omp_cgroup_mem_alloc = 6,
- omp_pteam_mem_alloc = 7,
- omp_thread_mem_alloc = 8,
- __ompx_last_mem_alloc = omp_thread_mem_alloc,
- __omp_allocator_handle_t_max__ = __UINTPTR_MAX__
-} omp_allocator_handle_t;
-
-
-static int A[5] = {1,2,3,4,5};
+#include "allocate-allocator-handle.h"
+
+static int A1[5] = {1,2,3,4,5}; /* { dg-line A_decl } */
static int A2[5] = {1,2,3,4,5};
static int A3[5] = {1,2,3,4,5};
-static int A4[5] = {1,2,3,4,5};
-static int A5[5] = {1,2,3,4,5};
-int B, C, C2, D;
+static int A4[5] = {1,2,3,4,5}; /* { dg-line A4_decl } */
+static int A5[5] = {1,2,3,4,5}; /* { dg-line A5_decl } */
+int B, C, C2, D; /* { dg-note "declared here" } */
/* If the following fails because of added predefined allocators, please update
+ - include/gomp-constants.h's GOMP_OMP_PREDEF_ALLOC_MAX or GOMP_OMPX_PREDEF_ALLOC_MAX
- c/c-parser.c's c_parser_omp_allocate
- fortran/openmp.cc's is_predefined_allocator
- libgomp/env.c's parse_allocator
- libgomp/libgomp.texi (document the new values - multiple locations)
+ ensure that the memory-spaces are also up to date. */
-#pragma omp allocate(A) align(32) allocator((omp_allocator_handle_t) 9) /* { dg-error "'allocator' clause requires a predefined allocator as 'A' is static" "" { xfail c++ } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
-
+#pragma omp allocate(A1) align(32) allocator((omp_allocator_handle_t) 9) /* { dg-error "'allocator' clause requires a predefined allocator as 'A1' is static" } */
+/* { dg-note "'A1' declared here" "" { target c++ } A_decl } */
// typo in allocator name:
#pragma omp allocate(A2) allocator(omp_low_latency_mem_alloc)
/* { dg-error "'omp_low_latency_mem_alloc' undeclared here \\(not in a function\\); did you mean 'omp_low_lat_mem_alloc'\\?" "" { target c } .-1 } */
/* { dg-error "'omp_low_latency_mem_alloc' was not declared in this scope; did you mean 'omp_low_lat_mem_alloc'\\?" "" { target c++ } .-2 } */
/* { dg-error "'allocator' clause required for static variable 'A2'" "" { target c } .-3 } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-4 } */
/* align be const multiple of 2 */
#pragma omp allocate(A3) align(31) allocator(omp_default_mem_alloc) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
-/* allocator missing (required as A is static) */
-#pragma omp allocate(A4) align(32) /* { dg-error "'allocator' clause required for static variable 'A4'" "" { xfail c++ } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+/* allocator missing (required as A4 is static) */
+#pragma omp allocate(A4) align(32) /* { dg-error "'allocator' clause required for static variable 'A4'" } */
+/* { dg-note "'A4' declared here" "" { target c++ } A4_decl } */
/* "expression in the clause must be a constant expression that evaluates to one of the
predefined memory allocator values -> omp_low_lat_mem_alloc" */
#pragma omp allocate(B) allocator((omp_allocator_handle_t) (omp_high_bw_mem_alloc+1)) align(32) /* OK: omp_low_lat_mem_alloc */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
#pragma omp allocate(C) allocator((omp_allocator_handle_t) 2) /* OK: omp_large_cap_mem_alloc */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
-#pragma omp allocate(A5) align(32) allocator(omp_null_allocator) /* { dg-error "'allocator' clause requires a predefined allocator as 'A5' is static" "" { xfail c++ } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+#pragma omp allocate(A5) align(32) allocator(omp_null_allocator) /* { dg-error "'allocator' clause requires a predefined allocator as 'A5' is static" } */
+/* { dg-note "'A5' declared here" "" { target c++ } A5_decl } */
#pragma omp allocate(C2) align(32) allocator(omp_large_cap_mem_alloc)
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
// allocate directive in same TU
int f()
{
- #pragma omp allocate(D) align(32) allocator(omp_large_cap_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'D'" "" { xfail c++ } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
-/* { dg-note "declared here" "" { target c } 25 } */
- return A[0];
+ #pragma omp allocate(D) align(32) allocator(omp_large_cap_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'D'" } */
+ return A1[0];
}
int g()
{
- int a2=1, b2=2;
+ int a2=1, b2=2; /* { dg-line g_a2_b2_decl } */
#pragma omp allocate(a2)
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
- #pragma omp allocate(a2) /* { dg-error "'a2' already appeared as list item in an 'allocate' directive" "" { xfail c++ } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+ #pragma omp allocate(a2) /* { dg-error "'a2' already appeared as list item in an 'allocate' directive" } */
+/* { dg-note "'a2' previously appeared here" "" { target c++ } .-2 } */
{
int c2=3;
- #pragma omp allocate(c2, b2) /* { dg-error "'allocate' directive must be in the same scope as 'b2'" "" { xfail c++ } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
-/* { dg-note "declared here" "" { target c } .-9 } */
+ #pragma omp allocate(c2, b2) /* { dg-error "'allocate' directive must be in the same scope as 'b2'" } */
+/* { dg-note "declared here" "" { target *-*-* } g_a2_b2_decl } */
return c2+a2+b2;
}
}
int h(int q)
{
- #pragma omp allocate(q) /* { dg-error "function parameter 'q' may not appear as list item in an 'allocate' directive" "" { xfail c++ } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+ #pragma omp allocate(q) /* { dg-error "function parameter 'q' may not appear as list item in an 'allocate' directive" } */
+/* { dg-note "parameter 'q' declared here" "" { target c++ } .-3 } */
return q;
}
@@ -103,7 +77,7 @@ int
k ()
{
static int var3 = 8;
- #pragma omp allocate(var3) allocator((omp_allocator_handle_t)-1L) /* { dg-error "'allocator' clause requires a predefined allocator as 'var3' is static" "" { target c } } */
-/* { dg-message "sorry, unimplemented: '#pragma omp allocate' not yet supported" "" { target c++ } .-1 } */
+ #pragma omp allocate(var3) allocator((omp_allocator_handle_t)-1L) /* { dg-error "'allocator' clause requires a predefined allocator as 'var3' is static" } */
+/* { dg-note "'var3' declared here" "" { target c++ } .-2 } */
return var3;
}
diff --git a/gcc/testsuite/c-c++-common/gomp/allocate-allocator-handle.h b/gcc/testsuite/c-c++-common/gomp/allocate-allocator-handle.h
new file mode 100644
index 0000000..ecb2836
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/allocate-allocator-handle.h
@@ -0,0 +1,17 @@
+typedef enum omp_allocator_handle_t
+#if __cplusplus >= 201103L
+: __UINTPTR_TYPE__
+#endif
+{
+ omp_null_allocator = 0,
+ omp_default_mem_alloc = 1,
+ omp_large_cap_mem_alloc = 2,
+ omp_const_mem_alloc = 3,
+ omp_high_bw_mem_alloc = 4,
+ omp_low_lat_mem_alloc = 5,
+ omp_cgroup_mem_alloc = 6,
+ omp_pteam_mem_alloc = 7,
+ omp_thread_mem_alloc = 8,
+ __ompx_last_mem_alloc = omp_thread_mem_alloc,
+ __omp_allocator_handle_t_max__ = __UINTPTR_MAX__
+} omp_allocator_handle_t;
diff --git a/gcc/testsuite/c-c++-common/gomp/clauses-2.c b/gcc/testsuite/c-c++-common/gomp/clauses-2.c
index 8f98d57..b4b5004 100644
--- a/gcc/testsuite/c-c++-common/gomp/clauses-2.c
+++ b/gcc/testsuite/c-c++-common/gomp/clauses-2.c
@@ -15,7 +15,7 @@ foo (int *p, int q, struct S t, int i, int j, int k, int l)
bar (p);
#pragma omp target map (p) , map (p[0])
bar (p);
- #pragma omp target map (q) map (q) /* { dg-error "appears more than once in map clauses" } */
+ #pragma omp target map (q) map (q)
bar (&q);
#pragma omp target map (p[0]) map (p[0]) /* { dg-error "appears more than once in data clauses" } */
bar (p);
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c
new file mode 100644
index 0000000..dffb19d
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-12.c
@@ -0,0 +1,22 @@
+/* { dg-do compile } */
+
+struct XYZ {
+ int a;
+ int *b;
+ int c;
+};
+
+#pragma omp declare mapper(struct XYZ t)
+/* { dg-error "missing 'map' clause" "" { target c } .-1 } */
+/* { dg-error "missing 'map' clause before end of line" "" { target c++ } .-2 } */
+
+struct ABC {
+ int *a;
+ int b;
+ int c;
+};
+
+#pragma omp declare mapper(struct ABC d) firstprivate(d.b)
+/* { dg-error "unexpected clause" "" { target c } .-1 } */
+/* { dg-error "expected end of line before '\\(' token" "" { target c } .-2 } */
+/* { dg-error "unexpected clause before '\\(' token" "" { target c++ } .-3 } */
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c
new file mode 100644
index 0000000..ecda2e5
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-15.c
@@ -0,0 +1,59 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp -fdump-tree-gimple" } */
+
+typedef struct {
+ int a, b, c, d;
+} S;
+
+int main ()
+{
+ S s;
+ #pragma omp declare mapper (S x) map(alloc: x.a) map(to: x.b) \
+ map(from: x.c) map(tofrom: x.d)
+
+ #pragma omp target enter data map(to: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(to:s\.b \[len: [0-9]+\]\) map\(alloc:s\.c \[len: [0-9]+\]\) map\(to:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+ #pragma omp target exit data map(from: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: 4\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(from:s\.c \[len: [0-9]+\]\) map\(from:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+
+ #pragma omp target enter data map(alloc: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(alloc:s\.b \[len: [0-9]+\]\) map\(alloc:s\.c \[len: [0-9]+\]\) map\(alloc:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+ #pragma omp target exit data map(release: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: [0-9]+\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(release:s\.c \[len: [0-9]+\]\) map\(release:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+
+ #pragma omp target enter data map(present, to: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(force_present:s\.a \[len: [0-9]+\]\) map\(force_present:s\.b \[len: [0-9]+\]\) map\(force_present:s\.c \[len: [0-9]+\]\) map\(force_present:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+ #pragma omp target exit data map(present, from: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: [0-9]+\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(force_present:s\.c \[len: [0-9]+\]\) map\(force_present:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+
+ #pragma omp target enter data map(always, to: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(always,to:s\.b \[len: [0-9]+\]\) map\(alloc:s\.c \[len: [0-9]+\]\) map\(always,to:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+ #pragma omp target exit data map(always, from: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: [0-9]+\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(always,from:s\.c \[len: [0-9]+\]\) map\(always,from:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+
+ #pragma omp target enter data map(always, present, to: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(force_present:s\.a \[len: [0-9]+\]\) map\(always,present,to:s\.b \[len: [0-9]+\]\) map\(force_present:s\.c \[len: [0-9]+\]\) map\(always,present,to:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+ #pragma omp target exit data map(always, present, from: s)
+
+ /* { dg-final { scan-tree-dump-times {map\(release:s\.a \[len: [0-9]+\]\) map\(release:s\.b \[len: [0-9]+\]\) map\(always,present,from:s\.c \[len: [0-9]+\]\) map\(always,present,from:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c
new file mode 100644
index 0000000..20383cc
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-16.c
@@ -0,0 +1,39 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp -fdump-tree-gimple" } */
+
+typedef struct {
+ int a, b, c, d;
+} S;
+
+int main ()
+{
+ S s = { 0, 0, 0, 0 };
+ #pragma omp declare mapper (S x) map(alloc: x.a) map(to: x.b) \
+ map(from: x.c) map(tofrom: x.d)
+
+ #pragma omp target data map(s)
+ /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(to:s\.b \[len: [0-9]+\]\) map\(from:s\.c \[len: [0-9]+\]\) map\(tofrom:s\.d \[len: [0-9]+\]\)} 3 "gimple" } } */
+ {
+ #pragma omp target
+ {
+ s.a++;
+ s.b++;
+ s.c++;
+ s.d++;
+ }
+ }
+
+ #pragma omp target data map(alloc: s)
+ /* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 4\]\) map\(alloc:s\.a \[len: [0-9]+\]\) map\(alloc:s\.b \[len: [0-9]+\]\) map\(alloc:s\.c \[len: [0-9]+\]\) map\(alloc:s\.d \[len: [0-9]+\]\)} 1 "gimple" } } */
+ {
+ #pragma omp target
+ {
+ s.a++;
+ s.b++;
+ s.c++;
+ s.d++;
+ }
+ }
+
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-17.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-17.c
new file mode 100644
index 0000000..ddbb59e
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-17.c
@@ -0,0 +1,38 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+typedef struct {
+ int a, b, c, d;
+} S;
+
+#pragma omp declare mapper (S s) map(alloc: s.a) map(to: s.b) map(from: s.c) \
+ map(tofrom: s.d)
+#pragma omp declare mapper (update: S s) map(s.a, s.b, s.c, s.d)
+
+int main()
+{
+ S v;
+#pragma omp target update to(v)
+/* { dg-warning {dropping .from. clause during mapper expansion in .#pragma omp target update.} "" { target *-*-* } .-1 } */
+/* { dg-warning {dropping .alloc. clause during mapper expansion in .#pragma omp target update.} "" { target *-*-* } .-2 } */
+/* { dg-final { scan-tree-dump-times {(?n)update to\(v\.d\) to\(v\.b\)$} 1 "original" } } */
+#pragma omp target update from(v)
+/* { dg-warning {dropping .to. clause during mapper expansion in .#pragma omp target update.} "" { target *-*-* } .-1 } */
+/* { dg-warning {dropping .alloc. clause during mapper expansion in .#pragma omp target update.} "" { target *-*-* } .-2 } */
+/* { dg-final { scan-tree-dump-times {(?n)update from\(v\.d\) from\(v\.c\)$} 1 "original" } } */
+
+#pragma omp target update to(mapper(update): v)
+/* { dg-final { scan-tree-dump-times {(?n)update to\(v\.d\) to\(v\.c\) to\(v\.b\) to\(v\.a\)$} 1 "original" } } */
+#pragma omp target update from(mapper(update): v)
+/* { dg-final { scan-tree-dump-times {(?n)update from\(v\.d\) from\(v\.c\) from\(v\.b\) from\(v\.a\)$} 1 "original" } } */
+
+#pragma omp target update to(present, mapper(update): v)
+/* { dg-final { scan-tree-dump-times {(?n)update to\(present:v\.d\) to\(present:v\.c\) to\(present:v\.b\) to\(present:v\.a\)$} 2 "original" } } */
+#pragma omp target update from(present, mapper(update): v)
+/* { dg-final { scan-tree-dump-times {(?n)update from\(present:v\.d\) from\(present:v\.c\) from\(present:v\.b\) from\(present:v\.a\)$} 2 "original" } } */
+
+#pragma omp target update to(present: v.a, v.b, v.c, v.d)
+#pragma omp target update from(present: v.a, v.b, v.c, v.d)
+
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-19.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-19.c
new file mode 100644
index 0000000..fd40c6a
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-19.c
@@ -0,0 +1,40 @@
+/* { dg-do compile } */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+
+typedef struct {
+ int *ptr;
+} S;
+
+int main(void)
+{
+#pragma omp declare mapper(grid: S x) map(([9][11]) x.ptr[3:3:2][1:4:3])
+ S q;
+ q.ptr = (int *) calloc (9 * 11, sizeof (int));
+
+ /* The 'grid' mapper specifies a noncontiguous region, so it can't be used
+ for 'map' like this. */
+#pragma omp target enter data map(mapper(grid), to: q)
+/* { dg-error {array section is not contiguous in .map. clause} "" { target *-*-* } .-1 } */
+/* { dg-error {.#pragma omp target enter data. must contain at least one .map. clause} "" { target *-*-* } .-2 } */
+
+#pragma omp target
+ for (int i = 0; i < 9*11; i++)
+ q.ptr[i] = i;
+
+ /* It's OK on a 'target update' directive though. */
+#pragma omp target update from(mapper(grid): q)
+
+ for (int j = 0; j < 9; j++)
+ for (int i = 0; i < 11; i++)
+ if (j >= 3 && j <= 7 && ((j - 3) % 2) == 0
+ && i >= 1 && i <= 10 && ((i - 1) % 3) == 0)
+ assert (q.ptr[j * 11 + i] == j * 11 + i);
+
+#pragma omp target exit data map(mapper(grid), release: q)
+/* { dg-error {array section is not contiguous in .map. clause} "" { target *-*-* } .-1 } */
+/* { dg-error {.#pragma omp target exit data. must contain at least one .map. clause} "" { target *-*-* } .-2 } */
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c
new file mode 100644
index 0000000..e491bcd
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-3.c
@@ -0,0 +1,30 @@
+// { dg-do compile }
+// { dg-additional-options "-fdump-tree-gimple" }
+
+#include <stdlib.h>
+
+// Test named mapper invocation.
+
+struct S {
+ int *ptr;
+ int size;
+};
+
+int main (int argc, char *argv[])
+{
+ int N = 1024;
+#pragma omp declare mapper (mapN:struct S s) map(to:s.ptr, s.size) \
+ map(s.ptr[:N])
+
+ struct S s;
+ s.ptr = (int *) malloc (sizeof (int) * N);
+
+#pragma omp target map(mapper(mapN), tofrom: s)
+// { dg-final { scan-tree-dump {map\(struct:s \[len: 2\]\) map\(alloc:s\.ptr \[len: [0-9]+\]\) map\(to:s\.size \[len: [0-9]+\]\) map\(tofrom:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} "gimple" } }
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c
new file mode 100644
index 0000000..39e3ab1
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-4.c
@@ -0,0 +1,78 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+/* Check mapper binding clauses. */
+
+struct Y {
+ int z;
+};
+
+struct Z {
+ int z;
+};
+
+#pragma omp declare mapper (struct Y y) map(tofrom: y)
+#pragma omp declare mapper (struct Z z) map(tofrom: z)
+
+int foo (void)
+{
+ struct Y yy;
+ struct Z zz;
+ int dummy;
+
+#pragma omp target data map(dummy)
+ {
+ #pragma omp target
+ {
+ yy.z++;
+ zz.z++;
+ }
+ yy.z++;
+ }
+ return yy.z;
+}
+
+struct P
+{
+ struct Z *zp;
+};
+
+int bar (void)
+{
+ struct Y yy;
+ struct Z zz;
+ struct P pp;
+ struct Z t;
+ int dummy;
+
+ pp.zp = &t;
+
+#pragma omp declare mapper (struct Y y) map(tofrom: y.z)
+#pragma omp declare mapper (struct Z z) map(tofrom: z.z)
+
+#pragma omp target data map(dummy)
+ {
+ #pragma omp target
+ {
+ yy.z++;
+ zz.z++;
+ }
+ yy.z++;
+ }
+
+ #pragma omp declare mapper(struct P x) map(to:x.zp) map(tofrom:*x.zp)
+
+ #pragma omp target
+ {
+ zz = *pp.zp;
+ }
+
+ return zz.z;
+}
+
+/* { dg-final { scan-tree-dump-times {mapper_binding\(struct Y,omp declare mapper ~1Y\) mapper_binding\(struct Z,omp declare mapper ~1Z\)} 2 "original" { target c++ } } } */
+/* { dg-final { scan-tree-dump {mapper_binding\(struct Z,omp declare mapper ~1Z\) mapper_binding\(struct P,omp declare mapper ~1P\)} "original" { target c++ } } } */
+
+/* { dg-final { scan-tree-dump {mapper_binding\(struct Z,#pragma omp declare mapper \(struct Z z\) map\(tofrom:z\)\) mapper_binding\(struct Y,#pragma omp declare mapper \(struct Y y\) map\(tofrom:y\)\)} "original" { target c } } } */
+/* { dg-final { scan-tree-dump {mapper_binding\(struct Z,#pragma omp declare mapper \(struct Z z\) map\(tofrom:z\.z\)\) mapper_binding\(struct Y,#pragma omp declare mapper \(struct Y y\) map\(tofrom:y\.z\)\)} "original" { target c } } } */
+/* { dg-final { scan-tree-dump {mapper_binding\(struct P,#pragma omp declare mapper \(struct P x\) map\(tofrom:\(x\.zp\)\[0:1\]\) map\(to:x.zp\)\) mapper_binding\(struct Z,#pragma omp declare mapper \(struct Z z\) map\(tofrom:z\.z\)\)} "original" { target c } } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c
new file mode 100644
index 0000000..86f14e7
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-5.c
@@ -0,0 +1,26 @@
+/* { dg-do compile } */
+
+typedef struct S_ {
+ int *myarr;
+ int size;
+} S;
+
+#pragma omp declare mapper (named: struct S_ v) map(to:v.size, v.myarr) \
+ map(tofrom: v.myarr[0:v.size])
+/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-2 } */
+/* { dg-note "'#pragma omp declare mapper \\(named: S_\\)' previously defined here" "" { target c++ } .-3 } */
+
+#pragma omp declare mapper (named: S v) map(to:v.size, v.myarr) \
+ map(tofrom: v.myarr[0:v.size])
+/* { dg-error "redeclaration of 'named' '#pragma omp declare mapper' for type 'S' \\\{aka 'struct S_'\\\}" "" { target c } .-2 } */
+/* { dg-error "redefinition of '#pragma omp declare mapper \\(named: S\\)'" "" { target c++ } .-3 } */
+
+#pragma omp declare mapper (struct S_ v) map(to:v.size, v.myarr) \
+ map(tofrom: v.myarr[0:v.size])
+/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-2 } */
+/* { dg-note "'#pragma omp declare mapper \\(S_\\)' previously defined here" "" { target c++ } .-3 } */
+
+#pragma omp declare mapper (S v) map(to:v.size, v.myarr) \
+ map(tofrom: v.myarr[0:v.size])
+/* { dg-error "redeclaration of '<default>' '#pragma omp declare mapper' for type 'S' \\\{aka 'struct S_'\\\}" "" { target c } .-2 } */
+/* { dg-error "redefinition of '#pragma omp declare mapper \\(S\\)'" "" { target c++ } .-3 } */
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c
new file mode 100644
index 0000000..c13eb8b
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-6.c
@@ -0,0 +1,23 @@
+/* { dg-do compile } */
+
+int x = 5;
+
+struct Q {
+ int *arr1;
+ int *arr2;
+ int *arr3;
+};
+
+#pragma omp declare mapper (struct Q myq) map(myq.arr2[0:x])
+
+struct R {
+ int *arr1;
+ int *arr2;
+ int *arr3;
+};
+
+#pragma omp declare mapper (struct R myr) map(myr.arr3[0:y])
+/* { dg-error "'y' undeclared" "" { target c } .-1 } */
+/* { dg-error "'y' was not declared in this scope" "" { target c++ } .-2 } */
+
+int y = 7;
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c
new file mode 100644
index 0000000..0f8dd25
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-7.c
@@ -0,0 +1,29 @@
+/* { dg-do compile } */
+
+struct Q {
+ int *arr1;
+ int *arr2;
+ int *arr3;
+};
+
+int foo (void)
+{
+ int x = 5;
+ #pragma omp declare mapper (struct Q myq) map(myq.arr2[0:x])
+ return x;
+}
+
+struct R {
+ int *arr1;
+ int *arr2;
+ int *arr3;
+};
+
+int bar (void)
+{
+ #pragma omp declare mapper (struct R myr) map(myr.arr3[0:y])
+ /* { dg-error "'y' undeclared" "" { target c } .-1 } */
+ /* { dg-error "'y' was not declared in this scope" "" { target c++ } .-2 } */
+ int y = 7;
+ return y;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c
new file mode 100644
index 0000000..dadca28
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-8.c
@@ -0,0 +1,43 @@
+/* { dg-do compile } */
+
+struct Q {
+ int *arr1;
+ int *arr2;
+ int *arr3;
+ int len;
+};
+
+struct R {
+ struct Q qarr[5];
+};
+
+struct R2 {
+ struct Q *qptr;
+};
+
+#pragma omp declare mapper (struct Q myq) map(myq.arr1[0:myq.len]) \
+ map(myq.arr2[0:myq.len]) \
+ map(myq.arr3[0:myq.len])
+
+#pragma omp declare mapper (struct R myr) map(myr.qarr[2:3])
+
+#pragma omp declare mapper (struct R2 myr2) map(myr2.qptr[2:3])
+
+int main (int argc, char *argv[])
+{
+ struct R r;
+ struct R2 r2;
+ int N = 256;
+
+#pragma omp target
+/* { dg-message "sorry, unimplemented: user-defined mapper with non-unit length array section" "" { target *-*-* } .-1 } */
+ {
+ for (int i = 2; i < 5; i++)
+ for (int j = 0; j < N; j++)
+ {
+ r.qarr[i].arr1[j]++;
+ r2.qptr[i].arr2[j]++;
+ }
+ }
+}
+
diff --git a/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c b/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c
new file mode 100644
index 0000000..b568c5a
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/declare-mapper-9.c
@@ -0,0 +1,34 @@
+/* { dg-do compile } */
+
+int x = 5;
+
+struct Q {
+ int *arr1;
+ int *arr2;
+ int *arr3;
+};
+
+int y = 5;
+
+#pragma omp declare mapper (struct Q myq) map(myq.arr2[0:x])
+/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-1 } */
+/* { dg-note "'#pragma omp declare mapper \\(Q\\)' previously defined here" "" { target c++ } .-2 } */
+
+#pragma omp declare mapper (struct Q myq) map(myq.arr2[0:y])
+/* { dg-error "redeclaration of '<default>' '#pragma omp declare mapper' for type 'struct Q'" "" { target c } .-1 } */
+/* { dg-error "redefinition of '#pragma omp declare mapper \\(Q\\)'" "" { target c++ } .-2 } */
+
+struct R {
+ int *arr1;
+};
+
+void foo (void)
+{
+#pragma omp declare mapper (struct R myr) map(myr.arr1[0:x])
+/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-1 } */
+/* { dg-note "'#pragma omp declare mapper \\(R\\)' previously declared here" "" { target c++ } .-2 } */
+
+#pragma omp declare mapper (struct R myr) map(myr.arr1[0:y])
+/* { dg-error "redeclaration of '<default>' '#pragma omp declare mapper' for type 'struct R'" "" { target c } .-1 } */
+/* { dg-error "redeclaration of '#pragma omp declare mapper \\(R\\)'" "" { target c++ } .-2 } */
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-1.c b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-1.c
new file mode 100644
index 0000000..28cac0d
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-1.c
@@ -0,0 +1,55 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Check basic functionality for the delimited form of "declare variant"
+ - no error re duplicate definitions
+ - variants are registered and correctly resolved at call site. */
+
+int foo (int a)
+{
+ return a;
+}
+
+int bar (int x)
+{
+ return x;
+}
+
+#pragma omp begin declare variant match (construct={target})
+int foo (int a)
+{
+ return a + 1;
+}
+
+int bar (int x)
+{
+ return x * 2;
+}
+#pragma omp end declare variant
+
+/* Because of the high score value, this variant for "bar" should always be
+ selected even when the one above also matches. */
+#pragma omp begin declare variant match (implementation={vendor(score(10000):"gnu")})
+int bar (int x)
+{
+ return x * 4;
+}
+#pragma omp end declare variant
+
+int main (void)
+{
+ if (foo (42) != 42) __builtin_abort ();
+ if (bar (3) != 12) __builtin_abort ();
+#pragma omp target
+ {
+ if (foo (42) != 43) __builtin_abort ();
+ if (bar (3) != 12) __builtin_abort ();
+ }
+}
+
+/* { dg-final { scan-tree-dump-times "omp declare variant base \\(foo.ompvariant." 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "omp declare variant base \\(bar.ompvariant." 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "foo \\(42\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "foo\\.ompvariant. \\(42\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "bar \\(3\\)" 0 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "bar\\.ompvariant. \\(3\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-2.c b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-2.c
new file mode 100644
index 0000000..03bfe27
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-2.c
@@ -0,0 +1,66 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-foffload=disable -fdump-tree-original" } */
+
+/* Check for elision of preprocessed code in a begin/end declare variant
+ construct when it can be determined at parse time that the selector
+ can never match. */
+
+int foobar (int x, int y)
+{
+ return x * y;
+}
+
+int baz (int x)
+{
+ return x;
+}
+
+#pragma omp begin declare variant match (implementation={vendor("acme")}) /* { dg-warning "unknown property" } */
+int foobar (int x, int y)
+{
+ random junk that would ordinarily cause a parse error;
+ return x + y;
+}
+#pragma omp end declare variant
+
+#pragma omp begin declare variant match (device={kind(fpga)})
+int foobar (int x, int y)
+{
+ random junk that would ordinarily cause a parse error;
+ return x + y;
+}
+#pragma omp end declare variant
+
+/* Per the OpenMP specification, elision only happens when the implementation
+ or device selectors cannot match; the user/condition selector doesn't
+ matter for this. */
+#pragma omp begin declare variant match (user={condition (0)})
+int foobar (int x, int y)
+{
+ return x + y;
+}
+#pragma omp end declare variant
+
+/* Check that we're finding the right "omp end declare variant" when
+ constructs are nested. */
+#pragma omp begin declare variant match (implementation={vendor("acme")}) /* { dg-warning "unknown property" } */
+ #pragma omp begin declare variant match (device={kind(fpga)})
+ int baz (int x)
+ {
+ random junk that would ordinarily cause a parse error;
+ return x + 1;
+ }
+ #pragma omp end declare variant
+ #pragma omp begin declare variant match (device={kind(host)})
+ int baz (int x)
+ {
+ random junk that would ordinarily cause a parse error;
+ return x + 2;
+ }
+ #pragma omp end declare variant
+#pragma omp end declare variant
+
+/* { dg-final { scan-tree-dump-times "foobar.ompvariant" 1 "original" } } */
+/* { dg-final { scan-tree-dump-not "baz.ompvariant" "original" } } */
+
+
diff --git a/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-3.c b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-3.c
new file mode 100644
index 0000000..63d10d7
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-3.c
@@ -0,0 +1,50 @@
+/* { dg-do compile } */
+
+/* Check that an error is diagnosed when a function defined in a
+ "begin declare variant" construct doesn't have a visible declaration
+ at that point.
+
+ The spec is not completely clear on this; it says the base function must be
+ "declared elsewhere without an associated declare variant directive",
+ without defining what "elsewhere" means. Particularly in C++ it would be
+ incorrect to inject such a declaration at the point of the variant
+ definition (think of a variant for a class method that is defined with a
+ qualified name outside of the class declaration, for instance). The C++
+ front end could differentiate between cases where base declaration injection
+ is allowed vs not, but for now it seems simplest just to require that a
+ definition always be visible. */
+
+/* This declaration of baz is incompatible with the variant below. */
+extern double baz (double, double);
+
+/* This is not a function at all. */
+extern int quux;
+
+#pragma omp begin declare variant match (construct={target})
+int foo (int a) /* { dg-error "no previous declaration of base function" } */
+{
+ return a + 1;
+}
+
+int bar (int x) /* { dg-error "no previous declaration of base function" } */
+{
+ return x * 2;
+}
+
+int baz (int x) /* { dg-error "variant function definition does not match previous declaration of .baz." } */
+{
+ return x * 2;
+}
+
+int quux (int x, int y) /* { dg-error "variant function definition does not match previous declaration of .quux." } */
+{
+ return x + y;
+}
+#pragma omp end declare variant
+
+/* This later definition of foo doesn't count for resolving the variant
+ above. */
+int foo (int a)
+{
+ return a;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-4.c b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-4.c
new file mode 100644
index 0000000..f6726ab
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-4.c
@@ -0,0 +1,31 @@
+/* { dg-do compile } */
+
+/* Check that a proper error is diagnosed if an "omp begin declare variant"
+ construct has an invalid selector, and that this causes the whole variant
+ to be skipped over rather than a duplicate definition error. */
+
+int foo (int a)
+{
+ return a;
+}
+
+#pragma omp begin declare variant match (construct=target) /* { dg-error "expected '\{' before 'target'" } */
+int foo (int a)
+{
+ return a + 1;
+}
+
+#pragma omp end declare variant
+
+int bar (int x)
+{
+ return x;
+}
+
+#pragma omp begin declare variant match (gibberish = {blah(1)}) /* { dg-error "expected context selector set name" } */
+int bar (int x)
+{
+ return x + 2;
+}
+
+#pragma omp end declare variant
diff --git a/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-5.c b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-5.c
new file mode 100644
index 0000000..4e1645b
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-5.c
@@ -0,0 +1,26 @@
+/* { dg-do compile } */
+
+/* Check that the simd trait is rejected in the match clause for
+ "begin declare variant". */
+
+int foo (int a)
+{
+ return a;
+}
+
+int bar (int x)
+{
+ return x;
+}
+
+#pragma omp begin declare variant match (construct={target, simd}) /* { dg-error "the 'simd' selector is not permitted" } */
+int foo (int a)
+{
+ return a + 1;
+}
+
+int bar (int x)
+{
+ return x * 2;
+}
+#pragma omp end declare variant
diff --git a/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-6.c b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-6.c
new file mode 100644
index 0000000..9b03b00
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-6.c
@@ -0,0 +1,71 @@
+/* { dg-do compile { target x86_64-*-* } } */
+/* { dg-additional-options "-fdump-tree-gimple -foffload=disable" } */
+
+/* Test merging of context selectors for nested "begin declare variant"
+ directives.
+
+ The spec (TR12) says: "the effective context selectors of the outer
+ directive are appended do the context selector of the inner directive to
+ form the effective context selector of the inner directive. If a
+ trait-set-selector is present on both directives, the trait-selector list of
+ the outer directive is appended to the trait-selector list of the inner
+ directive after equivalent trait-selectors have been removed from the outer
+ list." */
+
+int f1 (int x) { return x; }
+int f2 (int x) { return x; }
+int f3 (int x) { return x; }
+int f4 (int x) { return x; }
+int f5 (int x) { return x; }
+
+/* Check that duplicate traits can be detected, even when the properties
+ use different forms. (If these were considered different, it would
+ trigger an error instead.) */
+#pragma omp begin declare variant match (implementation={vendor(gnu)})
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+int f1 (int x) { return -x; }
+#pragma omp end declare variant
+#pragma omp end declare variant
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+#pragma omp begin declare variant match (implementation={vendor(gnu)})
+int f2 (int x) { return -x; }
+#pragma omp end declare variant
+#pragma omp end declare variant
+
+/* Check that non-duplicate traits are collected from both inner and outer. */
+
+#pragma omp begin declare variant match (device={kind("host")})
+#pragma omp begin declare variant match (device={arch("x86_64")})
+int f3 (int x) { return -x; }
+#pragma omp end declare variant
+#pragma omp end declare variant
+/* { dg-final { scan-tree-dump "f3\\.ompvariant.*kind \\(.host.\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "f3\\.ompvariant.*arch \\(.x86_64.\\)" "gimple" } } */
+
+/* Check that traits for construct selectors merge as expected. */
+
+#pragma omp begin declare variant match (construct={parallel, for})
+#pragma omp begin declare variant match (construct={teams})
+int f4 (int x) { return -x; }
+#pragma omp end declare variant
+#pragma omp end declare variant
+/* { dg-final { scan-tree-dump "f4\\.ompvariant.*teams, parallel, for" "gimple" } } */
+
+/* Check that multiple trait sets are collected. */
+
+extern int flag;
+
+#pragma omp begin declare variant match (construct={parallel, for})
+#pragma omp begin declare variant match (construct={teams})
+#pragma omp begin declare variant match (user={condition(flag)})
+#pragma omp begin declare variant match (device={kind("host")})
+int f5 (int x) { return -x; }
+#pragma omp end declare variant
+#pragma omp end declare variant
+#pragma omp end declare variant
+#pragma omp end declare variant
+/* { dg-final { scan-tree-dump "f5\\.ompvariant.*teams, parallel, for" "gimple" } } */
+/* { dg-final { scan-tree-dump "f5\\.ompvariant.*flag" "gimple" } } */
+/* { dg-final { scan-tree-dump "f5\\.ompvariant.*kind \\(.host.\\)" "gimple" } } */
+
diff --git a/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-7.c b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-7.c
new file mode 100644
index 0000000..49a1d53
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/delim-declare-variant-7.c
@@ -0,0 +1,27 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Test that merging of context selectors from an enclosing "begin declare
+ variant" directive applies to nested regular "declare variant" directives
+ (not just nested "begin declare variant", which is tested elsewhere). */
+
+extern int foo1 (int);
+extern int foo2 (int);
+
+#pragma omp begin declare variant match (implementation={vendor(gnu)})
+
+#pragma omp declare variant (foo1) \
+ match (construct={parallel,for})
+#pragma omp declare variant (foo2) \
+ match (device={kind(any)})
+extern int foo (int);
+
+#pragma omp end declare variant
+
+int foo (int x)
+{
+ return x + 42;
+}
+
+/* { dg-final { scan-tree-dump-times "omp declare variant base" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "vendor \\(.gnu.\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/directive-1.c b/gcc/testsuite/c-c++-common/gomp/directive-1.c
index 21ca319..e3ede6e 100644
--- a/gcc/testsuite/c-c++-common/gomp/directive-1.c
+++ b/gcc/testsuite/c-c++-common/gomp/directive-1.c
@@ -19,7 +19,6 @@ foo (void)
int i, k = 0, l = 0;
#pragma omp allocate, (i) /* { dg-error "expected '\\\(' before ',' token" } */
/* { dg-error "expected end of line before ',' token" "" { target c++ } .-1 } */
- /* { dg-message "not yet supported" "" { target c++ } .-2 } */
#pragma omp critical, (bar) /* { dg-error "expected an OpenMP clause before '\\\(' token" } */
;
#pragma omp flush, (k, l) /* { dg-error "expected '\\\(' or end of line before ',' token" "" { target c } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/map-6.c b/gcc/testsuite/c-c++-common/gomp/map-6.c
index 014ed35..dc9a8c6 100644
--- a/gcc/testsuite/c-c++-common/gomp/map-6.c
+++ b/gcc/testsuite/c-c++-common/gomp/map-6.c
@@ -13,19 +13,19 @@ foo (void)
#pragma omp target map (to:a)
;
- #pragma omp target map (a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */
+ #pragma omp target map (a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'iterator', 'mapper' or 'present'" } */
;
- #pragma omp target map (close, a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */
+ #pragma omp target map (close, a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'iterator', 'mapper' or 'present'" } */
;
- #pragma omp target enter data map(b7) map (close, a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */
+ #pragma omp target enter data map(b7) map (close, a to: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'iterator', 'mapper' or 'present'" } */
;
- #pragma omp target exit data map(b7) map (close, a from: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */
+ #pragma omp target exit data map(b7) map (close, a from: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'iterator', 'mapper' or 'present'" } */
;
- #pragma omp target data map(b7) map (close, a from: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close' or 'present'" } */
+ #pragma omp target data map(b7) map (close, a from: b) /* { dg-error "'map' clause with map-type modifier other than 'always', 'close', 'iterator', 'mapper' or 'present'" } */
;
@@ -157,10 +157,10 @@ foo (void)
#pragma omp target map (always, close)
;
- #pragma omp target map (always, always) /* { dg-error "'always' appears more than once in map clauses" } */
+ #pragma omp target map (always, always)
;
- #pragma omp target map (always, always, close) /* { dg-error "'always' appears more than once in map clauses" } */
+ #pragma omp target map (always, always, close)
;
#pragma omp target map (always, close, to: always, close, b7)
diff --git a/gcc/testsuite/c-c++-common/gomp/pr118579.c b/gcc/testsuite/c-c++-common/gomp/pr118579.c
index 2a96085..5d2de9a 100644
--- a/gcc/testsuite/c-c++-common/gomp/pr118579.c
+++ b/gcc/testsuite/c-c++-common/gomp/pr118579.c
@@ -6,7 +6,8 @@ void fvar(int *, int *);
#pragma omp declare variant(fvar) \
match(construct={dispatch}) \
adjust_args(need_device_ptr: yyy, xxx, xxx)
-/* { dg-error "37: .xxx. is specified more than once" "" { target *-*-* } .-1 } */
+/* { dg-error "42: OpenMP parameter list items must specify a unique parameter" "" { target *-*-* } .-1 } */
+/* { dg-note "37: parameter previously specified here" "" { target *-*-* } .-2 } */
void f(int *xxx, int*yyy);
diff --git a/gcc/testsuite/c-c++-common/gomp/target-map-iterators-1.c b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-1.c
new file mode 100644
index 0000000..70076bd
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-1.c
@@ -0,0 +1,23 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp" } */
+
+#define DIM1 17
+#define DIM2 39
+
+void f (int **x, int **y)
+{
+ #pragma omp target map(iterator(i=0:DIM1), to: x[i][:DIM2])
+ ;
+
+ #pragma omp target map(iterator(i=0:DIM1), to: x[i][:DIM2], y[i][:DIM2])
+ ;
+
+ #pragma omp target map(iterator(i=0:DIM1), to: x[i][:DIM2] + 2)
+ ;
+
+ #pragma omp target map(iterator(i=0:DIM1), iterator(j=0:DIM2), to: x[i][j]) /* { dg-error "too many 'iterator' modifiers" } */
+ ;
+
+ #pragma omp target map(iterator(i=0:DIM1), to: (i % 2 == 0) ? x[i] : y[i]) /* { dg-message "unsupported map expression" } */
+ ;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/target-map-iterators-2.c b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-2.c
new file mode 100644
index 0000000..57ebb10
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-2.c
@@ -0,0 +1,25 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp -fdump-tree-gimple" } */
+
+void f (int *x, float *y, double *z)
+{
+ #pragma omp target map(iterator(i=0:10), to: x) /* { dg-warning "iterator variable .i. not used in clause expression" } */
+ /* Add a reference to x to ensure that the 'to' clause does not get
+ dropped. */
+ x[0] = 0;
+
+ #pragma omp target map(iterator(i2=0:10, j2=0:20), from: x[i2]) /* { dg-warning "iterator variable .j2. not used in clause expression" } */
+ ;
+
+ #pragma omp target map(iterator(i3=0:10, j3=0:20, k3=0:30), to: x[i3+j3], y[j3+k3], z[k3+i3])
+ /* { dg-warning "iterator variable .i3. not used in clause expression" "" { target *-*-* } .-1 } */
+ /* { dg-warning "iterator variable .j3. not used in clause expression" "" { target *-*-* } .-2 } */
+ /* { dg-warning "iterator variable .k3. not used in clause expression" "" { target *-*-* } .-3 } */
+ ;
+}
+
+/* { dg-final { scan-tree-dump-times "map\\\(to:x" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\\(iterator\\\(int i2=0:10:1, loop_label=\[^\\\)\]+\\\):from:" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\\(iterator\\\(int i3=0:10:1, int j3=0:20:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\\(iterator\\\(int j3=0:20:1, int k3=0:30:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\\(iterator\\\(int i3=0:10:1, int k3=0:30:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/target-map-iterators-3.c b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-3.c
new file mode 100644
index 0000000..87b32e4
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-3.c
@@ -0,0 +1,23 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp -fdump-tree-gimple" } */
+
+#define DIM1 10
+#define DIM2 20
+#define DIM3 30
+
+void f (int ***x, float ***y, double **z)
+{
+ #pragma omp target \
+ map(to: x, y) \
+ map(iterator(i=0:DIM1, j=0:DIM2), to: x[i][j][:DIM3], y[i][j][:DIM3]) \
+ map(from: z) \
+ map(iterator(i=0:DIM1), from: z[i][:DIM2])
+ ;
+}
+
+/* { dg-final { scan-tree-dump-times "if \\(i <= 9\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 3 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "if \\(j <= 19\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(iterator\\(int i=0:10:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=\[0-9\]+\\):from:\\*D\\\.\[0-9\]+" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(iterator\\(int i=0:10:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=\[0-9\]+\\):attach:\\*D\\\.\[0-9\]+" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(iterator\\(int i=0:10:1, int j=0:20:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=\[0-9\]+\\):to:\\*D\\\.\[0-9\]+" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\(iterator\\(int i=0:10:1, int j=0:20:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=\[0-9\]+\\):attach:\\*D\\\.\[0-9\]+" 4 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/target-map-iterators-4.c b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-4.c
new file mode 100644
index 0000000..5dc5ad5
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-4.c
@@ -0,0 +1,18 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp -fdump-tree-gimple" } */
+/* { dg-additional-options "-std=c++98" { target c++ } } */
+
+int bar (int, int);
+void baz (int, int *);
+#pragma omp declare target enter (baz)
+
+void
+foo (int x, int *p)
+{
+ #pragma omp target map (iterator (i=0:4), to: p[bar (x, i)])
+ baz (x, p);
+}
+
+/* { dg-final { scan-tree-dump "firstprivate\\\(x\\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump-times "bar \\\(x, i\\\)" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "map\\\(iterator\\\(int i=0:4:1, loop_label=" 2 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/target-map-iterators-5.c b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-5.c
new file mode 100644
index 0000000..e79e6a5
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/target-map-iterators-5.c
@@ -0,0 +1,14 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp -fdump-tree-omplower" } */
+
+#define DIM2 17
+
+void f (int **x, int lbound, int ubound, int stride)
+{
+ #pragma omp target map(to:x) map(iterator(i=lbound:ubound:stride), to: x[i][:DIM2])
+ ;
+}
+
+/* { dg-final { scan-tree-dump-times "_\[0-9\]+ = ubound - lbound;" 2 "omplower" } } */
+/* { dg-final { scan-tree-dump-times "D\\\.\[0-9\]+ = __builtin_malloc \\(D\\\.\[0-9\]+\\);" 2 "omplower" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_free \\(omp_iter_data\\\.\[0-9\]+\\);" 2 "omplower" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/target-update-iterators-1.c b/gcc/testsuite/c-c++-common/gomp/target-update-iterators-1.c
new file mode 100644
index 0000000..64602d4
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/target-update-iterators-1.c
@@ -0,0 +1,20 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp" } */
+
+#define DIM1 17
+#define DIM2 39
+
+void f (int **x, float **y)
+{
+ #pragma omp target update to (iterator(i=0:DIM1): x[i][:DIM2])
+
+ #pragma omp target update to (iterator(i=0:DIM1): x[i][:DIM2], y[i][:DIM2])
+
+ #pragma omp target update to (iterator(i=0:DIM1), present: x[i][:DIM2])
+
+ #pragma omp target update to (iterator(i=0:DIM1), iterator(j=0:DIM2): x[i][j]) /* { dg-error "too many 'iterator' modifiers" } */
+ /* { dg-error ".#pragma omp target update. must contain at least one .from. or .to. clauses" "" { target *-*-* } .-1 } */
+
+ #pragma omp target update to (iterator(i=0:DIM1), something: x[i][j]) /* { dg-error ".to. or .from. clause with modifier other than .iterator., .mapper. or .present. before .something." } */
+ /* { dg-error ".#pragma omp target update. must contain at least one .from. or .to. clauses" "" { target *-*-* } .-1 } */
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/target-update-iterators-2.c b/gcc/testsuite/c-c++-common/gomp/target-update-iterators-2.c
new file mode 100644
index 0000000..ae0a222
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/target-update-iterators-2.c
@@ -0,0 +1,23 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp -fdump-tree-gimple" } */
+
+void f (int *x, float *y, double *z)
+{
+ #pragma omp target update to(iterator(i=0:10): x) /* { dg-warning "iterator variable .i. not used in clause expression" }*/
+ ;
+
+ #pragma omp target update from(iterator(i2=0:10, j2=0:20): x[i2]) /* { dg-warning "iterator variable .j2. not used in clause expression" }*/
+ ;
+
+ #pragma omp target update to(iterator(i3=0:10, j3=0:20, k3=0:30): x[i3+j3], y[j3+k3], z[k3+i3])
+ /* { dg-warning "iterator variable .i3. not used in clause expression" "" { target *-*-* } .-1 } */
+ /* { dg-warning "iterator variable .j3. not used in clause expression" "" { target *-*-* } .-2 } */
+ /* { dg-warning "iterator variable .k3. not used in clause expression" "" { target *-*-* } .-3 } */
+ ;
+}
+
+/* { dg-final { scan-tree-dump "update to\\\(x " "gimple" } } */
+/* { dg-final { scan-tree-dump "update from\\\(iterator\\\(int i2=0:10:1, loop_label=" "gimple" } } */
+/* { dg-final { scan-tree-dump "to\\\(iterator\\\(int i3=0:10:1, int k3=0:30:1, loop_label=" "gimple" } } */
+/* { dg-final { scan-tree-dump "to\\\(iterator\\\(int j3=0:20:1, int k3=0:30:1, loop_label=" "gimple" } } */
+/* { dg-final { scan-tree-dump "to\\\(iterator\\\(int i3=0:10:1, int j3=0:20:1, loop_label=" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/target-update-iterators-3.c b/gcc/testsuite/c-c++-common/gomp/target-update-iterators-3.c
new file mode 100644
index 0000000..6618962
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/target-update-iterators-3.c
@@ -0,0 +1,17 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp -fdump-tree-gimple" } */
+
+#define DIM1 10
+#define DIM2 20
+#define DIM3 30
+
+void f (int ***x, float ***y, double **z)
+{
+ #pragma omp target update to (iterator(i=0:DIM1, j=0:DIM2): x[i][j][:DIM3], y[i][j][:DIM3])
+ #pragma omp target update from (iterator(i=0:DIM1): z[i][:DIM2])
+}
+
+/* { dg-final { scan-tree-dump-times "if \\(i <= 9\\) goto <D\.\[0-9\]+>; else goto <D\.\[0-9\]+>;" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "if \\(j <= 19\\) goto <D\.\[0-9\]+>; else goto <D\.\[0-9\]+>;" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "to\\(iterator\\(int i=0:10:1, int j=0:20:1, loop_label=<D\.\[0-9\]+>, index=D\.\[0-9\]+, elems=omp_iter_data\.\[0-9\]+, elems_count=200\\):\\*D\.\[0-9\]+" 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "from\\(iterator\\(int i=0:10:1, loop_label=<D\.\[0-9\]+>, index=D\.\[0-9\]+, elems=omp_iter_data\.\[0-9\]+, elems_count=10\\):\\*D\.\[0-9\]+" 1 "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/uses_allocators-1.c b/gcc/testsuite/c-c++-common/gomp/uses_allocators-1.c
new file mode 100644
index 0000000..acfd5b7
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/uses_allocators-1.c
@@ -0,0 +1,46 @@
+typedef enum omp_allocator_handle_t
+#if __cplusplus >= 201103L
+: __UINTPTR_TYPE__
+#endif
+{
+ omp_default_mem_alloc = 1,
+ omp_low_lat_mem_alloc = 5,
+ __omp_allocator_handle_t_max__ = __UINTPTR_MAX__
+} omp_allocator_handle_t;
+
+typedef struct omp_alloctrait_t
+{
+ int key;
+ int value;
+} omp_alloctrait_t;
+
+extern void *omp_alloc (__SIZE_TYPE__, omp_allocator_handle_t);
+
+void
+f (omp_allocator_handle_t my_alloc)
+{
+ #pragma omp target
+ {
+ int a; /* { dg-error "'my_alloc' in 'allocator' clause inside a target region must be specified in an 'uses_allocators' clause on the 'target' directive" "" { target c } } */
+ #pragma omp allocate(a) allocator(my_alloc) /* { dg-error "'my_alloc' in 'allocator' clause inside a target region must be specified in an 'uses_allocators' clause on the 'target' directive" "" { target c++ } } */
+ a = 5;
+ void *prt = omp_alloc(32, my_alloc);
+ #pragma omp parallel allocate(allocator(my_alloc) : a) firstprivate(a) /* { dg-error "allocator 'my_alloc' in 'allocate' clause inside a target region must be specified in an 'uses_allocators' clause on the 'target' directive" } */
+ a = 7;
+ }
+}
+
+void
+g (omp_allocator_handle_t my_alloc)
+{
+ /* The following defines a default-mem-space allocator with no extra traits. */
+ #pragma omp target uses_allocators(my_alloc)
+ {
+ int a;
+ #pragma omp allocate(a) allocator(my_alloc)
+ a = 5;
+ void *prt = omp_alloc(32, my_alloc);
+ #pragma omp parallel allocate(allocator(my_alloc) : a) firstprivate(a)
+ a = 7;
+ }
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/uses_allocators-2.c b/gcc/testsuite/c-c++-common/gomp/uses_allocators-2.c
new file mode 100644
index 0000000..4dd1f13
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/uses_allocators-2.c
@@ -0,0 +1,33 @@
+typedef enum omp_allocator_handle_t
+#if __cplusplus >= 201103L
+: __UINTPTR_TYPE__
+#endif
+{
+ omp_default_mem_alloc = 1,
+ omp_low_lat_mem_alloc = 5,
+ __omp_allocator_handle_t_max__ = __UINTPTR_MAX__
+} omp_allocator_handle_t;
+
+typedef struct omp_alloctrait_t
+{
+ int key;
+ int value;
+} omp_alloctrait_t;
+
+void
+f ()
+{
+ omp_alloctrait_t trait[1] = {{1,1}};
+ omp_allocator_handle_t my_alloc;
+ #pragma omp target uses_allocators(traits(trait) : my_alloc) /* { dg-error "traits array 'trait' must be of 'const omp_alloctrait_t \\\[\\\]' type" } */
+ ;
+}
+
+void
+g ()
+{
+ const omp_alloctrait_t trait[1] = {{1,1}};
+ omp_allocator_handle_t my_alloc;
+ #pragma omp target uses_allocators(traits(trait) : my_alloc)
+ ;
+}
diff --git a/gcc/testsuite/g++.dg/goacc/data-clause-1.C b/gcc/testsuite/g++.dg/goacc/data-clause-1.C
index 07ef6ae..daea3f4 100644
--- a/gcc/testsuite/g++.dg/goacc/data-clause-1.C
+++ b/gcc/testsuite/g++.dg/goacc/data-clause-1.C
@@ -99,7 +99,7 @@ foo (int g[3][10], int h[4][8], int i[2][10], int j[][9],
bar (&j2[0][0]);
#pragma acc parallel copy(q[1:2])
;
- #pragma acc parallel copy(q[3:5][:10]) /* { dg-error "array section is not contiguous" } */
+ #pragma acc parallel copy(q[3:5][:10])
;
#pragma acc parallel copy(r[3:][2:1][1:2])
;
diff --git a/gcc/testsuite/g++.dg/goacc/loop-1.c b/gcc/testsuite/g++.dg/goacc/loop-1.c
new file mode 100644
index 0000000..51b20b0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/goacc/loop-1.c
@@ -0,0 +1,23 @@
+void
+f (int i, float j, int k)
+{
+#pragma acc parallel num_gangs (i) num_workers (i) vector_length (i)
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc parallel num_gangs (j) /* { dg-error "'num_gangs' expression must be integral" } */
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc parallel num_workers (j) /* { dg-error "'num_workers' expression must be integral" } */
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc parallel vector_length (j) /* { dg-error "'vector_length' expression must be integral" } */
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+}
diff --git a/gcc/testsuite/g++.dg/goacc/loop-2.c b/gcc/testsuite/g++.dg/goacc/loop-2.c
new file mode 100644
index 0000000..ddfb480
--- /dev/null
+++ b/gcc/testsuite/g++.dg/goacc/loop-2.c
@@ -0,0 +1,70 @@
+void
+f (int i, int j, int k)
+{
+#pragma acc kernels
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels
+#pragma acc loop gang (num: 10)
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels
+#pragma acc loop gang (static: 10)
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels
+#pragma acc loop gang (static: 5, num: 10)
+ for (i = 0; i < 20; ++i)
+ ;
+
+
+#pragma acc kernels
+#pragma acc loop gang (static: 5, num: 10, *) /* { dg-error "duplicate operand to clause" } */
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels
+#pragma acc loop gang (static: 5, num: 10, static: *) /* { dg-error "duplicate 'num' argument" } */
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels
+#pragma acc loop worker (static: 234) /* { dg-error "expected 'num' before" } */
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels
+#pragma acc loop worker (num: 234)
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels
+#pragma acc loop worker (num: 234, num: 12) /* { dg-error "duplicate operand to clause" } */
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels
+#pragma acc loop vector /* { dg-error "gang, worker and vector must occur in this order in a loop nest" } */
+ for (i = 0; i < 20; ++i)
+#pragma acc loop worker
+ for (j = 0; j < 25; ++j)
+ ;
+
+#pragma acc kernels
+#pragma acc loop worker (length: 20) /* { dg-error "expected 'num' before 'length'" } */
+ for (i = 0; i < 20; ++i)
+#pragma acc loop vector (length: 10)
+ for (j = 0; j < 25; ++j)
+ ;
+
+#pragma acc kernels
+#pragma acc loop worker
+ for (i = 0; i < 20; ++i)
+#pragma acc loop vector
+ for (j = 0; j < 25; ++j)
+ ;
+}
diff --git a/gcc/testsuite/g++.dg/goacc/loop-3.c b/gcc/testsuite/g++.dg/goacc/loop-3.c
new file mode 100644
index 0000000..c43b4f3
--- /dev/null
+++ b/gcc/testsuite/g++.dg/goacc/loop-3.c
@@ -0,0 +1,43 @@
+void
+f (int i, int j, int k)
+{
+#pragma acc kernels num_gangs (10) /* { dg-error "'num_gangs' is not valid" } */
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels num_workers (10) /* { dg-error "'num_workers' is not valid" } */
+#pragma acc loop worker
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc kernels vector_length (10) /* { dg-error "'vector_length' is not valid" } */
+#pragma acc loop vector
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc parallel num_gangs (10) num_workers (20) vector_length (32)
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc parallel num_gangs (i) num_workers (j) vector_length (k)
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc parallel num_gangs (10, i) /* { dg-error "expected '\\)' before ',' token" } */
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc parallel num_workers (10, i) /* { dg-error "expected '\\)' before ',' token" } */
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+
+#pragma acc parallel vector_length (10, i) /* { dg-error "expected '\\)' before ',' token" } */
+#pragma acc loop gang
+ for (i = 0; i < 20; ++i)
+ ;
+}
diff --git a/gcc/testsuite/g++.dg/goacc/reductions-1.C b/gcc/testsuite/g++.dg/goacc/reductions-1.C
new file mode 100644
index 0000000..829a658
--- /dev/null
+++ b/gcc/testsuite/g++.dg/goacc/reductions-1.C
@@ -0,0 +1,548 @@
+// Test for invalid reduction variables.
+
+class C1
+{
+ int b, d[10];
+
+public:
+ int a, c[10];
+
+ C1 () { a = 0; b = 0; }
+ int& get_b () { return b; }
+ int* get_d () { return d; }
+};
+
+template <typename T>
+class C2
+{
+ T b, d[10];
+
+public:
+ T a, c[10];
+
+ C2 () { a = 0; b = 0; }
+ T& get_b () { return b; }
+ T* get_d () { return d; }
+};
+
+struct S1
+{
+ int a, b, c[10], d[10];
+
+ S1 () { a = 0; b = 0; }
+ int& get_b () { return b; }
+ int* get_d () { return d; }
+};
+
+template <typename T>
+struct S2
+{
+ T a, b, c[10], d[10];
+
+ S2 () { a = 0; b = 0; }
+ T& get_b () { return b; }
+ T* get_d () { return d; }
+};
+
+template <typename T>
+void
+test_parallel ()
+{
+ int i, a[10];
+ T b[10];
+ C1 c1, c1a[10];
+ C2<T> c2, c2a[10];
+ S1 s1, s1a[10];
+ S2<float> s2, s2a[10];
+
+ // Reductions on class members.
+
+#pragma acc parallel reduction(+:c1.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.a += 1;
+
+#pragma acc parallel reduction(+:c1.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.get_b () += 1;
+
+#pragma acc parallel reduction(+:c1.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.c[1] += 1;
+
+#pragma acc parallel reduction(+:c1.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.get_d ()[1] += 1;
+
+#pragma acc parallel reduction(+:c1a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].a += 1;
+
+#pragma acc parallel reduction(+:c1a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].get_b () += 1;
+
+#pragma acc parallel reduction(+:c1a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].c[1] += 1;
+
+#pragma acc parallel reduction(+:c1a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].get_d ()[1] += 1;
+
+
+ // Reductions on a template class member.
+
+#pragma acc parallel reduction(+:c2.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.a += 1;
+
+#pragma acc parallel reduction(+:c2.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.get_b () += 1;
+
+#pragma acc parallel reduction(+:c2.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.c[1] += 1;
+
+#pragma acc parallel reduction(+:c2.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.get_d ()[1] += 1;
+
+
+#pragma acc parallel reduction(+:c2a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].a += 1;
+
+#pragma acc parallel reduction(+:c2a[1].get_b ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].get_b () += 1;
+
+#pragma acc parallel reduction(+:c2a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].c[1] += 1;
+
+#pragma acc parallel reduction(+:c2a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].get_d ()[1] += 1;
+
+
+ // Reductions on struct element.
+
+#pragma acc parallel reduction(+:s1.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.a += 1;
+
+#pragma acc parallel reduction(+:s1.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.get_b () += 1;
+
+#pragma acc parallel reduction(+:s1.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.c[1] += 1;
+
+#pragma acc parallel reduction(+:s1.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.get_d ()[1] += 1;
+
+#pragma acc parallel reduction(+:s1a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].a += 1;
+
+#pragma acc parallel reduction(+:s1a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].get_b () += 1;
+
+#pragma acc parallel reduction(+:s1a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].c[1] += 1;
+
+#pragma acc parallel reduction(+:s1a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].get_d ()[1] += 1;
+
+
+ // Reductions on a template struct element.
+
+#pragma acc parallel reduction(+:s2.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.a += 1;
+
+#pragma acc parallel reduction(+:s2.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.get_b () += 1;
+
+#pragma acc parallel reduction(+:s2.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.c[1] += 1;
+
+#pragma acc parallel reduction(+:s2.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.get_d ()[1] += 1;
+
+#pragma acc parallel reduction(+:s2a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].a += 1;
+
+#pragma acc parallel reduction(+:s2a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].get_b () += 1;
+
+#pragma acc parallel reduction(+:s2a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].c[1] += 1;
+
+#pragma acc parallel reduction(+:s2a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].get_d ()[1] += 1;
+
+
+ // Reductions on arrays.
+
+#pragma acc parallel reduction(+:a[10]) // { dg-error "zero length array section in 'reduction' clause" }
+ for (i = 0; i < 100; i++)
+ a[10] += 1;
+
+#pragma acc parallel reduction(+:b[10]) // { dg-error "zero length array section in 'reduction' clause" }
+ for (i = 0; i < 100; i++)
+ b[10] += 1;
+}
+
+template <typename T>
+void
+test_combined ()
+{
+ int i, a[10];
+ T b[10];
+ C1 c1, c1a[10];
+ C2<T> c2, c2a[10];
+ S1 s1, s1a[10];
+ S2<float> s2, s2a[10];
+
+ // Reductions on class members.
+
+#pragma acc parallel loop reduction(+:c1.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.a += 1;
+
+#pragma acc parallel loop reduction(+:c1.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.get_b () += 1;
+
+#pragma acc parallel loop reduction(+:c1.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.c[1] += 1;
+
+#pragma acc parallel loop reduction(+:c1.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.get_d ()[1] += 1;
+
+#pragma acc parallel loop reduction(+:c1a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].a += 1;
+
+#pragma acc parallel loop reduction(+:c1a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].get_b () += 1;
+
+#pragma acc parallel loop reduction(+:c1a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].c[1] += 1;
+
+#pragma acc parallel loop reduction(+:c1a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].get_d ()[1] += 1;
+
+
+ // Reductions on a template class member.
+
+#pragma acc parallel loop reduction(+:c2.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.a += 1;
+
+#pragma acc parallel loop reduction(+:c2.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.get_b () += 1;
+
+#pragma acc parallel loop reduction(+:c2.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.c[1] += 1;
+
+#pragma acc parallel loop reduction(+:c2.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.get_d ()[1] += 1;
+
+
+#pragma acc parallel loop reduction(+:c2a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].a += 1;
+
+#pragma acc parallel loop reduction(+:c2a[1].get_b ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].get_b () += 1;
+
+#pragma acc parallel loop reduction(+:c2a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].c[1] += 1;
+
+#pragma acc parallel loop reduction(+:c2a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].get_d ()[1] += 1;
+
+
+ // Reductions on struct element.
+
+#pragma acc parallel loop reduction(+:s1.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.a += 1;
+
+#pragma acc parallel loop reduction(+:s1.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.get_b () += 1;
+
+#pragma acc parallel loop reduction(+:s1.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.c[1] += 1;
+
+#pragma acc parallel loop reduction(+:s1.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.get_d ()[1] += 1;
+
+#pragma acc parallel loop reduction(+:s1a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].a += 1;
+
+#pragma acc parallel loop reduction(+:s1a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].get_b () += 1;
+
+#pragma acc parallel loop reduction(+:s1a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].c[1] += 1;
+
+#pragma acc parallel loop reduction(+:s1a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].get_d ()[1] += 1;
+
+
+ // Reductions on a template struct element.
+
+#pragma acc parallel loop reduction(+:s2.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.a += 1;
+
+#pragma acc parallel loop reduction(+:s2.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.get_b () += 1;
+
+#pragma acc parallel loop reduction(+:s2.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.c[1] += 1;
+
+#pragma acc parallel loop reduction(+:s2.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.get_d ()[1] += 1;
+
+#pragma acc parallel loop reduction(+:s2a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].a += 1;
+
+#pragma acc parallel loop reduction(+:s2a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].get_b () += 1;
+
+#pragma acc parallel loop reduction(+:s2a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].c[1] += 1;
+
+#pragma acc parallel loop reduction(+:s2a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].get_d ()[1] += 1;
+
+
+ // Reductions on arrays.
+
+#pragma acc parallel loop reduction(+:a[10]) // { dg-error "zero length array section in 'reduction' clause" }
+ for (i = 0; i < 100; i++)
+ a[10] += 1;
+
+#pragma acc parallel loop reduction(+:b[10]) // { dg-error "zero length array section in 'reduction' clause" }
+ for (i = 0; i < 100; i++)
+ b[10] += 1;
+}
+
+template <typename T>
+void
+test_loop ()
+{
+ int i, a[10];
+ T b[10];
+ C1 c1, c1a[10];
+ C2<T> c2, c2a[10];
+ S1 s1, s1a[10];
+ S2<float> s2, s2a[10];
+
+ // Reductions on class members.
+
+ #pragma acc parallel
+ {
+
+#pragma acc loop reduction(+:c1.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.a += 1;
+
+#pragma acc loop reduction(+:c1.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.get_b () += 1;
+
+#pragma acc loop reduction(+:c1.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.c[1] += 1;
+
+#pragma acc loop reduction(+:c1.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1.get_d ()[1] += 1;
+
+#pragma acc loop reduction(+:c1a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].a += 1;
+
+#pragma acc loop reduction(+:c1a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].get_b () += 1;
+
+#pragma acc loop reduction(+:c1a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].c[1] += 1;
+
+#pragma acc loop reduction(+:c1a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c1a[1].get_d ()[1] += 1;
+
+
+ // Reductions on a template class member.
+
+#pragma acc loop reduction(+:c2.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.a += 1;
+
+#pragma acc loop reduction(+:c2.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.get_b () += 1;
+
+#pragma acc loop reduction(+:c2.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.c[1] += 1;
+
+#pragma acc loop reduction(+:c2.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2.get_d ()[1] += 1;
+
+
+#pragma acc loop reduction(+:c2a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].a += 1;
+
+#pragma acc loop reduction(+:c2a[1].get_b ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].get_b () += 1;
+
+#pragma acc loop reduction(+:c2a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].c[1] += 1;
+
+#pragma acc loop reduction(+:c2a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ c2a[1].get_d ()[1] += 1;
+
+
+ // Reductions on struct element.
+
+#pragma acc loop reduction(+:s1.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.a += 1;
+
+#pragma acc loop reduction(+:s1.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.get_b () += 1;
+
+#pragma acc loop reduction(+:s1.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.c[1] += 1;
+
+#pragma acc loop reduction(+:s1.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1.get_d ()[1] += 1;
+
+#pragma acc loop reduction(+:s1a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].a += 1;
+
+#pragma acc loop reduction(+:s1a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.. token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].get_b () += 1;
+
+#pragma acc loop reduction(+:s1a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].c[1] += 1;
+
+#pragma acc loop reduction(+:s1a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s1a[1].get_d ()[1] += 1;
+
+
+ // Reductions on a template struct element.
+
+#pragma acc loop reduction(+:s2.a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.a += 1;
+
+#pragma acc loop reduction(+:s2.get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.get_b () += 1;
+
+#pragma acc loop reduction(+:s2.c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.c[1] += 1;
+
+#pragma acc loop reduction(+:s2.get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2.get_d ()[1] += 1;
+
+#pragma acc loop reduction(+:s2a[1].a) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].a += 1;
+
+#pragma acc loop reduction(+:s2a[1].get_b ()) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].get_b () += 1;
+
+#pragma acc loop reduction(+:s2a[1].c[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].c[1] += 1;
+
+#pragma acc loop reduction(+:s2a[1].get_d ()[1]) // { dg-error "expected '\\\)' before '\\\.' token" }
+ for (i = 0; i < 100; i++)
+ s2a[1].get_d ()[1] += 1;
+
+
+ // Reductions on arrays.
+
+#pragma acc loop reduction(+:a[10]) // { dg-error "zero length array section in 'reduction' clause" }
+ for (i = 0; i < 100; i++)
+ a[10] += 1;
+
+#pragma acc loop reduction(+:b[10]) // { dg-error "zero length array section in 'reduction' clause" }
+ for (i = 0; i < 100; i++)
+ b[10] += 1;
+ }
+}
+
+int
+main ()
+{
+ test_parallel<double> ();
+ test_combined<long> ();
+ test_loop<short> ();
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-1.C b/gcc/testsuite/g++.dg/gomp/adjust-args-1.C
index 29fde14..d0e0bce 100644
--- a/gcc/testsuite/g++.dg/gomp/adjust-args-1.C
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-1.C
@@ -1,8 +1,6 @@
/* Test parsing of OMP clause adjust_args */
/* { dg-do compile } */
-int b;
-
int f0 (void *a);
int g (void *a);
int f1 (int);
@@ -15,25 +13,36 @@ int f2a (void *a);
int f2b (void *a);
#pragma omp declare variant (f0) match (construct={dispatch},device={arch(gcn)}) adjust_args (need_device_ptr: a) /* { dg-error "'int f0.void..' used as a variant with incompatible 'construct' selector sets" } */
int f2c (void *a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (other: a) /* { dg-error "expected 'nothing' or 'need_device_ptr'" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (other: a) /* { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr'" } */
int f3 (int a);
#pragma omp declare variant (f0) adjust_args (nothing: a) /* { dg-error "an 'adjust_args' clause requires a 'match' clause" } */
int f4 (void *a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args () /* { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args () /* { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" } */
int f5 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing) /* { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing) /* { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" } */
int f6 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing:) /* { dg-error "expected unqualified-id before '\\)' token" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing:) /* { dg-error "expected primary-expression before '\\)' token" } */
int f7 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing: z) /* { dg-error "'z' has not been declared" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing: z) /* { dg-error "'z' is not a function parameter" } */
int f8 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (need_device_ptr: a) /* { dg-error "'a' is not a C pointer" } */
-int f9 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing: a) adjust_args (nothing: a) /* { dg-error "'a' is specified more than once" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (need_device_ptr: a) /* { dg-note "parameter specified here" } */
+int f9 (int a); /* { dg-error "parameter specified in an 'adjust_args' clause with the 'need_device_ptr' modifier must be of pointer type" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) \
+ adjust_args (nothing: a) \
+ adjust_args (nothing: a)
int f10 (int a);
-#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (nothing: a) adjust_args (need_device_ptr: a) /* { dg-error "'a' is specified more than once" } */
+/* { dg-note "parameter previously specified here" "" { target *-*-* } .-3 } */
+/* { dg-error "OpenMP parameter list items must specify a unique parameter" "" { target *-*-* } .-3 } */
+#pragma omp declare variant (g) match (construct={dispatch}) \
+ adjust_args (nothing: a) \
+ adjust_args (need_device_ptr: a)
int f11 (void *a);
-#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (need_device_ptr: b) /* { dg-error "'b' is not a function argument" } */
+/* { dg-note "parameter previously specified here" "" { target *-*-* } .-3 } */
+/* { dg-error "OpenMP parameter list items must specify a unique parameter" "" { target *-*-* } .-3 } */
+
+int b;
+
+#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (need_device_ptr: b) /* { dg-error "'b' is not a function parameter" } */
int f12 (void *a);
-#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (need_device_ptr: this) /* { dg-error "expected unqualified-id before 'this'" } */
+#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (need_device_ptr: this) /* { dg-error "expected unqualified-id, integer, or expression before 'this'" } */
int f13 (void *a);
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-10.C b/gcc/testsuite/g++.dg/gomp/adjust-args-10.C
new file mode 100644
index 0000000..b2ea5f8
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-10.C
@@ -0,0 +1,56 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Valid constexpr variable/NTTP in numeric range.
+ TODO: add tests including multiple instantiations of the same function template. */
+
+const int G = 2;
+
+template<int>
+struct S1 {};
+
+template<int, int>
+struct S2 {};
+
+
+void v0(int *, int *) {}
+
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: G:omp_num_args)
+void b0(int *, int *) {}
+
+
+template<typename T>
+void v1(T, int *, int *) {}
+
+#pragma omp declare variant(v1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: V:omp_num_args)
+template<int V>
+void b1(S1<V>, int *, int *) {}
+
+
+template<typename T>
+void v2(T, int *, int *, int *) {}
+
+#pragma omp declare variant(v2) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: LB:UB)
+template<int LB, int UB>
+void b2(S2<LB, UB>, int *, int *, int *) {}
+
+
+void f(int *p0, int *p1, int *p2, int *p3, int *p4, int *p5, int *p6)
+{
+ #pragma omp dispatch
+ b0(p0, p1);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p1, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v0 \\(p0, D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b1(S1<3>(), p2, p3);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p3, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v1<S1<3> > \\(D\.\[0-9\]+, p2, D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b2(S2<2, 3>(), p4, p5, p6);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p4, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p5, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v2<S2<2, 3> > \\(D\.\[0-9\]+, D\.\[0-9\]+, D\.\[0-9\]+, p6\\);" "gimple" } } */
+}
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 3 "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-11.C b/gcc/testsuite/g++.dg/gomp/adjust-args-11.C
new file mode 100644
index 0000000..2b91759
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-11.C
@@ -0,0 +1,112 @@
+/* { dg-do compile { target c++11 } } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Valid constexpr variable/NTTP in numeric range in functions
+ with a parameter pack. */
+
+template<int, int>
+struct S2 {};
+
+template<typename T, typename... Ts>
+void v0(T, Ts...) {}
+
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: LB:UB)
+template<int LB, int UB, typename... Ts>
+void b0(S2<LB, UB>, Ts...) {}
+
+
+void f0(int *p0, int *p1, int *p2)
+{
+ #pragma omp dispatch
+ b0(S2<2, 3>{}, p0, p1, p2);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p0, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p1, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v0<S2<2, 3>, int\\*, int\\*, int\\*> \\(D\.\[0-9\]+, D\.\[0-9\]+, D\.\[0-9\]+, p2\\);" "gimple" } } */
+}
+
+
+/* With multiple instantiations. */
+
+template<typename T, typename... Ts>
+void v1(T, Ts...) {}
+
+#pragma omp declare variant(v1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: V0+0:V1+0)
+template<int V0, int V1, typename... Ts>
+void b1(S2<V0, V1>, Ts...) {}
+
+void f1(int *f1_p0, int *f1_p1, int *f1_p2, int *f1_p3, int *f1_p4)
+{
+ #pragma omp dispatch
+ b1(S2<3, 3>{}, f1_p0, f1_p1);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f1_p1, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v1<S2<3, 3>, int\\*, int\\*> \\(D\.\[0-9\]+, f1_p0, D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b1(S2<4, 4>{}, f1_p2, f1_p3, f1_p4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f1_p4, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v1<S2<4, 4>, int\\*, int\\*, int\\*> \\(D\.\[0-9\]+, f1_p2, f1_p3, D\.\[0-9\]+\\);" "gimple" } } */
+}
+
+
+
+/* Multiple instantiations of function with parameter packs
+ with an adjust_args clause with a relative numeric range. */
+
+template<typename... Ts>
+void v2(Ts...) {}
+
+#pragma omp declare variant(v2) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1:omp_num_args)
+template<typename... Ts>
+void b2(Ts...) {}
+
+void f2(int *f2_p0, int *f2_p1, int *f2_p2, int *f2_p3, int *f2_p4, int *f2_p5)
+{
+ #pragma omp dispatch
+ b2(f2_p0);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f2_p0, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v2<int\\*> \\(D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b2(f2_p1, f2_p2);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f2_p1, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f2_p2, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v2<int\\*, int\\*> \\(D\.\[0-9\]+, D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b2(f2_p3, f2_p4, f2_p5);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f2_p3, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f2_p4, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f2_p5, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v2<int\\*, int\\*, int\\*> \\(D\.\[0-9\]+, D\.\[0-9\]+, D\.\[0-9\]+\\);" "gimple" } } */
+}
+
+
+template<typename... Ts>
+void v3(Ts...) {}
+
+#pragma omp declare variant(v3) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1:omp_num_args)
+template<typename... Ts>
+void b3(Ts...) {}
+
+void f3(int *f3_p0, int *f3_p1, int *f3_p2, int *f3_p3, int *f3_p4, int *f3_p5)
+{
+ #pragma omp dispatch
+ b3(f3_p0, f3_p1, f3_p2);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f3_p0, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f3_p1, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f3_p2, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v3<int\\*, int\\*, int\\*> \\(D\.\[0-9\]+, D\.\[0-9\]+, D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b3(f3_p3, f3_p4);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f3_p3, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f3_p4, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v3<int\\*, int\\*> \\(D\.\[0-9\]+, D\.\[0-9\]+\\);" "gimple" } } */
+ #pragma omp dispatch
+ b3(f3_p5);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(f3_p5, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "v3<int\\*> \\(D\.\[0-9\]+\\);" "gimple" } } */
+}
+
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 9 "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-12.C b/gcc/testsuite/g++.dg/gomp/adjust-args-12.C
new file mode 100644
index 0000000..1c7baf7
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-12.C
@@ -0,0 +1,62 @@
+/* Invalid value constexpr var/NTTP in numeric range in functions.
+ TODO: Add more cases. */
+
+template<int>
+struct S1 {};
+
+const int G0 = 0;
+const int G1 = 2;
+
+
+void v_g0(int *) {}
+
+/* { dg-error "expression of bound must be positive" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(v_g0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: G0+0:omp_num_args)
+void b_g0(int *) {}
+
+void v_g1(int *) {}
+
+/* { dg-error "expression of bound is out of range" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(v_g1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: G1+0:omp_num_args)
+void b_g1(int *) {}
+
+
+template<typename T>
+void v0(T, int *) {}
+
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: V+0:omp_num_args)
+template<int V>
+void b0(S1<V>, int *) {}
+
+template<typename T>
+void v1(T, int *) {}
+
+/* { dg-error "expression of bound must be positive" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(v1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: V+0:omp_num_args)
+template<int V>
+void b1(S1<V>, int *) {}
+
+template<typename T>
+void v2(T, int *) {}
+
+/* { dg-error "expression of bound is out of range" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(v2) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: V+0:omp_num_args)
+template<int V>
+void b2(S1<V>, int *) {}
+
+void f0(int *p0)
+{
+ /* Not out of range. */
+ #pragma omp dispatch
+ b0(S1<2>(), p0); /* { dg-bogus "required from here" } */
+ /* Out of range. */
+ #pragma omp dispatch
+ b1(S1<0>(), p0); /* { dg-message "required from here" } */
+ #pragma omp dispatch
+ b2(S1<3>(), p0); /* { dg-message "required from here" } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-13.C b/gcc/testsuite/g++.dg/gomp/adjust-args-13.C
new file mode 100644
index 0000000..5e183e0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-13.C
@@ -0,0 +1,95 @@
+/* { dg-do compile { target c++11 } } */
+
+/* Invalid value constexpr var/NTTP in numeric range in functions
+ with a parameter pack.
+ TODO: Add more cases. */
+
+template<int>
+struct S1 {};
+
+const int G0 = 0;
+const int G1 = 2;
+
+
+template<typename... Ts>
+void v_g0(int *, Ts...) {}
+template<typename... Ts>
+void v_g1(int *, Ts...) {}
+template<typename... Ts>
+void v_g2(int *, Ts...) {}
+
+
+/* Always invalid, should diagnose without instantiation. */
+/* { dg-error "expression of bound must be positive" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(v_g0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: G0+0:omp_num_args)
+template<typename... Ts>
+void b_g0(int *, Ts...) {}
+
+#pragma omp declare variant(v_g1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: G1+0:omp_num_args)
+template<typename... Ts>
+void b_g1(int *, Ts...) {}
+
+/* { dg-error "numeric range lower bound must be less than or equal to upper bound" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(v_g2) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: G1+0:omp_num_args)
+template<typename... Ts>
+void b_g2(int *, Ts...) {}
+
+
+void f0 (int *p0)
+{
+ /* All 3 of these have a fixed lb, equal to G1. */
+ /* In range, no error. */
+ #pragma omp dispatch
+ b_g1(p0, p0, p0);
+ #pragma omp dispatch
+ b_g2(p0, p0, p0);
+ /* Out of range. */
+ #pragma omp dispatch
+ b_g2(p0); /* { dg-message "required from here" } */
+}
+
+
+template<typename T, typename... Ts>
+void v0(T, Ts...) {}
+
+/* { dg-error "expression of bound must be positive" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: V+0:omp_num_args)
+template<int V, typename... Ts>
+void b0(S1<V>, Ts...) {}
+
+template<typename T, typename... Ts>
+void v1(T, Ts...) {}
+
+#pragma omp declare variant(v1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: V+0:omp_num_args)
+template<int V, typename... Ts>
+void b1(S1<V>, Ts...) {}
+
+template<typename T, typename... Ts>
+void v2(T, Ts...) {}
+
+/* { dg-error "expression of bound is out of range" "" { target *-*-* } .+2 } */
+#pragma omp declare variant(v2) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: V+0:omp_num_args)
+template<int V, typename... Ts>
+void b2(S1<V>, Ts...) {}
+
+void f1(int *p0, int *p1, int *p2)
+{
+ #pragma omp dispatch
+ b0(S1<0>{}, p0, p1, p2); /* { dg-message "required from here" } */
+ /* In range, no error. */
+ #pragma omp dispatch
+ b1(S1<2>{}, p0); /* { dg-bogus "required from here" } */
+ #pragma omp dispatch
+ b1(S1<4>{}, p0, p1, p2); /* { dg-bogus "required from here" } */
+ /* Out of range. */
+ #pragma omp dispatch
+ b2(S1<3>{}, p0); /* { dg-message "required from here" } */
+ #pragma omp dispatch
+ b2(S1<5>{}, p0, p1, p2); /* { dg-message "required from here" } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-14.C b/gcc/testsuite/g++.dg/gomp/adjust-args-14.C
new file mode 100644
index 0000000..e5a6322
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-14.C
@@ -0,0 +1,24 @@
+/* Make sure non-dependent nothing list items are not removed too early.
+ The order of the adjust_args clauses is important for this test, there was a
+ bug where we were removing nothing list-items before we encountered a
+ dependent item. */
+
+template<int>
+struct S {};
+
+template<typename T>
+void v0 (T) {}
+
+/* { dg-note "parameter previously specified here" "" { target *-*-* } .+3 } */
+/* { dg-error "expansion of numeric range specifies non-unique index 1" "" { target *-*-* } .+3 } */
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(nothing: 1) \
+ adjust_args(nothing: V+0:V+0)
+template<int V>
+void b0 (S<V>) {}
+
+void f ()
+{
+ #pragma omp dispatch
+ b0 (S<1>());
+}
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-15.C b/gcc/testsuite/g++.dg/gomp/adjust-args-15.C
new file mode 100644
index 0000000..63c954d
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-15.C
@@ -0,0 +1,23 @@
+/* { dg-do compile { target c++11 } } */
+
+/* Make sure non-dependent nothing list items are not removed too early.
+ The order of the adjust_args clauses is important for this test, there was a
+ bug where we were removing nothing list-items before we encountered a
+ dependent item. */
+
+template<typename... Ts>
+void v1 (int, Ts...) {}
+
+/* { dg-note "parameter previously specified here" "" { target *-*-* } .+3 } */
+/* { dg-error "expansion of numeric range specifies non-unique index 1" "" { target *-*-* } .+3 } */
+#pragma omp declare variant(v1) match(construct={dispatch}) \
+ adjust_args(nothing: 1) \
+ adjust_args(nothing: 1:omp_num_args)
+template<typename... Ts>
+void b1 (int, Ts...) {}
+
+void f ()
+{
+ #pragma omp dispatch
+ b1 (42, 42);
+}
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-16.C b/gcc/testsuite/g++.dg/gomp/adjust-args-16.C
new file mode 100644
index 0000000..c46870c
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-16.C
@@ -0,0 +1,30 @@
+/* Reject expressions outside of a numeric range. */
+
+void v_0(int, int, int) {}
+void v_1(int, int, int) {}
+void v_2(int, int, int) {}
+void v_3(int, int, int) {}
+
+const int constant_expression = 42;
+
+/* { dg-error "expected ':' before '\\)' token" "" { target *-*-* } .+2 } */
+/* { dg-note "an expression is only allowed in a numeric range" "" { target *-*-* } .+1 } */
+#pragma omp declare variant (v_0) match (construct={dispatch}) adjust_args (nothing: 0+1)
+void b0 (int, int, int) {}
+
+/* { dg-error "'constant_expression' is not a function parameter" "" { target *-*-* } .+2 } */
+/* { dg-note "an expression is only allowed in a numeric range" "" { xfail *-*-* } .+1 } */
+#pragma omp declare variant (v_1) match (construct={dispatch}) adjust_args (nothing: constant_expression)
+void b1 (int, int, int) {}
+
+/* { dg-error "expected ':' before '\\)' token" "" { target *-*-* } .+2 } */
+/* { dg-note "an expression is only allowed in a numeric range" "" { target *-*-* } .+1 } */
+#pragma omp declare variant (v_2) match (construct={dispatch}) adjust_args (nothing: constant_expression + 0)
+void b2 (int, int, int) {}
+
+/* { dg-error "expected ':' before '\\)' token" "" { target *-*-* } .+2 } */
+/* { dg-note "an expression is only allowed in a numeric range" "" { target *-*-* } .+1 } */
+#pragma omp declare variant (v_3) match (construct={dispatch}) adjust_args (nothing: 0 + constant_expression)
+void b3 (int, int, int) {}
+
+/* We could use some tests to make sure non constant-expressions get diagnosed nicely. */
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-17.C b/gcc/testsuite/g++.dg/gomp/adjust-args-17.C
new file mode 100644
index 0000000..62ddab0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-17.C
@@ -0,0 +1,44 @@
+void f(int*,int &,int*);
+void f0(int*,int &,int*);
+void f1(int*,int &,int*);
+void f2(int*,int &,int*);
+void f3(int*,int &,int*);
+void f4(int*,int &,int*);
+void f5(int*,int &,int*);
+void f6(int*,int &,int*);
+void f7(int*,int &,int*);
+void f8(int*,int &,int*);
+void f9(int*,int &,int*);
+void fa(int*,int &,int*);
+void f10(int*,int &,int*);
+void f11(int*,int &,int*);
+void f12(int*,int &,int*);
+void f13(int*,int &,int*);
+void f14(int*,int &,int*);
+void f15(int*,int &,int*);
+void f16(int*,int &,int*);
+
+#pragma omp declare variant(f) match(construct={dispatch}) adjust_args(x : y) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr'" }
+#pragma omp declare variant(f0) match(construct={dispatch}) adjust_args(x) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f1) match(construct={dispatch}) adjust_args(x,) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f2) match(construct={dispatch}) adjust_args(foo x) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f3) match(construct={dispatch}) adjust_args(nothing) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f4) match(construct={dispatch}) adjust_args(need_device_ptr) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f5) match(construct={dispatch}) adjust_args(nothing x) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f6) match(construct={dispatch}) adjust_args(need_device_ptr x) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f7) match(construct={dispatch}) adjust_args(need_device_addr x) // { dg-error "expected 'nothing', 'need_device_ptr' or 'need_device_addr' followed by ':'" }
+#pragma omp declare variant(f8) match(construct={dispatch}) adjust_args(nothing :) // { dg-error "expected primary-expression before '\\)' token" }
+#pragma omp declare variant(f9) match(construct={dispatch}) adjust_args(need_device_ptr :) // { dg-error "expected primary-expression before '\\)' token" }
+#pragma omp declare variant(fa) match(construct={dispatch}) adjust_args(need_device_addr :) // { dg-error "expected primary-expression before '\\)' token" }
+#pragma omp declare variant(f10) match(construct={dispatch}) adjust_args(need_device_addr : omp_num_args-1) // { dg-error "expected ':' before '\\)' token" }
+// { dg-note "93: an expression is only allowed in a numeric range" "" { target *-*-* } .-1 }
+
+// Valid:
+#pragma omp declare variant(f11) match(construct={dispatch}) adjust_args(nothing : z, 1:2)
+#pragma omp declare variant(f12) match(construct={dispatch}) adjust_args(need_device_ptr : x)
+#pragma omp declare variant(f13) match(construct={dispatch}) adjust_args(need_device_addr : y)
+#pragma omp declare variant(f14) match(construct={dispatch}) adjust_args(nothing : :)
+#pragma omp declare variant(f15) match(construct={dispatch}) adjust_args(need_device_ptr : 3:3)
+#pragma omp declare variant(f16) match(construct={dispatch}) adjust_args(need_device_addr : 2:2)
+
+void g(int*x, int &y, int *z);
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-2.C b/gcc/testsuite/g++.dg/gomp/adjust-args-2.C
index a78f06e..73d6548 100644
--- a/gcc/testsuite/g++.dg/gomp/adjust-args-2.C
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-2.C
@@ -7,12 +7,13 @@ struct S {
bool operator!() { return !a; }
};
+
template <typename T>
T f0(T a, T *b);
-#pragma omp declare variant (f0) match (construct={dispatch}) adjust_args (need_device_ptr: a, b)
+#pragma omp declare variant (f0) match (construct={dispatch}) adjust_args (need_device_ptr: a, b) /* { dg-note "parameter specified here" } */
template <typename T>
-T f1(T a, T *b);
+T f1(T a, T *b); /* { dg-error "parameter specified in an 'adjust_args' clause with the 'need_device_ptr' modifier must be of pointer type" } */
namespace N {
class C{
@@ -29,8 +30,8 @@ namespace N {
#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (need_device_ptr: c)
void f3(N::C *c);
void f4(S *&s);
-#pragma omp declare variant (f4) match (construct={dispatch}) adjust_args (need_device_ptr: s)
-void f5(S *&s);
+#pragma omp declare variant (f4) match (construct={dispatch}) adjust_args (need_device_ptr: s) /* { dg-note "parameter specified here" } */
+void f5(S *&s); /* { dg-message "parameter with type reference to pointer in an 'adjust_args' with the 'need_device_ptr' modifier is not currently supported" } */
void test() {
S s, *sp;
@@ -39,7 +40,7 @@ void test() {
#pragma omp dispatch
s.f0(a);
#pragma omp dispatch
- f1(b, a);
+ f1(b, a); /* { dg-message "required from here" } */
#pragma omp dispatch
c.f0(&c);
#pragma omp dispatch
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-5.C b/gcc/testsuite/g++.dg/gomp/adjust-args-5.C
new file mode 100644
index 0000000..04bb17f
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-5.C
@@ -0,0 +1,42 @@
+/* PR c++/119659 */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Test correct argument gets adjusted. */
+
+struct S {
+ void v0(int *, int *) {}
+
+ #pragma omp declare variant(v0) match(construct={dispatch}) adjust_args(need_device_ptr: a)
+ void b0(int *a, int *b) {}
+
+ void v1(int *, int *) {}
+
+ #pragma omp declare variant(v1) match(construct={dispatch}) adjust_args(need_device_ptr: 1)
+ void b1(int *a, int *b) {}
+
+ void v2(int *, int *) {}
+
+ #pragma omp declare variant(v2) match(construct={dispatch}) adjust_args(need_device_ptr: 1:1)
+ void b2(int *a, int *b) {}
+};
+
+
+void f(int *p0, int *p1, int *p2, int *p3, int *p4, int *p5)
+{
+ S s;
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 3 "gimple" } } */
+ #pragma omp dispatch
+ s.b0(p0, p1);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p0, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v0 \\(&s, D\.\[0-9\]+, p1\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ s.b1(p2, p3);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p2, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v1 \\(&s, D\.\[0-9\]+, p3\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ s.b2(p4, p5);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p4, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v2 \\(&s, D\.\[0-9\]+, p5\\);" "gimple" } } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-6.C b/gcc/testsuite/g++.dg/gomp/adjust-args-6.C
new file mode 100644
index 0000000..77d5d1c
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-6.C
@@ -0,0 +1,97 @@
+/* PR c++/119659 */
+
+/* { dg-do compile { target c++11 } } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Test correct argument gets adjusted. */
+
+struct S {
+ template<typename... Ts>
+ void v0_pack(int *, Ts...) {}
+
+ #pragma omp declare variant(v0_pack) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: a)
+ template<typename... Ts>
+ void b0_pack(int *a, Ts...) { static_cast<void>(a); }
+
+
+ template<typename... Ts>
+ void v1_pack(int *, Ts...) {}
+
+ #pragma omp declare variant(v1_pack) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1)
+ template<typename... Ts>
+ void b1_pack(int *a, Ts...) { static_cast<void>(a); }
+
+
+ template<typename... Ts>
+ void v2_pack(int *, Ts...) {}
+
+ #pragma omp declare variant(v2_pack) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1:1)
+ template<typename... Ts>
+ void b2_pack(int *a, Ts...) { static_cast<void>(a); }
+
+
+ template<typename... Ts>
+ void v3_pack(int *, Ts...) {}
+
+ #pragma omp declare variant(v3_pack) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 2)
+ template<typename... Ts>
+ void b3_pack(int *a, Ts...) { static_cast<void>(a); }
+
+
+ template<typename... Ts>
+ void v4_pack(int *, Ts...) {}
+
+ #pragma omp declare variant(v4_pack) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 2:2)
+ template<typename... Ts>
+ void b4_pack(int *a, Ts...) { static_cast<void>(a); }
+};
+
+
+void f(int *p0, int *p1, int *p2, int *p3,
+ int *p4, int *p5, int *p6, int *p7,
+ int *p8, int *p9, int *pA, int *pB,
+ int *pC, int *pD, int *pE, int *pF)
+{
+ S s;
+ #pragma omp dispatch
+ s.b0_pack(p0, p1);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p0, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v0_pack<int\\*> \\(&s, D\.\[0-9\]+, p1\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ s.b1_pack(p2, p3);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p2, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v1_pack<int\\*> \\(&s, D\.\[0-9\]+, p3\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ s.b2_pack(p4, p5);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p4, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v2_pack<int\\*> \\(&s, D\.\[0-9\]+, p5\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ s.b3_pack(p6, p7);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p7, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v3_pack<int\\*> \\(&s, p6, D\.\[0-9\]+\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ s.b3_pack(p8, p9, pA);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(p9, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v3_pack<int\\*, int\\*> \\(&s, p8, D\.\[0-9\]+, pA\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ s.b4_pack(pB, pC);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(pC, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v4_pack<int\\*> \\(&s, pB, D\.\[0-9\]+\\);" "gimple" } } */
+
+ #pragma omp dispatch
+ s.b4_pack(pD, pE, pF);
+/* { dg-final { scan-tree-dump "D\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(pC, D\.\[0-9\]+\\);" "gimple" } } */
+/* { dg-final { scan-tree-dump "S::v4_pack<int\\*, int\\*> \\(&s, pD, D\.\[0-9\]+, pF\\);" "gimple" } } */
+}
+
+/* { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = __builtin_omp_get_default_device \\(\\);" 7 "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-7.C b/gcc/testsuite/g++.dg/gomp/adjust-args-7.C
new file mode 100644
index 0000000..4b526fc
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-7.C
@@ -0,0 +1,100 @@
+/* PR c++/118859 */
+
+/* Diagnose invalid substituted types of depdendent parameters specified
+ in a need_device_ptr/need_device_addr modified adjust_args clause.
+ TODO: Need more cases with varying reference specifiers in the
+ variant/base function. */
+
+template<typename T>
+void v0(T) {}
+
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1) /* { dg-note "parameter specified here" } */
+template<typename T>
+void b0(T) {} /* { dg-error "parameter specified in an 'adjust_args' clause with the 'need_device_ptr' modifier must be of pointer type" } */
+
+
+template<typename T>
+void v1(T) {}
+
+#pragma omp declare variant(v1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1)
+template<typename T>
+void b1(T) {}
+
+void f0(int *p0, int *p1)
+{
+ #pragma omp dispatch
+ b0(42); /* { dg-message "required from here" } */
+ #pragma omp dispatch
+ b0(p0); /* { dg-bogus "required from here" } */
+ #pragma omp dispatch
+ b1(p1); /* { dg-bogus "required from here" } */
+}
+
+template<typename T>
+struct Type { typedef T type; };
+
+template<typename T>
+void v2(Type<T>, typename Type<T>::type) {}
+
+#pragma omp declare variant(v2) match(construct={dispatch}) \
+ adjust_args(need_device_addr: 2) /* { dg-note "parameter specified here" } */
+template<typename T>
+void b2(Type<T>, typename Type<T>::type) {} /* { dg-error "parameter specified in an 'adjust_args' clause with the 'need_device_addr' modifier must be of reference type" } */
+
+
+template<typename T>
+void v3(Type<T>, typename Type<T>::type) {}
+
+#pragma omp declare variant(v3) match(construct={dispatch}) \
+ adjust_args(need_device_addr: 2)
+template<typename T>
+void b3(Type<T>, typename Type<T>::type) {}
+
+
+void f2(int &r0, int &r1)
+{
+ #pragma omp dispatch
+ b2(Type<int>(), 42); /* { dg-message "required from here" } */
+ #pragma omp dispatch
+ b2(Type<int&>(), r0); /* { dg-bogus "required from here" } */
+ #pragma omp dispatch
+ b3(Type<int&>(), r1); /* { dg-bogus "required from here" } */
+}
+
+template<typename T>
+void vX(T) {}
+
+#pragma omp declare variant(vX) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1)
+template<typename T>
+void bX(T) {}
+
+template<typename T>
+void vY(T&) {}
+
+#pragma omp declare variant(vY) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1) /* { dg-note "parameter specified here" } */
+template<typename T>
+void bY(T&) {} /* { dg-message "parameter with type reference to pointer in an 'adjust_args' with the 'need_device_ptr' modifier is not currently supported" } */
+
+
+template<typename T>
+void v4(Type<T>, typename Type<T>::type) {}
+
+#pragma omp declare variant(v4) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 2) /* { dg-note "parameter specified here" } */
+template<typename T>
+void b4(Type<T>, typename Type<T>::type) {} /* { dg-message "parameter with type reference to pointer in an 'adjust_args' with the 'need_device_ptr' modifier is not currently supported" } */
+
+
+void f3(int *p, int *&rp0, int *&rp1)
+{
+ #pragma omp dispatch
+ bX(rp0); /* { dg-bogus "required from here" } */
+ #pragma omp dispatch
+ bY(p); /* { dg-message "required from here" } */
+ #pragma omp dispatch
+ b4(Type<int *&>(), rp1); /* { dg-message "required from here" } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-8.C b/gcc/testsuite/g++.dg/gomp/adjust-args-8.C
new file mode 100644
index 0000000..a03f438
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-8.C
@@ -0,0 +1,23 @@
+/* PR c++/118859 */
+
+/* { dg-do compile { target c++11 } } */
+
+/* Diagnose invalid types in a parameter pack that corresponds to an index
+ specified in a need_device_ptr/need_device_addr modified adjust_args clause.
+ TODO: Needs more cases, ideally matching the preceding (adjust-args-5.C) test cases. */
+
+template<typename... Ts>
+void v0(Ts...) {}
+
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1) /* { dg-note "parameter specified here" } */
+template<typename... Ts>
+void b0(Ts...) {} /* { dg-error "parameter specified in an 'adjust_args' clause with the 'need_device_ptr' modifier must be of pointer type" } */
+
+void f0(int p0, int p1)
+{
+ #pragma omp dispatch
+ b0(42, p0); /* { dg-message "required from here" } */
+ #pragma omp dispatch
+ b0(p1, 42); /* { dg-bogus "required from here" } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/adjust-args-9.C b/gcc/testsuite/g++.dg/gomp/adjust-args-9.C
new file mode 100644
index 0000000..3492f19
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/adjust-args-9.C
@@ -0,0 +1,39 @@
+/* { dg-do compile { target c++11 } } */
+
+/* Literal numeric range in function template with a parameter pack.
+
+ This case may seem to be unremarkable, but it's a non-dependent numeric range
+ in a function template in which we don't know the amount of parameters.
+ The way it's handled (at the time of writing) causes some pretty low quality
+ diagnostics, hence the seperate test case.
+
+ The numeric range is expanded before the function is instantiated, so the
+ fact that it was a numeric range is forgotten by the time the size is known
+ and a diagnostic can be issued. */
+
+template<typename... Ts>
+void v0(Ts...) {}
+template<typename... Ts>
+void v1(Ts...) {}
+
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1:2)
+template<typename... Ts>
+void b0(Ts...) {}
+
+#pragma omp declare variant(v1) match(construct={dispatch}) \
+ adjust_args(need_device_ptr: 1:2) /* { dg-error "parameter list item index is out of range" } */
+template<typename... Ts>
+void b1(Ts...) {}
+
+void f(int *p)
+{
+ /* Not out of range. */
+ #pragma omp dispatch
+ b0(p, p); /* { dg-bogus "required from here" } */
+ #pragma omp dispatch
+ b1(p, p); /* { dg-bogus "required from here" } */
+ /* Out of range. */
+ #pragma omp dispatch
+ b1(p); /* { dg-message "required from here" } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-10.C b/gcc/testsuite/g++.dg/gomp/allocate-10.C
new file mode 100644
index 0000000..d5ff28a
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-10.C
@@ -0,0 +1,1019 @@
+#include "allocate-allocator-handle.h"
+
+/* Diagnostics for invalid cases. There are a few valid cases peppered in here
+ but that's not what is being tested for in here. */
+
+
+/****************************************************
+ * Reference variable used in an allocate directive *
+ ****************************************************/
+
+void ref_var()
+{
+ int a = 42;
+ int& ref = a; /* { dg-note "'ref' declared here" } */
+ #pragma omp allocate(ref) /* { dg-error "variable 'ref' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+template<typename>
+void ref_var_templ_not_instantiated()
+{
+ int a = 42;
+ int& ref = a; /* { dg-note "'ref' declared here" } */
+ #pragma omp allocate(ref) /* { dg-error "variable 'ref' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+template<typename T>
+void dependent_ref_var_templ_not_instantiated()
+{
+ T a = 42;
+ T& t = a; /* { dg-note "'t' declared here" } */
+ #pragma omp allocate(t) /* { dg-error "variable 't' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+template<typename T>
+void dependent_var_templ_not_instantiated()
+{
+ T t = 42;
+ #pragma omp allocate(t)
+}
+
+template<typename T>
+void dependent_var_templ_0()
+{
+ T t = 42;
+ #pragma omp allocate(t)
+}
+
+template<typename T>
+void dependent_var_templ_1()
+{
+ T t = 42; /* { dg-note "'t' declared here" } */
+ #pragma omp allocate(t) /* { dg-error "variable 't' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+template<typename T>
+void dependent_var_templ_2()
+{
+ int a;
+ T t = a; /* { dg-note "'t' declared here" } */
+ #pragma omp allocate(t) /* { dg-error "variable 't' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+void instantiate_var_templ()
+{
+ dependent_var_templ_0<int>(); /* { dg-bogus "required from here" } */
+ dependent_var_templ_1<int>(); /* { dg-bogus "required from here" } */
+ dependent_var_templ_1<int const&>(); /* { dg-message "required from here" } */
+ dependent_var_templ_2<int>(); /* { dg-bogus "required from here" } */
+ dependent_var_templ_2<int&>(); /* { dg-message "required from here" } */
+ dependent_var_templ_2<int const&>(); /* { dg-message "required from here" } */
+}
+
+
+/****************************
+ * Invalid allocator clause *
+ ****************************/
+
+template<omp_allocator_handle_t Alloc>
+void nttp_allocator()
+{
+ int a;
+ #pragma omp allocate(a) allocator(Alloc)
+}
+
+template<omp_allocator_handle_t Alloc>
+void nttp_allocator_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) allocator(Alloc)
+}
+
+template<int Alloc>
+void nttp_wrong_type_allocator_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" } */
+}
+
+template<typename AllocT, AllocT Alloc>
+void nttp_dependent_type_allocator()
+{
+ int a;
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" } */
+}
+
+template<typename AllocT, AllocT Alloc>
+void nttp_dependent_type_allocator_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) allocator(Alloc)
+}
+
+void instantiate_nttp_allocator()
+{
+ nttp_allocator<omp_default_mem_alloc>(); /* { dg-bogus "required from here" } */
+ nttp_dependent_type_allocator<omp_allocator_handle_t, omp_default_mem_alloc>(); /* { dg-bogus "required from here" } */
+ nttp_dependent_type_allocator<int, 5>(); /* { dg-message "required from here" } */
+}
+
+template<omp_allocator_handle_t Alloc>
+void nttp_allocator_static()
+{
+ static int a; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" } */
+}
+
+template<omp_allocator_handle_t Alloc>
+void nttp_allocator_uninstantiated_static()
+{
+ static int a;
+ #pragma omp allocate(a) allocator(Alloc)
+}
+
+template<int Alloc>
+void nttp_wrong_type_allocator_uninstantiated_static()
+{
+ static int a;
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" } */
+}
+
+template<typename AllocT, AllocT Alloc>
+void nttp_dependent_type_allocator_static_0()
+{
+ static int a; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" } */
+}
+
+template<typename AllocT, AllocT Alloc>
+void nttp_dependent_type_allocator_static_1()
+{
+ static int a;
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" } */
+}
+
+template<typename AllocT, AllocT Alloc>
+void nttp_dependent_type_allocator_uninstantiated_static()
+{
+ static int a;
+ #pragma omp allocate(a) allocator(Alloc)
+}
+
+#define DEFINITELY_NOT_PREDEFINED static_cast<omp_allocator_handle_t>(1024)
+
+void instantiate_nttp_allocator_static()
+{
+ nttp_allocator_static<omp_default_mem_alloc>(); /* { dg-bogus "required from here" } */
+ nttp_allocator_static<DEFINITELY_NOT_PREDEFINED>(); /* { dg-message "required from here" } */
+ nttp_dependent_type_allocator_static_0<omp_allocator_handle_t, omp_default_mem_alloc>(); /* { dg-bogus "required from here" } */
+ nttp_dependent_type_allocator_static_0<omp_allocator_handle_t, DEFINITELY_NOT_PREDEFINED>(); /* { dg-message "required from here" } */
+ nttp_dependent_type_allocator_static_1<int, 1>(); /* { dg-message "required from here" } */
+}
+
+#undef DEFINITELY_NOT_PREDEFINED
+
+
+template<typename AllocT>
+void templ_allocator_param_0(AllocT alloc)
+{
+ int a;
+ #pragma omp allocate(a) allocator(alloc)
+}
+
+template<typename AllocT>
+void templ_allocator_param_1(AllocT alloc)
+{
+ int a;
+ #pragma omp allocate(a) allocator(alloc) /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" } */
+}
+
+template<typename AllocT>
+void templ_allocator_param_uninstantiated(AllocT alloc)
+{
+ int a;
+ #pragma omp allocate(a) allocator(alloc)
+}
+
+void instantiate_templ_allocator_param()
+{
+ templ_allocator_param_0(omp_default_mem_alloc); /* { dg-bogus "required from here" } */
+ templ_allocator_param_1(omp_default_mem_alloc); /* { dg-bogus "required from here" } */
+ templ_allocator_param_1(0); /* { dg-message "required from here" } */
+}
+
+
+template<typename>
+void missing_allocator_clause_uninstantiated()
+{
+ static int a; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) /* { dg-error "'allocator' clause required for static variable 'a'" } */
+}
+
+/* Cases that are never constant omp_allocator_handle_t expressions (and are required to be) */
+
+template<typename>
+void allocator_param_static_uninstantiated(omp_allocator_handle_t alloc)
+{
+ static int a; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) allocator(alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" } */
+}
+
+template<typename>
+void allocator_var_static_uninstantiated()
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ static int a; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) allocator(alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" } */
+}
+
+/* See cp/semantics.cc:finish_omp_allocate
+ These cases will always be invalid but diagnosing type dependent cases
+ before instantiation is too difficult. */
+
+template<typename AllocT>
+void templ_allocator_param_static_uninstantiated(AllocT alloc)
+{
+ static int a;
+ #pragma omp allocate(a) allocator(alloc)
+}
+
+template<typename AllocT>
+void templ_allocator_var_static_uninstantiated()
+{
+ AllocT alloc = omp_default_mem_alloc;
+ static int a;
+ #pragma omp allocate(a) allocator(alloc)
+}
+
+
+/************************
+ * Invalid align clause *
+ ************************/
+
+template<int Align>
+void nttp_align()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+}
+
+template<int Align>
+void nttp_align_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) align(Align)
+}
+
+template<int* Align>
+void nttp_wrong_type_align_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+}
+
+template<typename AlignT, AlignT Align>
+void nttp_dependent_type_align_0()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+}
+
+template<typename AlignT, AlignT Align>
+void nttp_dependent_type_align_1()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { xfail *-*-* } } */
+}
+
+template<typename AlignT, AlignT Align>
+void nttp_dependent_type_align_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) align(Align)
+}
+
+void instantiate_nttp_align()
+{
+ nttp_align<32>();
+ nttp_align<42>(); /* { dg-message "required from here" } */
+ nttp_dependent_type_align_0<int, 32>(); /* { dg-bogus "required from here" } */
+ nttp_dependent_type_align_0<int, 42>(); /* { dg-message "required from here" } */
+ nttp_dependent_type_align_1<int, 32>(); /* { dg-bogus "required from here" } */
+ /* We just need any non integer NTTP that is valid in c++98, this fits the bill. */
+ nttp_dependent_type_align_1<void(*)(), instantiate_nttp_align>(); /* { dg-message "required from here" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "Bugged diagnostic, see comment" { target *-*-* } .-1 } */
+ /* I believe this diagnostic is bugged, it should refer to where the
+ expression is used, not where it originated from. This isn't a bug for
+ this feature though so I'm making the test case work around it,
+ when this bug is fixed this test case, and the xfail in the test case in
+ nttp_dependent_type_align_1 can be remove. */
+}
+
+/* Cases that are never constant integer expressions (always required for the align clause) */
+
+template<typename>
+void align_param_uninstantiated(int align)
+{
+ int a;
+ #pragma omp allocate(a) align(align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+}
+
+template<typename>
+void align_var_uninstantiated()
+{
+ int align = 32;
+ int a;
+ #pragma omp allocate(a) align(align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+}
+
+/* See cp/semantics.cc:finish_omp_allocate
+ These cases will always be invalid but diagnosing type dependent cases
+ before instantiation is too difficult. */
+
+template<typename AlignT>
+void templ_align_param_uninstantiated(AlignT align)
+{
+ int a;
+ #pragma omp allocate(a) align(align)
+}
+
+template<typename AlignT>
+void templ_align_var_uninstantiated()
+{
+ AlignT align = 32;
+ int a;
+ #pragma omp allocate(a) align(align)
+}
+
+
+
+/***************
+ * Mixed cases *
+ ***************/
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_uninstantiated()
+{
+ int b = 42;
+ Var a = b;
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+}
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_valid()
+{
+ int b = 42;
+ Var a = b;
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+}
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_0()
+{
+ int b = 42;
+ Var a = b; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+ /* { dg-error "variable 'a' with reference type may not appear as a list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+}
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_1()
+{
+ int b = 42;
+ Var a = b;
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+ /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" "" { target *-*-* } .-1 } */
+}
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_2()
+{
+ int b = 42;
+ Var a = b;
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_3()
+{
+ int b = 42;
+ Var a = b; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+ /* { dg-error "variable 'a' with reference type may not appear as a list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" "" { target *-*-* } .-2 } */
+}
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_4()
+{
+ int b = 42;
+ Var a = b; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+ /* { dg-error "variable 'a' with reference type may not appear as a list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+}
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_5()
+{
+ int b = 42;
+ Var a = b;
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+ /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" "" { target *-*-* } .-1 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+}
+
+template<typename Var,
+ typename AllocT, AllocT Alloc,
+ typename AlignT, AlignT Align>
+void all_dependent_6()
+{
+ int b = 42;
+ Var a = b; /* { dg-note "'a' declared here" } */
+ #pragma omp allocate(a) allocator(Alloc) align(Align)
+ /* { dg-error "variable 'a' with reference type may not appear as a list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" "" { target *-*-* } .-2 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-3 } */
+}
+
+void instantiate_all_dependent()
+{
+ all_dependent_valid<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>();
+ /* Don't test the type mismatch for the align clause here, it's diagnostic
+ location is buggy, and the error message is the same. We just really want
+ to test that we aren't emitting bogus errors when multiple things are
+ dependent, so it's unnecessary to test that case again. */
+ all_dependent_0<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>(); /* { dg-bogus "required from here" } */
+ all_dependent_0<int&, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>(); /* { dg-message "required from here" } */
+
+ all_dependent_1<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>(); /* { dg-bogus "required from here" } */
+ all_dependent_1<int, int, 1, int, 32>(); /* { dg-message "required from here" } */
+
+ all_dependent_2<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>(); /* { dg-bogus "required from here" } */
+ all_dependent_2<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 42>(); /* { dg-message "required from here" } */
+
+ all_dependent_3<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>(); /* { dg-bogus "required from here" } */
+ all_dependent_3<int&, int, 1, int, 32>(); /* { dg-message "required from here" } */
+
+ all_dependent_4<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>(); /* { dg-bogus "required from here" } */
+ all_dependent_4<int&, omp_allocator_handle_t, omp_default_mem_alloc, int, 42>(); /* { dg-message "required from here" } */
+
+ all_dependent_5<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>(); /* { dg-bogus "required from here" } */
+ all_dependent_5<int, int, 1, int, 42>(); /* { dg-message "required from here" } */
+
+ all_dependent_6<int, omp_allocator_handle_t, omp_default_mem_alloc, int, 32>(); /* { dg-bogus "required from here" } */
+ all_dependent_6<int&, int, 1, int, 42>(); /* { dg-message "required from here" } */
+}
+
+/* We are missing combined cases for static var used in the allocate directive,
+ but it should be fine, the combined cases immediately above are probably
+ overkill as it is. */
+
+
+/******************************
+ * Invalid allocate directive *
+ ******************************/
+
+/* We are only testing that we gracefully handle an empty list of vars. */
+
+void no_parens()
+{
+ #pragma omp allocate /* { dg-error "expected '\\\(' before end of line" } */
+}
+
+template<typename>
+void templ_no_parens()
+{
+ #pragma omp allocate /* { dg-error "expected '\\\(' before end of line" } */
+}
+template void templ_no_parens<void>();
+
+template<typename>
+void templ_no_parens_uninstantiated()
+{
+ #pragma omp allocate /* { dg-error "expected '\\\(' before end of line" } */
+}
+
+void no_vars()
+{
+ #pragma omp allocate() /* { dg-error "expected unqualified-id before '\\\)' token" } */
+}
+
+template<typename>
+void templ_no_vars()
+{
+ #pragma omp allocate() /* { dg-error "expected unqualified-id before '\\\)' token" } */
+}
+template void templ_no_vars<void>();
+
+template<typename>
+void templ_no_vars_uninstantiated()
+{
+ #pragma omp allocate() /* { dg-error "expected unqualified-id before '\\\)' token" } */
+}
+
+/* We can't diagnose anything about the allocator clause if we have no
+ variables, but we do need to make sure we don't crash. */
+
+void no_vars_allocator()
+{
+ #pragma omp allocate() allocator(omp_default_mem_alloc) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+}
+
+template<typename>
+void templ_no_vars_allocator()
+{
+ #pragma omp allocate() allocator(omp_default_mem_alloc) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+}
+template void templ_no_vars_allocator<void>();
+
+template<typename>
+void templ_no_vars_allocator_uninstantiated()
+{
+ #pragma omp allocate() allocator(omp_default_mem_alloc) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+}
+
+/* We can still diagnose errors about the align clause without any vars. */
+
+void no_vars_invalid_align()
+{
+ #pragma omp allocate() align(42) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+
+template<typename>
+void templ_no_vars_invalid_align()
+{
+ #pragma omp allocate() align(42) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+template void templ_no_vars_invalid_align<void>();
+
+template<typename>
+void templ_no_vars_invalid_align_uninstantiated()
+{
+ #pragma omp allocate() align(42) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+
+template<int Align>
+void templ_no_vars_dep_align()
+{
+ #pragma omp allocate() align(Align) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+}
+template void templ_no_vars_dep_align<32>();
+
+template<int Align>
+void templ_no_vars_dep_align_invalid()
+{
+ #pragma omp allocate() align(Align) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+template void templ_no_vars_dep_align_invalid<42>();
+
+template<int Align>
+void templ_no_vars_dep_align_uninstantiated()
+{
+ #pragma omp allocate() align(Align) /* { dg-error "expected unqualified-id before '\\\)' token" } */
+}
+
+/*********************************
+ * All vars in directive invalid *
+ *********************************/
+
+void invalid_vars_param(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+}
+
+template<typename>
+void templ_invalid_vars_param(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+}
+template void templ_invalid_vars_param<void>(int);
+
+template<typename>
+void templ_invalid_vars_param_uninstantiated(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+}
+
+void invalid_vars_out_of_scope()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ }
+}
+
+template<typename>
+void templ_invalid_vars_out_of_scope()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ }
+}
+template void templ_invalid_vars_out_of_scope<void>();
+
+template<typename>
+void templ_invalid_vars_out_of_scope_uninstantiated()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ }
+}
+
+void invalid_vars_out_of_scope_and_param(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ }
+}
+
+template<typename>
+void templ_invalid_vars_out_of_scope_and_param(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_and_param<void>(int);
+
+template<typename>
+void templ_invalid_vars_out_of_scope_and_param_uninstantiated(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ }
+}
+
+/* Same as above, we can't diagnose anything about the allocator clause if we
+ have no variables, but we do need to make sure we don't crash. */
+
+void invalid_vars_param_allocator(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) allocator(omp_default_mem_alloc) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+}
+
+template<typename>
+void templ_invalid_vars_param_allocator(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) allocator(omp_default_mem_alloc) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+}
+template void templ_invalid_vars_param_allocator<void>(int);
+
+template<typename>
+void templ_invalid_vars_param_allocator_uninstantiated(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) allocator(omp_default_mem_alloc) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+}
+
+void invalid_vars_out_of_scope_allocator()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) allocator(omp_default_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ }
+}
+
+template<typename>
+void templ_invalid_vars_out_of_scope_allocator()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) allocator(omp_default_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_allocator<void>();
+
+template<typename>
+void templ_invalid_vars_out_of_scope_allocator_uninstantiated()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) allocator(omp_default_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ }
+}
+
+void invalid_vars_out_of_scope_and_param_allocator(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) allocator(omp_default_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ }
+}
+
+template<typename>
+void templ_invalid_vars_out_of_scope_and_param_allocator(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) allocator(omp_default_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_and_param_allocator<void>(int);
+
+template<typename>
+void templ_invalid_vars_out_of_scope_and_param_allocator_uninstantiated(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) allocator(omp_default_mem_alloc) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ }
+}
+
+/* Invalid vars with non-dependent invalid align */
+
+void invalid_vars_param_align_invalid(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) align(42) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+
+template<typename>
+void templ_invalid_vars_param_align_invalid(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) align(42) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+template void templ_invalid_vars_param_align_invalid<void>(int);
+
+template<typename>
+void templ_invalid_vars_param_align_invalid_uninstantiated(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) align(42) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+
+void invalid_vars_out_of_scope_align_invalid()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) align(42) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+ }
+}
+
+template<typename>
+void templ_invalid_vars_out_of_scope_align_invalid()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) align(42) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_align_invalid<void>();
+
+template<typename>
+void templ_invalid_vars_out_of_scope_align_invalid_uninstantiated()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) align(42) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+ }
+}
+
+void invalid_vars_out_of_scope_and_param_align_invalid(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) align(42) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+ }
+}
+
+template<typename>
+void templ_invalid_vars_out_of_scope_and_param_align_invalid(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) align(42) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_and_param_align_invalid<void>(int);
+
+template<typename>
+void templ_invalid_vars_out_of_scope_and_param_align_invalid_uninstantiated(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) align(42) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+ }
+}
+
+
+/* Param (dependent align) */
+
+template<int Align>
+void templ_invalid_vars_param_dependent_align_uninstantiated(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) align(Align) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+}
+
+template<int Align>
+void templ_invalid_vars_param_dependent_align(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) align(Align) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+}
+template void templ_invalid_vars_param_dependent_align<32>(int);
+
+template<int Align>
+void templ_invalid_vars_param_dependent_align_invalid(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ #pragma omp allocate(p) align(Align) /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+template void templ_invalid_vars_param_dependent_align_invalid<42>(int);
+
+
+/* Out of scope (dependent align) */
+
+template<int Align>
+void templ_invalid_vars_out_of_scope_dependent_align_uninstantiated()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) align(Align) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ }
+}
+
+template<int Align>
+void templ_invalid_vars_out_of_scope_dependent_align()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) align(Align) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_dependent_align<32>();
+
+template<int Align>
+void templ_invalid_vars_out_of_scope_dependent_align_invalid()
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a) align(Align) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_dependent_align_invalid<42>();
+
+
+/* Param and out of scope (dependent align) */
+
+template<int Align>
+void templ_invalid_vars_out_of_scope_and_param_dependent_align_uninstantiated(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) align(Align) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ }
+}
+
+template<int Align>
+void templ_invalid_vars_out_of_scope_and_param_dependent_align(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) align(Align) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_and_param_dependent_align<32>(int);
+
+template<int Align>
+void templ_invalid_vars_out_of_scope_and_param_dependent_align_invalid(int p) /* { dg-note "parameter 'p' declared here" } */
+{
+ int a; /* { dg-note "declared here" } */
+ {
+ #pragma omp allocate(a, p) align(Align) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ /* { dg-error "function parameter 'p' may not appear as list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+ }
+}
+template void templ_invalid_vars_out_of_scope_and_param_dependent_align_invalid<42>(int);
+
+
+
+/****************************************************
+ * uses of var in multiple directives in a template *
+ ****************************************************/
+
+/* We are missing a lot of cases here but testing all of them shouldn't be
+ necessary. Uses of variables in multiple directives are diagnosed during
+ parsing so templates shouldn't change anything. This is of course as long
+ as we don't change that, and these cases should be enough to deter anyone
+ from doing so. */
+
+template<typename>
+void multiple_uses_non_dependent_directive_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) /* { dg-note "'a' previously appeared here" } */
+ #pragma omp allocate(a) /* { dg-error "'a' already appeared as list item in an 'allocate' directive" } */
+}
+
+template<typename>
+void multiple_uses_non_dependent_directive()
+{
+ int a;
+ #pragma omp allocate(a) /* { dg-note "'a' previously appeared here" } */
+ #pragma omp allocate(a) /* { dg-error "'a' already appeared as list item in an 'allocate' directive" } */
+}
+template void multiple_uses_non_dependent_directive<void>();
+
+
+template<int Align>
+void multiple_uses_dep_directive_before_align_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-note "'a' previously appeared here" } */
+ #pragma omp allocate(a) /* { dg-error "'a' already appeared as list item in an 'allocate' directive" } */
+}
+
+template<int Align>
+void multiple_uses_dep_directive_before_valid_align()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-note "'a' previously appeared here" } */
+ #pragma omp allocate(a) /* { dg-error "'a' already appeared as list item in an 'allocate' directive" } */
+}
+template void multiple_uses_dep_directive_before_valid_align<32>();
+
+template<int Align>
+void multiple_uses_dep_directive_before_invalid_align()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-note "'a' previously appeared here" } */
+ #pragma omp allocate(a) /* { dg-error "'a' already appeared as list item in an 'allocate' directive" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+}
+template void multiple_uses_dep_directive_before_invalid_align<42>();
+
+
+/* Dependent directive after the independent one. */
+
+template<int Align>
+void multiple_uses_dep_directive_after_align_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) /* { dg-note "'a' previously appeared here" } */
+ #pragma omp allocate(a) align(Align) /* { dg-error "'a' already appeared as list item in an 'allocate' directive" } */
+}
+
+template<int Align>
+void multiple_uses_dep_directive_after_valid_align()
+{
+ int a;
+ #pragma omp allocate(a) /* { dg-note "'a' previously appeared here" } */
+ #pragma omp allocate(a) align(Align) /* { dg-error "'a' already appeared as list item in an 'allocate' directive" } */
+}
+template void multiple_uses_dep_directive_after_valid_align<32>();
+
+template<int Align>
+void multiple_uses_dep_directive_after_invalid_align()
+{
+ int a;
+ #pragma omp allocate(a) /* { dg-note "'a' previously appeared here" } */
+ #pragma omp allocate(a) align(Align) /* { dg-error "'a' already appeared as list item in an 'allocate' directive" } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+}
+template void multiple_uses_dep_directive_after_invalid_align<42>();
+
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-11.C b/gcc/testsuite/g++.dg/gomp/allocate-11.C
new file mode 100644
index 0000000..38638d7
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-11.C
@@ -0,0 +1,50 @@
+/* { dg-do compile { target c++11 } } */
+
+/* Diagnostics for rvalue reference vars used in an allocate directive. */
+
+void rref_var()
+{
+ int&& ref = 42; /* { dg-note "'ref' declared here" } */
+ #pragma omp allocate(ref) /* { dg-error "variable 'ref' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+void const_rref_var()
+{
+ int const&& ref = 42; /* { dg-note "'ref' declared here" } */
+ #pragma omp allocate(ref) /* { dg-error "variable 'ref' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+template<typename>
+void rref_var_templ_not_instantiated()
+{
+ int&& ref = 42; /* { dg-note "'ref' declared here" } */
+ #pragma omp allocate(ref) /* { dg-error "variable 'ref' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+template<typename>
+void const_rref_var_templ_not_instantiated()
+{
+ int const&& ref = 42; /* { dg-note "'ref' declared here" } */
+ #pragma omp allocate(ref) /* { dg-error "variable 'ref' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+template<typename T>
+void dependent_rref_var_templ_not_instantiated()
+{
+ T&& t = 42; /* { dg-note "'t' declared here" } */
+ #pragma omp allocate(t) /* { dg-error "variable 't' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+
+template<typename T>
+void dependent_var_templ()
+{
+ T t = 42; /* { dg-note "'t' declared here" } */
+ #pragma omp allocate(t) /* { dg-error "variable 't' with reference type may not appear as a list item in an 'allocate' directive" } */
+}
+void instantiate_var_templ()
+{
+ dependent_var_templ<int>(); /* { dg-bogus "required from here" } */
+ dependent_var_templ<int&&>(); /* { dg-message "required from here" } */
+ dependent_var_templ<int const&&>(); /* { dg-message "required from here" } */
+}
+
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-12.C b/gcc/testsuite/g++.dg/gomp/allocate-12.C
new file mode 100644
index 0000000..678c398
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-12.C
@@ -0,0 +1,108 @@
+/* { dg-do compile { target c++17 } } */
+#include "allocate-allocator-handle.h"
+
+/* Invalid allocator clause */
+
+template<auto Alloc>
+void auto_nttp_allocator()
+{
+ int a;
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" } */
+}
+
+template<auto Alloc>
+void auto_nttp_allocator_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) allocator(Alloc)
+}
+
+#define DEFINITELY_NOT_PREDEFINED static_cast<omp_allocator_handle_t>(1024)
+
+void instantiate_auto_nttp_allocator()
+{
+ auto_nttp_allocator<omp_default_mem_alloc>(); /* { dg-bogus "required from here" } */
+ auto_nttp_allocator<DEFINITELY_NOT_PREDEFINED>(); /* { dg-bogus "required from here" } */
+ auto_nttp_allocator<1>(); /* { dg-message "required from here" } */
+}
+
+#undef DEFINITELY_NOT_PREDEFINED
+
+template<auto Alloc>
+void auto_nttp_allocator_static_0()
+{
+ static int a;
+ #pragma omp allocate(a) allocator(Alloc)
+ /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" "" { target *-*-* } .-1 } */
+ /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" "" { target *-*-* } .-2 } */
+}
+
+template<auto Alloc>
+void auto_nttp_allocator_static_1()
+{
+ static int a;
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause expression has type 'int' rather than 'omp_allocator_handle_t'" } */
+}
+
+template<auto Alloc>
+void auto_nttp_allocator_static_2()
+{
+ static int a;
+ #pragma omp allocate(a) allocator(Alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" } */
+}
+
+template<auto Alloc>
+void auto_nttp_allocator_static_uninstantiated()
+{
+ static int a;
+ #pragma omp allocate(a) allocator(Alloc)
+}
+
+#define DEFINITELY_NOT_PREDEFINED static_cast<omp_allocator_handle_t>(1024)
+
+void instantiate_auto_nttp_allocator_static()
+{
+ auto_nttp_allocator_static_0<omp_default_mem_alloc>(); /* { dg-bogus "required from here" } */
+ auto_nttp_allocator_static_0<1>(); /* { dg-message "required from here" } */
+ auto_nttp_allocator_static_0<DEFINITELY_NOT_PREDEFINED>(); /* { dg-message "required from here" } */
+
+ auto_nttp_allocator_static_1<omp_default_mem_alloc>(); /* { dg-bogus "required from here" } */
+ auto_nttp_allocator_static_1<1>(); /* { dg-message "required from here" } */
+
+ auto_nttp_allocator_static_2<omp_default_mem_alloc>(); /* { dg-bogus "required from here" } */
+ auto_nttp_allocator_static_2<DEFINITELY_NOT_PREDEFINED>(); /* { dg-message "required from here" } */
+}
+
+#undef DEFINITELY_NOT_PREDEFINED
+
+/* Invalid align clause */
+
+template<auto Align>
+void auto_nttp_align_uninstantiated()
+{
+ int a;
+ #pragma omp allocate(a) align(Align)
+}
+
+template<auto Align>
+void auto_nttp_align_0()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+}
+
+template<auto Align>
+void auto_nttp_align_1()
+{
+ int a;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+}
+
+void instantiate_auto_nttp_align()
+{
+ auto_nttp_align_0<32>(); /* { dg-bogus "required from here" } */
+ auto_nttp_align_0<42>(); /* { dg-message "required from here" } */
+
+ auto_nttp_align_1<32>(); /* { dg-bogus "required from here" } */
+ auto_nttp_align_1<nullptr>(); /* { dg-message "required from here" } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-13.C b/gcc/testsuite/g++.dg/gomp/allocate-13.C
new file mode 100644
index 0000000..feec331
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-13.C
@@ -0,0 +1,172 @@
+/* { dg-do compile { target c++11 } } */
+#include "allocate-allocator-handle.h"
+
+/* Incorrect use of lambda captures in a directive or clause.
+ There are a few cases in here that are impacted by the bug with implicit
+ constexpr functions detailed in allocate-15.C and allocate-16.C. */
+
+void capture_used_in_directive()
+{
+ int a = 42;
+ auto cl = [a](){
+ #pragma omp allocate(a) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ };
+}
+
+template<typename>
+void capture_used_in_directive_templ_uninstantiated()
+{
+ int a = 42;
+ auto cl = [a](){
+ #pragma omp allocate(a) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ };
+}
+
+template<typename>
+void capture_used_in_directive_templ()
+{
+ int a = 42;
+ auto cl = [a](){
+ #pragma omp allocate(a) /* { dg-error "'allocate' directive must be in the same scope as 'a'" } */
+ };
+}
+
+void instantiate_capture_used_in_directive()
+{
+ capture_used_in_directive_templ<void>();
+}
+
+
+
+void capture_used_in_allocator_clause_static_var()
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ auto cl = [alloc](){
+ static int a = 42;
+ #pragma omp allocate(a) allocator(alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" "" { xfail c++17 } } */
+ /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" "" { target c++17 } .-1 } */
+ };
+}
+
+/* This is similar to capture_used_in_align_clause_templ_uninstantiated below,
+ see below for more info. */
+template<typename>
+void capture_used_in_allocator_clause_static_var_templ_uninstantiated()
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ auto cl = [alloc](){
+ static int a = 42;
+ #pragma omp allocate(a) allocator(alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" "" { xfail *-*-* } } */
+ /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" "" { target c++17 } .-1 } */
+ };
+}
+
+/* It's not viable to diagnose this case, see the comment on
+ dependent_capture_used_in_align_clause_templ_uninstantiated below. */
+template<typename T>
+void dependent_capture_used_in_allocator_clause_static_var_templ_uninstantiated()
+{
+ T alloc = omp_default_mem_alloc;
+ auto cl = [alloc](){
+ static int a = 42;
+ #pragma omp allocate(a) allocator(alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" "" { xfail *-*-* } } */
+ /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" "" { target c++17 } .-1 } */
+ };
+}
+
+template<typename>
+void capture_used_in_allocator_clause_static_var_templ()
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ auto cl = [alloc](){
+ static int a = 42;
+ #pragma omp allocate(a) allocator(alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" "" { xfail c++17 } } */
+ /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" "" { target c++17 } .-1 } */
+ };
+}
+
+template<typename T>
+void dependent_capture_used_in_allocator_clause_static_var_templ()
+{
+ T alloc = omp_default_mem_alloc;
+ auto cl = [alloc](){
+ static int a = 42;
+ #pragma omp allocate(a) allocator(alloc) /* { dg-error "'allocator' clause requires a predefined allocator as 'a' is static" "" { xfail c++17 } } */
+ /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" "" { target c++17 } .-1 } */
+ };
+}
+
+void instantiate_capture_used_in_allocator_clause_static_var()
+{
+ capture_used_in_allocator_clause_static_var_templ<void>();
+ dependent_capture_used_in_allocator_clause_static_var_templ<omp_allocator_handle_t>();
+}
+
+
+
+void capture_used_in_align_clause()
+{
+ int align = 32;
+ auto cl = [align](){
+ int a;
+ #pragma omp allocate(a) align(align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ };
+}
+
+/* This case should be diagnosable, but we don't even try right now. Even if
+ we did try by checking if an expr is potential_constant_expression, it
+ appears to incorrectly returns true for the align clause's expression here.
+ We know the type is int so we know it's not an empty type, so we should be
+ able to know that it can't possibly be a constant expression even before
+ the template is instantiated. Unfortunately, as stated above,
+ potential_constant_expression does not agree. It's also possible this is
+ not a bug in potential_constant_expression and there is something I am
+ overlooking. */
+template<typename>
+void capture_used_in_align_clause_templ_uninstantiated()
+{
+ int align = 32;
+ auto cl = [align](){
+ int a;
+ #pragma omp allocate(a) align(align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { xfail *-*-* } } */
+ };
+}
+
+/* Unlike the above case this case is very hard to diagnose,
+ potential_constant_expression correctly returns true for the align clause's
+ expr here. See cp/semantics.cc:finish_omp_allocate for more information. */
+template<typename T>
+void dependent_capture_used_in_align_clause_templ_uninstantiated()
+{
+ T align = 32;
+ auto cl = [align](){
+ int a;
+ #pragma omp allocate(a) align(align) /* { eg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { xfail *-*-* } } */
+ };
+}
+
+template<typename>
+void capture_used_in_align_clause_templ()
+{
+ int align = 32;
+ auto cl = [align](){
+ int a;
+ #pragma omp allocate(a) align(align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ };
+}
+
+template<typename T>
+void dependent_capture_used_in_align_clause_templ()
+{
+ T align = 32;
+ auto cl = [align](){
+ int a;
+ #pragma omp allocate(a) align(align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ };
+}
+
+void instantiate_capture_used_in_align()
+{
+ capture_used_in_align_clause_templ<void>();
+ dependent_capture_used_in_align_clause_templ<int>();
+}
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-14.C b/gcc/testsuite/g++.dg/gomp/allocate-14.C
new file mode 100644
index 0000000..a959758
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-14.C
@@ -0,0 +1,172 @@
+/* { dg-do compile { target c++17 } } */
+
+/* Nested lambdas */
+
+#include "allocate-allocator-handle.h"
+
+template<int Align>
+auto lambda_00()
+{
+ return [](auto p0){
+ return [](auto p1){
+ return [](auto p2){
+ return [p2](auto p3){
+ int b = 42;
+ decltype(p3) a = b;
+ #pragma omp allocate(a) align(Align) allocator(p2)
+ return a;
+ };
+ };
+ };
+ };
+}
+
+template<int Align>
+auto lambda_01()
+{
+ return [](auto p0){
+ return [](auto p1){
+ return [](auto p2){
+ return [p2](auto p3){
+ int b = 42;
+ decltype(p3) a = b; /* { dg-message "'a' declared here" } */
+ #pragma omp allocate(a) align(Align) allocator(p2)
+ /* { dg-error "variable 'a' with reference type may not appear as a list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+ /* { dg-error "'allocator' clause expression has type 'const int' rather than 'omp_allocator_handle_t'" "" { target *-*-* } .-3 } */
+ return a;
+ };
+ };
+ };
+ };
+}
+
+template<int Align>
+auto lambda_02()
+{
+ return [](auto p0){
+ return [](auto p1){
+ return [](auto p2){
+ return [p2](auto p3){
+ int b = 42;
+ decltype(p3) a = b;
+ #pragma omp allocate(a) align(Align) allocator(p2)
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-1 } */
+ return a;
+ };
+ };
+ };
+ };
+}
+
+void instantiate_lambdas_0()
+{
+ /* valid */
+ auto c00 = lambda_00<32>();
+ auto c01 = c00(0);
+ auto c02 = c01(0);
+ auto c03 = c02(omp_default_mem_alloc);
+ c03(0);
+ /* invalid */
+ auto c10 = lambda_01<30>(); /* { dg-message "required from here" } */
+ auto c11 = c10(0); /* { dg-bogus "required from here" } */
+ auto c12 = c11(0); /* { dg-bogus "required from here" } */
+ auto c13 = c12(0); /* { dg-message "required from here" } */
+ int a = 0;
+ c13.operator()<int&>(a); /* { dg-message "required from here" } */
+ /* partially instantiated (invalid) */
+ auto c20 = lambda_02<30>(); /* { dg-message "required from here" } */
+}
+
+
+
+template<int Align>
+auto lambda_10()
+{
+ return [](auto p0){
+ int a = 42;
+ #pragma omp allocate(a) align(Align)
+ return [](auto p1){
+ int a = 42;
+ #pragma omp allocate(a) align(Align)
+ return [](auto p2){
+ int a = 42;
+ #pragma omp allocate(a) align(Align)
+ return [p2](auto p3){
+ int b = 42;
+ decltype(p3) a = b;
+ #pragma omp allocate(a) align(Align) allocator(p2)
+ return a;
+ };
+ };
+ };
+ };
+}
+
+template<int Align>
+auto lambda_11()
+{
+ return [](auto p0){
+ int a = 42;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ return [](auto p1){
+ int a = 42;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ return [](auto p2){
+ int a = 42;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ return [p2](auto p3){
+ int b = 42;
+ decltype(p3) a = b; /* { dg-message "'a' declared here" } */
+ #pragma omp allocate(a) align(Align) allocator(p2)
+ /* { dg-error "variable 'a' with reference type may not appear as a list item in an 'allocate' directive" "" { target *-*-* } .-1 } */
+ /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" "" { target *-*-* } .-2 } */
+ /* { dg-error "'allocator' clause expression has type 'const int' rather than 'omp_allocator_handle_t'" "" { target *-*-* } .-3 } */
+ return a;
+ };
+ };
+ };
+ };
+}
+
+template<int Align>
+auto lambda_12()
+{
+ return [](auto p0){
+ int a = 42;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ return [](auto p1){
+ int a = 42;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ return [](auto p2){
+ int a = 42;
+ #pragma omp allocate(a) align(Align) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ return [p2](auto p3){
+ int b = 42;
+ decltype(p3) a = b;
+ #pragma omp allocate(a) align(Align) allocator(p2) /* { dg-error "'align' clause argument needs to be positive constant power of two integer expression" } */
+ return a;
+ };
+ };
+ };
+ };
+}
+
+void instantiate_lambdas_1()
+{
+ /* valid */
+ auto c00 = lambda_10<32>();
+ auto c01 = c00(0);
+ auto c02 = c01(0);
+ auto c03 = c02(omp_default_mem_alloc);
+ c03(0);
+ /* invalid */
+ auto c10 = lambda_11<30>(); /* { dg-message "required from here" } */
+ auto c11 = c10(0); /* { dg-bogus "required from here" } */
+ auto c12 = c11(0); /* { dg-bogus "required from here" } */
+ auto c13 = c12(0); /* { dg-message "required from here" } */
+ int a = 0;
+ c13.operator()<int&>(a); /* { dg-message "required from here" } */
+ /* partially instantiated (invalid) */
+ auto c20 = lambda_12<30>(); /* { dg-message "required from here" } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-15.C b/gcc/testsuite/g++.dg/gomp/allocate-15.C
new file mode 100644
index 0000000..88b4c57
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-15.C
@@ -0,0 +1,148 @@
+/* { dg-do compile { target c++17 } } */
+#include "allocate-allocator-handle.h"
+
+/* Check application of align clause to static variables used in an OpenMP
+ allocate directive in functions that are implicitly constexpr.
+ Lambdas, lambdas in function templates.
+ Missing cases for generics lambdas, see below.
+ See allocate-16.C for cases in inline functions/function templates with
+ -fimplicit-constexpr.
+
+ This test case is valid in c++11 but the bug we are testing for does not
+ manifest until c++17, which makes lambdas implicit constexpr functions.
+
+ For now, we simply do not support these cases. */
+
+
+
+/* These cases had problems in c++17 and up because of dubious handling of
+ constexpr functions in cp/decl.cc:make_rtl_for_nonlocal_decl. In c++17 and
+ up lambdas are implicitly constexpr, and are always considered potentially
+ constexpr functions. I think this is dubious as the constexpr flag does get
+ set for a lambdas call operator, it also causes odd bugs where a lambda
+ can be used in a constant expression, even when it should not be able to.
+ But I digress, there is another test case for that and that oddity is not
+ the root of this problem.
+
+ Usually, make_rtl_for_nonlocal_decl defers compilation of local static
+ variables until later, except when a function is declared constexpr. From
+ looking at why this code was originally added, I feel like it was a heavy
+ handed fix for the original problem as it should have just made sure
+ __func__, __PRETTY_FUNC__, and other static variables of that kind processed
+ differently. I would imagine that the thought process behind it went
+ something like "well, static local variables aren't allowed in constexpr
+ functions anyway, so this isn't a big deal" and I can understand this
+ rationale. With that said, __func__ and it's counterparts do not seem to be
+ processed in make_rtl_for_nonlocal_decl anymore, so the added handling seems
+ to be irrelevant now at best.
+
+ Unfortunately, as stated in the first paragraph, because lambdas are
+ unconditionally considered constexpr in c++17 and up, local static variables
+ in lambdas are never deferred. As far as I can tell, this has the
+ consequence that they are always emitted regardless of whether they are used
+ or not. This really isn't that big a deal in the grand scheme of things,
+ and it may very well be that they get pruned during LTO so the impact of
+ this is probably slim to none.
+
+ However, as soon as OpenMP allocate directives come into play, the problems
+ are much more pronounced. In non templates, early finalization occurs
+ before we even parse the allocate directive, before the "omp allocate"
+ attribute is added to the var decl. Consequentially, the specified
+ alignment in the align clause of the directive does not get applied to the
+ variable. In function templates the consequences are much worse, parsing
+ the template decl adds an incomplete "omp allocate" attribute to the var
+ decl as a marker in an incomplete state. During instantiation of the
+ template, early finalization of the decl occurs, before we have substituted
+ into the allocate directive and finalized the attribute on the var decl.
+ In this case, varpool_node::finalize_decl finds the "omp allocate" attribute
+ and tries to read an alignment from it, which has not been stored yet.
+ At best we crash here, at worst it reads garbage as an OMP_CLAUSE is stored
+ there for diagnostic purposes.
+
+ This also occurs for inline functions with -fimplicit-constexpr, but as
+ noted above those tests are split out to allocate-16.C. */
+
+
+
+/* Making a regex for demangled identifiers is actually way harder than making
+ a regex for mangled ones, too many escapes are needed. */
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 256\\s*\.type\\s*_ZZZ6f0_256vENKUlvE_clEvE1a" } */
+int* f0_256()
+{
+ auto cl = [](){
+ static int a = 42;
+ #pragma omp allocate(a) align(256) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+ };
+ return cl();
+}
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 512\\s*\.type\\s*_ZZZ6f0_512vENKUlvE_clEvE1a" } */
+int* f0_512()
+{
+ auto cl = [](){
+ static int a = 42;
+ #pragma omp allocate(a) align(512) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+ };
+ return cl();
+}
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 1024\\s*\.type\\s*_ZZZ7f0_1024vENKUlvE_clEvE1a" } */
+int* f0_1024()
+{
+ auto cl = [](){
+ static int a = 42;
+ #pragma omp allocate(a) align(1024) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+ };
+ return cl();
+}
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 256\\s*\.type\\s*_ZZZ6f1_256IvEPivENKUlvE_clEvE1a" } */
+template<typename>
+int* f1_256()
+{
+ auto cl = [](){
+ static int a = 42;
+ #pragma omp allocate(a) align(256) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+ };
+ return cl();
+}
+template int* f1_256<void>();
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 512\\s*\.type\\s*_ZZZ6f1_512IvEPivENKUlvE_clEvE1a" } */
+template<typename>
+int* f1_512()
+{
+ auto cl = [](){
+ static int a = 42;
+ #pragma omp allocate(a) align(512) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+ };
+ return cl();
+}
+template int* f1_512<void>();
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 1024\\s*\.type\\s*_ZZZ7f1_1024IvEPivENKUlvE_clEvE1a" } */
+template<typename>
+int* f1_1024()
+{
+ auto cl = [](){
+ static int a = 42;
+ #pragma omp allocate(a) align(1024) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+ };
+ return cl();
+}
+template int* f1_1024<void>();
+
+/* Missing cases for generic lambda, and generic lambda in function template.
+ They shouldn't behave differently, but for completeness they should be
+ added, I'm just not going to spend any more time on this right now. */
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-16.C b/gcc/testsuite/g++.dg/gomp/allocate-16.C
new file mode 100644
index 0000000..d7f9bd4
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-16.C
@@ -0,0 +1,81 @@
+/* { dg-do compile { target c++14 } } */
+/* { dg-additional-options "-fimplicit-constexpr" } */
+#include "allocate-allocator-handle.h"
+
+/* Check application of align clause to static variables used in an OpenMP
+ allocate directive in functions that are implicitly constexpr.
+ Inline functions and function templates with -fimplicit-constexpr.
+
+ See allocate-15.C for more information, and cases using lambdas.
+
+ For now, we simply do not support these cases. */
+
+/* Making a regex for demangled identifiers is actually way harder than making
+ a regex for mangled ones, too many escapes are needed.
+
+ We need to ODR-use the regular functions to force them to be emitted. */
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 256\\s*\.type\\s*_ZZ6f0_256vE1a" } */
+inline int* f0_256()
+{
+ static int a = 42;
+ #pragma omp allocate(a) align(256) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+}
+constexpr int*(*odr_use_f0_256)() = &f0_256;
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 512\\s*\.type\\s*_ZZ6f0_512vE1a" } */
+inline int* f0_512()
+{
+ static int a = 42;
+ #pragma omp allocate(a) align(512) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+}
+constexpr int*(*odr_use_f0_512)() = &f0_512;
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 1024\\s*\.type\\s*_ZZ7f0_1024vE1a" } */
+inline int* f0_1024()
+{
+ static int a = 42;
+ #pragma omp allocate(a) align(1024) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+}
+constexpr int*(*odr_use_f0_1024)() = &f0_1024;
+
+
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 256\\s*\.type\\s*_ZZ6f1_256IvEPivE1a" } */
+template<typename>
+inline int* f1_256()
+{
+ static int a = 42;
+ #pragma omp allocate(a) align(256) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+}
+template int* f1_256<void>();
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 512\\s*\.type\\s*_ZZ6f1_512IvEPivE1a" } */
+template<typename>
+inline int* f1_512()
+{
+ static int a = 42;
+ #pragma omp allocate(a) align(512) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+}
+template int* f1_512<void>();
+
+/* scan-assembler test fails due to "sorry"; disabled by removing outer {}. */
+/* dg-final { scan-assembler "\.align 1024\\s*\.type\\s*_ZZ7f1_1024IvEPivE1a" } */
+template<typename>
+inline int* f1_1024()
+{
+ static int a = 42;
+ #pragma omp allocate(a) align(1024) allocator(omp_default_mem_alloc) /* { dg-message "static variable 'a' is not supported in an 'allocate' directive in an implicit constexpr function" } */
+ return &a;
+}
+template int* f1_1024<void>();
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-17.C b/gcc/testsuite/g++.dg/gomp/allocate-17.C
new file mode 100644
index 0000000..ca13845
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-17.C
@@ -0,0 +1,69 @@
+/* { dg-do compile { target c++17 } } */
+
+/* OpenMP allocate directive in constant expressions where execution does not
+ pass through the allocation of the variable in the directive.
+ Lambdas, both implicit and explicit constexpr,
+ in a function and in a function template.
+
+ These cases will be valid if/when OpenMP relaxes restrictions on directives
+ in constexpr functions. It might make sense to only allow this behavior in
+ c++23 though.
+
+ Constexpr lambdas are only permitted in c++17, it doesn't make sense to test
+ anything prior than that. */
+
+void do_constexpr_lambda()
+{
+ auto cl = [](bool b) constexpr {
+ if (b)
+ return 42;
+ int a = 42;
+ #pragma omp allocate(a) /* { dg-error "OpenMP directives may not appear in 'constexpr' functions" } */
+ return a;
+ };
+ constexpr int v = cl(true); /* { dg-error "'do_constexpr_lambda\\\(\\\)::<lambda\\\(bool\\\)>' called in a constant expression" "" { xfail *-*-* } } */
+}
+
+void do_lambda()
+{
+ auto cl = [](bool b){
+ if (b)
+ return 42;
+ int a = 42;
+ #pragma omp allocate(a) /* { dg-error "OpenMP directives may not appear in 'constexpr' functions" "" { xfail *-*-* } } */
+ return a;
+ };
+ constexpr int v = cl(true); /* { dg-error "'do_lambda\\\(\\\)::<lambda\\\(bool\\\)>' called in a constant expression" "" { xfail *-*-* } } */
+}
+
+template<typename>
+void templ_do_constexpr_lambda()
+{
+ auto cl = [](bool b) constexpr {
+ if (b)
+ return 42;
+ int a = 42;
+ #pragma omp allocate(a) /* { dg-error "OpenMP directives may not appear in 'constexpr' functions" } */
+ return a;
+ };
+ constexpr int v = cl(true); /* { dg-error "'templ_do_constexpr_lambda<void>\\\(\\\)::<lambda\\\(bool\\\)>' called in a constant expression" "" { xfail *-*-* } } */
+}
+template void templ_do_constexpr_lambda<void>();
+
+template<typename>
+void templ_do_lambda()
+{
+ auto cl = [](bool b){
+ if (b)
+ return 42;
+ int a = 42;
+ #pragma omp allocate(a) /* { dg-error "OpenMP directives may not appear in 'constexpr' functions" "" { xfail *-*-* } } */
+ return a;
+ };
+ constexpr int v = cl(true); /* { dg-error "'templ_do_lambda<void>\\\(\\\)::<lambda\\\(bool\\\)>' called in a constant expression" "" { xfail *-*-* } } */
+}
+template void templ_do_lambda<void>();
+
+/* Missing cases for generic lambda, and generic lambda in function template.
+ They shouldn't behave differently, but for completeness they should be
+ added, I'm just not going to spend any more time on this right now. */
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-18.C b/gcc/testsuite/g++.dg/gomp/allocate-18.C
new file mode 100644
index 0000000..3c8ca20
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-18.C
@@ -0,0 +1,60 @@
+/* { dg-do compile { target c++14 } } */
+/* { dg-additional-options "-fimplicit-constexpr" } */
+
+/* OpenMP allocate directive in constant expressions where execution does not
+ pass through the allocation of the variable in the directive.
+ Regular functions and function templates,
+ constexpr and inline with -fimplicit-constexpr.
+
+ These cases will be valid if/when OpenMP relaxes restrictions on directives
+ in constexpr functions. It might make sense to only allow this behavior in
+ c++23 though.
+
+ It doesn't make sense to test these cases in c++11 as constexpr functions
+ are far more limited, and are diagnosed completely differently.
+
+ Even though -fimplicit-constexpr is an extension, its behavior is similar to
+ lambdas in c++17, so I am including tests for it.
+ See allocate-17.C for test cases involving lambdas. */
+
+constexpr int f_constexpr(bool b)
+{
+ if (b)
+ return 42;
+ int a = 42;
+ #pragma omp allocate(a) /* { dg-error "OpenMP directives may not appear in 'constexpr' functions" } */
+ return a;
+}
+constexpr int g0 = f_constexpr(true); /* { dg-error "'constexpr int f_constexpr\\\(bool\\\)' called in a constant expression" "" { xfail *-*-* } } */
+
+template<typename>
+constexpr int f_constexpr_templ(bool b)
+{
+ if (b)
+ return 42;
+ int a = 42;
+ #pragma omp allocate(a) /* { dg-error "OpenMP directives may not appear in 'constexpr' functions" } */
+ return a;
+}
+constexpr int g1 = f_constexpr_templ<void>(true); /* { dg-error "'constexpr int f_constexpr_templ\\\(bool\\\) \\\[with <template-parameter-1-1> = void\\\]' called in a constant expression" "" { xfail *-*-* } } */
+
+inline int f_inline(bool b)
+{
+ if (b)
+ return 42;
+ int a = 42;
+ #pragma omp allocate(a) /* { dg-error "OpenMP directives may not appear in 'constexpr' functions" "" { xfail *-*-* } } */
+ return a;
+}
+constexpr int g2 = f_inline(true); /* { dg-error "'int f_inline\\\(bool\\\)' called in a constant expression" "" { xfail *-*-* } } */
+
+template<typename>
+inline int f_inline_templ(bool b)
+{
+ if (b)
+ return 42;
+ int a = 42;
+ #pragma omp allocate(a) /* { dg-error "OpenMP directives may not appear in 'constexpr' functions" "" { xfail *-*-* } } */
+ return a;
+}
+constexpr int g3 = f_inline_templ<void>(true); /* { dg-error "'int f_inline_templ\\\(bool\\\) \\\[with <template-parameter-1-1> = void\\\]' called in a constant expression" "" { xfail *-*-* } } */
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-19.C b/gcc/testsuite/g++.dg/gomp/allocate-19.C
new file mode 100644
index 0000000..de726ec
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-19.C
@@ -0,0 +1,27 @@
+/* This used to ICE due to NRVO being attempted on 's', NRVO can not be
+ done on a variable used in an allocate directive. */
+
+/* NRVO probably kicks in when sizeof(T) is greater than 16. */
+struct S {
+ char _v[17];
+};
+
+S f0()
+{
+ S s;
+ #pragma omp allocate(s)
+ return s;
+}
+
+/* Also test with a VERY LARGE type just in case the above isn't big enough
+ to trigger NRVO in all cases. */
+struct Big {
+ char _v[4096];
+};
+
+Big f1()
+{
+ Big b;
+ #pragma omp allocate(b)
+ return b;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-20.C b/gcc/testsuite/g++.dg/gomp/allocate-20.C
new file mode 100644
index 0000000..d9bc1de
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-20.C
@@ -0,0 +1,18 @@
+/* Just a silly ICE I came across by accident, easy fix, might be a problem
+ with lookup_name but I'm not certain.
+
+ For some reason, the floating 'a;' breaks lookup_name in tsubst_stmt during
+ substitution of the allocate directive, despite it being found no problem
+ during parsing of the allocate directive's var list.
+ I don't have time to investigate it further so I'm just going to fix it
+ by checking for NULL_TREE on the return of lookup_name. */
+
+template<typename>
+void f()
+{
+ a; /* { dg-error "'a' was not declared in this scope" } */
+ int a = 42;
+ #pragma omp allocate(a)
+}
+template void f<void>();
+
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-21.C b/gcc/testsuite/g++.dg/gomp/allocate-21.C
new file mode 100644
index 0000000..576d516
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-21.C
@@ -0,0 +1,26 @@
+/* { dg-do compile { target c++11 } } */
+
+/* Dependent function calls in a clause. */
+
+/* Not constexpr, invalid value. */
+template<typename T>
+int get_align(T) { return 42; }
+
+template<typename T>
+void f()
+{
+ int a = 42;
+ #pragma omp allocate(a) align(get_align(T{}))
+}
+
+namespace foo
+{
+ struct S {};
+
+ constexpr int get_align(S) { return 32; }
+}
+
+void instantiate()
+{
+ f<foo::S>();
+}
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-5.C b/gcc/testsuite/g++.dg/gomp/allocate-5.C
new file mode 100644
index 0000000..af28388
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-5.C
@@ -0,0 +1,321 @@
+#include "allocate-allocator-handle.h"
+
+/* All cases are valid and should work. */
+
+/* Note: the OpenMP allocate directive is not supposed to change the alignof
+ of expr a, it was decided to have too many edge cases. The static asserts
+ in these cases correctly test that it remains untouched. */
+
+struct S0 {
+ int _v;
+ S0(int v) : _v(v) {}
+ operator int() const { return 42; }
+};
+
+struct S1 {
+ int _v[32];
+ S1(int v) : _v() {
+ int *end = _v + sizeof(_v) / sizeof(*_v);
+ for (int *it = _v; it != end; ++it)
+ *it = v;
+ }
+ operator int() const { return 42; }
+};
+
+/**********************
+ * dependent variable *
+ **********************/
+
+template<typename T>
+T dep_local()
+{
+ T a = 42;
+ #pragma omp allocate(a)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(T));
+ #endif
+ return a;
+}
+
+template<typename T>
+T dep_local_align()
+{
+ T a = 42;
+ #pragma omp allocate(a) align(32)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(T));
+ #endif
+ return a;
+}
+
+template<typename T>
+T dep_local_alloc_0()
+{
+ T a = 42;
+ #pragma omp allocate(a) allocator(omp_default_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(T));
+ #endif
+ return a;
+}
+
+template<typename T>
+T dep_local_alloc_1()
+{
+ T a = 42;
+ #pragma omp allocate(a) allocator(omp_large_cap_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(T));
+ #endif
+ return a;
+}
+
+template<typename T>
+T dep_local_align_alloc_0()
+{
+ T a = 42;
+ #pragma omp allocate(a) align(32) allocator(omp_default_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(T));
+ #endif
+ return a;
+}
+
+template<typename T>
+T dep_local_align_alloc_1()
+{
+ T a = 42;
+ #pragma omp allocate(a) align(32) allocator(omp_large_cap_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(T));
+ #endif
+ return a;
+}
+
+#define INSTANTIATE_ALL_WITH_T(type) \
+ do { \
+ type v0 = dep_local<type>(); \
+ type v1 = dep_local_align<type>(); \
+ type v2 = dep_local_alloc_0<type>(); \
+ type v3 = dep_local_alloc_1<type>(); \
+ type v4 = dep_local_align_alloc_0<type>(); \
+ type v5 = dep_local_align_alloc_1<type>(); \
+ static_cast<void>(v0); \
+ static_cast<void>(v1); \
+ static_cast<void>(v2); \
+ static_cast<void>(v3); \
+ static_cast<void>(v4); \
+ static_cast<void>(v5); \
+ } while (false)
+
+void instantiate_dep_tests()
+{
+ INSTANTIATE_ALL_WITH_T(int);
+ INSTANTIATE_ALL_WITH_T(float);
+ INSTANTIATE_ALL_WITH_T(S0);
+ INSTANTIATE_ALL_WITH_T(S1);
+}
+
+#undef INSTANTIATE_ALL_WITH_T
+
+/**********************
+ * template parameter *
+ **********************/
+
+template<typename T>
+int template_parm(T)
+{
+ int a = 42;
+ #pragma omp allocate(a)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+template<typename T>
+int template_parm_align(T)
+{
+ int a = 42;
+ #pragma omp allocate(a) align(32)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+template<typename T>
+int template_parm_alloc_0(T)
+{
+ int a = 42;
+ #pragma omp allocate(a) allocator(omp_default_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+template<typename T>
+int template_parm_alloc_1(T)
+{
+ int a = 42;
+ #pragma omp allocate(a) allocator(omp_large_cap_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+template<typename T>
+int template_parm_align_alloc_0(T)
+{
+ int a = 42;
+ #pragma omp allocate(a) align(32) allocator(omp_default_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+template<typename T>
+int template_parm_align_alloc_1(T)
+{
+ int a = 42;
+ #pragma omp allocate(a) align(32) allocator(omp_large_cap_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+#define INSTANTIATE_ALL_WITH_T(type) \
+ do { \
+ type a = 42; \
+ int v0 = template_parm(a); \
+ int v1 = template_parm_align(a); \
+ int v2 = template_parm_alloc_0(a); \
+ int v3 = template_parm_alloc_1(a); \
+ int v4 = template_parm_align_alloc_0(a); \
+ int v5 = template_parm_align_alloc_1(a); \
+ static_cast<void>(v0); \
+ static_cast<void>(v1); \
+ static_cast<void>(v2); \
+ static_cast<void>(v3); \
+ static_cast<void>(v4); \
+ static_cast<void>(v5); \
+ } while (false)
+
+void instantiate_template_parm_tests()
+{
+ INSTANTIATE_ALL_WITH_T(int);
+ INSTANTIATE_ALL_WITH_T(float);
+ INSTANTIATE_ALL_WITH_T(S0);
+ INSTANTIATE_ALL_WITH_T(S1);
+}
+
+#undef INSTANTIATE_ALL_WITH_T
+
+/*************************************
+ * non-type template parameter align *
+ *************************************/
+
+template<int Align>
+int nttp_align()
+{
+ int a = 42;
+ #pragma omp allocate(a) align(Align)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+template<int Align>
+int nttp_align_alloc_0()
+{
+ int a = 42;
+ #pragma omp allocate(a) align(Align) allocator(omp_default_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+template<int Align>
+int nttp_align_alloc_1()
+{
+ int a = 42;
+ #pragma omp allocate(a) align(Align) allocator(omp_large_cap_mem_alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+#define INSTANTIATE_ALL_WITH_V(value) \
+ do { \
+ int v0 = nttp_align<value>(); \
+ int v1 = nttp_align_alloc_0<value>(); \
+ int v2 = nttp_align_alloc_1<value>(); \
+ } while (false)
+
+void instantiate_nttp_align_tests()
+{
+ INSTANTIATE_ALL_WITH_V(1);
+ INSTANTIATE_ALL_WITH_V(2);
+ INSTANTIATE_ALL_WITH_V(4);
+ INSTANTIATE_ALL_WITH_V(8);
+ INSTANTIATE_ALL_WITH_V(16);
+ INSTANTIATE_ALL_WITH_V(32);
+ INSTANTIATE_ALL_WITH_V(64);
+ INSTANTIATE_ALL_WITH_V(128);
+ INSTANTIATE_ALL_WITH_V(256);
+ INSTANTIATE_ALL_WITH_V(512);
+ INSTANTIATE_ALL_WITH_V(1024);
+ INSTANTIATE_ALL_WITH_V(2048);
+ INSTANTIATE_ALL_WITH_V(4096);
+}
+
+#undef INSTANTIATE_ALL_WITH_V
+
+
+template<omp_allocator_handle_t Alloc>
+int nttp_alloc()
+{
+ int a = 42;
+ #pragma omp allocate(a) allocator(Alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+template<omp_allocator_handle_t Alloc>
+int nttp_alloc_align()
+{
+ int a = 42;
+ #pragma omp allocate(a) align(32) allocator(Alloc)
+ #if __cplusplus >= 201103L
+ static_assert(alignof(a) == alignof(int));
+ #endif
+ return a;
+}
+
+#define INSTANTIATE_ALL_WITH_V(value) \
+ do { \
+ int v0 = nttp_alloc<value>(); \
+ int v1 = nttp_alloc_align<value>(); \
+ } while (false)
+
+void instantiate_nttp_alloc_tests()
+{
+ INSTANTIATE_ALL_WITH_V(omp_default_mem_alloc);
+ INSTANTIATE_ALL_WITH_V(omp_large_cap_mem_alloc);
+ INSTANTIATE_ALL_WITH_V(omp_const_mem_alloc);
+ INSTANTIATE_ALL_WITH_V(omp_high_bw_mem_alloc);
+}
+
+#undef INSTANTIATE_ALL_WITH_V
+
+/* We are probably missing quite a few cases here */
+/* missing cases for alloc param */
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-6.C b/gcc/testsuite/g++.dg/gomp/allocate-6.C
new file mode 100644
index 0000000..d33b7d5
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-6.C
@@ -0,0 +1,391 @@
+/* { dg-do compile { target c++11 } } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#include "allocate-allocator-handle.h"
+
+/* Valid uses of lambda captures in an allocator clause. */
+
+/* { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc" 200 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_GOMP_free" 200 "gimple" } } */
+
+template<typename, typename>
+struct is_same { static constexpr bool value = false; };
+
+template<typename T>
+struct is_same<T, T> { static constexpr bool value = true; };
+
+struct S0 {
+ int _v;
+ S0(int v) : _v(v) {}
+ operator int() const { return 42; }
+};
+
+struct S1 {
+ int _v[32];
+ S1(int v) : _v() {
+ int *end = _v + sizeof(_v) / sizeof(*_v);
+ for (int *it = _v; it != end; ++it)
+ *it = v;
+ }
+ operator int() const { return 42; }
+};
+
+/* Suppresses int/float cases from being optimized out, I'm not sure if this is
+ going to be sufficient for all cases though. */
+int (*prevent_optimization)() = nullptr;
+
+#define BLANK_ARGUMENT
+
+/* Capturing with an initiaizer was added in C++14 */
+#if __cplusplus >= 201402L
+
+#define CAPTURE_LITERAL_INIT_LAMBDA(type) \
+do { \
+ auto capture_literal_init = [alloc = omp_default_mem_alloc](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc)") \
+ return a; \
+ }; \
+ auto result = capture_literal_init(); \
+ static_assert(is_same<type, decltype(result)>::value); \
+} while (false)
+
+void test_capture_literal_init_nondep_lambdas()
+{
+ /* 4 cases */
+ CAPTURE_LITERAL_INIT_LAMBDA(int);
+ CAPTURE_LITERAL_INIT_LAMBDA(float);
+ CAPTURE_LITERAL_INIT_LAMBDA(S0);
+ CAPTURE_LITERAL_INIT_LAMBDA(S1);
+}
+
+/* 1 case per instantiation */
+template<typename T>
+void test_capture_literal_init_dependent_lambdas()
+{
+ CAPTURE_LITERAL_INIT_LAMBDA(T);
+}
+/* 4 cases */
+template void test_capture_literal_init_dependent_lambdas<int>();
+template void test_capture_literal_init_dependent_lambdas<float>();
+template void test_capture_literal_init_dependent_lambdas<S0>();
+template void test_capture_literal_init_dependent_lambdas<S1>();
+
+#undef CAPTURE_LITERAL_INIT_LAMBDA
+
+
+
+#define EXPLICIT_CAPTURE_WITH_INIT_LAMBDA(type, opt_tok, capture) \
+do { \
+ auto explicit_capture_with_init = [opt_tok alloc = capture](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc)") \
+ return a; \
+ }; \
+ auto result = explicit_capture_with_init(); \
+ static_assert(is_same<type, decltype(result)>::value); \
+} while (false)
+
+/* 4 cases per expansion */
+#define TEST_LAMBDAS_WITH_TYPE(type, opt_tok) \
+do { \
+ EXPLICIT_CAPTURE_WITH_INIT_LAMBDA(type, opt_tok, alloc); \
+ EXPLICIT_CAPTURE_WITH_INIT_LAMBDA(type, opt_tok, alloc_ref); \
+ EXPLICIT_CAPTURE_WITH_INIT_LAMBDA(type, opt_tok, alloc_param); \
+ EXPLICIT_CAPTURE_WITH_INIT_LAMBDA(type, opt_tok, alloc_ref_param); \
+} while (false)
+
+/* 4*4 = 16 cases */
+void test_capture_by_value_with_init_nondep_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ TEST_LAMBDAS_WITH_TYPE(int, BLANK_ARGUMENT);
+ TEST_LAMBDAS_WITH_TYPE(float, BLANK_ARGUMENT);
+ TEST_LAMBDAS_WITH_TYPE(S0, BLANK_ARGUMENT);
+ TEST_LAMBDAS_WITH_TYPE(S1, BLANK_ARGUMENT);
+}
+
+/* 4*4 = 16 cases */
+void test_capture_by_ref_with_init_nondep_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ TEST_LAMBDAS_WITH_TYPE(int, &);
+ TEST_LAMBDAS_WITH_TYPE(float, &);
+ TEST_LAMBDAS_WITH_TYPE(S0, &);
+ TEST_LAMBDAS_WITH_TYPE(S1, &);
+}
+
+/* 4 cases per instantiation */
+template<typename T>
+void test_capture_by_value_with_init_dependent_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ TEST_LAMBDAS_WITH_TYPE(T, BLANK_ARGUMENT);
+}
+/* 4*4 = 16 cases */
+template void test_capture_by_value_with_init_dependent_lambdas<int>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_capture_by_value_with_init_dependent_lambdas<float>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_capture_by_value_with_init_dependent_lambdas<S0>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_capture_by_value_with_init_dependent_lambdas<S1>(omp_allocator_handle_t, omp_allocator_handle_t&);
+
+/* 4 cases per instantiation */
+template<typename T>
+void test_capture_by_ref_with_init_dependent_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ TEST_LAMBDAS_WITH_TYPE(T, &);
+}
+/* 4*4 = 16 cases */
+template void test_capture_by_ref_with_init_dependent_lambdas<int>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_capture_by_ref_with_init_dependent_lambdas<float>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_capture_by_ref_with_init_dependent_lambdas<S0>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_capture_by_ref_with_init_dependent_lambdas<S1>(omp_allocator_handle_t, omp_allocator_handle_t&);
+
+#undef EXPLICIT_CAPTURE_WITH_INIT_LAMBDA
+#undef TEST_LAMBDAS_WITH_TYPE
+
+#else
+/* There are 4 + 4 + 16 + 16 + 16 + 16 cases in the above, we replicate that
+ many so our count in dg-final isn't wrong in C++11 mode.
+ The counter isn't required but it doesn't hurt and might make it easier
+ to inspect the asm if we need to, that's the goal anyway. */
+
+#define DUMMY_ALLOC(counter) \
+do { \
+ auto dummy_ ##counter = [alloc](){ \
+ int a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc)") \
+ return a; \
+ }; \
+ auto result = dummy_ ##counter(); \
+} while (false)
+
+#define DUMMY_X4(counter) \
+do { \
+ DUMMY_ALLOC(counter ##A); \
+ DUMMY_ALLOC(counter ##B); \
+ DUMMY_ALLOC(counter ##C); \
+ DUMMY_ALLOC(counter ##D); \
+} while (false)
+
+void dummy_cases(omp_allocator_handle_t alloc)
+{
+ /* 4x1 for test_capture_literal_init_nondep_lambdas */
+ DUMMY_X4(0);
+ /* 4x1 for test_capture_literal_init_dependent_lambdas */
+ DUMMY_X4(1);
+ /* 4x4 for test_capture_by_value_with_init_nondep_lambdas */
+ DUMMY_X4(2);
+ DUMMY_X4(3);
+ DUMMY_X4(4);
+ DUMMY_X4(5);
+ /* 4x4 for test_capture_by_value_with_init_dependent_lambdas */
+ DUMMY_X4(6);
+ DUMMY_X4(7);
+ DUMMY_X4(8);
+ DUMMY_X4(9);
+ /* 4x4 for test_capture_by_ref_with_init_dependent_lambdas */
+ DUMMY_X4(9);
+ DUMMY_X4(10);
+ DUMMY_X4(11);
+ DUMMY_X4(12);
+ /* 4x4 for test_capture_by_ref_with_init_nondep_lambdas */
+ DUMMY_X4(13);
+ DUMMY_X4(14);
+ DUMMY_X4(15);
+ DUMMY_X4(16);
+}
+
+#undef DUMMY_ALLOC
+#undef DUMMY_X4
+
+#endif
+
+
+#define EXPLICIT_CAPTURE_LAMBDAS(type, opt_tok) \
+do { \
+ auto explicit_capture0 = [opt_tok alloc](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc)") \
+ return a; \
+ }; \
+ auto result0 = explicit_capture0(); \
+ static_assert(is_same<type, decltype(result0)>::value); \
+ \
+ auto explicit_capture1 = [opt_tok alloc_ref](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc_ref)") \
+ return a; \
+ }; \
+ auto result1 = explicit_capture1(); \
+ static_assert(is_same<type, decltype(result1)>::value); \
+ \
+ auto explicit_capture2 = [opt_tok alloc_param](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc_param)") \
+ return a; \
+ }; \
+ auto result2 = explicit_capture2(); \
+ static_assert(is_same<type, decltype(result2)>::value); \
+ \
+ auto explicit_capture3 = [opt_tok alloc_ref_param](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc_ref_param)") \
+ return a; \
+ }; \
+ auto result3 = explicit_capture3(); \
+ static_assert(is_same<type, decltype(result3)>::value); \
+} while (false)
+
+void test_explicit_capture_by_value_nondep_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ EXPLICIT_CAPTURE_LAMBDAS(int, BLANK_ARGUMENT);
+ EXPLICIT_CAPTURE_LAMBDAS(float, BLANK_ARGUMENT);
+ EXPLICIT_CAPTURE_LAMBDAS(S0, BLANK_ARGUMENT);
+ EXPLICIT_CAPTURE_LAMBDAS(S1, BLANK_ARGUMENT);
+}
+
+void test_explicit_capture_by_ref_nondep_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ EXPLICIT_CAPTURE_LAMBDAS(int, &);
+ EXPLICIT_CAPTURE_LAMBDAS(float, &);
+ EXPLICIT_CAPTURE_LAMBDAS(S0, &);
+ EXPLICIT_CAPTURE_LAMBDAS(S1, &);
+}
+
+template<typename T>
+void test_explicit_capture_by_value_dependent_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ EXPLICIT_CAPTURE_LAMBDAS(T, BLANK_ARGUMENT);
+}
+template void test_explicit_capture_by_value_dependent_lambdas<int>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_explicit_capture_by_value_dependent_lambdas<float>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_explicit_capture_by_value_dependent_lambdas<S0>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_explicit_capture_by_value_dependent_lambdas<S1>(omp_allocator_handle_t, omp_allocator_handle_t&);
+
+
+template<typename T>
+void test_explicit_capture_by_ref_dependent_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ EXPLICIT_CAPTURE_LAMBDAS(T, &);
+}
+template void test_explicit_capture_by_ref_dependent_lambdas<int>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_explicit_capture_by_ref_dependent_lambdas<float>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_explicit_capture_by_ref_dependent_lambdas<S0>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_explicit_capture_by_ref_dependent_lambdas<S1>(omp_allocator_handle_t, omp_allocator_handle_t&);
+
+#undef EXPLICIT_CAPTURE_LAMBDA
+#undef TEST_LAMBDAS_WITH_TYPE
+
+
+#define DEFAULT_CAPTURE_LAMBDAS(type, capture) \
+do { \
+ auto default_capture0 = [capture](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc)") \
+ return a; \
+ }; \
+ auto result0 = default_capture0(); \
+ static_assert(is_same<type, decltype(result0)>::value); \
+ \
+ auto default_capture1 = [capture](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc_ref)") \
+ return a; \
+ }; \
+ auto result1 = default_capture1(); \
+ static_assert(is_same<type, decltype(result1)>::value); \
+ \
+ auto default_capture2 = [capture](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc_param)") \
+ return a; \
+ }; \
+ auto result2 = default_capture2(); \
+ static_assert(is_same<type, decltype(result2)>::value); \
+ \
+ auto default_capture3 = [capture](){ \
+ type a = prevent_optimization(); \
+ _Pragma("omp allocate(a) allocator(alloc_ref_param)") \
+ return a; \
+ }; \
+ auto result3 = default_capture3(); \
+ static_assert(is_same<type, decltype(result3)>::value); \
+} while (false)
+
+
+
+void test_default_capture_by_value_nondep_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ DEFAULT_CAPTURE_LAMBDAS(int, =);
+ DEFAULT_CAPTURE_LAMBDAS(float, =);
+ DEFAULT_CAPTURE_LAMBDAS(S0, =);
+ DEFAULT_CAPTURE_LAMBDAS(S1, =);
+}
+
+void test_default_capture_by_ref_nondep_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ DEFAULT_CAPTURE_LAMBDAS(int, &);
+ DEFAULT_CAPTURE_LAMBDAS(float, &);
+ DEFAULT_CAPTURE_LAMBDAS(S0, &);
+ DEFAULT_CAPTURE_LAMBDAS(S1, &);
+}
+
+template<typename T>
+void test_default_capture_by_value_dependent_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ DEFAULT_CAPTURE_LAMBDAS(T, =);
+}
+template void test_default_capture_by_value_dependent_lambdas<int>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_default_capture_by_value_dependent_lambdas<float>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_default_capture_by_value_dependent_lambdas<S0>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_default_capture_by_value_dependent_lambdas<S1>(omp_allocator_handle_t, omp_allocator_handle_t&);
+
+template<typename T>
+void test_default_capture_by_ref_dependent_lambdas(omp_allocator_handle_t alloc_param,
+ omp_allocator_handle_t& alloc_ref_param)
+{
+ omp_allocator_handle_t alloc = omp_default_mem_alloc;
+ omp_allocator_handle_t& alloc_ref = alloc;
+ DEFAULT_CAPTURE_LAMBDAS(T, &);
+}
+template void test_default_capture_by_ref_dependent_lambdas<int>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_default_capture_by_ref_dependent_lambdas<float>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_default_capture_by_ref_dependent_lambdas<S0>(omp_allocator_handle_t, omp_allocator_handle_t&);
+template void test_default_capture_by_ref_dependent_lambdas<S1>(omp_allocator_handle_t, omp_allocator_handle_t&);
+
+#undef DEFAULT_CAPTURE_LAMBDA
+#undef TEST_LAMBDAS_WITH_TYPE
+
+/* Potential missing cases: captures that are type dependent, mutable lambdas. */
+
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-7.C b/gcc/testsuite/g++.dg/gomp/allocate-7.C
new file mode 100644
index 0000000..012b52b
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-7.C
@@ -0,0 +1,99 @@
+/* { dg-do compile { target c++20 } } */
+
+#include "allocate-allocator-handle.h"
+
+/* C++20 tests */
+
+struct S0 {
+ int _v;
+ S0(int v) : _v(v) {}
+ operator int() const { return 42; }
+};
+
+struct S1 {
+ int _v[32];
+ S1(int v) : _v{v, v, v, v, v, v, v, v,
+ v, v, v, v, v, v, v, v,
+ v, v, v, v, v, v, v, v,
+ v, v, v, v, v, v, v, v} {}
+ operator int() const { return 42; }
+};
+
+/*****************************
+ * template parameter (auto) *
+ *****************************/
+
+int auto_parm(auto)
+{
+ int a = 42;
+ #pragma omp allocate(a)
+ static_assert(alignof(a) == alignof(int));
+ return a;
+}
+
+int auto_parm_align(auto)
+{
+ int a = 42;
+ #pragma omp allocate(a) align(32)
+ static_assert(alignof(a) == alignof(int));
+ return a;
+}
+
+int auto_parm_alloc_0(auto)
+{
+ int a = 42;
+ #pragma omp allocate(a) allocator(omp_default_mem_alloc)
+ static_assert(alignof(a) == alignof(int));
+ return a;
+}
+
+int auto_parm_alloc_1(auto)
+{
+ int a = 42;
+ #pragma omp allocate(a) allocator(omp_large_cap_mem_alloc)
+ static_assert(alignof(a) == alignof(int));
+ return a;
+}
+
+int auto_parm_align_alloc_0(auto)
+{
+ int a = 42;
+ #pragma omp allocate(a) align(32) allocator(omp_default_mem_alloc)
+ static_assert(alignof(a) == alignof(int));
+ return a;
+}
+
+int auto_parm_align_alloc_1(auto)
+{
+ int a = 42;
+ #pragma omp allocate(a) align(32) allocator(omp_large_cap_mem_alloc)
+ static_assert(alignof(a) == alignof(int));
+ return a;
+}
+
+#define INSTANTIATE_ALL_WITH_T(type) \
+ do { \
+ type a = 42; \
+ int v0 = auto_parm(a); \
+ int v1 = auto_parm_align(a); \
+ int v2 = auto_parm_alloc_0(a); \
+ int v3 = auto_parm_alloc_1(a); \
+ int v4 = auto_parm_align_alloc_0(a); \
+ int v5 = auto_parm_align_alloc_1(a); \
+ static_cast<void>(v0); \
+ static_cast<void>(v1); \
+ static_cast<void>(v2); \
+ static_cast<void>(v3); \
+ static_cast<void>(v4); \
+ static_cast<void>(v5); \
+ } while (false)
+
+void instantiate_auto_parm_tests()
+{
+ INSTANTIATE_ALL_WITH_T(int);
+ INSTANTIATE_ALL_WITH_T(float);
+ INSTANTIATE_ALL_WITH_T(S0);
+ INSTANTIATE_ALL_WITH_T(S1);
+}
+
+#undef INSTANTIATE_ALL_WITH_T
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-8.C b/gcc/testsuite/g++.dg/gomp/allocate-8.C
new file mode 100644
index 0000000..b5d06b0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-8.C
@@ -0,0 +1,45 @@
+/* { dg-do compile { target c++11 } } */
+#include "allocate-allocator-handle.h"
+
+/* I had wanted to simply include /include/gomp-constants.h to ensure
+ synchronization, but including files from that directory does not seem
+ to be supported. */
+#define GOMP_OMP_PREDEF_ALLOC_MAX 8
+#define GOMP_OMPX_PREDEF_ALLOC_MIN 200
+#define GOMP_OMPX_PREDEF_ALLOC_MAX 200
+
+/* Test that all predefined allocators are correctly treated as predefined. */
+
+template<omp_allocator_handle_t Alloc>
+void test_predefined_alloc()
+{
+ static int a = 42;
+ #pragma omp allocate(a) allocator(Alloc)
+}
+
+/* Because this is written to work as far back as c++11 it is a little bit
+ crusty. It is metaprogrammed to automatically test the full ranges
+ specified above. */
+
+template<omp_allocator_handle_t...>
+struct sequence {};
+
+template<__UINTPTR_TYPE__ Offset, __UINTPTR_TYPE__... Is>
+using modified = sequence<static_cast<omp_allocator_handle_t>(Is + Offset)...>;
+
+template<__UINTPTR_TYPE__ Start, __UINTPTR_TYPE__ End>
+using make_offset_sequence = modified<Start, __integer_pack(End - Start)...>;
+
+template<omp_allocator_handle_t... Allocs>
+void unpack(sequence<Allocs...>)
+{
+ int helper[] = {(test_predefined_alloc<Allocs>(), 0)...};
+}
+
+void do_tests()
+{
+ /* make_sequence creates a sequence [Start, End) while the *_MAX values are
+ inclusive, add 1 to the End arg to create an exclusive range. */
+ unpack(make_offset_sequence<1, GOMP_OMP_PREDEF_ALLOC_MAX + 1>{});
+ unpack(make_offset_sequence<GOMP_OMPX_PREDEF_ALLOC_MIN, GOMP_OMPX_PREDEF_ALLOC_MAX + 1>{});
+}
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-9.C b/gcc/testsuite/g++.dg/gomp/allocate-9.C
new file mode 100644
index 0000000..a2b7fb0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-9.C
@@ -0,0 +1,45 @@
+#include "allocate-allocator-handle.h"
+
+/* If the following fails because of added predefined allocators, please update
+ - include/gomp-constants.h's GOMP_OMP_PREDEF_ALLOC_MAX or GOMP_OMPX_PREDEF_ALLOC_MAX
+ - libgomp/env.c's parse_allocator
+ - libgomp/libgomp.texi (document the new values - multiple locations)
+ - gcc/testsuite/c-c++-common/gomp/allocate-9.c (fix the hardcoded values)
+ - gcc/testsuite/g++.dg/gomp/allocate-8.C (update GOMP_OMP_PREDEF_ALLOC_MAX or GOMP_OMPX_PREDEF_ALLOC_MAX)
+ + ensure that the memory-spaces are also up to date. */
+
+/* I had wanted to simply include /include/gomp-constants.h to ensure
+ synchronization, while also having hardcoded values as a canary, but
+ including files from that directory does not seem to be supported. */
+#define GOMP_OMP_PREDEF_ALLOC_MAX 8
+#define GOMP_OMPX_PREDEF_ALLOC_MIN 200
+#define GOMP_OMPX_PREDEF_ALLOC_MAX 200
+
+int g0 = 42; /* { dg-note "'g0' declared here" }*/
+#pragma omp allocate(g0) allocator(omp_null_allocator)
+/* { dg-error "'allocator' clause requires a predefined allocator as 'g0' is static" "" { target *-*-* } .-1 } */
+int g1 = 42; /* { dg-note "'g1' declared here" }*/
+#pragma omp allocate(g1) allocator(static_cast<omp_allocator_handle_t>(GOMP_OMP_PREDEF_ALLOC_MAX + 1))
+/* { dg-error "'allocator' clause requires a predefined allocator as 'g1' is static" "If this test fails because of added predefined allocators please ensure everything is updated accordingly, see this test case for more information" { target *-*-* } .-1 } */
+int g2 = 42; /* { dg-note "'g2' declared here" }*/
+#pragma omp allocate(g2) allocator(static_cast<omp_allocator_handle_t>(GOMP_OMPX_PREDEF_ALLOC_MIN - 1))
+/* { dg-error "'allocator' clause requires a predefined allocator as 'g2' is static" "" { target *-*-* } .-1 } */
+int g3 = 42; /* { dg-note "'g3' declared here" }*/
+#pragma omp allocate(g3) allocator(static_cast<omp_allocator_handle_t>(GOMP_OMPX_PREDEF_ALLOC_MAX + 1))
+/* { dg-error "'allocator' clause requires a predefined allocator as 'g3' is static" "If this test fails because of added predefined allocators please ensure everything is updated accordingly, see this test case for more information" { target *-*-* } .-1 } */
+
+void test_predefined_allocs()
+{
+ static int a0 = 42; /* { dg-note "'a0' declared here" }*/
+ #pragma omp allocate(a0) allocator(omp_null_allocator)
+ /* { dg-error "'allocator' clause requires a predefined allocator as 'a0' is static" "" { target *-*-* } .-1 } */
+ static int a1 = 42; /* { dg-note "'a1' declared here" }*/
+ #pragma omp allocate(a1) allocator(static_cast<omp_allocator_handle_t>(GOMP_OMP_PREDEF_ALLOC_MAX + 1))
+ /* { dg-error "'allocator' clause requires a predefined allocator as 'a1' is static" "If this test fails because of added predefined allocators please ensure everything is updated accordingly, see this test case for more information" { target *-*-* } .-1 } */
+ static int a2 = 42; /* { dg-note "'a2' declared here" }*/
+ #pragma omp allocate(a2) allocator(static_cast<omp_allocator_handle_t>(GOMP_OMPX_PREDEF_ALLOC_MIN - 1))
+ /* { dg-error "'allocator' clause requires a predefined allocator as 'a2' is static" "" { target *-*-* } .-1 } */
+ static int a3 = 42; /* { dg-note "'a3' declared here" }*/
+ #pragma omp allocate(a3) allocator(static_cast<omp_allocator_handle_t>(GOMP_OMPX_PREDEF_ALLOC_MAX + 1))
+ /* { dg-error "'allocator' clause requires a predefined allocator as 'a3' is static" "If this test fails because of added predefined allocators please ensure everything is updated accordingly, see this test case for more information" { target *-*-* } .-1 } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/allocate-allocator-handle.h b/gcc/testsuite/g++.dg/gomp/allocate-allocator-handle.h
new file mode 100644
index 0000000..3576867
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/allocate-allocator-handle.h
@@ -0,0 +1,16 @@
+typedef enum omp_allocator_handle_t
+#if __cplusplus >= 201103L
+: __UINTPTR_TYPE__
+#endif
+{
+ omp_null_allocator = 0,
+ omp_default_mem_alloc = 1,
+ omp_large_cap_mem_alloc = 2,
+ omp_const_mem_alloc = 3,
+ omp_high_bw_mem_alloc = 4,
+ omp_low_lat_mem_alloc = 5,
+ omp_cgroup_mem_alloc = 6,
+ omp_pteam_mem_alloc = 7,
+ omp_thread_mem_alloc = 8,
+ __omp_allocator_handle_t_max__ = __UINTPTR_MAX__
+} omp_allocator_handle_t;
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-1.C b/gcc/testsuite/g++.dg/gomp/append-args-1.C
index 70952e0..b0ff66a 100644
--- a/gcc/testsuite/g++.dg/gomp/append-args-1.C
+++ b/gcc/testsuite/g++.dg/gomp/append-args-1.C
@@ -51,9 +51,8 @@ void repl2(T, T2, T3, T3);
append_args(interop(target, targetsync, prefer_type(1)), \
interop(target, prefer_type({fr(3), attr("ompx_nop")},{fr(2)},{attr("ompx_all")})))
template<typename T, typename T2>
-void base2(T x, T2 y);
-
-
+void base2(T x, T2 y); /* { dg-error "parameter specified in an 'adjust_args' clause with the 'need_device_ptr' modifier must be of pointer type" } */
+/* { dg-note "parameter specified here" "" { target *-*-* } .-5 } */
template<typename T,typename T3>
void tooFewRepl(T, T, T3);
#pragma omp declare variant(tooFewRepl) match(construct={dispatch}) \
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-10.C b/gcc/testsuite/g++.dg/gomp/append-args-10.C
new file mode 100644
index 0000000..9d07628
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/append-args-10.C
@@ -0,0 +1,36 @@
+/* PR c++/119601 */
+/* { dg-do compile { target c++11 } } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Parameter pack cases, check that interop arguments are passed correctly. */
+
+#include "append-args-omp-interop-t.h"
+
+template<typename... Args>
+void v0(int*, Args...) {}
+
+#pragma omp declare variant(v0) match(construct={dispatch}) \
+ append_args(interop(target))
+template<typename... Args>
+void b0(int *, Args...) {}
+
+
+template<typename... Args>
+void v1(int*, Args...) {}
+
+#pragma omp declare variant(v1) match(construct={dispatch}) \
+ append_args(interop(target), \
+ interop(targetsync))
+template<typename... Args>
+void b1(int *, Args...) {}
+
+
+void f1(int *p0, int *p1)
+{
+ #pragma omp dispatch
+ b0(p0);
+/* { dg-final { scan-tree-dump "v0<\[^>\]*> \\(p0, interop\.\[0-9\]\\);" "gimple" } } */
+ #pragma omp dispatch
+ b1(p1, 1, 2, 3);
+/* { dg-final { scan-tree-dump "v1<int, int, int, omp_interop_t, omp_interop_t> \\(p1, 1, 2, 3, interop\.\[0-9\], interop\.\[0-9\]\\);" "gimple" } } */
+} \ No newline at end of file
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-11.C b/gcc/testsuite/g++.dg/gomp/append-args-11.C
new file mode 100644
index 0000000..fbec59e
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/append-args-11.C
@@ -0,0 +1,96 @@
+/* PR c++/119602 */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#include "append-args-omp-interop-t.h"
+
+/* Check multiple instantiations with a dependent prefer_type value
+ have the correct value. */
+
+typedef enum omp_interop_fr_t
+{
+ omp_ifr_cuda = 1,
+ omp_ifr_cuda_driver = 2,
+ omp_ifr_opencl = 3,
+ omp_ifr_sycl = 4,
+ omp_ifr_hip = 5,
+ omp_ifr_level_zero = 6,
+ omp_ifr_hsa = 7,
+ omp_ifr_last = omp_ifr_hsa
+} omp_interop_fr_t;
+
+template<omp_interop_fr_t V>
+struct FR {};
+
+template<omp_interop_fr_t V, typename T2>
+void v_dependent_fr(FR<V>, T2) { }
+
+#pragma omp declare variant(v_dependent_fr) match(construct={dispatch}) \
+ append_args(interop(target, \
+ prefer_type(V)))
+template<omp_interop_fr_t V>
+void b_dependent_fr(FR<V>) { }
+
+
+template<typename T, typename T2>
+void v_cuda(T, T2) { }
+
+#pragma omp declare variant(v_cuda) match(construct={dispatch}) \
+ append_args(interop(target, \
+ prefer_type(omp_ifr_cuda_driver)))
+template<typename T>
+void b_cuda(T) { }
+
+
+template<typename T, typename T2>
+void v_hip(T, T2) { }
+
+#pragma omp declare variant(v_hip) match(construct={dispatch}) \
+ append_args(interop(target, \
+ prefer_type(omp_ifr_hip)))
+template<typename T>
+void b_hip(T) { }
+
+
+template<typename T, typename T2>
+void v_hsa(T, T2) { }
+
+#pragma omp declare variant(v_hsa) match(construct={dispatch}) \
+ append_args(interop(target, \
+ prefer_type(omp_ifr_hsa)))
+template<typename T>
+void b_hsa(T) { }
+
+void f ()
+{
+ #pragma omp dispatch
+ b_dependent_fr (FR<omp_ifr_cuda_driver>());
+
+ #pragma omp dispatch
+ b_dependent_fr (FR<omp_ifr_hip>());
+
+ #pragma omp dispatch
+ b_dependent_fr (FR<omp_ifr_level_zero>());
+
+ #pragma omp dispatch
+ b_dependent_fr (FR<omp_ifr_hsa>());
+
+ #pragma omp dispatch
+ b_cuda (0);
+
+ #pragma omp dispatch
+ b_hip (0);
+
+ #pragma omp dispatch
+ b_hsa (0);
+}
+
+/* "\\\[" and "\\\]" matches a literal '[' and ']',
+ "\\\\" matches a literal '\' in case anyone is wondering. */
+/* omp_ifr_cuda_driver */
+/* { dg-final { scan-tree-dump-times "pref_type\.\[0-9\]+\\\[0\\\] = \"\\\\x80\\\\x02\\\\x80\\\\x00\";" 2 "gimple" } } */
+/* omp_ifr_hip */
+/* { dg-final { scan-tree-dump-times "pref_type\.\[0-9\]+\\\[0\\\] = \"\\\\x80\\\\x05\\\\x80\\\\x00\";" 2 "gimple" } } */
+/* omp_ifr_level_zero */
+/* { dg-final { scan-tree-dump-times "pref_type\.\[0-9\]+\\\[0\\\] = \"\\\\x80\\\\x06\\\\x80\\\\x00\";" 1 "gimple" } } */
+/* omp_ifr_hsa */
+/* { dg-final { scan-tree-dump-times "pref_type\.\[0-9\]+\\\[0\\\] = \"\\\\x80\\\\x07\\\\x80\\\\x00\";" 2 "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-9.C b/gcc/testsuite/g++.dg/gomp/append-args-9.C
new file mode 100644
index 0000000..95c8c3f
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/append-args-9.C
@@ -0,0 +1,21 @@
+/* PR c++/119775 */
+
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#include "append-args-omp-interop-t.h"
+
+struct S {
+ void v(int *, omp_interop_t) {}
+
+ #pragma omp declare variant(v) match(construct={dispatch}) \
+ append_args(interop(target))
+ void b(int *) {}
+};
+
+void f(int *p)
+{
+ S s = S();
+ #pragma omp dispatch
+ s.b(p);
+/* { dg-final { scan-tree-dump "S::v \\(&s, p,\ interop\.\[0-9\]+\\);" "gimple" } } */
+}
diff --git a/gcc/testsuite/g++.dg/gomp/append-args-omp-interop-t.h b/gcc/testsuite/g++.dg/gomp/append-args-omp-interop-t.h
new file mode 100644
index 0000000..0a3eb91
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/append-args-omp-interop-t.h
@@ -0,0 +1,11 @@
+#if __cplusplus >= 201103L
+# define __GOMP_UINTPTR_T_ENUM : __UINTPTR_TYPE__
+#else
+# define __GOMP_UINTPTR_T_ENUM
+#endif
+
+typedef enum omp_interop_t __GOMP_UINTPTR_T_ENUM
+{
+ omp_interop_none = 0,
+ __omp_interop_t_max__ = __UINTPTR_MAX__
+} omp_interop_t;
diff --git a/gcc/testsuite/g++.dg/gomp/array-shaping-1.C b/gcc/testsuite/g++.dg/gomp/array-shaping-1.C
new file mode 100644
index 0000000..8627aa7
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/array-shaping-1.C
@@ -0,0 +1,22 @@
+// { dg-do compile }
+// { dg-additional-options "-fdump-tree-original" }
+
+template<typename T, typename E, int A, int B, int C, int D>
+void foo ()
+{
+ T *ptr;
+ E a = A, b = B, c = C, d = D;
+
+ /* Dependent types for indices. */
+#pragma omp target update from(([a][b+1][c][d]) ptr[1:a-2][1:b][1:c-2][1:d-2])
+// { dg-final { scan-tree-dump {map\(from_grid:VIEW_CONVERT_EXPR.*\(\*ptr\) \[len: 1\]\) map\(grid_dim:1 \[len: [^\]]+\]\) map\(grid_dim:1 \[len: [^\]]+\]\) map\(grid_dim:1 \[len: [^\]]+\]\) map\(grid_dim:1 \[len: [^]]+\]\)} "original" } }
+}
+
+int main()
+{
+ char *ptr;
+
+ foo<char, short, 3, 4, 5, 6> ();
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/array-shaping-2.C b/gcc/testsuite/g++.dg/gomp/array-shaping-2.C
new file mode 100644
index 0000000..861d662
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/array-shaping-2.C
@@ -0,0 +1,134 @@
+// { dg-do compile }
+// { dg-additional-options "-fdump-tree-original" }
+
+template<typename T>
+struct St
+{
+ T ***ppptr;
+ T ***&rppptr;
+
+ St(T ***p, T ***&rp) : ppptr(p), rppptr(rp) { }
+};
+
+template<typename A, typename B>
+void foo()
+{
+ A *ptr;
+ A **pptr = &ptr;
+ A ***ppptr = &pptr;
+ A ***&rppptr = ppptr;
+
+#pragma omp target update to(([10]) (**ppptr)[3:4:2])
+// { dg-final { scan-tree-dump {map\(to_grid:VIEW_CONVERT_EXPR<int\[10\]>\(\*\*\*ppptr\) \[len: [0-9]+\]\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update to(([10]) (**rppptr)[3:4:2])
+// { dg-final { scan-tree-dump {map\(to_grid:VIEW_CONVERT_EXPR<int\[10\]>\(\*\*\*\*rppptr\) \[len: [0-9]+\]\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update to((**ppptr)[3:4:2])
+// { dg-final { scan-tree-dump {map\(to_grid:\*\*ppptr \[len: [0-9]+\]\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update to((**rppptr)[3:4:2])
+// { dg-final { scan-tree-dump {map\(to_grid:\*\*\*rppptr \[len: [0-9]+\]\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+ B *ptr2;
+ B **pptr2 = &ptr2;
+ B ***ppptr2 = &pptr2;
+ St<B> *s = new St<B>(ppptr2, ppptr2);
+ St<B> **ps = &s;
+ St<B> **&rps = ps;
+
+#pragma omp target update from(([10]) (**(*ps)->ppptr)[3:4:2])
+// { dg-final { scan-tree-dump {map\(from_grid:VIEW_CONVERT_EXPR<long int\[10\]>\(\*\*\*\(\*ps\)->ppptr\) \[len: [0-9]+\]\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update from(([10]) (**(*rps)->rppptr)[3:4:2])
+// { dg-final { scan-tree-dump {map\(from_grid:VIEW_CONVERT_EXPR<long int\[10\]>\(\*\*\*\*\(\*\*rps\)->rppptr\) \[len: [0-9]+\]\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update from((**(*ps)->ppptr)[3:4:2])
+// { dg-final { scan-tree-dump {map\(from_grid:\*\*\(\*ps\)->ppptr \[len: [0-9]+\]\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update from((**(*rps)->rppptr)[3:4:2])
+// { dg-final { scan-tree-dump {map\(from_grid:\*\*\*\(\*\*rps\)->rppptr \[len: [0-9]+\]\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+ B arr[10][10];
+ B (*parr)[10][10] = &arr;
+ B (**pparr2)[10][10] = &parr;
+ B (**&rpparr2)[10][10] = pparr2;
+
+#pragma omp target update from(**pparr2)
+// { dg-final { scan-tree-dump {from\(\*NON_LVALUE_EXPR <\*pparr2> \[len: [0-9]+\]\)} "original" } }
+
+#pragma omp target update to((**pparr2)[1:5:2][3:4:2])
+// { dg-final { scan-tree-dump {map\(to_grid:\*\*pparr2 \[len: [0-9]+\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update from((**rpparr2)[1:5:2][3:4:2])
+// { dg-final { scan-tree-dump {map\(from_grid:\*\*\*rpparr2 \[len: [0-9]+\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\) map\(grid_dim:3 \[len: 4\]\) map\(grid_stride:2\)} "original" } }
+
+ delete s;
+}
+
+struct S
+{
+ short ***ppptr;
+ short ***&rppptr;
+
+ S(short ***p, short ***&rp) : ppptr(p), rppptr(rp) { }
+};
+
+int main()
+{
+ char *ptr;
+ char **pptr = &ptr;
+ char ***ppptr = &pptr;
+ char ***&rppptr = ppptr;
+
+#pragma omp target update to(([10]) (**ppptr)[1:5:2])
+// { dg-final { scan-tree-dump {map\(to_grid:VIEW_CONVERT_EXPR<char\[10\]>\(\*\*\*ppptr\) \[len: 1\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update to(([10]) (**rppptr)[1:5:2])
+// { dg-final { scan-tree-dump {map\(to_grid:VIEW_CONVERT_EXPR<char\[10\]>\(\*\*\*\*rppptr\) \[len: 1\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update to((**ppptr)[1:5:2])
+// { dg-final { scan-tree-dump {map\(to_grid:\*\*ppptr \[len: 1\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update to((**rppptr)[1:5:2])
+// { dg-final { scan-tree-dump {map\(to_grid:\*\*\*rppptr \[len: 1\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+ short *ptr2;
+ short **pptr2 = &ptr2;
+ short ***ppptr2 = &pptr2;
+ S *s = new S(ppptr2, ppptr2);
+ S **ps = &s;
+ S **&rps = ps;
+
+#pragma omp target update from(([10]) (**(*ps)->ppptr)[1:5:2])
+// { dg-final { scan-tree-dump {map\(from_grid:VIEW_CONVERT_EXPR<short int\[10\]>\(\*\*\*\(\*ps\)->ppptr\) \[len: [0-9]+\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update from(([10]) (**(*rps)->rppptr)[1:5:2])
+// { dg-final { scan-tree-dump {map\(from_grid:VIEW_CONVERT_EXPR<short int\[10\]>\(\*\*\*\*\(\*\*rps\)->rppptr\) \[len: [0-9]+\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update from((**(*ps)->ppptr)[1:5:2])
+// { dg-final { scan-tree-dump {map\(from_grid:\*\*\(\*ps\)->ppptr \[len: [0-9]+\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update from((**(*rps)->rppptr)[1:5:2])
+// { dg-final { scan-tree-dump {map\(from_grid:\*\*\*\(\*\*rps\)->rppptr \[len: [0-9]+\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+ delete s;
+
+ short arr[10][10];
+ short (*parr)[10][10] = &arr;
+ short (**pparr)[10][10] = &parr;
+ short (**&rpparr)[10][10] = pparr;
+
+#pragma omp target update from(**pparr)
+// { dg-final { scan-tree-dump {from\(\*NON_LVALUE_EXPR <\*pparr> \[len: [0-9]+\]\)} "original" } }
+
+#pragma omp target update to((**pparr)[1:5:2][1:5:2])
+// { dg-final { scan-tree-dump {map\(to_grid:\*\*pparr \[len: [0-9]+\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+#pragma omp target update from((**rpparr)[1:5:2][1:5:2])
+// { dg-final { scan-tree-dump {map\(from_grid:\*\*\*rpparr \[len: [0-9]+\]\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\) map\(grid_dim:1 \[len: 5\]\) map\(grid_stride:2\)} "original" } }
+
+ foo<int, long> ();
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-shaping-1.C b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-1.C
new file mode 100644
index 0000000..1f4e68b
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-1.C
@@ -0,0 +1,47 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+
+template<typename T, int C, int D>
+void foo (T *w)
+{
+ memset (w, 0, sizeof (T) * 100);
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ w[j * 10 + i] = i + j * 3;
+
+#pragma omp target update to(([C][D]) w[3:2][1:8][0:5])
+// { dg-error "too many array section specifiers for" "" { target *-*-* } .-1 }
+// { dg-error "'#pragma omp target update' must contain at least one 'from' or 'to' clauses" "" { target *-*-* } .-2 }
+
+#pragma omp target exit data map(from: w[:100])
+}
+
+int main()
+{
+ float *arr = new float[100];
+
+ memset (arr, 0, sizeof (float) * 100);
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j * 3;
+
+#pragma omp target update to(([10][10]) arr[3:2][1:8][0:5])
+// { dg-error "too many array section specifiers for" "" { target *-*-* } .-1 }
+// { dg-error "'#pragma omp target update' must contain at least one 'from' or 'to' clauses" "" { target *-*-* } .-2 }
+
+#pragma omp target exit data map(from: arr[:100])
+
+ foo<float, 5, 20> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-shaping-2.C b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-2.C
new file mode 100644
index 0000000..d320929
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-2.C
@@ -0,0 +1,52 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+
+template<typename T, int C, int D>
+void foo (T *w)
+{
+ /* This isn't allowed. We get a cascade of errors because it looks a bit
+ like lambda-definition syntax */
+#pragma omp target enter data map(to: ([C][D]) w[:100])
+ // { dg-error {capture of non-variable 'C'} "" { target *-*-* } .-1 }
+ // { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-2 }
+ // { dg-warning {lambda expressions only available with} "" { target c++98_only } .-3 }
+ // { dg-error {expected '\)' before 'w'} "" { target *-*-* } .-4 }
+ // { dg-error {does not have pointer or array type} "" { target *-*-* } .-5 }
+
+#pragma omp target exit data map(from: ([C][D]) w[:100])
+ // { dg-error {capture of non-variable 'C'} "" { target *-*-* } .-1 }
+ // { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-2 }
+ // { dg-warning {lambda expressions only available with} "" { target c++98_only } .-3 }
+ // { dg-error {expected '\)' before 'w'} "" { target *-*-* } .-4 }
+ // { dg-error {does not have pointer or array type} "" { target *-*-* } .-5 }
+}
+
+int main()
+{
+ float *arr = new float[100];
+
+ /* This isn't allowed (as above). */
+#pragma omp target enter data map(to: ([10][10]) arr[:100])
+ // { dg-error {expected identifier before numeric constant} "" { target *-*-* } .-1 }
+ // { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-2 }
+ // { dg-warning {lambda expressions only available with} "" { target c++98_only } .-3 }
+ // { dg-error {expected '\)' before 'arr'} "" { target *-*-* } .-4 }
+ // { dg-error {no match for 'operator\[\]' in} "" { target *-*-* } .-5 }
+ // { dg-error {'#pragma omp target enter data' must contain at least one 'map' clause} "" { target *-*-*} .-6 }
+
+#pragma omp target exit data map(from: ([10][10]) arr[:100])
+ // { dg-error {expected identifier before numeric constant} "" { target *-*-* } .-1 }
+ // { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-2 }
+ // { dg-warning {lambda expressions only available with} "" { target c++98_only } .-3 }
+ // { dg-error {no match for 'operator\[\]' in} "" { target *-*-* } .-4 }
+ // { dg-error {expected '\)' before 'arr'} "" { target *-*-* } .-5 }
+ // { dg-error {'#pragma omp target exit data' must contain at least one 'map' clause} "" { target *-*-* } .-6 }
+
+ foo<float, 5, 20> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-shaping-3.C b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-3.C
new file mode 100644
index 0000000..90d0a5a
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-3.C
@@ -0,0 +1,53 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+
+template<typename T>
+void foo (T *w)
+{
+ memset (w, 0, sizeof (T) * 100);
+ int c = 50;
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ w[j * 10 + i] = i + j * 3;
+
+ /* This starts out looking like an array-shape cast. Make sure it's still
+ parsed as a lambda. */
+#pragma omp target update to(([c] (T *v) -> T { return v[c]; } (w)))
+ // { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-1 }
+ // { dg-warning {lambda expressions only available with} "" { target c++98_only } .-2 }
+
+#pragma omp target exit data map(from: w[:100])
+}
+
+int main()
+{
+ float *arr = new float[100];
+ int c = 50;
+
+ memset (arr, 0, sizeof (float) * 100);
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j * 3;
+
+ /* As above. */
+#pragma omp target update to(([c] (float *v) -> float { return v[c]; } (arr)))
+ // { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-1 }
+ // { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 }
+ // { dg-warning {lambda expressions only available with} "" { target c++98_only } .-3 }
+
+#pragma omp target exit data map(from: arr[:100])
+
+ foo<float> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-shaping-4.C b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-4.C
new file mode 100644
index 0000000..4518f03
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-4.C
@@ -0,0 +1,60 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+
+template<typename T>
+extern T* baz(T*);
+
+template<typename T>
+void foo (T *w)
+{
+ memset (w, 0, sizeof (T) * 100);
+ int c = 50;
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ w[j * 10 + i] = i + j * 3;
+
+ /* No array-shaping inside a function call. */
+#pragma omp target update to(baz(([10][10]) w))
+ // { dg-error {expected identifier before numeric constant} "" { target *-*-* } .-1 }
+ // { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-2 }
+ // { dg-warning {lambda expressions only available with} "" { target c++98_only } .-3 }
+ // { dg-error {expected '\)' before 'w'} "" { target *-*-* } .-4 }
+ // { dg-error {no match for 'operator\[\]' in} "" { target *-*-* } .-5 }
+
+#pragma omp target exit data map(from: w[:100])
+}
+
+int main()
+{
+ float *arr = new float[100];
+ int c = 50;
+
+ memset (arr, 0, sizeof (float) * 100);
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j * 3;
+
+ /* As above. */
+#pragma omp target update to(baz(([10][10]) arr))
+ // { dg-error {expected identifier before numeric constant} "" { target *-*-* } .-1 }
+ // { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-2 }
+ // { dg-warning {lambda expressions only available with} "" { target c++98_only } .-3 }
+ // { dg-error {no match for 'operator\[\]' in} "" { target *-*-* } .-4 }
+ // { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-5 }
+
+#pragma omp target exit data map(from: arr[:100])
+
+ foo<float> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-shaping-5.C b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-5.C
new file mode 100644
index 0000000..25edb9d
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-5.C
@@ -0,0 +1,55 @@
+// { dg-do compile }
+// { dg-additional-options "-std=c++14" }
+
+#include <string.h>
+#include <assert.h>
+
+template<typename T>
+void foo (T *w)
+{
+ memset (w, 0, sizeof (T) * 100);
+ int c = 50;
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ w[j * 10 + i] = i + j * 3;
+
+ /* No array-shaping inside a lambda body. */
+#pragma omp target update to([&](const int d) -> auto& { return ([d][d]) w; } (10))
+// { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-1 }
+// { dg-error {expected ';' before 'w'} "" { target *-*-* } .-2 }
+// { dg-error {no match for 'operator\[\]' in} "" { target *-*-* } .-3 }
+
+#pragma omp target exit data map(from: w[:100])
+}
+
+int main()
+{
+ float *arr = new float[100];
+ int c = 50;
+
+ memset (arr, 0, sizeof (float) * 100);
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j * 3;
+
+ /* As above. */
+#pragma omp target update to([&](const int d) -> auto& { return ([d][d]) arr; } (10))
+// { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-1 }
+// { dg-error {no match for 'operator\[\]' in} "" { target *-*-* } .-2 }
+// { dg-error {expected ';' before 'arr'} "" { target *-*-* } .-3 }
+// { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-4 }
+
+#pragma omp target exit data map(from: arr[:100])
+
+ foo<float> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-shaping-6.C b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-6.C
new file mode 100644
index 0000000..e796eaa
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-6.C
@@ -0,0 +1,59 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+
+template<typename T>
+void foo (T *w)
+{
+ memset (w, 0, sizeof (T) * 100);
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ w[j * 10 + i] = i + j * 3;
+
+ /* No array-shaping inside a statement expression. */
+#pragma omp target update to( ({ int d = 10; ([d][d]) w; )} )
+// { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-1 }
+// { dg-warning {lambda expressions only available with} "" { target c++98_only } .-2 }
+// { dg-error {no match for 'operator\[\]'} "" { target *-*-* } .-3 }
+// { dg-error {expected ';' before 'w'} "" { target *-*-* } .-4 }
+// { dg-error {expected primary-expression before '\)' token} "" { target *-*-* } .-5 }
+// { dg-error {expected '\)' before end of line} "" { target *-*-* } .-6 }
+// { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-7 }
+
+#pragma omp target exit data map(from: w[:100])
+}
+
+int main()
+{
+ float *arr = new float[100];
+
+ memset (arr, 0, sizeof (float) * 100);
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j * 3;
+
+ /* As above. */
+#pragma omp target update to( ({ int d = 10; ([d][d]) arr; )} )
+// { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-1 }
+// { dg-warning {lambda expressions only available with} "" { target c++98_only } .-2 }
+// { dg-error {no match for 'operator\[\]'} "" { target *-*-* } .-3 }
+// { dg-error {expected primary-expression before '\)' token} "" { target *-*-* } .-4 }
+// { dg-error {expected '\)' before end of line} "" { target *-*-* } .-5 }
+// { dg-message {sorry, unimplemented: unsupported map expression} "" { target *-*-* } .-6 }
+// { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-7 }
+
+#pragma omp target exit data map(from: arr[:100])
+
+ foo<float> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-shaping-7.C b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-7.C
new file mode 100644
index 0000000..c4b5d78
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-7.C
@@ -0,0 +1,44 @@
+// { dg-do compile }
+// { dg-additional-options "-std=c++11" }
+
+#include <new>
+
+template<typename T>
+struct St {
+ T *pp;
+};
+
+template<typename T>
+void foo (T *w)
+{
+ alignas (St<T>) unsigned char buf[sizeof (St<T>)];
+ T *sub1;
+
+ /* No array shaping op in brace initialiser (nonsensical anyway, but make
+ sure it doesn't parse). */
+#pragma omp target update to( new (buf) St<T> { ([10][10]) sub1 } )
+// { dg-error {expected identifier before numeric constant} "" { target *-*-* } .-1 }
+// { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-2 }
+// { dg-error {expected '\}' before 'sub1'} "" { target *-*-* } .-3 }
+}
+
+struct S {
+ int *pp;
+};
+
+int main()
+{
+ alignas (S) unsigned char buf[sizeof (S)];
+ int *sub1;
+
+ // As above.
+#pragma omp target update to( new (buf) S { ([10][10]) sub1 } )
+// { dg-error {expected identifier before numeric constant} "" { target *-*-* } .-1 }
+// { dg-error {expected '\{' before '\[' token} "" { target *-*-* } .-2 }
+// { dg-error {expected '\}' before 'sub1'} "" { target *-*-* } .-3 }
+// { dg-error {no match for 'operator\[\]'} "" { target *-*-* } .-4 }
+// { dg-error {could not convert} "" { target *-*-* } .-5 }
+// { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-6 }
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/bad-array-shaping-8.C b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-8.C
new file mode 100644
index 0000000..02d7de6
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/bad-array-shaping-8.C
@@ -0,0 +1,50 @@
+// { dg-do compile }
+
+template<typename T>
+void foo ()
+{
+ T *ptr;
+
+#pragma omp target update to(([5][6][7]) ptr[0:4][0:7][0:7])
+// { dg-error {length '7' with stride '1' above array section size in 'to' clause} "" { target *-*-* } .-1 }
+
+#pragma omp target update to(([5][6][7]) ptr[1:5][0:6][0:7])
+// { dg-error {high bound '6' above array section size in 'to' clause} "" { target *-*-* } .-1 }
+
+ // This one's OK...
+#pragma omp target update from(([100]) ptr[3:33:3])
+
+ // But this is one element out of bounds.
+#pragma omp target update from(([100]) ptr[4:33:3])
+// { dg-error {high bound '101' above array section size in 'from' clause} "" { target *-*-* } .-1 }
+
+#pragma omp target update to(([10][10]) ptr[0:9:-1][0:9])
+// { dg-error {length '9' with stride '-1' above array section size in 'to' clause} "" { target *-*-* } .-1 }
+}
+
+int main()
+{
+ char *ptr;
+
+#pragma omp target update to(([5][6][7]) ptr[0:4][0:7][0:7])
+// { dg-error {length '7' with stride '1' above array section size in 'to' clause} "" { target *-*-* } .-1 }
+// { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 }
+
+#pragma omp target update to(([5][6][7]) ptr[1:5][0:6][0:7])
+// { dg-error {high bound '6' above array section size in 'to' clause} "" { target *-*-* } .-1 }
+// { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 }
+
+#pragma omp target update from(([100]) ptr[3:33:3])
+
+#pragma omp target update from(([100]) ptr[4:33:3])
+// { dg-error {high bound '101' above array section size in 'from' clause} "" { target *-*-* } .-1 }
+// { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 }
+
+#pragma omp target update to(([10][10]) ptr[0:9:-1][0:9])
+// { dg-error {length '9' with stride '-1' above array section size in 'to' clause} "" { target *-*-* } .-1 }
+// { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 }
+
+ foo<char> ();
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/declare-mapper-1.C b/gcc/testsuite/g++.dg/gomp/declare-mapper-1.C
new file mode 100644
index 0000000..8af3bac
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/declare-mapper-1.C
@@ -0,0 +1,58 @@
+// { dg-do compile }
+// { dg-additional-options "-fdump-tree-gimple" }
+
+// "omp declare mapper" support -- check expansion in gimple.
+
+struct S {
+ int *ptr;
+ int size;
+};
+
+#define N 64
+
+#pragma omp declare mapper (S w) map(w.size, w.ptr, w.ptr[:w.size])
+#pragma omp declare mapper (foo:S w) map(to:w.size, w.ptr) map(w.ptr[:w.size])
+
+int main (int argc, char *argv[])
+{
+ S s;
+ s.ptr = new int[N];
+ s.size = N;
+
+#pragma omp declare mapper (bar:S w) map(w.size, w.ptr, w.ptr[:w.size])
+
+#pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+#pragma omp target map(tofrom: s)
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+#pragma omp target map(mapper(default), tofrom: s)
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+#pragma omp target map(mapper(foo), alloc: s)
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+#pragma omp target map(mapper(bar), tofrom: s)
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+ return 0;
+}
+
+// { dg-final { scan-tree-dump-times {map\(struct:s \[len: 2\]\) map\(alloc:s\.ptr \[len: [0-9]+\]\) map\(tofrom:s\.size \[len: [0-9]+\]\) map\(tofrom:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} 4 "gimple" } }
+// { dg-final { scan-tree-dump-times {map\(struct:s \[len: 2\]\) map\(alloc:s\.ptr \[len: [0-9]+\]\) map\(alloc:s\.size \[len: [0-9]+\]\) map\(alloc:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} 1 "gimple" } }
diff --git a/gcc/testsuite/g++.dg/gomp/declare-mapper-2.C b/gcc/testsuite/g++.dg/gomp/declare-mapper-2.C
new file mode 100644
index 0000000..7df72c7
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/declare-mapper-2.C
@@ -0,0 +1,30 @@
+// { dg-do compile }
+
+// Error-checking tests for "omp declare mapper".
+
+struct S {
+ int *ptr;
+ int size;
+};
+
+struct Z {
+ int z;
+};
+
+int main (int argc, char *argv[])
+{
+#pragma omp declare mapper (S v) map(v.size, v.ptr[:v.size]) // { dg-note "'#pragma omp declare mapper \\(S\\)' previously declared here" }
+
+ /* This one's a duplicate. */
+#pragma omp declare mapper (default: S v) map (to: v.size) map (v) // { dg-error "redeclaration of '#pragma omp declare mapper \\(S\\)'" }
+
+ /* ...and this one doesn't use a "base language identifier" for the mapper
+ name. */
+#pragma omp declare mapper (case: S v) map (to: v.size) // { dg-error "expected identifier or 'default' before 'case'" }
+ // { dg-error "expected ':' before 'case'" "" { target *-*-* } .-1 }
+
+ /* A non-struct/class/union type isn't supposed to work. */
+#pragma omp declare mapper (name:Z [5]foo) map (foo[0].z) // { dg-error "'Z \\\[5\\\]' is not a struct, union or class type in '#pragma omp declare mapper'" }
+
+ return 0;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-1.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-1.C
new file mode 100644
index 0000000..dfeb7c4
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-1.C
@@ -0,0 +1,39 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-foffload=disable -fdump-tree-gimple" } */
+
+/* Check that variants within a "begin declare variant" directive
+ are attached to the correct overloaded function. */
+
+int f (int x) { return x; }
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+int f (int x) { return -1; }
+#pragma omp end declare variant
+
+int f (int x, int y) { return x * y; }
+
+#pragma omp begin declare variant match (construct={target})
+int f (int x, int y) { return -2; }
+#pragma omp end declare variant
+
+int f (int x, int y, int z) { return x * y * z; }
+
+#pragma omp begin declare variant match (device={kind("host")})
+int f (int x, int y, int z) { return -3; }
+#pragma omp end declare variant
+
+int main (void)
+{
+ if (f (10) != -1) __builtin_abort ();
+ if (f (10, 20) != 200) __builtin_abort (); /* no match on this one */
+ if (f (10, 20, 30) != -3) __builtin_abort ();
+}
+
+/* { dg-final { scan-tree-dump "f\\.ompvariant. \\(10\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "f \\(10, 20\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "f\\.ompvariant. \\(10, 20, 30\\)" "gimple" } } */
+
+
+
+
+
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-2.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-2.C
new file mode 100644
index 0000000..1784e14
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-2.C
@@ -0,0 +1,53 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Check that "omp begin declare variant" works on methods in a
+ class declaration. */
+
+class test1 {
+
+ private:
+ int n;
+ static int m;
+
+ public:
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ int get_n (void) { return n * 2; }
+ static int get_m (void) { return m * 2; }
+ #pragma omp end declare variant
+
+ #pragma omp begin declare variant match (construct={target})
+ int get_n (void) { return this->n * 2; }
+ #pragma omp end declare variant
+
+ /* The base methods are deliberately declared after the variants in order
+ to check that the lookup can still find them. */
+ void set_n (int x) { n = x; }
+ int get_n (void) { return n; }
+
+ static void set_m (int x) { m = x; }
+ static int get_m (void) { return m; }
+};
+
+int test1::m;
+
+int main (void)
+{
+ test1 t1;
+ t1.set_n (10);
+ if (t1.get_n () != 20) __builtin_abort ();
+ test1::set_m (1);
+ if (test1::get_m () != 2) __builtin_abort ();
+}
+
+/* { dg-final { scan-tree-dump "test1::get_n\\.ompvariant. \\(&t1\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "test1::get_m\\.ompvariant. \\(\\)" "gimple" } } */
+
+/* The variants must have internal linkage, not .globl or .weak. */
+/* { dg-final { scan-assembler-not "\\.globl\[ \t\]*_?_ZN5test117get_n\\.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.globl\[ \t\]*_?_ZN5test117get_m\\.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.weak\[ \t\]*_?_ZN5test117get_n\\.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.weak\[ \t\]*_?_ZN5test117get_m\\.ompvariant" } } */
+
+
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-3.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-3.C
new file mode 100644
index 0000000..ccbb01c
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-3.C
@@ -0,0 +1,37 @@
+/* { dg-do compile } */
+
+/* Check that "omp begin declare variant" for class methods outside of the
+ class declaration gives a sorry. C++ generally does not allow injection
+ of additional methods into a class outside of its declaration so it is
+ not clear what this is supposed to do. */
+
+class test1 {
+
+ private:
+ int n;
+ static int m;
+
+ public:
+
+ void set_n (int x) { n = x; }
+ int get_n (void) { return n; }
+
+ static void set_m (int x) { m = x; }
+ static int get_m (void) { return m; }
+
+};
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+int test1::get_n (void) { return n * 2; } /* { dg-message "sorry, unimplemented: cannot handle qualified name for variant function" } */
+static int test1::get_m (void) { return m * 2; } /* { dg-message "sorry, unimplemented: cannot handle qualified name for variant function" } */
+#pragma omp end declare variant
+
+int main (void)
+{
+ test1 t1;
+ t1.set_n (10);
+ if (t1.get_n () != 20) __builtin_abort ();
+ test1::set_m (1);
+ if (test1::get_m () != 2) __builtin_abort ();
+}
+
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-4.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-4.C
new file mode 100644
index 0000000..567cf9c
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-4.C
@@ -0,0 +1,57 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Like c-c++-common/delim-declare-variant-1.c, but with namespaces. */
+
+namespace n1 {
+
+int foo (int a)
+{
+ return a;
+}
+
+int bar (int x)
+{
+ return x;
+}
+
+#pragma omp begin declare variant match (construct={target})
+int foo (int a)
+{
+ return a + 1;
+}
+
+int bar (int x)
+{
+ return x * 2;
+}
+#pragma omp end declare variant
+
+/* Because of the high score value, this variant for "bar" should always be
+ selected even when the one above also matches. */
+#pragma omp begin declare variant match (implementation={vendor(score(10000):"gnu")})
+int bar (int x)
+{
+ return x * 4;
+}
+#pragma omp end declare variant
+
+} /* namespace n1 */
+
+int main (void)
+{
+ if (n1::foo (42) != 42) __builtin_abort ();
+ if (n1::bar (3) != 12) __builtin_abort ();
+#pragma omp target
+ {
+ if (n1::foo (42) != 43) __builtin_abort ();
+ if (n1::bar (3) != 12) __builtin_abort ();
+ }
+}
+
+/* { dg-final { scan-tree-dump-times "omp declare variant base \\(foo.ompvariant." 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "omp declare variant base \\(bar.ompvariant." 2 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "foo \\(42\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "foo\\.ompvariant. \\(42\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "bar \\(3\\)" 0 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "bar\\.ompvariant. \\(3\\)" 2 "gimple" } } */
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-40.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-40.C
new file mode 100644
index 0000000..4f35d20
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-40.C
@@ -0,0 +1,51 @@
+// { dg-do compile }
+
+// Check that variants for a template function are instantiated correctly.
+// FIXME: Fails due to PR118530.
+
+template<typename T>
+void f_default_param (T = 42) {}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void f_default_param (T = 42) {}
+#pragma omp end declare variant
+
+template<typename T>
+void f_no_param () {} // { dg-bogus "no matching function for call" "PR118530" { xfail *-*-* } }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void f_no_param () {}
+#pragma omp end declare variant
+
+void instantiate_f()
+{
+ f_default_param<int>();
+ f_no_param<int>();
+}
+
+template<int>
+void nttp () {} // { dg-bogus "no matching function for call" "PR118530" { xfail *-*-* } }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<int>
+void nttp () {}
+#pragma omp end declare variant
+
+void instantiate_nttp()
+{
+ nttp<42>();
+}
+
+template<typename>
+struct S {};
+
+template<template<typename> class Templ>
+void templ_templ () {} // { dg-bogus "no matching function for call" "PR118530" { xfail *-*-* } }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<template<typename> class Templ>
+void templ_templ () {}
+#pragma omp end declare variant
+
+void instantiate_templ_templ()
+{
+ templ_templ<S>();
+}
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-41.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-41.C
new file mode 100644
index 0000000..38e41e7
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-41.C
@@ -0,0 +1,31 @@
+/* { dg-do compile { target c++11 } } */
+
+/* This test case fails in omp_finish_variant_function because base_decl
+ is a SCOPE_REF and it cannot be resolved to an actual base function decl
+ to hang the variant attribute on. */
+
+template<typename T, typename U>
+ class is_same {
+ static constexpr bool value = false;
+};
+
+template<typename T>
+class is_same<T, T> {
+ static constexpr bool value = true;
+};
+
+template<typename T>
+void fn (T&&) { }
+
+#pragma omp begin declare variant match(implementation={vendor("gnu")})
+template<typename T>
+void fn(T&&) { // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+ static_assert(is_same<T, int>::value);
+}
+#pragma omp end declare variant
+
+int main()
+{
+ int lvalue = 42;
+ fn(0);
+}
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-5.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-5.C
new file mode 100644
index 0000000..e8db369
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-5.C
@@ -0,0 +1,53 @@
+/* { dg-do compile } */
+
+/* Check that "omp begin declare variant" for a namespace function outside of
+ the namespace gives an error. C++ generally does not allow injection of
+ additional function into a namespace outside of its scope so this is just a
+ generic error. */
+
+namespace n1 {
+
+int foo (int a)
+{
+ return a;
+}
+
+int bar (int x)
+{
+ return x;
+}
+
+} /* namespace n1 */
+
+
+#pragma omp begin declare variant match (construct={target})
+int n1::foo (int a) /* { dg-message "sorry, unimplemented: cannot handle qualified name for variant function" } */
+{
+ return a + 1;
+}
+
+int n1::bar (int x) /* { dg-message "sorry, unimplemented: cannot handle qualified name for variant function" } */
+{
+ return x * 2;
+}
+#pragma omp end declare variant
+
+/* Because of the high score value, this variant for "bar" should always be
+ selected even when the one above also matches. */
+#pragma omp begin declare variant match (implementation={vendor(score(10000):"gnu")})
+int n1::bar (int x) /* { dg-message "sorry, unimplemented: cannot handle qualified name for variant function" } */
+{
+ return x * 4;
+}
+#pragma omp end declare variant
+
+int main (void)
+{
+ if (n1::foo (42) != 42) __builtin_abort ();
+ if (n1::bar (3) != 12) __builtin_abort ();
+#pragma omp target
+ {
+ if (n1::foo (42) != 43) __builtin_abort ();
+ if (n1::bar (3) != 12) __builtin_abort ();
+ }
+}
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-50.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-50.C
new file mode 100644
index 0000000..a958b52
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-50.C
@@ -0,0 +1,99 @@
+/* { dg-do compile } */
+
+/* Test for restrictions on declare variant functions on virtual functions,
+ constructors, and destructors. */
+
+struct S0
+{
+ virtual void f_virtual_before0 () {}
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ virtual void f_virtual_before0 () {} // { dg-error "declare variant directives are not allowed on virtual functions" }
+ #pragma omp end declare variant
+
+ virtual void f_virtual_before1 () {}
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ void f_virtual_before1 () {} // { dg-error "declare variant directives are not allowed on virtual functions" }
+ #pragma omp end declare variant
+
+ void f_virtual_before2 () {}
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ virtual void f_virtual_before2 () {} // { dg-error "declare variant directives are not allowed on virtual functions" }
+ #pragma omp end declare variant
+
+ void f_virtual_before3 () {}
+ // code elision, no error
+ #pragma omp begin declare variant match (implementation={vendor("cray")})
+ virtual void f_virtual_before3 () {}
+ #pragma omp end declare variant
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ virtual void f_virtual_after0 () {} // { dg-error "declare variant directives are not allowed on virtual functions" }
+ #pragma omp end declare variant
+ virtual void f_virtual_after0 () {}
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ void f_virtual_after1 () {} // { dg-error "declare variant directives are not allowed on virtual functions" }
+ #pragma omp end declare variant
+ virtual void f_virtual_after1 () {}
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ virtual void f_virtual_after2 () {} // { dg-error "declare variant directives are not allowed on virtual functions" }
+ #pragma omp end declare variant
+ void f_virtual_after2 () {}
+};
+
+struct S_before {
+ S_before() {}
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_before() {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+
+ S_before(int) {}
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_before(int) {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+
+ S_before(double) {}
+ // code elision, no error
+ #pragma omp begin declare variant match (implementation={vendor("cray")})
+ S_before(double) {}
+ #pragma omp end declare variant
+
+ template<typename T>
+ S_before(T) {}
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ template<typename T>
+ S_before(T) {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+
+ ~S_before() {}
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ ~S_before() {} // { dg-error "declare variant directives are not allowed on destructors" }
+ #pragma omp end declare variant
+};
+
+struct S_after {
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_after() {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+ S_after() {}
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_after(int) {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+ S_after(int) {}
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ template<typename T>
+ S_after(T) {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+ template<typename T>
+ S_after(T) {}
+
+ // code elision, no error
+ #pragma omp begin declare variant match (implementation={vendor("cray")})
+ ~S_after() {}
+ #pragma omp end declare variant
+ ~S_after() {}
+};
+
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-51.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-51.C
new file mode 100644
index 0000000..9e65309
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-51.C
@@ -0,0 +1,181 @@
+/* { dg-do compile { target c++11 } } */
+
+/* Test delimited declare variant on constexpr, deleted, and defaulted
+ functions. */
+/* C++11 */
+
+/* TODO: add templates cases for constexpr/delete free functions */
+
+/* Do we warn for the mismatch?
+ TBH we probably warn whenever a variant function is constexpr in general.
+ I can't imagine that we are going to support constant evaluation of a
+ variant function, realistically the only choice is to always use the base
+ function if a constant-expression is required. */
+constexpr int freefn_mismatched_constexpr_before0 () { return 0; }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+int freefn_mismatched_constexpr_before0 () { return 1; }
+#pragma omp end declare variant
+
+int freefn_mismatched_constexpr_before1 () { return 0; }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+constexpr int freefn_mismatched_constexpr_before1 () { return 1; }
+#pragma omp end declare variant
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+constexpr int freefn_mismatched_constexpr_after0 () { return 1; } // { dg-error "no previous declaration of base function" }
+#pragma omp end declare variant
+int freefn_mismatched_constexpr_after0 () { return 0; }
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+int freefn_mismatched_constexpr_after1 () { return 1; } // { dg-error "no previous declaration of base function" }
+#pragma omp end declare variant
+constexpr int freefn_mismatched_constexpr_after1 () { return 0; }
+
+
+
+void freefn_deleted_before () = delete;
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+void freefn_deleted_before () {} // { dg-error "declare variant directives are not allowed on deleted functions" }
+#pragma omp end declare variant
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+void freefn_deleted_after () {} // { dg-error "no previous declaration of base function" }
+#pragma omp end declare variant
+void freefn_deleted_after () = delete;
+
+/* TECHNICALLY allowed by the spec, but obviously conflicts with the intention. */
+void freefn_variant_deleted_base_before () {}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+void freefn_variant_deleted_base_before () = delete; // { dg-error "declare variant directives are not allowed on deleted functions" }
+#pragma omp end declare variant
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+void freefn_variant_deleted_base_after () = delete; // { dg-error "declare variant directives are not allowed on deleted functions" }
+#pragma omp end declare variant
+void freefn_variant_deleted_base_after () {};
+
+
+/* For now, obviously error, not sure if we error on just the base or on
+ both though.
+ In the future, I think if the base and all variants are deleted, we can
+ treat a call to the function as deleted before we determine a variant. */
+void freefn_both_deleted_base_before () = delete;
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+void freefn_both_deleted_base_before () = delete; // { dg-error "declare variant directives are not allowed on deleted functions" }
+#pragma omp end declare variant
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+void freefn_both_deleted_base_after () = delete; // { dg-error "declare variant directives are not allowed on deleted functions" }
+#pragma omp end declare variant
+void freefn_both_deleted_base_after () = delete;
+
+
+
+
+struct S0
+{
+ void f_deleted_before () = delete;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ void f_deleted_before () {} // { dg-error "declare variant directives are not allowed on deleted functions" }
+ #pragma omp end declare variant
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ void f_deleted_after () {} // { dg-error "declare variant directives are not allowed on deleted functions" }
+ #pragma omp end declare variant
+ void f_deleted_after () = delete;
+};
+
+
+/* These should error for constructor/destructor, not default. */
+struct S_default_before {
+ S_default_before() = default;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_before() {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+
+ S_default_before(S_default_before const&) = default;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_before(S_default_before const&) {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+
+ S_default_before(S_default_before&&) = default;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_before(S_default_before&&) {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+
+ ~S_default_before() = default;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ ~S_default_before() {} // { dg-error "declare variant directives are not allowed on destructors" }
+ #pragma omp end declare variant
+};
+
+struct S_default_after {
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_after() {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+ S_default_after() = default;
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_after(S_default_after const&) {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+ S_default_after(S_default_after const&) = default;
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_after(S_default_after&&) {} // { dg-error "declare variant directives are not allowed on constructors" }
+ #pragma omp end declare variant
+ S_default_after(S_default_after&&) = default;
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ ~S_default_after() {} // { dg-error "declare variant directives are not allowed on destructors" }
+ #pragma omp end declare variant
+ ~S_default_after() = default;
+};
+
+/* These should error for default/delete. */
+struct S_default_assignment_before {
+ S_default_assignment_before& operator=(S_default_assignment_before const&) = default;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_assignment_before& operator=(S_default_assignment_before const&) { return *this; } // { dg-error "declare variant directives are not allowed on defaulted functions" }
+ #pragma omp end declare variant
+
+ S_default_assignment_before& operator=(S_default_assignment_before&&) = default;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_assignment_before& operator=(S_default_assignment_before&&) { return *this; } // { dg-error "declare variant directives are not allowed on defaulted functions" }
+ #pragma omp end declare variant
+};
+
+struct S_default_assignment_after {
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_assignment_after& operator=(S_default_assignment_after const&) { return *this; } // { dg-error "declare variant directives are not allowed on defaulted functions" }
+ #pragma omp end declare variant
+ S_default_assignment_after& operator=(S_default_assignment_after const&) = default;
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_default_assignment_after& operator=(S_default_assignment_after&&) { return *this; } // { dg-error "declare variant directives are not allowed on defaulted functions" }
+ #pragma omp end declare variant
+ S_default_assignment_after& operator=(S_default_assignment_after&&) = default;
+};
+
+struct S_deleted_assignment_before {
+ S_deleted_assignment_before& operator=(S_deleted_assignment_before const&) = delete;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_deleted_assignment_before& operator=(S_deleted_assignment_before const&) { return *this; } // { dg-error "declare variant directives are not allowed on deleted functions" }
+ #pragma omp end declare variant
+
+ S_deleted_assignment_before& operator=(S_deleted_assignment_before&&) = delete;
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_deleted_assignment_before& operator=(S_deleted_assignment_before&&) { return *this; } // { dg-error "declare variant directives are not allowed on deleted functions" }
+ #pragma omp end declare variant
+};
+
+struct S_deleted_assignment_after {
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_deleted_assignment_after& operator=(S_deleted_assignment_after const&) { return *this; } // { dg-error "declare variant directives are not allowed on deleted functions" }
+ #pragma omp end declare variant
+ S_deleted_assignment_after& operator=(S_deleted_assignment_after const&) = delete;
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ S_deleted_assignment_after& operator=(S_deleted_assignment_after&&) { return *this; } // { dg-error "declare variant directives are not allowed on deleted functions" }
+ #pragma omp end declare variant
+ S_deleted_assignment_after& operator=(S_deleted_assignment_after&&) = delete;
+};
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-52.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-52.C
new file mode 100644
index 0000000..4f4a005
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-52.C
@@ -0,0 +1,24 @@
+/* { dg-do compile { target c++20 } } */
+
+/* The procedure that a declare variant directive determined to be a function
+ variant may not be an immediate function + Declare variant directives may
+ not be specified for immediate functions. */
+consteval void freefn_consteval_before0 () {}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+consteval void freefn_consteval_before0 () {} // { dg-error "declare variant directives are not allowed on immediate functions" }
+#pragma omp end declare variant
+
+/* Declare variant directives may not be specified for immediate functions. */
+consteval void freefn_consteval_before1 () {}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+void freefn_consteval_before1 () {} // { dg-error "declare variant directives are not allowed on immediate functions" }
+#pragma omp end declare variant
+
+/* The procedure that a declare variant directive determined to be a function
+ variant may not be an immediate function. */
+void freefn_consteval_before2 () {}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+consteval void freefn_consteval_before2 () {} // { dg-error "declare variant directives are not allowed on immediate functions" }
+#pragma omp end declare variant
+
+
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-6.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-6.C
new file mode 100644
index 0000000..30dee4c
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-6.C
@@ -0,0 +1,72 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Check "begin declare variant" on template functions. */
+
+template <typename T>
+T foo (T a)
+{
+ return a;
+}
+
+template <typename T>
+T bar (T x)
+{
+ return x;
+}
+
+#pragma omp begin declare variant match (construct={target})
+template <typename T1>
+T1 foo (T1 a)
+{
+ return a + 1;
+}
+
+template <typename T1>
+T1 bar (T1 x)
+{
+ return x * 2;
+}
+#pragma omp end declare variant
+
+/* Because of the high score value, this variant for "bar" should always be
+ selected even when the one above also matches. */
+#pragma omp begin declare variant match (implementation={vendor(score(10000):"gnu")})
+template <typename T2>
+T2 bar (T2 x)
+{
+ return x * 4;
+}
+#pragma omp end declare variant
+
+int main (void)
+{
+ if (foo<int> (42) != 42) __builtin_abort ();
+ if (bar<int> (3) != 12) __builtin_abort ();
+#pragma omp target
+ {
+ if (foo<int> (42) != 43) __builtin_abort ();
+ if (bar<int> (3) != 12) __builtin_abort ();
+ }
+}
+
+/* Make sure all the template functions are instantiated. */
+/* { dg-final { scan-tree-dump "int foo.ompvariant.<int> \\(.*\\)" "gimple" } }
+/* { dg-final { scan-tree-dump "int foo<int> \\(.*\\)" "gimple" } }
+/* { dg-final { scan-tree-dump "int bar.ompvariant.<int> \\(.*\\)" "gimple" } }
+
+/* Make sure the calls are resolved correctly. */
+/* { dg-final { scan-tree-dump-times "foo<int> \\(42\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "foo\\.ompvariant.<int> \\(42\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "bar<int> \\(3\\)" 0 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "bar\\.ompvariant.<int> \\(3\\)" 2 "gimple" } } */
+
+/* The variants must have internal linkage, not .globl or .weak. */
+/* { dg-final { scan-assembler-not "\\.globl\[ \t\]*_?_Z15foo.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.globl\[ \t\]*_?_Z15bar.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.weak\[ \t\]*_?_Z15foo.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.weak\[ \t\]*_?_Z15bar.ompvariant" } } */
+
+
+
+
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-7.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-7.C
new file mode 100644
index 0000000..b24e6c0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-7.C
@@ -0,0 +1,57 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* Check that "omp begin declare variant" works on methods in a template
+ class declaration. */
+
+template <typename T>
+class test1 {
+
+ private:
+ T n;
+ static T m;
+
+ public:
+
+ void set_n (T x) { n = x; }
+ T get_n (void) { return n; }
+
+ static void set_m (T x) { m = x; }
+ static T get_m (void) { return m; }
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ T get_n (void) { return n * 2; }
+ static T get_m (void) { return m * 2; }
+ #pragma omp end declare variant
+
+ #pragma omp begin declare variant match (construct={target})
+ T get_n (void) { return this->n * 2; }
+ #pragma omp end declare variant
+};
+
+template <typename T>
+T test1<T>::m;
+
+int main (void)
+{
+ test1<int> t1;
+ t1.set_n (10);
+ if (t1.get_n () != 20) __builtin_abort ();
+ test1<int>::set_m (1);
+ if (test1<int>::get_m () != 2) __builtin_abort ();
+}
+
+/* Make sure the "declare variant" replacement happens. */
+/* { dg-final { scan-tree-dump "test1<int>::get_n\\.ompvariant. \\(&t1\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "test1<int>::get_m\\.ompvariant. \\(\\)" "gimple" } } */
+
+/* Make sure the variant methods are instantiated. */
+/* { dg-final { scan-tree-dump "int test1<int>::get_n\\.ompvariant. \\(.*\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "int test1<int>::get_m\\.ompvariant. \\(.*\\)" "gimple" } } */
+
+/* The variants must have internal linkage, not .globl or .weak. */
+/* { dg-final { scan-assembler-not "\\.globl\[ \t\]*_?_ZN5test1IiE17get_n.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.globl\[ \t\]*_?_ZN5test1IiE17get_m.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.weak\[ \t\]*_?_ZN5test1IiE17get_n.ompvariant" } } */
+/* { dg-final { scan-assembler-not "\\.weak\[ \t\]*_?_ZN5test1IiE17get_m.ompvariant" } } */
+
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-70.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-70.C
new file mode 100644
index 0000000..ed1e1ae
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-70.C
@@ -0,0 +1,206 @@
+/* { dg-do compile { target c++11 } } */
+
+/* Check that the substituted type in variant is the same as the one in the
+ base. */
+
+template<typename T, typename U>
+struct is_same {
+ static constexpr bool value = false;
+};
+
+template<typename T>
+struct is_same<T, T> {
+ static constexpr bool value = true;
+};
+
+/* Using static_assert directly in a variant triggers the SCOPE_REF bug noted
+ in delim-declare-variant-41.C. We'll avoid that by outsourcing the checks
+ to this function. PR118791 is a different bug that affects also the
+ non-delimited form of "declare variant". */
+template<typename T, typename U>
+void fail_if_not_same() {
+ static_assert(is_same<T, U>::value); // { dg-bogus "static assertion failed" "PR118791" { xfail *-*-* } }
+}
+
+/* Sanity checks are included in the base function just to be absolutely
+ certain there were no mistakes made in the tests. They should match the
+ cases in the variant function exactly. */
+
+template<typename T>
+void fwdref_passed_lvalue_int (T&& p) {
+ static_assert(is_same<T, int&>::value);
+ static_assert(is_same<decltype(p), int&>::value);
+ static_assert(is_same<decltype((p)), int&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void fwdref_passed_lvalue_int (T&& p) {
+ fail_if_not_same<T, int&>();
+ fail_if_not_same<decltype(p), int&>();
+ fail_if_not_same<decltype((p)), int&>();
+}
+#pragma omp end declare variant
+
+template<typename T>
+void fwdref_passed_lvalue_const_int (T&& p) {
+ static_assert(is_same<T, int const&>::value);
+ static_assert(is_same<decltype(p), int const&>::value);
+ static_assert(is_same<decltype((p)), int const&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void fwdref_passed_lvalue_const_int (T&& p) {
+ fail_if_not_same<T, int const&>();
+ fail_if_not_same<decltype(p), int const&>();
+ fail_if_not_same<decltype((p)), int const&>();
+}
+#pragma omp end declare variant
+
+template<typename T>
+void fwdref_passed_rvalue_int (T&& p) {
+ static_assert(is_same<T, int>::value);
+ static_assert(is_same<decltype(p), int&&>::value);
+ static_assert(is_same<decltype((p)), int&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void fwdref_passed_rvalue_int (T&& p) {
+ fail_if_not_same<T, int>();
+ fail_if_not_same<decltype(p), int&&>();
+ fail_if_not_same<decltype((p)), int&>();
+}
+#pragma omp end declare variant
+
+template<typename T>
+void fwdref_passed_rvalue_const_int (T&& p) {
+ static_assert(is_same<T, int const>::value);
+ static_assert(is_same<decltype(p), int const&&>::value);
+ static_assert(is_same<decltype((p)), int const&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void fwdref_passed_rvalue_const_int (T&& p) {
+ fail_if_not_same<T, int const>();
+ fail_if_not_same<decltype(p), int const&&>();
+ fail_if_not_same<decltype((p)), int const&>();
+}
+#pragma omp end declare variant
+
+void instantiate_fwdref()
+{
+ int lvalue = 0;
+ fwdref_passed_lvalue_int(lvalue);
+ fwdref_passed_lvalue_const_int(static_cast<int const&>(lvalue));
+ fwdref_passed_rvalue_int(0);
+ fwdref_passed_rvalue_const_int(static_cast<int const&&>(0));
+}
+
+
+
+template<typename T>
+void explicit_instantiate_fwdref_with_lvalue_int (T&& p) {
+ static_assert(is_same<T, int&>::value);
+ static_assert(is_same<decltype(p), int&>::value);
+ static_assert(is_same<decltype((p)), int&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void explicit_instantiate_fwdref_with_lvalue_int (T&& p) {
+ fail_if_not_same<T, int&>();
+ fail_if_not_same<decltype(p), int&>();
+ fail_if_not_same<decltype((p)), int&>();
+}
+#pragma omp end declare variant
+
+template<typename T>
+void explicit_instantiate_fwdref_with_lvalue_const_int (T&& p) {
+ static_assert(is_same<T, int const&>::value);
+ static_assert(is_same<decltype(p), int const&>::value);
+ static_assert(is_same<decltype((p)), int const&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void explicit_instantiate_fwdref_with_lvalue_const_int (T&& p) {
+ fail_if_not_same<T, int const&>();
+ fail_if_not_same<decltype(p), int const&>();
+ fail_if_not_same<decltype((p)), int const&>();
+}
+#pragma omp end declare variant
+
+template<typename T>
+void explicit_instantiate_fwdref_with_rvalue_int (T&& p) {
+ static_assert(is_same<T, int&&>::value);
+ static_assert(is_same<decltype(p), int&&>::value);
+ static_assert(is_same<decltype((p)), int&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void explicit_instantiate_fwdref_with_rvalue_int (T&& p) {
+ fail_if_not_same<T, int&&>();
+ fail_if_not_same<decltype(p), int&&>();
+ fail_if_not_same<decltype((p)), int&>();
+}
+#pragma omp end declare variant
+
+template<typename T>
+void explicit_instantiate_fwdref_with_rvalue_const_int (T&& p) {
+ static_assert(is_same<T, int const&&>::value);
+ static_assert(is_same<decltype(p), int const&&>::value);
+ static_assert(is_same<decltype((p)), int const&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void explicit_instantiate_fwdref_with_rvalue_const_int (T&& p) {
+ fail_if_not_same<T, int const&&>();
+ fail_if_not_same<decltype(p), int const&&>();
+ fail_if_not_same<decltype((p)), int const&>();
+}
+#pragma omp end declare variant
+
+/* Technically a missuse of a forwarding reference */
+void explicit_instantiate_fwdref()
+{
+ int lvalue = 0;
+ explicit_instantiate_fwdref_with_lvalue_int<int&>(lvalue);
+ explicit_instantiate_fwdref_with_lvalue_const_int<int const&>(static_cast<int const&>(lvalue));
+ explicit_instantiate_fwdref_with_rvalue_int<int&&>(0); // { dg-bogus "required from here" "PR118791" { xfail *-*-* } }
+ explicit_instantiate_fwdref_with_rvalue_const_int<int const&&>(static_cast<int const&&>(0)); // { dg-bogus "required from here" "PR118791" { xfail *-*-* } }
+}
+
+
+template<typename T>
+void const_lref_passed_lvalue_int (T const& p) {
+ static_assert(is_same<T, int>::value);
+ static_assert(is_same<decltype(p), int const&>::value);
+ static_assert(is_same<decltype((p)), int const&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void const_lref_passed_lvalue_int (T const& p) {
+ fail_if_not_same<T, int>();
+ fail_if_not_same<decltype(p), int const&>();
+ fail_if_not_same<decltype((p)), int const&>();
+}
+#pragma omp end declare variant
+
+template<typename T>
+void const_lref_passed_lvalue_const_int (T const& p) {
+ static_assert(is_same<T, int>::value);
+ static_assert(is_same<decltype(p), int const&>::value);
+ static_assert(is_same<decltype((p)), int const&>::value);
+}
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void const_lref_passed_lvalue_const_int (T const& p) {
+ fail_if_not_same<T, int>();
+ fail_if_not_same<decltype(p), int const&>();
+ fail_if_not_same<decltype((p)), int const&>();
+}
+#pragma omp end declare variant
+
+void instantiate_const_lref()
+{
+ int lvalue = 0;
+ const_lref_passed_lvalue_int(lvalue);
+ const_lref_passed_lvalue_const_int(static_cast<int const&>(lvalue));
+}
diff --git a/gcc/testsuite/g++.dg/gomp/delim-declare-variant-71.C b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-71.C
new file mode 100644
index 0000000..7bd59d0
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/delim-declare-variant-71.C
@@ -0,0 +1,157 @@
+/* { dg-do compile { target c++11 } } */
+
+/* Test static_assert in variants. */
+/* Most of the tests in this file are broken and xfailed.
+ See also delim-declare-variant-41.C for a simpler test case for
+ the "base function cannot be resolved" sorry. */
+
+struct has_value_true { static constexpr bool value = true; };
+
+template<typename T>
+struct always_true {
+ static constexpr bool value = true;
+};
+
+template<typename T>
+void static_assert_in_variant_static_member_uninstantiated (T) { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void static_assert_in_variant_static_member_uninstantiated (T) // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(T::value);
+}
+#pragma omp end declare variant
+
+template<typename T>
+void static_assert_in_variant_static_member_no_param_uninstantiated () { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void static_assert_in_variant_static_member_no_param_uninstantiated () // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(T::value);
+}
+#pragma omp end declare variant
+
+template<typename T>
+void static_assert_in_variant_static_member (T) { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void static_assert_in_variant_static_member (T) // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(T::value);
+}
+#pragma omp end declare variant
+
+template<typename T>
+void static_assert_in_variant_static_member_no_param () { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void static_assert_in_variant_static_member_no_param () // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(T::value);
+}
+#pragma omp end declare variant
+
+void instantiate_static_assert_in_variant_static_member()
+{
+ static_assert_in_variant_static_member(has_value_true{});
+ static_assert_in_variant_static_member_no_param<has_value_true>();
+}
+
+
+template<typename T>
+void static_assert_in_variant_templ_member_uninstantiated (T) { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void static_assert_in_variant_templ_member_uninstantiated (T) // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(always_true<T>::value);
+}
+#pragma omp end declare variant
+
+template<typename T>
+void static_assert_in_variant_templ_member_no_param_uninstantiated () { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void static_assert_in_variant_templ_member_no_param_uninstantiated () // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(always_true<T>::value);
+}
+#pragma omp end declare variant
+
+template<typename T>
+void static_assert_in_variant_templ_member (T) { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void static_assert_in_variant_templ_member (T) // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(always_true<T>::value);
+}
+#pragma omp end declare variant
+
+template<typename T>
+void static_assert_in_variant_templ_member_no_param () { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<typename T>
+void static_assert_in_variant_templ_member_no_param () // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(always_true<T>::value);
+}
+#pragma omp end declare variant
+
+void instantiate_static_assert_in_variant_templ_member()
+{
+ static_assert_in_variant_templ_member(0);
+ static_assert_in_variant_templ_member_no_param<int>();
+}
+
+
+/* PR118530 affects also the non-delimited form of "declare variant". */
+template<bool B>
+void static_assert_in_variant_nttp_uninstantiated () { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<bool B>
+void static_assert_in_variant_nttp_uninstantiated () {
+ static_assert(B);
+}
+#pragma omp end declare variant
+
+template<bool B>
+void static_assert_in_variant_nttp () { } // { dg-bogus "no matching function for call" "PR118530" { xfail *-*-* } }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<bool B>
+void static_assert_in_variant_nttp () {
+ static_assert(B);
+}
+#pragma omp end declare variant
+
+void instantiate_static_assert_in_variant_nttp()
+{
+ static_assert_in_variant_nttp<true>();
+}
+
+
+template<template<typename> class Templ>
+void static_assert_in_variant_template_template_uninstantiated () { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<template<typename> class Templ>
+void static_assert_in_variant_template_template_uninstantiated () // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(Templ<void>::value);
+}
+#pragma omp end declare variant
+
+template<template<typename> class Templ>
+void static_assert_in_variant_template_template () { }
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+template<template<typename> class Templ>
+void static_assert_in_variant_template_template () // { dg-bogus "base function cannot be resolved" "" { xfail *-*-* } }
+{
+ static_assert(Templ<void>::value);
+}
+#pragma omp end declare variant
+
+void instantiate_static_assert_in_variant_template_template()
+{
+ static_assert_in_variant_template_template<always_true>();
+}
diff --git a/gcc/testsuite/gcc.dg/goacc/loop-processing-1.c b/gcc/testsuite/gcc.dg/goacc/loop-processing-1.c
index f6e2515..6e034d1 100644
--- a/gcc/testsuite/gcc.dg/goacc/loop-processing-1.c
+++ b/gcc/testsuite/gcc.dg/goacc/loop-processing-1.c
@@ -9,10 +9,10 @@ void vector_1 (int *ary, int size)
{
#pragma acc loop gang
for (int jx = 0; jx < 1; jx++)
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int ix = 0; ix < size; ix++)
ary[ix] = place ();
}
}
-/* { dg-final { scan-tree-dump {OpenACC loops.*Loop 0\(0\).*Loop 44\(1\).*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, 0, 1, 68\);.*Head-0:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, 0, 1, 68\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_FORK, \.data_dep\.[0-9_]+, 0\);.*Tail-0:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_TAIL_MARK, \.data_dep\.[0-9_]+, 1\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_JOIN, \.data_dep\.[0-9_]+, 0\);.*Loop 6\(6\).*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, 0, 2, 6\);.*Head-0:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, 0, 2, 6\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_FORK, \.data_dep\.[0-9_]+, 1\);.*Head-1:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, \.data_dep\.[0-9_]+, 1\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_FORK, \.data_dep\.[0-9_]+, 2\);.*Tail-1:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_TAIL_MARK, \.data_dep\.[0-9_]+, 2\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_JOIN, \.data_dep\.[0-9_]+, 2\);.*Tail-0:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_TAIL_MARK, \.data_dep\.[0-9_]+, 1\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_JOIN, \.data_dep\.[0-9_]+, 1\);} "oaccloops" } } */
+/* { dg-final { scan-tree-dump {OpenACC loops.*Loop 0\(0\).*Loop [0-9]{2}\(1\).*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, 0, 1, 68\);.*Head-0:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, 0, 1, 68\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_FORK, \.data_dep\.[0-9_]+, 0\);.*Tail-0:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_TAIL_MARK, \.data_dep\.[0-9_]+, 1\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_JOIN, \.data_dep\.[0-9_]+, 0\);.*Loop 6\(6\).*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, 0, 2, 6\);.*Head-0:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, 0, 2, 6\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_FORK, \.data_dep\.[0-9_]+, 1\);.*Head-1:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_HEAD_MARK, \.data_dep\.[0-9_]+, 1\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_FORK, \.data_dep\.[0-9_]+, 2\);.*Tail-1:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_TAIL_MARK, \.data_dep\.[0-9_]+, 2\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_JOIN, \.data_dep\.[0-9_]+, 2\);.*Tail-0:.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_TAIL_MARK, \.data_dep\.[0-9_]+, 1\);.*\.data_dep\.[0-9_]+ = \.UNIQUE \(OACC_JOIN, \.data_dep\.[0-9_]+, 1\);} "oaccloops" } } */
diff --git a/gcc/testsuite/gcc.dg/gomp/adjust-args-1.c b/gcc/testsuite/gcc.dg/gomp/adjust-args-1.c
index 90787ef..a91e7ab 100644
--- a/gcc/testsuite/gcc.dg/gomp/adjust-args-1.c
+++ b/gcc/testsuite/gcc.dg/gomp/adjust-args-1.c
@@ -1,8 +1,6 @@
/* Test parsing of OMP clause adjust_args */
/* { dg-do compile } */
-int b;
-
int f0 (void *a);
int g (void *a);
int f1 (int);
@@ -17,16 +15,27 @@ int f4 (void *a);
int f5 (int a);
#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing) /* { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" } */
int f6 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing:) /* { dg-error "expected identifier before '\\)' token" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing:) /* { dg-error "expected expression before '\\)' token" } */
int f7 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing: z) /* { dg-error "'z' undeclared here \\(not in a function\\)" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing: z) /* { dg-error "'z' is not a function parameter" } */
int f8 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (need_device_ptr: a) /* { dg-error "'a' is not of pointer type" } */
-int f9 (int a);
-#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (nothing: a) adjust_args (nothing: a) /* { dg-error "'a' is specified more than once" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) adjust_args (need_device_ptr: a) /* { dg-note "specified here" } */
+int f9 (int a); /* { dg-error "'a' is not of pointer type" } */
+#pragma omp declare variant (f1) match (construct={dispatch}) \
+ adjust_args (nothing: a) \
+ adjust_args (nothing: a)
int f10 (int a);
-#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (nothing: a) adjust_args (need_device_ptr: a) /* { dg-error "'a' is specified more than once" } */
+/* { dg-note "previously specified here" "" { target *-*-* } .-3 } */
+/* { dg-error "parameter list item specified more than once" "" { target *-*-* } .-3 } */
+#pragma omp declare variant (g) match (construct={dispatch}) \
+ adjust_args (nothing: a) \
+ adjust_args (need_device_ptr: a)
int f11 (void *a);
-#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (need_device_ptr: b) /* { dg-error "'b' is not a function argument" } */
+/* { dg-note "previously specified here" "" { target *-*-* } .-3 } */
+/* { dg-error "parameter list item specified more than once" "" { target *-*-* } .-3 } */
+
+int b;
+
+#pragma omp declare variant (g) match (construct={dispatch}) adjust_args (need_device_ptr: b) /* { dg-error "'b' is not a function parameter" } */
int f12 (void *a);
diff --git a/gcc/testsuite/gcc.dg/gomp/adjust-args-3.c b/gcc/testsuite/gcc.dg/gomp/adjust-args-3.c
new file mode 100644
index 0000000..a9e7fab
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/adjust-args-3.c
@@ -0,0 +1,47 @@
+void f(int*,int *,int*);
+void f0(int*,int *,int*);
+void f1(int*,int *,int*);
+void f2(int*,int *,int*);
+void f3(int*,int *,int*);
+void f4(int*,int *,int*);
+void f5(int*,int *,int*);
+void f6(int*,int *,int*);
+void f7(int*,int *,int*);
+void f8(int*,int *,int*);
+void f9(int*,int *,int*);
+void fa(int*,int *,int*);
+void f10(int*,int *,int*);
+void f11(int*,int *,int*);
+void f12(int*,int *,int*);
+void f13(int*,int *,int*);
+void f14(int*,int *,int*);
+void f15(int*,int *,int*);
+void f16(int*,int *,int*);
+
+#pragma omp declare variant(f) match(construct={dispatch}) adjust_args(x : y) // { dg-error "expected 'nothing' or 'need_device_ptr'" }
+#pragma omp declare variant(f0) match(construct={dispatch}) adjust_args(x) // { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f1) match(construct={dispatch}) adjust_args(x,) // { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f2) match(construct={dispatch}) adjust_args(foo x) // { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f3) match(construct={dispatch}) adjust_args(nothing) // { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f4) match(construct={dispatch}) adjust_args(need_device_ptr) // { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f5) match(construct={dispatch}) adjust_args(nothing x) // { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f6) match(construct={dispatch}) adjust_args(need_device_ptr x) // { dg-error "expected 'nothing' or 'need_device_ptr' followed by ':'" }
+#pragma omp declare variant(f7) match(construct={dispatch}) adjust_args(need_device_addr x) // { dg-error "expected 'nothing' or 'need_device_ptr'" }
+#pragma omp declare variant(f8) match(construct={dispatch}) adjust_args(nothing :) // { dg-error "expected expression before '\\)' token" }
+#pragma omp declare variant(f9) match(construct={dispatch}) adjust_args(need_device_ptr :) // { dg-error "expected expression before '\\)' token" }
+#pragma omp declare variant(fa) match(construct={dispatch}) adjust_args(need_device_addr :) // { dg-error "expected 'nothing' or 'need_device_ptr'" }
+// { dg-note "73: 'need_device_addr' is not valid for C" "" { target *-*-* } .-1 }
+#pragma omp declare variant(f10) match(construct={dispatch}) adjust_args(need_device_ptr : omp_num_args-1) // { dg-error "expected ':' before '\\)' token" }
+// { dg-note "92: an expression is only allowed in a numeric range" "" { target *-*-* } .-1 }
+
+// Valid:
+#pragma omp declare variant(f11) match(construct={dispatch}) adjust_args(nothing : z, 1:2)
+#pragma omp declare variant(f12) match(construct={dispatch}) adjust_args(need_device_ptr : x)
+#pragma omp declare variant(f13) match(construct={dispatch}) adjust_args(need_device_addr : y) // { dg-error "expected 'nothing' or 'need_device_ptr'" }
+// { dg-note "74: 'need_device_addr' is not valid for C" "" { target *-*-* } .-1 }
+#pragma omp declare variant(f14) match(construct={dispatch}) adjust_args(nothing : :)
+#pragma omp declare variant(f15) match(construct={dispatch}) adjust_args(need_device_ptr : 3:3)
+#pragma omp declare variant(f16) match(construct={dispatch}) adjust_args(need_device_addr : 2:2)// { dg-error "expected 'nothing' or 'need_device_ptr'" }
+// { dg-note "74: 'need_device_addr' is not valid for C" "" { target *-*-* } .-1 }
+
+void g(int*x, int *y, int *z);
diff --git a/gcc/testsuite/gcc.dg/gomp/append-args-1.c b/gcc/testsuite/gcc.dg/gomp/append-args-1.c
index 81dd106..743d042 100644
--- a/gcc/testsuite/gcc.dg/gomp/append-args-1.c
+++ b/gcc/testsuite/gcc.dg/gomp/append-args-1.c
@@ -37,8 +37,8 @@ void variant_fn3(); /* { dg-error "argument 1 of 'variant_fn3' must be of 'omp_
#pragma omp declare variant(variant_fn3) match(construct={dispatch}) append_args(interop(target)) \
adjust_args(need_device_ptr: x,y)
void bar3();
-/* { dg-error "'x' undeclared here \\(not in a function\\)" "" { target *-*-* } .-2 } */
-/* { dg-error "'y' undeclared here \\(not in a function\\)" "" { target *-*-* } .-3 } */
+/* { dg-error "'x' is not a function parameter" "" { target *-*-* } .-2 } */
+/* { dg-error "'y' is not a function parameter" "" { target *-*-* } .-3 } */
/* { dg-note "'append_args' specified here" "" { target *-*-* } .-5 } */
@@ -56,7 +56,8 @@ void variant_fn5(omp_interop_t, omp_interop_t);
adjust_args(need_device_ptr: x,y)
void bar5();
/* { dg-error "variant 'variant_fn5' and base 'bar5' have incompatible types" "" { target *-*-* } .-3 } */
-
+/* { dg-error "'x' is not a function parameter" "" { target *-*-* } .-3 } */
+/* { dg-error "'y' is not a function parameter" "" { target *-*-* } .-4 } */
void variant_fn6(omp_interop_t, omp_interop_t);
#pragma omp declare variant(variant_fn6) match(construct={dispatch}) append_args(interop(target))
diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-1.c b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-1.c
new file mode 100644
index 0000000..42d584f
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-1.c
@@ -0,0 +1,26 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+#include <stdlib.h>
+
+int main (void)
+{
+ float *arr = calloc (100, sizeof (float));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j * 3;
+
+#pragma omp target update to(([10][10]) arr[3:2][1:8][0:5])
+// { dg-error "too many array section specifiers for" "" { target *-*-* } .-1 }
+// { dg-error "'#pragma omp target update' must contain at least one 'from' or 'to' clauses" "" { target *-*-* } .-2 }
+
+#pragma omp target exit data map(from: arr[:100])
+
+ free (arr);
+
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-2.c b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-2.c
new file mode 100644
index 0000000..6be3e00
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-2.c
@@ -0,0 +1,24 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+#include <stdlib.h>
+
+int main (void)
+{
+ float *arr = calloc (100, sizeof (float));
+
+ /* This isn't allowed. */
+#pragma omp target enter data map(to: ([10][10]) arr[:100])
+/* { dg-error {expected expression before '\[' token} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target enter data' must contain at least one 'map' clause} "" { target *-*-* } .-2 } */
+
+ /* Nor this. */
+#pragma omp target exit data map(from: ([10][10]) arr[:100])
+/* { dg-error {expected expression before '\[' token} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target exit data' must contain at least one 'map' clause} "" { target *-*-* } .-2 } */
+
+ free (arr);
+
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-3.c b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-3.c
new file mode 100644
index 0000000..1715b8f
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-3.c
@@ -0,0 +1,30 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+#include <stdlib.h>
+
+extern float* baz(void*);
+
+int main (void)
+{
+ float *arr = calloc (100, sizeof (float));
+ int c = 50;
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j * 3;
+
+ /* No array shaping inside a function call. */
+#pragma omp target update to(baz(([10][10]) arr))
+/* { dg-error {expected expression before '\[' token} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 } */
+
+#pragma omp target exit data map(from: arr[:100])
+
+ free (arr);
+
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-4.c b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-4.c
new file mode 100644
index 0000000..cebefd3
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-4.c
@@ -0,0 +1,27 @@
+// { dg-do compile }
+
+#include <string.h>
+#include <assert.h>
+#include <stdlib.h>
+
+int main (void)
+{
+ float *arr = calloc (100, sizeof (float));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j * 3;
+
+ /* No array shaping inside a statement expression. */
+#pragma omp target update to( ({ int d = 10; ([d][d]) arr; }) )
+/* { dg-error {expected expression before '\[' token} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 } */
+
+#pragma omp target exit data map(from: arr[:100])
+
+ free (arr);
+
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-5.c b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-5.c
new file mode 100644
index 0000000..e1c4991
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-5.c
@@ -0,0 +1,17 @@
+// { dg-do compile }
+
+struct S {
+ void *pp;
+};
+
+int main()
+{
+ int *sub1;
+
+ /* No array section inside compound literal. */
+#pragma omp target update to( (struct S) { .pp = ([10][10]) sub1 } )
+/* { dg-error {expected expression before '\[' token} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 } */
+
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-6.c b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-6.c
new file mode 100644
index 0000000..d282d85
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-6.c
@@ -0,0 +1,26 @@
+// { dg-do compile }
+
+int main (void)
+{
+ char *ptr;
+
+#pragma omp target update to(([5][6][7]) ptr[0:4][0:7][0:7])
+/* { dg-error {length '7' above array section size in 'to' clause} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 } */
+
+#pragma omp target update to(([5][6][7]) ptr[1:5][0:6][0:7])
+/* { dg-error {high bound '6' above array section size in 'to' clause} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 } */
+
+#pragma omp target update from(([100]) ptr[3:33:3])
+
+#pragma omp target update from(([100]) ptr[4:33:3])
+/* { dg-error {high bound '101' above array section size in 'from' clause} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 } */
+
+#pragma omp target update to(([10][10]) ptr[0:9:-1][0:9])
+/* { dg-error {length '9' with stride '-1' above array section size in 'to' clause} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 } */
+
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-7.c b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-7.c
new file mode 100644
index 0000000..233d8da
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/bad-array-shaping-c-7.c
@@ -0,0 +1,15 @@
+/* { dg-do compile } */
+
+int cond;
+
+int main (void)
+{
+ int *arr;
+
+ /* No array shaping inside conditional operator. */
+#pragma omp target update to(cond ? ([3][9]) arr : ([2][7]) arr)
+/* { dg-error {expected expression before '\[' token} "" { target *-*-* } .-1 } */
+/* { dg-error {'#pragma omp target update' must contain at least one 'from' or 'to' clauses} "" { target *-*-* } .-2 } */
+
+ return 0;
+}
diff --git a/gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c b/gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c
new file mode 100644
index 0000000..efc9c13
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/declare-mapper-10.c
@@ -0,0 +1,61 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+// "omp declare mapper" support -- check expansion in gimple.
+
+#include <stdlib.h>
+
+struct S {
+ int *ptr;
+ int size;
+};
+
+#define N 64
+
+#pragma omp declare mapper (struct S w) map(w.size, w.ptr, w.ptr[:w.size])
+#pragma omp declare mapper (foo:struct S w) map(to:w.size, w.ptr) \
+ map(w.ptr[:w.size])
+
+int main (int argc, char *argv[])
+{
+ struct S s;
+ s.ptr = (int *) malloc (sizeof (int) * N);
+ s.size = N;
+
+#pragma omp declare mapper (bar:struct S w) map(w.size, w.ptr, w.ptr[:w.size])
+
+#pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+#pragma omp target map(tofrom: s)
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+#pragma omp target map(mapper(default), tofrom: s)
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+#pragma omp target map(mapper(foo), alloc: s)
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+#pragma omp target map(mapper(bar), tofrom: s)
+ {
+ for (int i = 0; i < N; i++)
+ s.ptr[i]++;
+ }
+
+ return 0;
+}
+
+/* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 2\]\) map\(tofrom:s\.ptr \[len: [0-9]+\]\) map\(tofrom:s\.size \[len: [0-9]+\]\) map\(tofrom:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} 4 "gimple" { target c++ } } } */
+/* { dg-final { scan-tree-dump-times {map\(struct:s \[len: 2\]\) map\(to:s\.ptr \[len: [0-9]+\]\) map\(to:s\.size \[len: [0-9]+\]\) map\(alloc:\*_[0-9]+ \[len: _[0-9]+\]\) map\(attach:s\.ptr \[bias: 0\]\)} 1 "gimple" { target c++ } } } */
diff --git a/gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c b/gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c
new file mode 100644
index 0000000..927065e
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/declare-mapper-11.c
@@ -0,0 +1,33 @@
+// { dg-do compile }
+
+// Error-checking tests for "omp declare mapper".
+
+typedef struct {
+ int *ptr;
+ int size;
+} S;
+
+typedef struct {
+ int z;
+} Z;
+
+int main (int argc, char *argv[])
+{
+#pragma omp declare mapper (S v) map(v.size, v.ptr[:v.size])
+/* { dg-error "previous '#pragma omp declare mapper'" "" { target c } .-1 } */
+
+ /* This one's a duplicate. */
+#pragma omp declare mapper (default: S v) map (to: v.size) map (v)
+/* { dg-error "redeclaration of '<default>' '#pragma omp declare mapper' for type 'S'" "" { target c } .-1 } */
+
+ /* ...and this one doesn't use a "base language identifier" for the mapper
+ name. */
+#pragma omp declare mapper (case: S v) map (to: v.size)
+/* { dg-error "expected identifier or 'default'" "" { target c } .-1 } */
+
+ /* A non-struct/class/union type isn't supposed to work. */
+#pragma omp declare mapper (name:Z [5]foo) map (foo[0].z)
+/* { dg-error "'Z\\\[5\\\]' is not a struct or union type in '#pragma omp declare mapper'" "" { target c } .-1 } */
+
+ return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-reduction.f90 b/gcc/testsuite/gfortran.dg/goacc/array-reduction.f90
index 5c489ff..f521bcc 100644
--- a/gcc/testsuite/gfortran.dg/goacc/array-reduction.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/array-reduction.f90
@@ -1,39 +1,42 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
program test
implicit none
integer a(10), i
a(:) = 0
-
+
! Array reductions.
-
- !$acc parallel reduction (+:a) ! { dg-error "Array 'a' is not permitted in reduction" }
+
+ !$acc parallel reduction (+:a)
do i = 1, 10
a = a + 1
end do
!$acc end parallel
!$acc parallel
- !$acc loop reduction (+:a) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a)
do i = 1, 10
a = a + 1
end do
!$acc end parallel
!$acc kernels
- !$acc loop reduction (+:a) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a)
do i = 1, 10
a = a + 1
end do
!$acc end kernels
- !$acc serial reduction (+:a) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc serial reduction (+:a)
do i = 1, 10
a = a + 1
end do
!$acc end serial
!$acc serial
- !$acc loop reduction (+:a) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a)
do i = 1, 10
a = a + 1
end do
@@ -41,35 +44,35 @@ program test
! Subarray reductions.
-
- !$acc parallel reduction (+:a(1:5)) ! { dg-error "Array 'a' is not permitted in reduction" }
+
+ !$acc parallel reduction (+:a(1:5))
do i = 1, 10
a = a + 1
end do
!$acc end parallel
!$acc parallel
- !$acc loop reduction (+:a(1:5)) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a(1:5))
do i = 1, 10
a = a + 1
end do
!$acc end parallel
!$acc kernels
- !$acc loop reduction (+:a(1:5)) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a(1:5))
do i = 1, 10
a = a + 1
end do
!$acc end kernels
- !$acc serial reduction (+:a(1:5)) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc serial reduction (+:a(1:5))
do i = 1, 10
a = a + 1
end do
!$acc end serial
!$acc serial
- !$acc loop reduction (+:a(1:5)) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a(1:5))
do i = 1, 10
a = a + 1
end do
@@ -77,35 +80,35 @@ program test
! Reductions on array elements.
-
- !$acc parallel reduction (+:a(1)) ! { dg-error "Array 'a' is not permitted in reduction" }
+
+ !$acc parallel reduction (+:a(1))
do i = 1, 10
a(1) = a(1) + 1
end do
!$acc end parallel
!$acc parallel
- !$acc loop reduction (+:a(1)) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a(1))
do i = 1, 10
a(1) = a(1) + 1
end do
!$acc end parallel
!$acc kernels
- !$acc loop reduction (+:a(1)) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a(1))
do i = 1, 10
a(1) = a(1) + 1
end do
!$acc end kernels
-
- !$acc serial reduction (+:a(1)) ! { dg-error "Array 'a' is not permitted in reduction" }
+
+ !$acc serial reduction (+:a(1))
do i = 1, 10
a(1) = a(1) + 1
end do
!$acc end serial
!$acc serial
- !$acc loop reduction (+:a(1)) ! { dg-error "Array 'a' is not permitted in reduction" }
+ !$acc loop reduction (+:a(1))
do i = 1, 10
a(1) = a(1) + 1
end do
@@ -114,3 +117,7 @@ program test
print *, a
end program test
+
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc loop private\\(i\\) reduction\\(\\+:MEM.*\\\[.*&a.*\\\]\\)" 9 "gimple" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_parallel reduction\\(\\+:MEM.*\\\[.*&a.*\\\]\\) map\\(tofrom:a \\\[len: \[0-9\]+\\\]\\)" 3 "gimple" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_serial reduction\\(\\+:MEM.*\\\[.*&a.*\\\]\\) map\\(tofrom:a \\\[len: \[0-9\]+\\\]\\)" 3 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/assumed-size.f90 b/gcc/testsuite/gfortran.dg/goacc/assumed-size.f90
new file mode 100644
index 0000000..12f44c4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/assumed-size.f90
@@ -0,0 +1,35 @@
+! Test if implicitly determined data clauses work with an
+! assumed-sized array variable. Note that the array variable, 'a',
+! has been explicitly copied in and out via acc enter data and acc
+! exit data, respectively.
+
+! This does not appear to be supported by the OpenACC standard as of version
+! 3.0. There is however real-world code that relies on this working, so we
+! make an attempt to support it.
+
+program test
+ implicit none
+
+ integer, parameter :: n = 100
+ integer a(n), i
+
+ call dtest (a, n)
+
+ do i = 1, n
+ if (a(i) /= i) call abort
+ end do
+end program test
+
+subroutine dtest (a, n)
+ integer i, n
+ integer a(*)
+
+ !$acc enter data copyin(a(1:n))
+
+ !$acc parallel loop
+ do i = 1, n
+ a(i) = i
+ end do
+
+ !$acc exit data copyout(a(1:n))
+end subroutine dtest
diff --git a/gcc/testsuite/gfortran.dg/goacc/common-block-3.f90 b/gcc/testsuite/gfortran.dg/goacc/common-block-3.f90
index 4861a64..dc222c6 100644
--- a/gcc/testsuite/gfortran.dg/goacc/common-block-3.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/common-block-3.f90
@@ -52,13 +52,13 @@ end program main
! { dg-final { scan-tree-dump-times "omp target oacc_parallel .*map\\(tofrom:c \\\[len: 4\\\]\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "omp target oacc_data_kernels .*map\\(force_tofrom:i \\\[len: 4\\\]\\)" 1 "omplower" } }
-! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_present:i \\\[len: 4\\\]\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_present:i \\\[len: 4\\\].*\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "omp target oacc_data_kernels .*map\\(tofrom:x \\\[len: 400\\\]\\)" 1 "omplower" } }
-! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_present:x \\\[len: 400\\\]\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_present:x \\\[len: 400\\\].*\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "omp target oacc_data_kernels .*map\\(tofrom:y \\\[len: 400\\\]\\\)" 1 "omplower" } }
-! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_present:y \\\[len: 400\\\]\\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_present:y \\\[len: 400\\\].*\\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "omp target oacc_data_kernels .*map\\(force_tofrom:c \\\[len: 4\\\]\\)" 1 "omplower" } }
-! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_present:c \\\[len: 4\\\]\\)" 1 "omplower" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_kernels .*map\\(force_present:c \\\[len: 4\\\].*\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "omp target oacc_serial .*map\\(tofrom:a \\\[len: 400\\\]\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "omp target oacc_serial .*map\\(tofrom:b \\\[len: 400\\\]\\\)" 1 "omplower" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-3.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-3.f95
index 9127cba..c94f515 100644
--- a/gcc/testsuite/gfortran.dg/goacc/declare-3.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-3.f95
@@ -38,8 +38,7 @@ program test
use mod_b
use mod_d
use mod_e
-
- ! { dg-final { scan-tree-dump {(?n)#pragma acc data map\(force_alloc:d\) map\(force_to:b\) map\(force_alloc:a\)$} original } }
+ ! { dg-final { scan-tree-dump {(?n)#pragma acc data map\(force_alloc:d\) map\(to:b\) map\(alloc:a\)$} original } }
end program test
! { dg-final { scan-tree-dump-times {#pragma acc data} 1 original } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-allocatable-1.f90 b/gcc/testsuite/gfortran.dg/goacc/declare-allocatable-1.f90
new file mode 100644
index 0000000..5349e0d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-allocatable-1.f90
@@ -0,0 +1,25 @@
+! Verify that OpenACC declared allocatable arrays have implicit
+! OpenACC enter and exit pragmas at the time of allocation and
+! deallocation.
+
+! { dg-additional-options "-fdump-tree-original" }
+
+program allocate
+ implicit none
+ integer, allocatable :: a(:), b
+ integer, parameter :: n = 100
+ integer i
+ !$acc declare create(a,b)
+
+ allocate (a(n), b)
+
+ !$acc parallel loop copyout(a, b)
+ do i = 1, n
+ a(i) = b
+ end do
+
+ deallocate (a, b)
+end program allocate
+
+! { dg-final { scan-tree-dump-times "pragma acc enter data map.declare_allocate" 2 "original" } }
+! { dg-final { scan-tree-dump-times "pragma acc exit data map.declare_deallocate" 2 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data-2.f90 b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data-2.f90
index 6a16c8a..a835937 100644
--- a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data-2.f90
@@ -9,17 +9,17 @@ type(t) :: var
allocate (var%arr(1:100))
!$acc enter data copyin(var%arr(10:20))
-! { dg-final { scan-tree-dump-times {(?n)#pragma acc enter data map\(to:\*\(integer\(kind=[0-9]+\)\[0:\] \*\) parm\.[0-9]+\.data \[len: D.[0-9]+ \* [0-9]+\]\) map\(to:var\.arr \[pointer set, len: [0-9]+\]\) map\(attach_detach:var\.arr\.data \[bias: \(integer\(kind=[0-9]+\)\) parm\.[0-9]+\.data - \(integer\(kind=[0-9]+\)\) var\.arr\.data\]\);$} 1 "original" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma acc enter data map\(to:\*\(integer\(kind=[0-9]+\)\[0:\] \*\) parm\.[0-9]+\.data \[len: D.[0-9]+ \* [0-9]+\]\) map\(to:var\.arr \[pointer set, len: [0-9]+\]\) map\(attach_detach:var\.arr\.data \[bias: D.[0-9]+\]\);$} 1 "original" } }
!$acc exit data delete(var%arr(10:20))
-! { dg-final { scan-tree-dump-times {(?n)#pragma acc exit data map\(release:\*\(integer\(kind=[0-9]+\)\[0:\] \*\) parm\.[0-9]+\.data \[len: D\.[0-9]+ \* [0-9]+\]\) map\(release:var\.arr \[pointer set, len: [0-9]+\]\) map\(attach_detach:var\.arr\.data \[bias: \(integer\(kind=[0-9]+\)\) parm\.[0-9]+\.data - \(integer\(kind=[0-9]+\)\) var\.arr\.data\]\);$} 1 "original" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma acc exit data map\(release:\*\(integer\(kind=[0-9]+\)\[0:\] \*\) parm\.[0-9]+\.data \[len: D\.[0-9]+ \* [0-9]+\]\) map\(release:var\.arr \[pointer set, len: [0-9]+\]\) map\(attach_detach:var\.arr\.data \[bias: D.[0-9]+\]\);$} 1 "original" } }
!$acc enter data create(var%arr(20:30))
-! { dg-final { scan-tree-dump-times {(?n)#pragma acc enter data map\(alloc:\*\(integer\(kind=[0-9]+\)\[0:\] \*\) parm\.[0-9]+\.data \[len: D\.[0-9]+ \* [0-9]+\]\) map\(to:var\.arr \[pointer set, len: [0-9]+\]\) map\(attach_detach:var\.arr\.data \[bias: \(integer\(kind=[0-9]+\)\) parm\.[0-9]+\.data - \(integer\(kind=[0-9]+\)\) var\.arr\.data\]\);$} 1 "original" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma acc enter data map\(alloc:\*\(integer\(kind=[0-9]+\)\[0:\] \*\) parm\.[0-9]+\.data \[len: D\.[0-9]+ \* [0-9]+\]\) map\(to:var\.arr \[pointer set, len: [0-9]+\]\) map\(attach_detach:var\.arr\.data \[bias: D.[0-9]+\]\);$} 1 "original" } }
!$acc exit data finalize delete(var%arr(20:30))
-! { dg-final { scan-tree-dump-times {(?n)#pragma acc exit data map\(release:\*\(integer\(kind=[0-9]+\)\[0:\] \*\) parm\.[0-9]+\.data \[len: D\.[0-9]+ \* [0-9]+\]\) map\(release:var\.arr \[pointer set, len: [0-9]+\]\) map\(attach_detach:var\.arr\.data \[bias: \(integer\(kind=[0-9]+\)\) parm\.[0-9]+\.data - \(integer\(kind=[0-9]+\)\) var\.arr\.data\]\) finalize;$} 1 "original" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma acc exit data map\(release:\*\(integer\(kind=[0-9]+\)\[0:\] \*\) parm\.[0-9]+\.data \[len: D\.[0-9]+ \* [0-9]+\]\) map\(release:var\.arr \[pointer set, len: [0-9]+\]\) map\(attach_detach:var\.arr\.data \[bias: D.[0-9]+\]\) finalize;$} 1 "original" } }
!$acc enter data copyin(var%arr)
diff --git a/gcc/testsuite/gfortran.dg/goacc/finalize-1.f b/gcc/testsuite/gfortran.dg/goacc/finalize-1.f
index 63beb47..b34c070 100644
--- a/gcc/testsuite/gfortran.dg/goacc/finalize-1.f
+++ b/gcc/testsuite/gfortran.dg/goacc/finalize-1.f
@@ -20,7 +20,7 @@
! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_exit_data map\\(delete:del_f \\\[len: \[0-9\]+\\\]\\) finalize$" 1 "gimple" } }
!$ACC EXIT DATA FINALIZE DELETE (del_f_p(2:5))
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(release:\\*\\(integer\\(kind=.\\)\\\[0:\\\] \\*\\) parm\\.0\\.data \\\[len: \[^\\\]\]+\\\]\\) map\\(release:del_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:\\(integer\\(kind=1\\)\\\[0:\\\] \\* restrict\\) del_f_p\\.data \\\[pointer assign, bias: \\(.*int.*\\) parm\\.0\\.data - \\(.*int.*\\) del_f_p\\.data\\\]\\) finalize;$" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(release:\\*\\(integer\\(kind=.\\)\\\[0:\\\] \\*\\) parm\\.0\\.data \\\[len: \[^\\\]\]+\\\]\\) map\\(release:del_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:\\(integer\\(kind=1\\)\\\[0:\\\] \\* restrict\\) del_f_p\\.data \\\[pointer assign, bias: D.\[0-9\]+\\\]\\) finalize;$" 1 "original" } }
! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_exit_data map\\(delete:MEM <\[^>\]+> \\\[\\(integer\\(kind=.\\)\\\[0:\\\] \\*\\)_\[0-9\]+\\\] \\\[len: \[^\\\]\]+\\\]\\) map\\(delete:del_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:del_f_p\\.data \\\[pointer assign, bias: \[^\\\]\]+\\\]\\) finalize$" 1 "gimple" } }
!$ACC EXIT DATA COPYOUT (cpo_r)
@@ -32,6 +32,6 @@
! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_exit_data map\\(force_from:cpo_f \\\[len: \[0-9\]+\\\]\\) finalize$" 1 "gimple" } }
!$ACC EXIT DATA COPYOUT (cpo_f_p(4:10)) FINALIZE
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(from:\\*\\(integer\\(kind=.\\)\\\[0:\\\] \\*\\) parm\\.1\\.data \\\[len: \[^\\\]\]+\\\]\\) map\\(release:cpo_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:\\(integer\\(kind=1\\)\\\[0:\\\] \\* restrict\\) cpo_f_p\\.data \\\[pointer assign, bias: \\(.*int.*\\) parm\\.1\\.data - \\(.*int.*\\) cpo_f_p\\.data\\\]\\) finalize;$" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc exit data map\\(from:\\*\\(integer\\(kind=.\\)\\\[0:\\\] \\*\\) parm\\.1\\.data \\\[len: \[^\\\]\]+\\\]\\) map\\(release:cpo_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:\\(integer\\(kind=1\\)\\\[0:\\\] \\* restrict\\) cpo_f_p\\.data \\\[pointer assign, bias: D.\[0-9\]+\\\]\\) finalize;$" 1 "original" } }
! { dg-final { scan-tree-dump-times "(?n)#pragma omp target oacc_exit_data map\\(force_from:MEM <\[^>\]+> \\\[\\(integer\\(kind=.\\)\\\[0:\\\] \\*\\)_\[0-9\]+\\\] \\\[len: \[^\\\]\]+\\\]\\) map\\(delete:cpo_f_p \\\[pointer set, len: \[0-9\]+\\\]\\) map\\(alloc:cpo_f_p\\.data \\\[pointer assign, bias: \[^\\\]\]+\\\]\\) finalize$" 1 "gimple" } }
END SUBROUTINE f
diff --git a/gcc/testsuite/gfortran.dg/goacc/implied-copy-1.f90 b/gcc/testsuite/gfortran.dg/goacc/implied-copy-1.f90
index 7f07c8a..b7f2faa 100644
--- a/gcc/testsuite/gfortran.dg/goacc/implied-copy-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/implied-copy-1.f90
@@ -29,7 +29,7 @@ subroutine test
!$acc end kernels loop
end subroutine test
-! { dg-final { scan-tree-dump-times "map\\(force_tofrom:s \\\[len: \[0-9\]+\\\]\\)" 1 "gimple" } }
-! { dg-final { scan-tree-dump-times "map\\(force_tofrom:p \\\[len: \[0-9\]+\\\]\\)" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(force_tofrom:s \\\[len: \[0-9\]+\\\].*\\)" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(force_tofrom:p \\\[len: \[0-9\]+\\\].*\\)" 1 "gimple" } }
! { dg-final { scan-tree-dump-times "map\\(tofrom:s \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } }
! { dg-final { scan-tree-dump-times "map\\(tofrom:p \\\[len: \[0-9\]+\\\]\\)" 2 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/kernels-decompose-1.f95 b/gcc/testsuite/gfortran.dg/goacc/kernels-decompose-1.f95
index 1a26844..dc823b7 100644
--- a/gcc/testsuite/gfortran.dg/goacc/kernels-decompose-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/kernels-decompose-1.f95
@@ -77,7 +77,7 @@ program main
!$acc end kernels
end program main
-! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_kernels map\(to:a\[_[0-9]+\] \[len: _[0-9]+\]\) map\(alloc:a \[pointer assign, bias: _[0-9]+\]\) map\(tofrom:sum \[len: [0-9]+\]\)$} 1 "gimple" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_kernels map\(to:a\[D.[0-9]+\] \[len: _[0-9]+\]\) map\(alloc:a \[pointer assign, bias: D.[0-9]+\]\) map\(tofrom:sum \[len: [0-9]+\]\)$} 1 "gimple" } }
! { dg-final { scan-tree-dump-times {(?n)#pragma acc loop private\(i\)$} 2 "gimple" } }
! { dg-final { scan-tree-dump-times {(?n)#pragma acc loop private\(i\) independent$} 1 "gimple" } }
@@ -86,11 +86,11 @@ end program main
! Check that the OpenACC 'kernels' got decomposed into 'data' and an enclosed
! sequence of compute constructs.
-! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_data_kernels map\(to:a\[_[0-9]+\] \[len: _[0-9]+\]\) map\(tofrom:sum \[len: [0-9]+\]\)$} 1 "omp_oacc_kernels_decompose" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_data_kernels map\(to:a\[D.[0-9]+\] \[len: _[0-9]+\]\) map\(tofrom:sum \[len: [0-9]+\]\)$} 1 "omp_oacc_kernels_decompose" } }
! As noted above, we get three "old-style" kernel regions, one gang-single region, and one parallelized loop region.
-! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_kernels async\(-1\) map\(force_present:a\[_[0-9]+\] \[len: _[0-9]+\]\) map\(alloc:a \[pointer assign, bias: _[0-9]+\]\) map\(force_present:sum \[len: [0-9]+\]\)$} 3 "omp_oacc_kernels_decompose" } }
-! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_parallel_kernels_parallelized async\(-1\) map\(force_present:a\[_[0-9]+\] \[len: _[0-9]+\]\) map\(alloc:a \[pointer assign, bias: _[0-9]+\]\) map\(force_present:sum \[len: [0-9]+\]\)$} 1 "omp_oacc_kernels_decompose" } }
-! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_parallel_kernels_gang_single async\(-1\) num_gangs\(1\) map\(force_present:a\[_[0-9]+\] \[len: _[0-9]+\]\) map\(alloc:a \[pointer assign, bias: _[0-9]+\]\) map\(force_present:sum \[len: [0-9]+\]\)$} 1 "omp_oacc_kernels_decompose" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_kernels async\(-1\) map\(force_present:a\[D.[0-9]+\] \[len: _[0-9]+\]\) map\(alloc:a \[pointer assign, bias: D.[0-9]+\]\) map\(force_present:sum \[len: [0-9]+\]\)$} 3 "omp_oacc_kernels_decompose" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_parallel_kernels_parallelized async\(-1\) map\(force_present:a\[D.[0-9]+\] \[len: _[0-9]+\]\) map\(alloc:a \[pointer assign, bias: D.[0-9]+\]\) map\(force_present:sum \[len: [0-9]+\]\)$} 1 "omp_oacc_kernels_decompose" } }
+! { dg-final { scan-tree-dump-times {(?n)#pragma omp target oacc_parallel_kernels_gang_single async\(-1\) num_gangs\(1\) map\(force_present:a\[D.[0-9]+\] \[len: _[0-9]+\]\) map\(alloc:a \[pointer assign, bias: D.[0-9]+\]\) map\(force_present:sum \[len: [0-9]+\]\)$} 1 "omp_oacc_kernels_decompose" } }
!
! 'data' plus five CCs.
! { dg-final { scan-tree-dump-times {(?n)#pragma omp target } 6 "omp_oacc_kernels_decompose" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95
index afc8a27..6542515 100644
--- a/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95
@@ -29,7 +29,7 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc loop tile(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc loop tile(i) ! { dg-error "constant expression" }
@@ -82,7 +82,7 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc kernels loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc kernels loop tile(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc kernels loop tile(i) ! { dg-error "constant expression" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95
index 4bfca74..dae8f66 100644
--- a/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95
@@ -20,7 +20,7 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc loop tile(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc loop tile(i) ! { dg-error "constant expression" }
@@ -73,7 +73,7 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc parallel loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc parallel loop tile(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc parallel loop tile(i) ! { dg-error "constant expression" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95
index 79d8d1b..2e0a7a0 100644
--- a/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95
@@ -20,7 +20,7 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc loop tile(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc loop tile(i) ! { dg-error "constant expression" }
@@ -73,7 +73,7 @@ program test
DO j = 1,10
ENDDO
ENDDO
- !$acc serial loop tile(-1) ! { dg-warning "must be positive" }
+ !$acc serial loop tile(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc serial loop tile(i) ! { dg-error "constant expression" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-auto-1.f90 b/gcc/testsuite/gfortran.dg/goacc/loop-auto-1.f90
new file mode 100644
index 0000000..8d600f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-auto-1.f90
@@ -0,0 +1,88 @@
+! Ensure that the auto clause falls back to seq parallelism when the
+! OpenACC loop is not explicitly independent.
+
+! { dg-additional-options "-fopt-info-optimized-omp" }
+
+program test
+ implicit none
+ integer, parameter :: n = 100
+ integer i, j, k, l
+
+ !$acc parallel loop auto ! { dg-message "optimized: assigned OpenACC seq loop parallelism" }
+ do i = 1, n
+ !$acc loop auto independent ! { dg-message "optimized: assigned OpenACC gang loop parallelism" }
+ do j = 1, n
+ !$acc loop worker vector ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" }
+ do k = 1, n
+ end do
+ end do
+ end do
+
+ !$acc parallel loop auto independent ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" }
+ do i = 1, n
+ !$acc loop auto ! { dg-message "optimized: assigned OpenACC seq loop parallelism" }
+ do j = 1, n
+ !$acc loop auto ! { dg-message "optimized: assigned OpenACC seq loop parallelism" }
+ do k = 1, n
+ !$acc loop auto independent ! { dg-message "optimized: assigned OpenACC vector loop parallelism" }
+ do l = 1, n
+ end do
+ end do
+ end do
+ end do
+
+ !$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" }
+ do i = 1, n
+ !$acc loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" }
+ do j = 1, n
+ !$acc loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" }
+ do k = 1, n
+ !$acc loop auto independent ! { dg-message "optimized: assigned OpenACC seq loop parallelism" }
+ ! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 }
+ do l = 1, n
+ end do
+ !$acc loop auto ! { dg-message "optimized: assigned OpenACC seq loop parallelism" }
+ do l = 1, n
+ end do
+ end do
+ end do
+ end do
+
+
+ !$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" }
+ ! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 }
+ do i = 1, n
+ !$acc loop gang worker ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" }
+ do j = 1, n
+ !$acc loop auto ! { dg-message "optimized: assigned OpenACC seq loop parallelism" }
+ do k = 1, n
+ !$acc loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" }
+ do l = 1, n
+ end do
+ end do
+ !$acc loop auto independent ! { dg-message "optimized: assigned OpenACC vector loop parallelism" }
+ do l = 1, n
+ end do
+ end do
+ !$acc loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" }
+ do j = 1, n
+ !$acc loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" }
+ do k = 1, n
+ end do
+ end do
+ end do
+
+ !$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" }
+ do i = 1, n
+ !$acc loop ! { dg-message "optimized: assigned OpenACC worker loop parallelism" }
+ do j = 1, n
+ !$acc loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" }
+ ! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 }
+ do k = 1, n
+ !$acc loop ! { dg-message "optimized: assigned OpenACC vector loop parallelism" }
+ do l = 1, n
+ end do
+ end do
+ end do
+ end do
+end program test
diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-tree-1.f90 b/gcc/testsuite/gfortran.dg/goacc/loop-tree-1.f90
index 150f930..4b2b49f 100644
--- a/gcc/testsuite/gfortran.dg/goacc/loop-tree-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/loop-tree-1.f90
@@ -44,4 +44,4 @@ end program test
! { dg-final { scan-tree-dump-times "private\\(m\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "reduction\\(\\+:sum\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "map\\(tofrom:sum \\\[len: \[0-9\]+\\\]\\)" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(tofrom:sum \\\[len: \[0-9\]+\\\] \\\[runtime_implicit\\\]\\)" 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/modules.f95 b/gcc/testsuite/gfortran.dg/goacc/modules.f95
index 1e8d826..42e715e 100644
--- a/gcc/testsuite/gfortran.dg/goacc/modules.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/modules.f95
@@ -18,8 +18,7 @@ SUBROUTINE reduction_kernel(x_min,x_max,y_min,y_max,arr,sum)
!$ACC DATA PRESENT(arr) COPY(sum)
!$ACC PARALLEL LOOP REDUCTION(+ : sum)
- ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
DO k=y_min,y_max
DO j=x_min,x_max
sum=sum*arr(j,k)
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr70828.f90 b/gcc/testsuite/gfortran.dg/goacc/pr70828.f90
new file mode 100644
index 0000000..648bad8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr70828.f90
@@ -0,0 +1,22 @@
+! Ensure that pointer mappings are preserved in nested parallel
+! constructs.
+
+! { dg-additional-options "-fdump-tree-gimple" }
+
+program test
+ integer, parameter :: n = 100
+ integer i, data(n)
+
+ data(:) = 0
+
+ !$acc data copy(data(5:n-10))
+ !$acc parallel loop
+ do i = 10, n - 10
+ data(i) = i
+ end do
+ !$acc end parallel loop
+ !$acc end data
+end program test
+
+! { dg-final { scan-tree-dump-times "omp target oacc_data map\\(tofrom:data\\\[D\\.\[0-9\]+\\\] \\\[len: _\[0-9\]+\\\]\\) map\\(alloc:data \\\[pointer assign, bias: D\\.\[0-9\]+\\\]\\)" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "omp target oacc_parallel map\\(force_present:data\\\[D\\.\[0-9\]+\\\] \\\[len: D\\.\[0-9\]+\\\]\\) map\\(alloc:data \\\[pointer assign, bias: D\\.\[0-9\]+\\\]\\)" 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/private-explicit-kernels-1.f95 b/gcc/testsuite/gfortran.dg/goacc/private-explicit-kernels-1.f95
index 5d563d2..f54b244 100644
--- a/gcc/testsuite/gfortran.dg/goacc/private-explicit-kernels-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/private-explicit-kernels-1.f95
@@ -30,7 +30,7 @@ program test
!$acc kernels ! Explicit "private(i0_1)" clause cannot be specified here.
! { dg-final { scan-tree-dump-times "private\\(i0_1\\)" 1 "original" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(i0_1\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
- ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i0_1 \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { xfail *-*-* } } } ! PR90067
+ ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i0_1 \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { target *-*-* } } }
do i0_1 = 1, 100
end do
!$acc end kernels
@@ -40,7 +40,7 @@ program test
! { dg-final { scan-tree-dump-times "private\\(j0_2\\)" 1 "original" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(i0_2\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(j0_2\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
- ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:j0_2 \\\[len: \[0-9\]+\\\]\\) map\\(force_tofrom:i0_2 \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { xfail *-*-* } } } ! PR90067
+ ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:j0_2 \\\[len: \[0-9\]+\\\]\\) map\\(force_tofrom:i0_2 \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { target *-*-* } } }
do i0_2 = 1, 100
do j0_2 = 1, 100
end do
@@ -82,7 +82,7 @@ program test
!$acc kernels ! Explicit "private(i2_2_s)" clause cannot be specified here.
! { dg-final { scan-tree-dump-times "private\\(i2_2_s\\)" 1 "original" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(i2_2_s\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
- ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i2_2_s \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { xfail *-*-* } } } ! PR90067
+ ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i2_2_s \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { target *-*-* } } }
do i2_2_s = 1, 100
!$acc loop private(j2_2_s) independent
! { dg-final { scan-tree-dump-times "#pragma acc loop private\\(j2_2_s\\) independent" 1 "original" } }
@@ -231,7 +231,7 @@ program test
!$acc kernels ! Explicit "private(i3_5_s)" clause cannot be specified here.
! { dg-final { scan-tree-dump-times "private\\(i3_5_s\\)" 1 "original" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(i3_5_s\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
- ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i3_5_s \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { xfail *-*-* } } } ! PR90067
+ ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i3_5_s \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { target *-*-* } } }
do i3_5_s = 1, 100
!$acc loop private(j3_5_s) independent
! { dg-final { scan-tree-dump-times "#pragma acc loop private\\(j3_5_s\\) independent" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/private-predetermined-kernels-1.f95 b/gcc/testsuite/gfortran.dg/goacc/private-predetermined-kernels-1.f95
index 12a7854..49b41a5 100644
--- a/gcc/testsuite/gfortran.dg/goacc/private-predetermined-kernels-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/private-predetermined-kernels-1.f95
@@ -30,7 +30,7 @@ program test
!$acc kernels
! { dg-final { scan-tree-dump-times "private\\(i0_1\\)" 1 "original" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(i0_1\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
- ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i0_1 \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { xfail *-*-* } } } ! PR90067
+ ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i0_1 \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { target *-*-* } } }
do i0_1 = 1, 100
end do
!$acc end kernels
@@ -40,7 +40,7 @@ program test
! { dg-final { scan-tree-dump-times "private\\(j0_2\\)" 1 "original" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(i0_2\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(j0_2\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
- ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:j0_2 \\\[len: \[0-9\]+\\\]\\) map\\(force_tofrom:i0_2 \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { xfail *-*-* } } } ! PR90067
+ ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:j0_2 \\\[len: \[0-9\]+\\\]\\) map\\(force_tofrom:i0_2 \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { target *-*-* } } }
do i0_2 = 1, 100
do j0_2 = 1, 100
end do
@@ -82,7 +82,7 @@ program test
!$acc kernels
! { dg-final { scan-tree-dump-times "private\\(i2_2_s\\)" 1 "original" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(i2_2_s\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
- ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i2_2_s \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { xfail *-*-* } } } ! PR90067
+ ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i2_2_s \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { target *-*-* } } }
do i2_2_s = 1, 100
!$acc loop independent
! { dg-final { scan-tree-dump-times "#pragma acc loop private\\(j2_2_s\\) independent" 1 "original" } }
@@ -231,7 +231,7 @@ program test
!$acc kernels
! { dg-final { scan-tree-dump-times "private\\(i3_5_s\\)" 1 "original" { xfail *-*-* } } } ! PR90067
! { dg-final { scan-tree-dump-times "private\\(i3_5_s\\)" 1 "gimple" { xfail *-*-* } } } ! PR90067
- ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i3_5_s \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { xfail *-*-* } } } ! PR90067
+ ! { dg-final { scan-tree-dump-times "#pragma omp target oacc_kernels map\\(force_tofrom:i3_5_s \\\[len: \[0-9\]+\\\]\\)" 0 "gimple" { target *-*-* } } }
do i3_5_s = 1, 100
!$acc loop independent
! { dg-final { scan-tree-dump-times "#pragma acc loop private\\(j3_5_s\\) independent" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f90 b/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f90
index ad5e11a..c3fc774 100644
--- a/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute-loop.f90
@@ -40,7 +40,8 @@ contains
! (See C/C++ example.)
a = g (i, j, a, c)
- ! { dg-warning {'a' is used uninitialized} TODO { xfail *-*-* } .-1 }
+ ! { dg-warning {'a\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
+ ! { dg-note {'a\.[0-9]+' was declared here} "" { target *-*-* } l_loop$c_loop }
x = a
!$acc atomic write
y = a
@@ -51,9 +52,6 @@ contains
! { dg-note {variable 'j\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_compute$c_compute }
! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'j\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
- ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
- ! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
- ! { dg-note {variable 'a' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'x' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'y' in 'private' clause is candidate for adjusting OpenACC privatization level} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'C\.[0-9]+' declared in block potentially has improper OpenACC privatization level: 'const_decl'} "TODO" { target *-*-* } l_loop$c_loop }
diff --git a/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute.f90 b/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute.f90
index 68d084d..d4d548a 100644
--- a/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/privatization-1-compute.f90
@@ -37,12 +37,12 @@ contains
! (See C/C++ example.)
a = g (i, j, a, c)
- ! { dg-warning {'i' is used uninitialized} {} { target *-*-* } .-1 }
- ! { dg-note {'i' was declared here} {} { target *-*-* } l_function$c_function }
- ! { dg-warning {'j' is used uninitialized} {} { target *-*-* } .-3 }
- ! { dg-note {'j' was declared here} {} { target *-*-* } l_function$c_function }
- ! { dg-warning {'a' is used uninitialized} {} { target *-*-* } .-5 }
- ! { dg-note {'a' was declared here} {} { target *-*-* } l_function$c_function }
+ ! { dg-warning {'i\.[0-9]+' is used uninitialized} {} { target *-*-* } .-1 }
+ ! { dg-note {'i\.[0-9]+' was declared here} {} { target *-*-* } l_compute$c_compute }
+ ! { dg-warning {'j\.[0-9]+' is used uninitialized} {} { target *-*-* } .-3 }
+ ! { dg-note {'j\.[0-9]+' was declared here} {} { target *-*-* } l_compute$c_compute }
+ ! { dg-warning {'a\.[0-9]+' is used uninitialized} {} { target *-*-* } .-5 }
+ ! { dg-note {'a\.[0-9]+' was declared here} {} { target *-*-* } l_compute$c_compute }
x = a
!$acc atomic write ! ... to force 'TREE_ADDRESSABLE'.
y = a
diff --git a/gcc/testsuite/gfortran.dg/goacc/readonly-1.f90 b/gcc/testsuite/gfortran.dg/goacc/readonly-1.f90
index fc1e271..cad449e 100644
--- a/gcc/testsuite/gfortran.dg/goacc/readonly-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/readonly-1.f90
@@ -80,16 +80,16 @@ end program main
! The front end turns OpenACC 'declare' into OpenACC 'data'.
! { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(readonly,to:\\*b\\) map\\(alloc:b.+ map\\(to:\\*c\\) map\\(alloc:c.+" 1 "original" } }
! { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(readonly,to:g\\) map\\(to:h\\)" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc parallel map\\(readonly,to:\\*.+ map\\(alloc:a.+ map\\(readonly,to:\\*.+ map\\(alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc parallel map\\(readonly,to:a.+ map\\(alloc:a.+ map\\(readonly,to:b.+ map\\(alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc kernels map\\(readonly,to:\\*.+ map\\(alloc:a.+ map\\(readonly,to:\\*.+ map\\(alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc kernels map\\(readonly,to:a.+ map\\(alloc:a.+ map\\(readonly,to:b.+ map\\(alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc serial map\\(readonly,to:\\*.+ map\\(alloc:a.+ map\\(readonly,to:\\*.+ map\\(alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc serial map\\(readonly,to:a.+ map\\(alloc:a.+ map\\(readonly,to:b.+ map\\(alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(readonly,to:\\*.+ map\\(alloc:a.+ map\\(readonly,to:\\*.+ map\\(alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(readonly,to:a.+ map\\(alloc:a.+ map\\(readonly,to:b.+ map\\(alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc enter data map\\(readonly,to:\\*.+ map\\(alloc:a.+ map\\(readonly,to:\\*.+ map\\(alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
-! { dg-final { scan-tree-dump-times "(?n)#pragma acc enter data map\\(readonly,to:a.+ map\\(alloc:a.+ map\\(readonly,to:b.+ map\\(alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc parallel map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc parallel map\\(readonly,to:a.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:b.+ map\\(pt_readonly,alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc kernels map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc kernels map\\(readonly,to:a.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:b.+ map\\(pt_readonly,alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc serial map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc serial map\\(readonly,to:a.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:b.+ map\\(pt_readonly,alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc data map\\(readonly,to:a.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:b.+ map\\(pt_readonly,alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc enter data map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:\\*.+ map\\(pt_readonly,alloc:b.+ map\\(to:\\*.+ map\\(alloc:c.+" 1 "original" } }
+! { dg-final { scan-tree-dump-times "(?n)#pragma acc enter data map\\(readonly,to:a.+ map\\(pt_readonly,alloc:a.+ map\\(readonly,to:b.+ map\\(pt_readonly,alloc:b.+ map\\(to:c.+ map\\(alloc:c.+" 1 "original" } }
! { dg-final { scan-tree-dump-times "(?n)#pragma acc cache \\(readonly:\\*\\(integer\\(kind=4\\)\\\[0:\\\] \\*\\) parm.*data \\\[len: .+\\\]\\) \\(readonly:\\*\\(integer\\(kind=4\\)\\\[0:\\\] \\*\\) parm.*data \\\[len: .+\\\]\\);" 8 "original" } }
! { dg-final { scan-tree-dump-times "(?n)#pragma acc cache \\(\\*\\(integer\\(kind=4\\)\\\[0:\\\] \\*\\) parm.*data \\\[len: .+\\\]\\);" 8 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
index 2d9a111..4ab180a 100644
--- a/gcc/testsuite/gfortran.dg/goacc/reduction.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/reduction.f95
@@ -25,19 +25,14 @@ save i2
common /blk/ i1
!$acc parallel reduction (+:ia2)
-! { dg-error "Array 'ia2' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end parallel
!$acc parallel reduction (+:ra1)
-! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end parallel
!$acc parallel reduction (+:ca1)
-! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end parallel
!$acc parallel reduction (+:da1)
-! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end parallel
!$acc parallel reduction (.and.:la1)
-! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end parallel
!$acc parallel reduction (+:i3, r1, d1, c1)
!$acc end parallel
@@ -73,104 +68,84 @@ common /blk/ i1
!$acc parallel reduction (*:ia1) ! { dg-error "Assumed size" }
! { dg-error "Array 'ia1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end parallel
-!$acc parallel reduction (+:l1) ! { dg-error "OMP DECLARE REDUCTION \\+ not found for type LOGICAL" }
+!$acc parallel reduction (+:l1) ! { dg-error "Reduction operator \\+ is not valid for 'l1'" }
!$acc end parallel
-!$acc parallel reduction (*:la1) ! { dg-error "OMP DECLARE REDUCTION \\* not found for type LOGICAL" }
-! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (*:la1) ! { dg-error "Reduction operator \\* is not valid for 'la1'" }
!$acc end parallel
-!$acc parallel reduction (-:a1) ! { dg-error "OMP DECLARE REDUCTION - not found for type CHARACTER" }
+!$acc parallel reduction (-:a1) ! { dg-error "Reduction operator - is not valid for 'a1'" }
!$acc end parallel
-!$acc parallel reduction (+:t1) ! { dg-error "OMP DECLARE REDUCTION \\+ not found for type TYPE" }
+!$acc parallel reduction (+:t1)
!$acc end parallel
-!$acc parallel reduction (*:ta1) ! { dg-error "OMP DECLARE REDUCTION \\* not found for type TYPE" }
-! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (*:ta1)
!$acc end parallel
-!$acc parallel reduction (.and.:i3) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type INTEGER" }
+!$acc parallel reduction (.and.:i3) ! { dg-error "Reduction operator \\.and\\. is not valid for 'i3'" }
!$acc end parallel
-!$acc parallel reduction (.or.:ia2) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type INTEGER" }
-! { dg-error "Array 'ia2' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (.or.:ia2) ! { dg-error "Reduction operator \\.or\\. is not valid for 'ia2'" }
!$acc end parallel
-!$acc parallel reduction (.eqv.:r1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type REAL" }
+!$acc parallel reduction (.eqv.:r1) ! { dg-error "Reduction operator \\.eqv\\. is not valid for 'r1'" }
!$acc end parallel
-!$acc parallel reduction (.neqv.:ra1) ! { dg-error "OMP DECLARE REDUCTION \\.neqv\\. not found for type REAL" }
-! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (.neqv.:ra1) ! { dg-error "Reduction operator \\.neqv. is not valid for 'ra1'" }
!$acc end parallel
-!$acc parallel reduction (.and.:d1) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type REAL" }
+!$acc parallel reduction (.and.:d1) ! { dg-error "Reduction operator \\.and\\. is not valid for 'd1'" }
!$acc end parallel
-!$acc parallel reduction (.or.:da1) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type REAL" }
-! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (.or.:da1) ! { dg-error "Reduction operator \\.or\\. is not valid for 'da1'" }
!$acc end parallel
-!$acc parallel reduction (.eqv.:c1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type COMPLEX" }
+!$acc parallel reduction (.eqv.:c1) ! { dg-error "Reduction operator \\.eqv\\. is not valid for 'c1'" }
!$acc end parallel
-!$acc parallel reduction (.neqv.:ca1) ! { dg-error "OMP DECLARE REDUCTION \\.neqv\\. not found for type COMPLEX" }
-! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (.neqv.:ca1) ! { dg-error "Reduction operator \\.neqv\\. is not valid for 'ca1'" }
!$acc end parallel
-!$acc parallel reduction (.and.:a1) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type CHARACTER" }
+!$acc parallel reduction (.and.:a1) ! { dg-error "Reduction operator \\.and\\. is not valid for 'a1'" }
!$acc end parallel
-!$acc parallel reduction (.or.:t1) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type TYPE" }
+!$acc parallel reduction (.or.:t1) ! { dg-error "Reduction operator \\.or\\. is not valid for 't1'" }
!$acc end parallel
-!$acc parallel reduction (.eqv.:ta1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type TYPE" }
-! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (.eqv.:ta1) ! { dg-error "Reduction operator \\.eqv\\. is not valid for 'ta1'" }
!$acc end parallel
-!$acc parallel reduction (min:c1) ! { dg-error "OMP DECLARE REDUCTION min not found for type COMPLEX" }
+!$acc parallel reduction (min:c1) ! { dg-error "Reduction operator min is not valid for 'c1'" }
!$acc end parallel
-!$acc parallel reduction (max:ca1) ! { dg-error "OMP DECLARE REDUCTION max not found for type COMPLEX" }
-! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (max:ca1) ! { dg-error "Reduction operator max is not valid for 'ca1'" }
!$acc end parallel
-!$acc parallel reduction (max:l1) ! { dg-error "OMP DECLARE REDUCTION max not found for type LOGICAL" }
+!$acc parallel reduction (max:l1) ! { dg-error "Reduction operator max is not valid for 'l1'" }
!$acc end parallel
-!$acc parallel reduction (min:la1) ! { dg-error "OMP DECLARE REDUCTION min not found for type LOGICAL" }
-! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (min:la1) ! { dg-error "Reduction operator min is not valid for 'la1'" }
!$acc end parallel
-!$acc parallel reduction (max:a1) ! { dg-error "OMP DECLARE REDUCTION max not found for type CHARACTER" }
+!$acc parallel reduction (max:a1) ! { dg-error "Reduction operator max is not valid for 'a1'" }
!$acc end parallel
-!$acc parallel reduction (min:t1) ! { dg-error "OMP DECLARE REDUCTION min not found for type TYPE" }
+!$acc parallel reduction (min:t1)
!$acc end parallel
-!$acc parallel reduction (max:ta1) ! { dg-error "OMP DECLARE REDUCTION max not found for type TYPE" }
-! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (max:ta1)
!$acc end parallel
-!$acc parallel reduction (iand:r1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type REAL" }
+!$acc parallel reduction (iand:r1) ! { dg-error "Reduction operator iand is not valid for 'r1'" }
!$acc end parallel
-!$acc parallel reduction (ior:ra1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type REAL" }
-! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (ior:ra1) ! { dg-error "Reduction operator ior is not valid for 'ra1'" }
!$acc end parallel
-!$acc parallel reduction (ieor:d1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type REAL" }
+!$acc parallel reduction (ieor:d1) ! { dg-error "Reduction operator ieor is not valid for 'd1'" }
!$acc end parallel
-!$acc parallel reduction (ior:da1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type REAL" }
-! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (ior:da1) ! { dg-error "Reduction operator ior is not valid for 'da1'" }
!$acc end parallel
-!$acc parallel reduction (iand:c1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type COMPLEX" }
+!$acc parallel reduction (iand:c1) ! { dg-error "Reduction operator iand is not valid for 'c1'" }
!$acc end parallel
-!$acc parallel reduction (ior:ca1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type COMPLEX" }
-! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (ior:ca1) ! { dg-error "Reduction operator ior is not valid for 'ca1'" }
!$acc end parallel
-!$acc parallel reduction (ieor:l1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type LOGICAL" }
+!$acc parallel reduction (ieor:l1) ! { dg-error "Reduction operator ieor is not valid for 'l1'" }
!$acc end parallel
-!$acc parallel reduction (iand:la1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type LOGICAL" }
-! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (iand:la1) ! { dg-error "Reduction operator iand is not valid for 'la1'" }
!$acc end parallel
-!$acc parallel reduction (ior:a1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type CHARACTER" }
+!$acc parallel reduction (ior:a1) ! { dg-error "Reduction operator ior is not valid for 'a1'" }
!$acc end parallel
-!$acc parallel reduction (ieor:t1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type TYPE" }
+!$acc parallel reduction (ieor:t1)
!$acc end parallel
-!$acc parallel reduction (iand:ta1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type TYPE" }
-! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc parallel reduction (iand:ta1)
!$acc end parallel
!$acc serial reduction (+:ia2)
-! { dg-error "Array 'ia2' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end serial
!$acc serial reduction (+:ra1)
-! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end serial
!$acc serial reduction (+:ca1)
-! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end serial
!$acc serial reduction (+:da1)
-! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end serial
!$acc serial reduction (.and.:la1)
-! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end serial
!$acc serial reduction (+:i3, r1, d1, c1)
!$acc end serial
@@ -206,88 +181,73 @@ common /blk/ i1
!$acc serial reduction (*:ia1) ! { dg-error "Assumed size" }
! { dg-error "Array 'ia1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
!$acc end serial
-!$acc serial reduction (+:l1) ! { dg-error "OMP DECLARE REDUCTION \\+ not found for type LOGICAL" }
+!$acc serial reduction (+:l1) ! { dg-error "Reduction operator \\+ is not valid for 'l1'" }
!$acc end serial
-!$acc serial reduction (*:la1) ! { dg-error "OMP DECLARE REDUCTION \\* not found for type LOGICAL" }
-! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (*:la1) ! { dg-error "Reduction operator \\* is not valid for 'la1'" }
!$acc end serial
-!$acc serial reduction (-:a1) ! { dg-error "OMP DECLARE REDUCTION - not found for type CHARACTER" }
+!$acc serial reduction (-:a1) ! { dg-error "Reduction operator - is not valid for 'a1'" }
!$acc end serial
-!$acc serial reduction (+:t1) ! { dg-error "OMP DECLARE REDUCTION \\+ not found for type TYPE" }
+!$acc serial reduction (+:t1)
!$acc end serial
-!$acc serial reduction (*:ta1) ! { dg-error "OMP DECLARE REDUCTION \\* not found for type TYPE" }
-! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (*:ta1)
!$acc end serial
-!$acc serial reduction (.and.:i3) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type INTEGER" }
+!$acc serial reduction (.and.:i3) ! { dg-error "Reduction operator \\.and\\. is not valid for 'i3'" }
!$acc end serial
-!$acc serial reduction (.or.:ia2) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type INTEGER" }
-! { dg-error "Array 'ia2' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (.or.:ia2) ! { dg-error "Reduction operator \\.or\\. is not valid for 'ia2'" }
!$acc end serial
-!$acc serial reduction (.eqv.:r1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type REAL" }
+!$acc serial reduction (.eqv.:r1) ! { dg-error "Reduction operator \\.eqv\\. is not valid for 'r1'" }
!$acc end serial
-!$acc serial reduction (.neqv.:ra1) ! { dg-error "OMP DECLARE REDUCTION \\.neqv\\. not found for type REAL" }
-! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (.neqv.:ra1) ! { dg-error "Reduction operator \\.neqv\\. is not valid for 'ra1'" }
!$acc end serial
-!$acc serial reduction (.and.:d1) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type REAL" }
+!$acc serial reduction (.and.:d1) ! { dg-error "Reduction operator \\.and\\. is not valid for 'd1'" }
!$acc end serial
-!$acc serial reduction (.or.:da1) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type REAL" }
-! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (.or.:da1) ! { dg-error "Reduction operator \\.or\\. is not valid for 'da1'" }
!$acc end serial
-!$acc serial reduction (.eqv.:c1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type COMPLEX" }
+!$acc serial reduction (.eqv.:c1) ! { dg-error "Reduction operator \\.eqv\\. is not valid for 'c1'" }
!$acc end serial
-!$acc serial reduction (.neqv.:ca1) ! { dg-error "OMP DECLARE REDUCTION \\.neqv\\. not found for type COMPLEX" }
-! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (.neqv.:ca1) ! { dg-error "Reduction operator \\.neqv\\. is not valid for 'ca1'" }
!$acc end serial
-!$acc serial reduction (.and.:a1) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type CHARACTER" }
+!$acc serial reduction (.and.:a1) ! { dg-error "Reduction operator \\.and\\. is not valid for 'a1'" }
!$acc end serial
-!$acc serial reduction (.or.:t1) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type TYPE" }
+!$acc serial reduction (.or.:t1) ! { dg-error "Reduction operator \\.or\\. is not valid for 't1'" }
!$acc end serial
-!$acc serial reduction (.eqv.:ta1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type TYPE" }
-! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (.eqv.:ta1) ! { dg-error "Reduction operator \\.eqv\\. is not valid for 'ta1'" }
!$acc end serial
-!$acc serial reduction (min:c1) ! { dg-error "OMP DECLARE REDUCTION min not found for type COMPLEX" }
+!$acc serial reduction (min:c1) ! { dg-error "Reduction operator min is not valid for 'c1'" }
!$acc end serial
-!$acc serial reduction (max:ca1) ! { dg-error "OMP DECLARE REDUCTION max not found for type COMPLEX" }
-! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (max:ca1) ! { dg-error "Reduction operator max is not valid for 'ca1'" }
!$acc end serial
-!$acc serial reduction (max:l1) ! { dg-error "OMP DECLARE REDUCTION max not found for type LOGICAL" }
+!$acc serial reduction (max:l1) ! { dg-error "Reduction operator max is not valid for 'l1'" }
!$acc end serial
-!$acc serial reduction (min:la1) ! { dg-error "OMP DECLARE REDUCTION min not found for type LOGICAL" }
-! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (min:la1) ! { dg-error "Reduction operator min is not valid for 'la1'" }
!$acc end serial
-!$acc serial reduction (max:a1) ! { dg-error "OMP DECLARE REDUCTION max not found for type CHARACTER" }
+!$acc serial reduction (max:a1) ! { dg-error "Reduction operator max is not valid for 'a1'" }
!$acc end serial
-!$acc serial reduction (min:t1) ! { dg-error "OMP DECLARE REDUCTION min not found for type TYPE" }
+!$acc serial reduction (min:t1)
!$acc end serial
-!$acc serial reduction (max:ta1) ! { dg-error "OMP DECLARE REDUCTION max not found for type TYPE" }
-! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (max:ta1)
!$acc end serial
-!$acc serial reduction (iand:r1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type REAL" }
+!$acc serial reduction (iand:r1) ! { dg-error "Reduction operator iand is not valid for 'r1'" }
!$acc end serial
-!$acc serial reduction (ior:ra1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type REAL" }
-! { dg-error "Array 'ra1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (ior:ra1) ! { dg-error "Reduction operator ior is not valid for 'ra1'" }
!$acc end serial
-!$acc serial reduction (ieor:d1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type REAL" }
+!$acc serial reduction (ieor:d1) ! { dg-error "Reduction operator ieor is not valid for 'd1'" }
!$acc end serial
-!$acc serial reduction (ior:da1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type REAL" }
-! { dg-error "Array 'da1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (ior:da1) ! { dg-error "Reduction operator ior is not valid for 'da1'" }
!$acc end serial
-!$acc serial reduction (iand:c1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type COMPLEX" }
+!$acc serial reduction (iand:c1) ! { dg-error "Reduction operator iand is not valid for 'c1'" }
!$acc end serial
-!$acc serial reduction (ior:ca1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type COMPLEX" }
-! { dg-error "Array 'ca1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (ior:ca1) ! { dg-error "Reduction operator ior is not valid for 'ca1'" }
!$acc end serial
-!$acc serial reduction (ieor:l1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type LOGICAL" }
+!$acc serial reduction (ieor:l1) ! { dg-error "Reduction operator ieor is not valid for 'l1'" }
!$acc end serial
-!$acc serial reduction (iand:la1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type LOGICAL" }
-! { dg-error "Array 'la1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (iand:la1) ! { dg-error "Reduction operator iand is not valid for 'la1'" }
!$acc end serial
-!$acc serial reduction (ior:a1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type CHARACTER" }
+!$acc serial reduction (ior:a1) ! { dg-error "Reduction operator ior is not valid for 'a1'" }
!$acc end serial
-!$acc serial reduction (ieor:t1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type TYPE" }
+!$acc serial reduction (ieor:t1)
!$acc end serial
-!$acc serial reduction (iand:ta1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type TYPE" }
-! { dg-error "Array 'ta1' is not permitted in reduction" "" { target "*-*-*" } .-1 }
+!$acc serial reduction (iand:ta1)
!$acc end serial
end subroutine
diff --git a/gcc/testsuite/gfortran.dg/goacc/sie.f95 b/gcc/testsuite/gfortran.dg/goacc/sie.f95
index 78b4601..c424b4c 100644
--- a/gcc/testsuite/gfortran.dg/goacc/sie.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/sie.f95
@@ -107,10 +107,10 @@ program test
!$acc parallel num_gangs(i+1)
!$acc end parallel
- !$acc parallel num_gangs(-1) ! { dg-warning "must be positive" }
+ !$acc parallel num_gangs(-1) ! { dg-error "must be positive" }
!$acc end parallel
- !$acc parallel num_gangs(0) ! { dg-warning "must be positive" }
+ !$acc parallel num_gangs(0) ! { dg-error "must be positive" }
!$acc end parallel
!$acc parallel num_gangs() ! { dg-error "Invalid character in name" }
@@ -135,10 +135,10 @@ program test
!$acc kernels num_gangs(i+1)
!$acc end kernels
- !$acc kernels num_gangs(-1) ! { dg-warning "must be positive" }
+ !$acc kernels num_gangs(-1) ! { dg-error "must be positive" }
!$acc end kernels
- !$acc kernels num_gangs(0) ! { dg-warning "must be positive" }
+ !$acc kernels num_gangs(0) ! { dg-error "must be positive" }
!$acc end kernels
!$acc kernels num_gangs() ! { dg-error "Invalid character in name" }
@@ -164,10 +164,10 @@ program test
!$acc parallel num_workers(i+1)
!$acc end parallel
- !$acc parallel num_workers(-1) ! { dg-warning "must be positive" }
+ !$acc parallel num_workers(-1) ! { dg-error "must be positive" }
!$acc end parallel
- !$acc parallel num_workers(0) ! { dg-warning "must be positive" }
+ !$acc parallel num_workers(0) ! { dg-error "must be positive" }
!$acc end parallel
!$acc parallel num_workers() ! { dg-error "Invalid expression after 'num_workers\\('" }
@@ -192,10 +192,10 @@ program test
!$acc kernels num_workers(i+1)
!$acc end kernels
- !$acc kernels num_workers(-1) ! { dg-warning "must be positive" }
+ !$acc kernels num_workers(-1) ! { dg-error "must be positive" }
!$acc end kernels
- !$acc kernels num_workers(0) ! { dg-warning "must be positive" }
+ !$acc kernels num_workers(0) ! { dg-error "must be positive" }
!$acc end kernels
!$acc kernels num_workers() ! { dg-error "Invalid expression after 'num_workers\\('" }
@@ -221,10 +221,10 @@ program test
!$acc parallel vector_length(i+1)
!$acc end parallel
- !$acc parallel vector_length(-1) ! { dg-warning "must be positive" }
+ !$acc parallel vector_length(-1) ! { dg-error "must be positive" }
!$acc end parallel
- !$acc parallel vector_length(0) ! { dg-warning "must be positive" }
+ !$acc parallel vector_length(0) ! { dg-error "must be positive" }
!$acc end parallel
!$acc parallel vector_length() ! { dg-error "Invalid expression after 'vector_length\\('" }
@@ -249,10 +249,10 @@ program test
!$acc kernels vector_length(i+1)
!$acc end kernels
- !$acc kernels vector_length(-1) ! { dg-warning "must be positive" }
+ !$acc kernels vector_length(-1) ! { dg-error "must be positive" }
!$acc end kernels
- !$acc kernels vector_length(0) ! { dg-warning "must be positive" }
+ !$acc kernels vector_length(0) ! { dg-error "must be positive" }
!$acc end kernels
!$acc kernels vector_length() ! { dg-error "Invalid expression after 'vector_length\\('" }
@@ -279,10 +279,10 @@ program test
!$acc loop gang(i+1)
do i = 1,10
enddo
- !$acc loop gang(-1) ! { dg-warning "must be positive" }
+ !$acc loop gang(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
- !$acc loop gang(0) ! { dg-warning "must be positive" }
+ !$acc loop gang(0) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc loop gang() ! { dg-error "Invalid character in name" }
@@ -311,10 +311,10 @@ program test
!$acc loop worker(i+1)
do i = 1,10
enddo
- !$acc loop worker(-1) ! { dg-warning "must be positive" }
+ !$acc loop worker(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
- !$acc loop worker(0) ! { dg-warning "must be positive" }
+ !$acc loop worker(0) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc loop worker() ! { dg-error "Invalid character in name" }
@@ -343,10 +343,10 @@ program test
!$acc loop vector(i+1)
do i = 1,10
enddo
- !$acc loop vector(-1) ! { dg-warning "must be positive" }
+ !$acc loop vector(-1) ! { dg-error "must be positive" }
do i = 1,10
enddo
- !$acc loop vector(0) ! { dg-warning "must be positive" }
+ !$acc loop vector(0) ! { dg-error "must be positive" }
do i = 1,10
enddo
!$acc loop vector() ! { dg-error "Invalid character in name" }
diff --git a/gcc/testsuite/gfortran.dg/goacc/tile-1.f90 b/gcc/testsuite/gfortran.dg/goacc/tile-1.f90
index f609b12..9ef7521 100644
--- a/gcc/testsuite/gfortran.dg/goacc/tile-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/tile-1.f90
@@ -44,17 +44,17 @@ subroutine parloop
do i = 1, n
end do
- !$acc parallel loop tile(-3) ! { dg-warning "must be positive" }
+ !$acc parallel loop tile(-3) ! { dg-error "must be positive" }
do i = 1, n
end do
- !$acc parallel loop tile(10, -3) ! { dg-warning "must be positive" }
+ !$acc parallel loop tile(10, -3) ! { dg-error "must be positive" }
do i = 1, n
do j = 1, n
end do
end do
- !$acc parallel loop tile(-100, 10, 5) ! { dg-warning "must be positive" }
+ !$acc parallel loop tile(-100, 10, 5) ! { dg-error "must be positive" }
do i = 1, n
do j = 1, n
do k = 1, n
@@ -114,7 +114,7 @@ subroutine par
end do
end do
- !$acc loop tile(-2) ! { dg-warning "must be positive" }
+ !$acc loop tile(-2) ! { dg-error "must be positive" }
do i = 1, n
end do
@@ -195,7 +195,7 @@ subroutine kern
end do
end do
- !$acc loop tile(-2) ! { dg-warning "must be positive" }
+ !$acc loop tile(-2) ! { dg-error "must be positive" }
do i = 1, n
end do
@@ -295,17 +295,17 @@ subroutine kernsloop
do i = 1, n
end do
- !$acc kernels loop tile(-3) ! { dg-warning "must be positive" }
+ !$acc kernels loop tile(-3) ! { dg-error "must be positive" }
do i = 1, n
end do
- !$acc kernels loop tile(10, -3) ! { dg-warning "must be positive" }
+ !$acc kernels loop tile(10, -3) ! { dg-error "must be positive" }
do i = 1, n
do j = 1, n
end do
end do
- !$acc kernels loop tile(-100, 10, 5) ! { dg-warning "must be positive" }
+ !$acc kernels loop tile(-100, 10, 5) ! { dg-error "must be positive" }
do i = 1, n
do j = 1, n
do k = 1, n
diff --git a/gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90 b/gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90
index e644fd7..95b039e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/adjust-args-14.f90
@@ -14,7 +14,7 @@ contains
! { dg-error "19: Argument 'y' at .1. to list item in 'need_device_addr' at .2. must not have the VALUE attribute" "" { target *-*-* } 8 }
! { dg-error "62: Argument 'y' at .1. to list item in 'need_device_addr' at .2. must not have the VALUE attribute" "" { target *-*-* } 9 }
-! { dg-message "sorry, unimplemented: 'need_device_addr' not yet supported" "" { target *-*-* } 9 }
+
! { dg-error "Argument 'z' at .1. to list item in 'need_device_ptr' at .2. must be a scalar of TYPE\\(C_PTR\\)" "" { target *-*-* } 8 }
! { dg-error "Argument 'z' at .1. to list item in 'need_device_ptr' at .2. must be a scalar of TYPE\\(C_PTR\\)" "" { target *-*-* } 10 }
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90
index 8bc6b76..0463f0e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90
@@ -24,6 +24,10 @@ module omp_lib_kinds
parameter :: omp_pteam_mem_alloc = 7
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_thread_mem_alloc = 8
+
+ integer, parameter :: omp_memspace_handle_kind = c_intptr_t
+ integer (omp_memspace_handle_kind), &
+ parameter :: omp_default_mem_space = 0
end module
subroutine bar (a, b, c)
@@ -80,7 +84,8 @@ subroutine foo(x, y)
!$omp target teams distribute parallel do private (x) firstprivate (y) &
!$omp allocate ((omp_default_mem_alloc + 0):z) allocate &
- !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r)
+ !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r) &
+ !$omp uses_allocators(memspace(omp_default_mem_space) : h)
do i = 1, 10
call bar (0, x, z);
call bar2 (1, y, r);
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90
new file mode 100644
index 0000000..7bf30df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-1.f90
@@ -0,0 +1,71 @@
+! { dg-do compile }
+
+! Basic "!$omp declare mapper" parsing tests.
+
+module mymod
+type s
+ integer :: c
+ integer :: d(99)
+ integer, dimension(100,100) :: e
+end type s
+
+!$omp declare mapper (s :: x) map(tofrom: x%c, x%d)
+!$omp declare mapper (withaname : s :: x) map(from: x%d(2:30))
+!$omp declare mapper (withaname2 : s :: x) map(from: x%d(5))
+!$omp declare mapper (named: s :: x) map(tofrom: x%e(:,3))
+!$omp declare mapper (named2: s :: x) map(tofrom: x%e(5,:))
+
+end module mymod
+
+program myprog
+use mymod, only: s
+type t
+ integer :: a
+ integer :: b
+end type t
+
+type u
+ integer :: q
+end type u
+
+type deriv
+ integer :: arr(100)
+ integer :: len
+end type deriv
+
+type(t) :: y
+type(s) :: z
+type(u) :: p
+type(deriv) :: d
+integer, dimension(100,100) :: i2d
+
+!$omp declare mapper (t :: x) map(tofrom: x%a) map(y%b)
+!$omp declare mapper (named: t :: x) map(tofrom: x%a) map(y%b)
+!$omp declare mapper (integer :: x) ! { dg-error "\\\!\\\$OMP DECLARE MAPPER with non-derived type" }
+
+!$omp declare mapper (deriv :: x) map(tofrom: x%len) &
+!$omp & map(tofrom: x%arr(:))
+
+!$omp target map(tofrom: z%e(:,5))
+!$omp end target
+
+!$omp target map(mapper(named), tofrom: y)
+!$omp end target
+
+!$omp target
+y%a = y%b
+!$omp end target
+
+d%len = 10
+
+!$omp target
+d%arr(5) = 13
+!$omp end target
+
+!$omp target map(tofrom: z)
+!$omp end target
+
+!$omp target map(mapper(withaname), from: z) map(tofrom:p%q)
+!$omp end target
+
+end program myprog
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90
new file mode 100644
index 0000000..8ae7393
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-14.f90
@@ -0,0 +1,26 @@
+program myprog
+type T
+integer :: arr1(10)
+integer :: arr2(10)
+end type T
+
+type U
+integer :: arr1(10)
+end type U
+
+type V
+integer :: arr1(10)
+end type V
+
+!$omp declare mapper (default: T :: x) map(to:x%arr1) map(from:x%arr2) ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER" }
+!$omp declare mapper (T :: x) map(to:x%arr1) ! { dg-error "Redefinition of \\\!\\\$OMP DECLARE MAPPER" }
+
+! Check what happens if we're SHOUTING too.
+!$omp declare mapper (default: U :: x) map(to:x%arr1) ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER" }
+!$omp declare mapper (DEFAULT: U :: x) map(to:x%arr1) ! { dg-error "Redefinition of \\\!\\\$OMP DECLARE MAPPER" }
+
+! Or if we're using a keyword (which should be fine).
+!$omp declare mapper (V :: x) map(alloc:x%arr1)
+!$omp declare mapper (integer : V :: x) map(tofrom:x%arr1(:))
+
+end program myprog
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90
new file mode 100644
index 0000000..483e848
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90
@@ -0,0 +1,60 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+type t
+integer, allocatable :: arrcomp(:)
+integer :: b, c, d
+end type t
+
+type(t) :: myvar
+
+!$omp declare mapper (t :: x) map(to: x%arrcomp) map(alloc: x%b) &
+!$omp & map(from: x%c) map(tofrom: x%d)
+
+allocate (myvar%arrcomp(1:100))
+
+!$omp target enter data map(to: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: 4\]\) map\(to:myvar\.d \[len: [0-9]+\]\) map\(to:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+!$omp target exit data map(from: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(from:myvar\.c \[len: [0-9]+\]\) map\(from:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+
+!$omp target enter data map(alloc: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(alloc:myvar\.d \[len: [0-9]+\]\) map\(alloc:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+!$omp target exit data map(release: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(release:myvar\.c \[len: [0-9]+\]\) map\(release:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+
+!$omp target enter data map(present, to: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(force_present:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\) map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(force_present:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(force_present:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } }
+
+!$omp target exit data map(present, from: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(force_present:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+
+!$omp target enter data map(always, to: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(always,to:myvar\.d \[len: [0-9]+\]\) map\(always,to:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+!$omp target exit data map(always, from: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(always,from:myvar\.c \[len: [0-9]+\]\) map\(always,from:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+
+!$omp target enter data map(always, present, to: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(force_present:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(always,present,to:myvar\.d \[len: [0-9]+\]\) map\(always,present,to:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+!$omp target exit data map(always, present, from: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(always,present,from:myvar\.c \[len: [0-9]+\]\) map\(always,present,from:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90
new file mode 100644
index 0000000..6c07261
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+type t
+integer :: a, b, c, d
+end type t
+
+type(t) :: myvar
+
+!$omp declare mapper (t :: x) map(to: x%a) map(alloc: x%b) &
+!$omp & map(from: x%c) map(tofrom: x%d)
+
+!$omp target data map(to: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.a \[len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(to:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } }
+
+!$omp end target data
+
+!$omp target data map(alloc: myvar)
+
+! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(alloc:myvar\.a \[len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(alloc:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } }
+
+!$omp end target data
+
+end
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 0000000..9555a94
--- /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
new file mode 100644
index 0000000..16afb51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-26.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+
+type t
+integer, allocatable :: arr(:)
+end type t
+
+!$omp declare mapper(even: T :: tv) map(tv%arr(2::2))
+
+type(t) :: var
+
+allocate(var%arr(100))
+
+var%arr = 0
+
+! You can't do this, the mapper specifies a noncontiguous access.
+!$omp target enter data map(mapper(even), to: var)
+! { dg-error {Stride should not be specified for array section in MAP clause} "" { target *-*-* } .-1 }
+
+var%arr = 1
+
+! But this is fine.
+!$omp target update to(mapper(even): var)
+
+! As 'enter data'.
+!$omp target exit data map(mapper(even), delete: var)
+! { dg-error {Stride should not be specified for array section in MAP clause} "" { target *-*-* } .-1 }
+
+end
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 0000000..6b3a181
--- /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/gcc/testsuite/gfortran.dg/gomp/declare-mapper-29.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-29.f90
new file mode 100644
index 0000000..e2039e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-29.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+
+! Check duplicate clause detection after mapper expansion.
+
+type t
+integer :: x
+end type t
+
+real(4) :: unrelated
+type(t) :: tvar
+
+!$omp declare mapper (t :: var) map(unrelated) map(var%x)
+
+tvar%x = 0
+unrelated = 5
+
+!$omp target firstprivate(unrelated) map(tofrom: tvar)
+! { dg-error "Symbol .unrelated. present on both data and map clauses" "" { target *-*-* } .-1 }
+tvar%x = unrelated
+!$omp end target
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90
new file mode 100644
index 0000000..7145d51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+
+type t
+integer :: x, y
+integer, allocatable :: arr(:)
+end type t
+
+type(t) :: var
+
+allocate(var%arr(1:20))
+
+var%arr = 0
+
+! If we ask for a named mapper that hasn't been defined, an error should be
+! raised. This isn't a *syntax* error, so the !$omp target..!$omp end target
+! block should still be parsed correctly.
+!$omp target map(mapper(arraymapper), tofrom: var)
+! { dg-error "User-defined mapper .arraymapper. not found" "" { target *-*-* } .-1 }
+var%arr(5) = 5
+!$omp end target
+
+! OTOH, this is a syntax error, and the offload block is not recognized.
+!$omp target map(
+! { dg-error "Syntax error in OpenMP variable list" "" { target *-*-* } .-1 }
+var%arr(6) = 6
+!$omp end target
+! { dg-error "Unexpected !.OMP END TARGET statement" "" { target *-*-* } .-1 }
+
+! ...but not for the specific name 'default'.
+!$omp target map(mapper(default), tofrom: var)
+var%arr(5) = 5
+!$omp end target
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90
new file mode 100644
index 0000000..0790fcd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-5.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+
+! Check duplicate mapper detection in module reader.
+
+module mod1
+type S
+integer, dimension(:), pointer :: arr
+end type S
+!$omp declare mapper (S :: v) map(to: v%arr) map(tofrom:v%arr(1))
+end module mod1
+
+module mod2
+type S
+character :: c
+integer, dimension(:), pointer :: arr
+end type S
+!$omp declare mapper (S :: v) map(to: v%arr) map(tofrom:v%arr(:))
+
+type(S) :: svar
+
+contains
+
+subroutine setup
+allocate(svar%arr(10))
+end subroutine setup
+
+subroutine teardown
+deallocate(svar%arr)
+end subroutine teardown
+
+end module mod2
+
+program myprog
+use mod1 ! { dg-error "Previous \\\!\\\$OMP DECLARE MAPPER from module mod1" }
+use mod2 ! { dg-error "Ambiguous \\\!\\\$OMP DECLARE MAPPER from module mod2" }
+
+call setup
+
+!$omp target
+svar%arr(1) = svar%arr(1) + 1
+!$omp end target
+
+call teardown
+
+end program myprog
diff --git a/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-1.f90 b/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-1.f90
new file mode 100644
index 0000000..5c60f5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-1.f90
@@ -0,0 +1,19 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+integer :: basicarray(100)
+integer, allocatable :: allocarray(:)
+
+allocate(allocarray(1:20))
+
+!$omp target update to(basicarray)
+
+!$omp target update from(basicarray(:))
+
+!$omp target update to(allocarray)
+
+!$omp target update from(allocarray(:))
+
+end
+
+! { dg-final { scan-tree-dump-times {omp target update from\(} 2 "original" } }
+! { dg-final { scan-tree-dump-times {omp target update to\(} 2 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-2.f90 b/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-2.f90
new file mode 100644
index 0000000..f5a5273
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-2.f90
@@ -0,0 +1,16 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+integer, allocatable :: allocarray(:)
+integer, allocatable :: allocarray2(:,:)
+
+allocate(allocarray(1:20))
+allocate(allocarray2(1:20,1:20))
+
+! This one must be noncontiguous
+!$omp target update to(allocarray(::2))
+! { dg-final { scan-tree-dump {omp target update map\(to_grid:} "original" } }
+
+!$omp target update from(allocarray2(:,5:15))
+! { dg-final { scan-tree-dump {omp target update from\(} "original" } }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-3.f90 b/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-3.f90
new file mode 100644
index 0000000..5cbfe7c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-3.f90
@@ -0,0 +1,16 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+integer, allocatable :: allocarray(:,:)
+
+allocate(allocarray(1:20,1:20))
+
+! This one could possibly be handled as a contiguous update - but isn't,
+! for now.
+!$omp target update to(allocarray(1:20,5:15))
+! { dg-final { scan-tree-dump {omp target update map\(to_grid:} "original" } }
+
+!$omp target update from(allocarray(:,5:15:2))
+! { dg-final { scan-tree-dump {omp target update map\(from_grid:} "original" } }
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-4.f90 b/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-4.f90
new file mode 100644
index 0000000..53152aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/noncontig-updates-4.f90
@@ -0,0 +1,15 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+integer, target :: tgtarray(20)
+integer, pointer, contiguous :: arrayptr(:)
+
+arrayptr => tgtarray
+
+!$omp target update from(arrayptr)
+! { dg-final { scan-tree-dump {omp target update from\(} "original" } }
+
+!$omp target update to(arrayptr(::2))
+! { dg-final { scan-tree-dump {omp target update map\(to_grid:} "original" } }
+
+end
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90 b/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90
index e7814a1..f303148 100644
--- a/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/num-teams-2.f90
@@ -9,13 +9,13 @@ subroutine foo (i)
!$omp teams num_teams (6 : 4) ! { dg-warning "NUM_TEAMS lower bound at .1. larger than upper bound at .2." }
!$omp end teams
- !$omp teams num_teams (-7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+ !$omp teams num_teams (-7) ! { dg-error "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
!$omp end teams
- !$omp teams num_teams (i : -7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+ !$omp teams num_teams (i : -7) ! { dg-error "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
!$omp end teams
- !$omp teams num_teams (-7 : 8) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+ !$omp teams num_teams (-7 : 8) ! { dg-error "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
!$omp end teams
end
@@ -25,13 +25,13 @@ subroutine bar (i)
!$omp target teams num_teams (6 : 4) ! { dg-warning "NUM_TEAMS lower bound at .1. larger than upper bound at .2." }
!$omp end target teams
- !$omp target teams num_teams (-7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+ !$omp target teams num_teams (-7) ! { dg-error "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
!$omp end target teams
- !$omp target teams num_teams (i : -7) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+ !$omp target teams num_teams (i : -7) ! { dg-error "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
!$omp end target teams
- !$omp target teams num_teams (-7 : 8) ! { dg-warning "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
+ !$omp target teams num_teams (-7 : 8) ! { dg-error "INTEGER expression of NUM_TEAMS clause at .1. must be positive" }
!$omp end target teams
end
end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr67500.f90 b/gcc/testsuite/gfortran.dg/gomp/pr67500.f90
index 1cecdc4..11ed69f 100644
--- a/gcc/testsuite/gfortran.dg/gomp/pr67500.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pr67500.f90
@@ -10,11 +10,11 @@ subroutine f2
end
subroutine f3 (i)
- !$omp declare simd simdlen(-2) ! { dg-warning "INTEGER expression of SIMDLEN clause at .1. must be positive" }
+ !$omp declare simd simdlen(-2) ! { dg-error "INTEGER expression of SIMDLEN clause at .1. must be positive" }
end subroutine
subroutine f4
- !$omp declare simd simdlen(0) ! { dg-warning "INTEGER expression of SIMDLEN clause at .1. must be positive" }
+ !$omp declare simd simdlen(0) ! { dg-error "INTEGER expression of SIMDLEN clause at .1. must be positive" }
end
subroutine foo(p, d, n)
@@ -31,11 +31,11 @@ subroutine foo(p, d, n)
do i = 1, 16
end do
- !$omp simd safelen(-2) ! { dg-warning "INTEGER expression of SAFELEN clause at .1. must be positive" }
+ !$omp simd safelen(-2) ! { dg-error "INTEGER expression of SAFELEN clause at .1. must be positive" }
do i = 1, 16
end do
- !$omp simd safelen(0) ! { dg-warning "INTEGER expression of SAFELEN clause at .1. must be positive" }
+ !$omp simd safelen(0) ! { dg-error "INTEGER expression of SAFELEN clause at .1. must be positive" }
do i = 1, 16
end do
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 b/gcc/testsuite/gfortran.dg/gomp/pr77516.f90
index 9c0a95b..3ac3f55 100644
--- a/gcc/testsuite/gfortran.dg/gomp/pr77516.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/pr77516.f90
@@ -4,7 +4,7 @@
program pr77516
integer :: i, x
x = 0
-!$omp simd safelen(0) reduction(+:x) ! { dg-warning "must be positive" }
+!$omp simd safelen(0) reduction(+:x) ! { dg-error "must be positive" }
do i = 1, 8
x = x + 1
end do
diff --git a/gcc/testsuite/gfortran.dg/gomp/scope-6.f90 b/gcc/testsuite/gfortran.dg/gomp/scope-6.f90
index 4c4f5e0..39a6590 100644
--- a/gcc/testsuite/gfortran.dg/gomp/scope-6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/scope-6.f90
@@ -20,4 +20,4 @@ contains
end
end
-! { dg-final { scan-tree-dump "omp scope private\\(a\\) firstprivate\\(b\\) reduction\\(\\+:c\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):a\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):b\\) allocate\\(allocator\\(D\\.\[0-9\]+\\):c\\)" "original" } }
+! { dg-final { scan-tree-dump "omp scope private\\(a\\) firstprivate\\(b\\) reduction\\(\\+:c\\) allocate\\(allocator\\(h\\):a\\) allocate\\(allocator\\(h\\):b\\) allocate\\(allocator\\(h\\):c\\)" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90
new file mode 100644
index 0000000..25abbaf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ implicit none
+
+ integer, parameter :: DIM1 = 17
+ integer, parameter :: DIM2 = 39
+ type :: array_ptr
+ integer, pointer :: ptr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1), y(DIM1)
+
+ !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:))
+ !$omp end target
+
+ !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:), y(i)%ptr(:))
+ !$omp end target
+
+ !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:) + 3) ! { dg-error "Syntax error in OpenMP variable list at .1." }
+ !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." }
+
+ !$omp target map(iterator(i=1:DIM1), iterator(j=1:DIM2), to: x(i)%ptr(j)) ! { dg-error "too many 'iterator' modifiers at .1." }
+ !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." }
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90
new file mode 100644
index 0000000..b4302aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-2.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+program main
+ implicit none
+
+ integer, parameter :: DIM = 40
+ type :: array_ptr
+ integer, pointer :: ptr(:)
+ end type
+
+ type (array_ptr) :: x(DIM), y(DIM), z(DIM)
+
+ !$omp target map(iterator(i=1:10), to: x) ! { dg-warning "iterator variable .i. not used in clause expression" }
+ ! Add a reference to x to ensure that the 'to' clause does not get dropped.
+ x(1)%ptr(1) = 0
+ !$omp end target
+
+ !$omp target map(iterator(i2=1:10, j2=1:20), from: x(i2)) ! { dg-warning "iterator variable .j2. not used in clause expression" }
+ !$omp end target
+
+ !$omp target map(iterator(i3=1:10, j3=1:20, k3=1:30), to: x(i3+j3), y(j3+k3), z(k3+i3))
+ !$omp end target
+ ! { dg-warning "iterator variable .i3. not used in clause expression" "" { target *-*-* } .-2 }
+ ! { dg-warning "iterator variable .j3. not used in clause expression" "" { target *-*-* } .-3 }
+ ! { dg-warning "iterator variable .k3. not used in clause expression" "" { target *-*-* } .-4 }
+end program
+
+! { dg-final { scan-tree-dump-times "map\\\(to:x" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) i2=1:10:1, loop_label=\[^\\\)\]+\\\):from:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) j3=1:20:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) k3=1:30:1, integer\\\(kind=4\\\) j3=1:20:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) k3=1:30:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90
new file mode 100644
index 0000000..1099955
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-3.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+program main
+ implicit none
+
+ integer, parameter :: DIM1 = 17
+ integer, parameter :: DIM2 = 27
+ type :: ptr_t
+ integer, pointer :: ptr(:)
+ end type
+
+ type (ptr_t) :: x(DIM1), y(DIM2)
+
+ !$omp target map(iterator(i=1:DIM1), to: x(i)%ptr(:)) map(iterator(i=1:DIM2), from: y(i)%ptr(:))
+ !$omp end target
+end program
+
+! { dg-final { scan-tree-dump-times "if \\(i <= 17\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "if \\(i <= 27\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=17\\):to:MEM <\[^>\]+> \\\[\\\(\[^ \]+ \\\*\\\)D\\\.\[0-9\]+\\\]" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=27\\):from:MEM <\[^>\]+> \\\[\\\(\[^ \]+ \\\*\\\)D\\\.\[0-9\]+\\\]" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=17\\):attach:x\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=27\\):attach:y\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90
new file mode 100644
index 0000000..804b686
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-4.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+module m
+ !$omp declare target (baz)
+ interface
+ subroutine baz (x, p)
+ integer, intent(in) :: x
+ integer, pointer :: p(:)
+ end subroutine
+ integer function bar (x, i)
+ integer :: x, i
+ end function
+ end interface
+contains
+ subroutine foo (x, p)
+ integer :: x
+ integer, pointer :: p(:)
+
+ !$omp target map (iterator (i=1:4), to: p(bar (x, i)))
+ ! FIXME: These warnings are due to implicit clauses generated that do
+ ! not use the iterator variable i.
+ ! { dg-warning "iterator variable .i. not used in clause expression" "" { target *-*-* } .-3 }
+ call baz (x, p)
+ !$omp end target
+ end subroutine
+end module
+
+! { dg-final { scan-tree-dump "firstprivate\\\(x\\\)" "gimple" } }
+! { dg-final { scan-tree-dump-times "bar \\\(x, &" 2 "gimple" } }
+! { dg-final { scan-tree-dump "map\\\(iterator\\\(integer\\\(kind=4\\\) i=1:4:1, loop_label=" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-5.f90 b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-5.f90
new file mode 100644
index 0000000..f620d1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-map-iterators-5.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-omplower" }
+
+module m
+ integer, parameter :: DIM1 = 31
+ integer, parameter :: DIM2 = 17
+ type :: array_ptr
+ integer, pointer :: ptr(:)
+ end type
+contains
+ subroutine f (x, stride)
+ type (array_ptr) :: x(:)
+ integer :: stride
+
+ !$omp target map(to: x) map(iterator(i=lbound(x, 1):ubound(x, 1):stride), to: x(i)%ptr(:))
+ !$omp end target
+ end subroutine
+end module
+
+! { dg-final { scan-tree-dump-times "D\\\.\[0-9\]+ = __builtin_malloc \\(D\\\.\[0-9\]+\\);" 3 "omplower" } }
+! { dg-final { scan-tree-dump-times "__builtin_free \\(omp_iter_data\\\.\[0-9\]+\\);" 3 "omplower" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-1.f90
new file mode 100644
index 0000000..d3acd84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 17
+ integer, parameter :: DIM2 = 39
+
+ type :: array_ptr
+ integer, pointer :: ptr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1), y(DIM1)
+
+ !$omp target update to (iterator(i=1:DIM1): x(i)%ptr(:))
+
+ !$omp target update to (iterator(i=1:DIM1): x(i)%ptr(:DIM2), y(i)%ptr(:))
+
+ !$omp target update to (iterator(i=1:DIM1), present: x(i)%ptr(:))
+
+ !$omp target update to (iterator(i=1:DIM1), iterator(j=i:DIM2): x(i)%ptr(j)) ! { dg-error "too many 'iterator' modifiers at .1." }
+
+ !$omp target update to (iterator(i=1:DIM1), something: x(i, j)) ! { dg-error "Syntax error in OpenMP variable list at .1." }
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-2.f90 b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-2.f90
new file mode 100644
index 0000000..c57b87c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-2.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 100
+
+ type :: array_ptr
+ integer, pointer :: ptr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1), y(DIM1), z(DIM1)
+
+ !$omp target update to(iterator(i=1:10): x) ! { dg-warning "iterator variable .i. not used in clause expression" }
+ !$omp target update from(iterator(i2=1:10, j2=1:20): x(i2)) ! { dg-warning "iterator variable .j2. not used in clause expression" }
+ !$omp target update to(iterator(i3=1:10, j3=1:20, k3=1:30): x(i3+j3), y(j3+k3), z(k3+i3))
+ ! { dg-warning "iterator variable .i3. not used in clause expression" "" { target *-*-* } .-1 }
+ ! { dg-warning "iterator variable .j3. not used in clause expression" "" { target *-*-* } .-2 }
+ ! { dg-warning "iterator variable .k3. not used in clause expression" "" { target *-*-* } .-3 }
+end program
+
+! { dg-final { scan-tree-dump-times "update to\\\(x " 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "update from\\\(iterator\\\(integer\\\(kind=4\\\) i2=1:10:1, loop_label=" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "to\\\(iterator\\\(integer\\\(kind=4\\\) j3=1:20:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "to\\\(iterator\\\(integer\\\(kind=4\\\) k3=1:30:1, integer\\\(kind=4\\\) j3=1:20:1, loop_label=" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "to\\\(iterator\\\(integer\\\(kind=4\\\) k3=1:30:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=" 1 "gimple" } }
+ \ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-3.f90 b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-3.f90
new file mode 100644
index 0000000..a8dffcf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-update-iterators-3.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 17
+ integer, parameter :: DIM2 = 39
+
+ type :: array_ptr
+ integer, pointer :: ptr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1, DIM2), y(DIM1, DIM2), z(DIM1)
+
+ !$omp target update to (iterator(i=1:DIM1, j=1:DIM2): x(i, j)%ptr(:), y(i, j)%ptr(:))
+ !$omp target update from (iterator(i=1:DIM1): z(i)%ptr(:))
+end program
+
+! { dg-final { scan-tree-dump-times "if \\(i <= 17\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 2 "gimple" } }
+! { dg-final { scan-tree-dump "if \\(j <= 39\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" "gimple" } }
+! { dg-final { scan-tree-dump-times "to\\(iterator\\(integer\\(kind=4\\) j=1:39:1, integer\\(kind=4\\) i=1:17:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=663\\):MEM <\[^>\]+> \\\[\\\(\[^ \]+ \\\*\\\)D\\\.\[0-9\]+\\\]" 2 "gimple" } }
+! { dg-final { scan-tree-dump "from\\(iterator\\(integer\\(kind=4\\) i=1:17:1, loop_label=<D\\\.\[0-9\]+>, index=D\\\.\[0-9\]+, elems=omp_iter_data\\\.\[0-9\]+, elems_count=17\\):MEM <\[^>\]+> \\\[\\\(\[^ \]+ \\\*\\\)D\\\.\[0-9\]+\\\]" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/uses_allocators-1.f90 b/gcc/testsuite/gfortran.dg/gomp/uses_allocators-1.f90
new file mode 100644
index 0000000..d7b00ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/uses_allocators-1.f90
@@ -0,0 +1,37 @@
+use iso_c_binding
+implicit none
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+ integer, parameter :: omp_alloctrait_key_kind = c_int
+ integer, parameter :: omp_alloctrait_val_kind = c_intptr_t
+ integer, parameter :: omp_memspace_handle_kind = c_intptr_t
+ integer (omp_memspace_handle_kind), &
+ parameter :: omp_default_mem_space = 0
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ type omp_alloctrait
+ integer (kind=omp_alloctrait_key_kind) key
+ integer (kind=omp_alloctrait_val_kind) value
+ end type omp_alloctrait
+ interface
+ function omp_alloc (size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_alloc
+ integer(c_size_t), value :: size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_alloc
+ end interface
+contains
+subroutine x
+integer :: mem
+type(omp_alloctrait), parameter:: mem2(1) = [omp_alloctrait(1,1)]
+integer(omp_allocator_handle_kind) :: var
+!$omp target uses_allocators(memspace(omp_default_mem_space), traits(mem2) : var) defaultmap(none)
+block;
+type(c_ptr) ::c
+c = omp_alloc(omp_default_mem_space, 20_8)
+end block
+!$omp target uses_allocators(omp_default_mem_alloc, var(mem2))
+block; end block
+end
+end
diff --git a/gcc/testsuite/gfortran.dg/openacc-define-3.f90 b/gcc/testsuite/gfortran.dg/openacc-define-3.f90
index dcc52b6..1a229f8 100644
--- a/gcc/testsuite/gfortran.dg/openacc-define-3.f90
+++ b/gcc/testsuite/gfortran.dg/openacc-define-3.f90
@@ -6,6 +6,6 @@
# error _OPENACC not defined
#endif
-#if _OPENACC != 201711
+#if _OPENACC != 201811
# error _OPENACC defined to wrong value
#endif
diff --git a/gcc/testsuite/gfortran.dg/pr67170.f90 b/gcc/testsuite/gfortran.dg/pr67170.f90
index 8023647..d7c33a4 100644
--- a/gcc/testsuite/gfortran.dg/pr67170.f90
+++ b/gcc/testsuite/gfortran.dg/pr67170.f90
@@ -28,4 +28,4 @@ end subroutine foo
end module test_module
end program
-! { dg-final { scan-tree-dump-times "= \\*arg_\[0-9\]+\\(D\\);" 1 "fre1" } }
+! { dg-final { scan-tree-dump-times "= \\*arg_\[0-9\]+\\(D\\)\\(ptro\\);" 1 "fre1" } }
diff --git a/gcc/tree-core.h b/gcc/tree-core.h
index bd19c99..4ad0850 100644
--- a/gcc/tree-core.h
+++ b/gcc/tree-core.h
@@ -278,7 +278,9 @@ enum omp_clause_code {
placeholder used in OMP_CLAUSE_REDUCTION_{INIT,MERGE}.
Operand 4: OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER: Another dummy
VAR_DECL placeholder, used like the above for C/C++ array
- reductions. */
+ reductions.
+ Operand 5: OMP_CLAUSE_REDUCTION_PRIVATE_DECL: A private VAR_DECL of
+ the original DECL associated with the reduction clause. */
OMP_CLAUSE_REDUCTION,
/* OpenMP clause: task_reduction (operator:variable_list). */
@@ -368,6 +370,10 @@ enum omp_clause_code {
/* OpenMP clause: doacross ({source,sink}:vec). */
OMP_CLAUSE_DOACROSS,
+ /* OpenMP mapper binding: record implicit mappers in scope for aggregate
+ types used within an offload region. */
+ OMP_CLAUSE__MAPPER_BINDING_,
+
/* Internal structure to hold OpenACC cache directive's variable-list.
#pragma acc cache (variable-list). */
OMP_CLAUSE__CACHE_,
@@ -551,6 +557,10 @@ enum omp_clause_code {
loop or not. */
OMP_CLAUSE__SIMT_,
+ /* Internally used only clause, flag whether this is an "ompacc"
+ target region or not. */
+ OMP_CLAUSE__OMPACC_,
+
/* OpenACC clause: independent. */
OMP_CLAUSE_INDEPENDENT,
@@ -587,6 +597,8 @@ enum omp_clause_code {
/* OpenMP clause: nocontext (scalar-expression). */
OMP_CLAUSE_NOCONTEXT,
+ /* OpenMP clause: uses_allocators. */
+ OMP_CLAUSE_USES_ALLOCATORS,
};
#undef DEFTREESTRUCT
diff --git a/gcc/tree-inline.cc b/gcc/tree-inline.cc
index 3289b4f..59a195e 100644
--- a/gcc/tree-inline.cc
+++ b/gcc/tree-inline.cc
@@ -1460,10 +1460,7 @@ copy_tree_body_r (tree *tp, int *walk_subtrees, void *data)
|| OMP_CLAUSE_CODE (*tp) == OMP_CLAUSE_DEPEND))
{
tree t = OMP_CLAUSE_DECL (*tp);
- if (t
- && TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (t && OMP_ITERATOR_DECL_P (t))
{
*walk_subtrees = 0;
OMP_CLAUSE_DECL (*tp) = copy_node (t);
@@ -1472,8 +1469,8 @@ copy_tree_body_r (tree *tp, int *walk_subtrees, void *data)
for (int i = 0; i <= 4; i++)
walk_tree (&TREE_VEC_ELT (TREE_PURPOSE (t), i),
copy_tree_body_r, id, NULL);
- if (TREE_VEC_ELT (TREE_PURPOSE (t), 5))
- remap_block (&TREE_VEC_ELT (TREE_PURPOSE (t), 5), id);
+ if (OMP_ITERATORS_BLOCK (TREE_PURPOSE (t)))
+ remap_block (&OMP_ITERATORS_BLOCK (TREE_PURPOSE (t)), id);
walk_tree (&TREE_VALUE (t), copy_tree_body_r, id, NULL);
}
}
diff --git a/gcc/tree-loop-distribution.cc b/gcc/tree-loop-distribution.cc
index fc0cd39..6be5afd 100644
--- a/gcc/tree-loop-distribution.cc
+++ b/gcc/tree-loop-distribution.cc
@@ -1197,6 +1197,16 @@ generate_memset_builtin (class loop *loop, partition *partition)
/* The new statements will be placed before LOOP. */
gsi = gsi_last_bb (loop_preheader_edge (loop)->src);
+ if (flag_openacc
+ && gsi_stmt (gsi)
+ && gimple_call_internal_p (gsi_stmt (gsi), IFN_UNIQUE)
+ && (TREE_INT_CST_LOW (gimple_call_arg (gsi_stmt (gsi), 0))
+ == (unsigned HOST_WIDE_INT) IFN_UNIQUE_OACC_FORK))
+ {
+ edge e = split_block (loop_preheader_edge (loop)->src, gsi_stmt (gsi));
+ gsi = gsi_last_bb (e->dest);
+ }
+
nb_bytes = rewrite_to_non_trapping_overflow (builtin->size);
nb_bytes = force_gimple_operand_gsi (&gsi, nb_bytes, true, NULL_TREE,
false, GSI_CONTINUE_LINKING);
@@ -1251,6 +1261,16 @@ generate_memcpy_builtin (class loop *loop, partition *partition)
/* The new statements will be placed before LOOP. */
gsi = gsi_last_bb (loop_preheader_edge (loop)->src);
+ if (flag_openacc
+ && gsi_stmt (gsi)
+ && gimple_call_internal_p (gsi_stmt (gsi), IFN_UNIQUE)
+ && (TREE_INT_CST_LOW (gimple_call_arg (gsi_stmt (gsi), 0))
+ == (unsigned HOST_WIDE_INT) IFN_UNIQUE_OACC_FORK))
+ {
+ edge e = split_block (loop_preheader_edge (loop)->src, gsi_stmt (gsi));
+ gsi = gsi_last_bb (e->dest);
+ }
+
nb_bytes = rewrite_to_non_trapping_overflow (builtin->size);
nb_bytes = force_gimple_operand_gsi (&gsi, nb_bytes, true, NULL_TREE,
false, GSI_CONTINUE_LINKING);
diff --git a/gcc/tree-nested.cc b/gcc/tree-nested.cc
index 8d75a2f..9bc7624 100644
--- a/gcc/tree-nested.cc
+++ b/gcc/tree-nested.cc
@@ -1532,6 +1532,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_BIND:
case OMP_CLAUSE__CONDTEMP_:
case OMP_CLAUSE__SCANTEMP_:
+ case OMP_CLAUSE__OMPACC_:
break;
/* The following clause belongs to the OpenACC cache directive, which
@@ -1796,6 +1797,8 @@ convert_nonlocal_reference_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
break;
case GIMPLE_OMP_TARGET:
+ walk_body (convert_nonlocal_reference_stmt, convert_nonlocal_reference_op,
+ info, gimple_omp_target_iterator_loops_ptr (as_a <gomp_target *> (stmt)));
if (!is_gimple_omp_offloaded (stmt))
{
save_suppress = info->suppress_expansion;
@@ -2317,6 +2320,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_BIND:
case OMP_CLAUSE__CONDTEMP_:
case OMP_CLAUSE__SCANTEMP_:
+ case OMP_CLAUSE__OMPACC_:
break;
/* The following clause belongs to the OpenACC cache directive, which
@@ -2517,6 +2521,9 @@ convert_local_reference_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
break;
case GIMPLE_OMP_TARGET:
+ walk_body (convert_local_reference_stmt, convert_local_reference_op, info,
+ gimple_omp_target_iterator_loops_ptr (as_a <gomp_target *> (stmt)));
+
if (!is_gimple_omp_offloaded (stmt))
{
save_suppress = info->suppress_expansion;
@@ -2903,6 +2910,9 @@ convert_tramp_reference_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
case GIMPLE_OMP_TASK:
do_parallel:
{
+ if (gimple_code (stmt) == GIMPLE_OMP_TARGET)
+ walk_body (convert_tramp_reference_stmt, convert_tramp_reference_op,
+ info, gimple_omp_target_iterator_loops_ptr (as_a <gomp_target *> (stmt)));
tree save_local_var_chain = info->new_local_var_chain;
walk_gimple_op (stmt, convert_tramp_reference_op, wi);
info->new_local_var_chain = NULL;
diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc
index c1a21e7..1bbc2aa 100644
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -437,16 +437,27 @@ dump_omp_iterators (pretty_printer *pp, tree iter, int spc, dump_flags_t flags)
{
if (it != iter)
pp_string (pp, ", ");
- dump_generic_node (pp, TREE_TYPE (TREE_VEC_ELT (it, 0)), spc, flags,
+ dump_generic_node (pp, TREE_TYPE (OMP_ITERATORS_VAR (it)), spc, flags,
false);
pp_space (pp);
- dump_generic_node (pp, TREE_VEC_ELT (it, 0), spc, flags, false);
+ dump_generic_node (pp, OMP_ITERATORS_VAR (it), spc, flags, false);
pp_equal (pp);
- dump_generic_node (pp, TREE_VEC_ELT (it, 1), spc, flags, false);
+ dump_generic_node (pp, OMP_ITERATORS_BEGIN (it), spc, flags, false);
pp_colon (pp);
- dump_generic_node (pp, TREE_VEC_ELT (it, 2), spc, flags, false);
+ dump_generic_node (pp, OMP_ITERATORS_END (it), spc, flags, false);
pp_colon (pp);
- dump_generic_node (pp, TREE_VEC_ELT (it, 3), spc, flags, false);
+ dump_generic_node (pp, OMP_ITERATORS_STEP (it), spc, flags, false);
+ }
+ if (OMP_ITERATORS_EXPANDED_P (iter))
+ {
+ pp_string (pp, ", loop_label=");
+ dump_generic_node (pp, OMP_ITERATORS_LABEL (iter), spc, flags, false);
+ pp_string (pp, ", index=");
+ dump_generic_node (pp, OMP_ITERATORS_INDEX (iter), spc, flags, false);
+ pp_string (pp, ", elems=");
+ dump_generic_node (pp, OMP_ITERATORS_ELEMS (iter), spc, flags, false);
+ pp_string (pp, ", elems_count=");
+ dump_generic_node (pp, OMP_ITERATORS_COUNT (iter), spc, flags, false);
}
pp_right_paren (pp);
}
@@ -898,13 +909,25 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_right_paren (pp);
break;
+ case OMP_CLAUSE_USES_ALLOCATORS:
+ pp_string (pp, "uses_allocators(");
+ dump_generic_node (pp, OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR (clause),
+ spc, flags, false);
+ pp_string (pp, ": memspace(");
+ dump_generic_node (pp, OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE (clause),
+ spc, flags, false);
+ pp_string (pp, "), traits(");
+ dump_generic_node (pp, OMP_CLAUSE_USES_ALLOCATORS_TRAITS (clause),
+ spc, flags, false);
+ pp_right_paren (pp);
+ pp_right_paren (pp);
+ break;
+
case OMP_CLAUSE_AFFINITY:
pp_string (pp, "affinity(");
{
tree t = OMP_CLAUSE_DECL (clause);
- if (TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (t))
{
dump_omp_iterators (pp, TREE_PURPOSE (t), spc, flags);
pp_colon (pp);
@@ -944,9 +967,7 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
}
{
tree t = OMP_CLAUSE_DECL (clause);
- if (TREE_CODE (t) == TREE_LIST
- && TREE_PURPOSE (t)
- && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ if (OMP_ITERATOR_DECL_P (t))
{
dump_omp_iterators (pp, TREE_PURPOSE (t), spc, flags);
pp_colon (pp);
@@ -1012,6 +1033,13 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_string (pp, "map(");
if (OMP_CLAUSE_MAP_READONLY (clause))
pp_string (pp, "readonly,");
+ if (OMP_CLAUSE_MAP_POINTS_TO_READONLY (clause))
+ pp_string (pp, "pt_readonly,");
+ if (OMP_CLAUSE_ITERATORS (clause))
+ {
+ dump_omp_iterators (pp, OMP_CLAUSE_ITERATORS (clause), spc, flags);
+ pp_colon (pp);
+ }
switch (OMP_CLAUSE_MAP_KIND (clause))
{
case GOMP_MAP_ALLOC:
@@ -1086,6 +1114,12 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
case GOMP_MAP_LINK:
pp_string (pp, "link");
break;
+ case GOMP_MAP_DECLARE_ALLOCATE:
+ pp_string (pp, "declare_allocate");
+ break;
+ case GOMP_MAP_DECLARE_DEALLOCATE:
+ pp_string (pp, "declare_deallocate");
+ break;
case GOMP_MAP_ATTACH:
pp_string (pp, "attach");
break;
@@ -1122,6 +1156,57 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
case GOMP_MAP_ALWAYS_PRESENT_TOFROM:
pp_string (pp, "always,present,tofrom");
break;
+ case GOMP_MAP_NONCONTIG_ARRAY_TO:
+ pp_string (pp, "to,noncontig_array");
+ break;
+ case GOMP_MAP_NONCONTIG_ARRAY_FROM:
+ pp_string (pp, "from,noncontig_array");
+ break;
+ case GOMP_MAP_NONCONTIG_ARRAY_TOFROM:
+ pp_string (pp, "tofrom,noncontig_array");
+ break;
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_TO:
+ pp_string (pp, "force_to,noncontig_array");
+ break;
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_FROM:
+ pp_string (pp, "force_from,noncontig_array");
+ break;
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_TOFROM:
+ pp_string (pp, "force_tofrom,noncontig_array");
+ break;
+ case GOMP_MAP_NONCONTIG_ARRAY_ALLOC:
+ pp_string (pp, "alloc,noncontig_array");
+ break;
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_ALLOC:
+ pp_string (pp, "force_alloc,noncontig_array");
+ break;
+ case GOMP_MAP_NONCONTIG_ARRAY_FORCE_PRESENT:
+ pp_string (pp, "force_present,noncontig_array");
+ break;
+ case GOMP_MAP_TO_GRID:
+ pp_string (pp, "to_grid");
+ break;
+ case GOMP_MAP_FROM_GRID:
+ pp_string (pp, "from_grid");
+ break;
+ case GOMP_MAP_GRID_DIM:
+ pp_string (pp, "grid_dim");
+ break;
+ case GOMP_MAP_GRID_STRIDE:
+ pp_string (pp, "grid_stride");
+ break;
+ case GOMP_MAP_UNSET:
+ pp_string (pp, "unset");
+ break;
+ case GOMP_MAP_PUSH_MAPPER_NAME:
+ pp_string (pp, "push_mapper");
+ break;
+ case GOMP_MAP_POP_MAPPER_NAME:
+ pp_string (pp, "pop_mapper");
+ break;
+ case GOMP_MAP_MAPPING_GROUP:
+ pp_string (pp, "mapping_group");
+ break;
default:
gcc_unreachable ();
}
@@ -1132,8 +1217,15 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
if (OMP_CLAUSE_SIZE (clause))
{
switch (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_MAP
- ? OMP_CLAUSE_MAP_KIND (clause) : GOMP_MAP_TO)
+ ? (GOMP_MAP_NONCONTIG_ARRAY_P (OMP_CLAUSE_MAP_KIND (clause))
+ ? GOMP_MAP_NONCONTIG_ARRAY
+ : OMP_CLAUSE_MAP_KIND (clause))
+ : GOMP_MAP_TO)
{
+ case GOMP_MAP_NONCONTIG_ARRAY:
+ gcc_assert (TREE_CODE (OMP_CLAUSE_SIZE (clause)) == TREE_LIST);
+ pp_string (pp, " [dimensions: ");
+ break;
case GOMP_MAP_POINTER:
case GOMP_MAP_FIRSTPRIVATE_POINTER:
case GOMP_MAP_FIRSTPRIVATE_REFERENCE:
@@ -1180,6 +1272,11 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_string (pp, "from(");
if (OMP_CLAUSE_MOTION_PRESENT (clause))
pp_string (pp, "present:");
+ if (OMP_CLAUSE_ITERATORS (clause))
+ {
+ dump_omp_iterators (pp, OMP_CLAUSE_ITERATORS (clause), spc, flags);
+ pp_colon (pp);
+ }
dump_generic_node (pp, OMP_CLAUSE_DECL (clause),
spc, flags, false);
goto print_clause_size;
@@ -1188,6 +1285,11 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_string (pp, "to(");
if (OMP_CLAUSE_MOTION_PRESENT (clause))
pp_string (pp, "present:");
+ if (OMP_CLAUSE_ITERATORS (clause))
+ {
+ dump_omp_iterators (pp, OMP_CLAUSE_ITERATORS (clause), spc, flags);
+ pp_colon (pp);
+ }
dump_generic_node (pp, OMP_CLAUSE_DECL (clause),
spc, flags, false);
goto print_clause_size;
@@ -1200,6 +1302,23 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
spc, flags, false);
goto print_clause_size;
+ case OMP_CLAUSE__MAPPER_BINDING_:
+ pp_string (pp, "mapper_binding(");
+ if (OMP_CLAUSE__MAPPER_BINDING__ID (clause))
+ {
+ dump_generic_node (pp, OMP_CLAUSE__MAPPER_BINDING__ID (clause), spc,
+ flags, false);
+ pp_comma (pp);
+ }
+ dump_generic_node (pp,
+ TREE_TYPE (OMP_CLAUSE__MAPPER_BINDING__DECL (clause)),
+ spc, flags, false);
+ pp_comma (pp);
+ dump_generic_node (pp, OMP_CLAUSE__MAPPER_BINDING__MAPPER (clause), spc,
+ flags, false);
+ pp_right_paren (pp);
+ break;
+
case OMP_CLAUSE_NUM_TEAMS:
pp_string (pp, "num_teams(");
if (OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (clause))
@@ -1429,6 +1548,12 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_string (pp, "_simt_");
break;
+ case OMP_CLAUSE__OMPACC_:
+ pp_string (pp, "_ompacc_");
+ if (OMP_CLAUSE__OMPACC__SEQ (clause))
+ pp_string (pp, "(seq)");
+ break;
+
case OMP_CLAUSE_GANG:
pp_string (pp, "gang");
if (OMP_CLAUSE_GANG_EXPR (clause) != NULL_TREE)
@@ -1761,7 +1886,9 @@ dump_block_node (pretty_printer *pp, tree block, int spc, dump_flags_t flags)
newline_and_indent (pp, spc + 2);
}
- if (BLOCK_SUBBLOCKS (block))
+ if (BLOCK_SUBBLOCKS (block)
+ && (!lang_GNU_Fortran ()
+ || TREE_CODE (BLOCK_SUBBLOCKS (block)) != STATEMENT_LIST))
{
pp_string (pp, "SUBBLOCKS: ");
for (t = BLOCK_SUBBLOCKS (block); t; t = BLOCK_CHAIN (t))
@@ -2884,6 +3011,11 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
dump_generic_node (pp, TREE_OPERAND (node, 1), spc, flags, false);
pp_colon (pp);
dump_generic_node (pp, TREE_OPERAND (node, 2), spc, flags, false);
+ if (TREE_OPERAND (node, 3))
+ {
+ pp_colon (pp);
+ dump_generic_node (pp, TREE_OPERAND (node, 3), spc, flags, false);
+ }
pp_right_bracket (pp);
break;
@@ -3755,6 +3887,8 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
pp_string (pp, "(D)");
if (SSA_NAME_OCCURS_IN_ABNORMAL_PHI (node))
pp_string (pp, "(ab)");
+ if (SSA_NAME_POINTS_TO_READONLY_MEMORY (node))
+ pp_string (pp, "(ptro)");
break;
case WITH_SIZE_EXPR:
@@ -4263,6 +4397,21 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
pp_string (pp, ")>");
break;
+ case OMP_DECLARE_MAPPER:
+ pp_string (pp, "#pragma omp declare mapper (");
+ if (OMP_DECLARE_MAPPER_ID (node))
+ {
+ dump_generic_node (pp, OMP_DECLARE_MAPPER_ID (node), spc, flags,
+ false);
+ pp_colon (pp);
+ }
+ dump_generic_node (pp, TREE_TYPE (node), spc, flags, false);
+ pp_space (pp);
+ dump_generic_node (pp, OMP_DECLARE_MAPPER_DECL (node), spc, flags, false);
+ pp_right_paren (pp);
+ dump_omp_clauses (pp, OMP_DECLARE_MAPPER_CLAUSES (node), spc, flags);
+ break;
+
case TRANSACTION_EXPR:
if (TRANSACTION_EXPR_OUTER (node))
pp_string (pp, "__transaction_atomic [[outer]]");
diff --git a/gcc/tree-ssanames.cc b/gcc/tree-ssanames.cc
index d7865f2..3605c4d 100644
--- a/gcc/tree-ssanames.cc
+++ b/gcc/tree-ssanames.cc
@@ -403,6 +403,9 @@ make_ssa_name_fn (struct function *fn, tree var, gimple *stmt,
else
SSA_NAME_RANGE_INFO (t) = NULL;
+ if (VAR_P (var) && VAR_POINTS_TO_READONLY (var))
+ SSA_NAME_POINTS_TO_READONLY_MEMORY (t) = 1;
+
SSA_NAME_IN_FREE_LIST (t) = 0;
SSA_NAME_IS_DEFAULT_DEF (t) = 0;
init_ssa_name_imm_use (t);
diff --git a/gcc/tree-vect-data-refs.cc b/gcc/tree-vect-data-refs.cc
index 3ba271b..d6cd93a 100644
--- a/gcc/tree-vect-data-refs.cc
+++ b/gcc/tree-vect-data-refs.cc
@@ -5035,7 +5035,21 @@ vect_analyze_data_refs (vec_info *vinfo, poly_uint64 *min_vf, bool *fatal)
/* Set vectype for STMT. */
scalar_type = TREE_TYPE (DR_REF (dr));
tree vectype = get_vectype_for_scalar_type (vinfo, scalar_type);
- if (!vectype)
+
+ /* FIXME: If the object is in an address-space in which the pointer size
+ is different to the default address space then vectorizing here will
+ lead to an ICE down the road because the address space information
+ gets lost. This work-around fixes the problem until we have a proper
+ solution. */
+ tree base_object = DR_REF (dr);
+ tree op = (TREE_CODE (base_object) == COMPONENT_REF
+ || TREE_CODE (base_object) == ARRAY_REF
+ ? TREE_OPERAND (base_object, 0) : base_object);
+ addr_space_t as = TYPE_ADDR_SPACE (TREE_TYPE (op));
+ bool addr_space_bug = (!ADDR_SPACE_GENERIC_P (as)
+ && targetm.addr_space.pointer_mode (as) != Pmode);
+
+ if (!vectype || addr_space_bug)
{
if (dump_enabled_p ())
{
diff --git a/gcc/tree.cc b/gcc/tree.cc
index eccfcc8..10e3d71 100644
--- a/gcc/tree.cc
+++ b/gcc/tree.cc
@@ -301,7 +301,7 @@ unsigned const char omp_clause_num_ops[] =
1, /* OMP_CLAUSE_SHARED */
1, /* OMP_CLAUSE_FIRSTPRIVATE */
2, /* OMP_CLAUSE_LASTPRIVATE */
- 5, /* OMP_CLAUSE_REDUCTION */
+ 6, /* OMP_CLAUSE_REDUCTION */
5, /* OMP_CLAUSE_TASK_REDUCTION */
5, /* OMP_CLAUSE_IN_REDUCTION */
1, /* OMP_CLAUSE_COPYIN */
@@ -321,11 +321,12 @@ unsigned const char omp_clause_num_ops[] =
1, /* OMP_CLAUSE_IS_DEVICE_PTR */
1, /* OMP_CLAUSE_INCLUSIVE */
1, /* OMP_CLAUSE_EXCLUSIVE */
- 2, /* OMP_CLAUSE_FROM */
- 2, /* OMP_CLAUSE_TO */
- 2, /* OMP_CLAUSE_MAP */
+ 3, /* OMP_CLAUSE_FROM */
+ 3, /* OMP_CLAUSE_TO */
+ 3, /* OMP_CLAUSE_MAP */
1, /* OMP_CLAUSE_HAS_DEVICE_ADDR */
1, /* OMP_CLAUSE_DOACROSS */
+ 3, /* OMP_CLAUSE__MAPPER_BINDING_ */
2, /* OMP_CLAUSE__CACHE_ */
1, /* OMP_CLAUSE_DESTROY */
2, /* OMP_CLAUSE_INIT */
@@ -382,6 +383,7 @@ unsigned const char omp_clause_num_ops[] =
1, /* OMP_CLAUSE_SIZES */
1, /* OMP_CLAUSE__SIMDUID_ */
0, /* OMP_CLAUSE__SIMT_ */
+ 0, /* OMP_CLAUSE__OMPACC_ */
0, /* OMP_CLAUSE_INDEPENDENT */
1, /* OMP_CLAUSE_WORKER */
1, /* OMP_CLAUSE_VECTOR */
@@ -394,6 +396,7 @@ unsigned const char omp_clause_num_ops[] =
0, /* OMP_CLAUSE_NOHOST */
1, /* OMP_CLAUSE_NOVARIANTS */
1, /* OMP_CLAUSE_NOCONTEXT */
+ 3, /* OMP_CLAUSE_USES_ALLOCATORS */
};
const char * const omp_clause_code_name[] =
@@ -428,6 +431,7 @@ const char * const omp_clause_code_name[] =
"map",
"has_device_addr",
"doacross",
+ "_mapper_binding_",
"_cache_",
"destroy",
"init",
@@ -484,6 +488,7 @@ const char * const omp_clause_code_name[] =
"sizes",
"_simduid_",
"_simt_",
+ "_ompacc_",
"independent",
"worker",
"vector",
@@ -496,6 +501,7 @@ const char * const omp_clause_code_name[] =
"nohost",
"novariants",
"nocontext",
+ "uses_allocators",
};
/* Unless specific to OpenACC, we tend to internally maintain OpenMP-centric
@@ -11722,6 +11728,9 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
case OMP_CLAUSE:
{
int len = omp_clause_num_ops[OMP_CLAUSE_CODE (t)];
+ /* Do not walk the iterator operand of OpenMP MAP clauses. */
+ if (OMP_CLAUSE_HAS_ITERATORS (t))
+ len--;
for (int i = 0; i < len; i++)
WALK_SUBTREE (OMP_CLAUSE_OPERAND (t, i));
WALK_SUBTREE_TAIL (OMP_CLAUSE_CHAIN (t));
diff --git a/gcc/tree.def b/gcc/tree.def
index c4ad8d0..2253a67 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1342,6 +1342,13 @@ DEFTREECODE (OMP_STRUCTURED_BLOCK, "omp_structured_block", tcc_statement, 1)
Operand 0: OMP_MASTER_BODY: Master section body. */
DEFTREECODE (OMP_MASTER, "omp_master", tcc_statement, 1)
+/* OpenMP - #pragma omp declare mapper ([id:] type var) [clause1 ... clauseN]
+ Operand 0: Identifier.
+ Operand 1: Variable decl.
+ Operand 2: List of clauses.
+ The type of the construct is used for the type to be mapped. */
+DEFTREECODE (OMP_DECLARE_MAPPER, "omp_declare_mapper", tcc_statement, 3)
+
/* OpenACC - #pragma acc cache (variable1 ... variableN)
Operand 0: OACC_CACHE_CLAUSES: List of variables (transformed into
OMP_CLAUSE__CACHE_ clauses). */
@@ -1412,7 +1419,7 @@ DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2)
DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0)
/* An OpenMP array section. */
-DEFTREECODE (OMP_ARRAY_SECTION, "omp_array_section", tcc_expression, 3)
+DEFTREECODE (OMP_ARRAY_SECTION, "omp_array_section", tcc_expression, 4)
/* OpenMP variant construct selector, used only in the middle end in the
expansions of variant constructs that can't be resolved until the
diff --git a/gcc/tree.h b/gcc/tree.h
index 99f2617..f3508ba 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1625,6 +1625,13 @@ class auto_suppress_location_wrappers
#define OMP_METADIRECTIVE_VARIANT_BODY(v) \
TREE_VALUE (TREE_VALUE (v))
+#define OMP_DECLARE_MAPPER_ID(NODE) \
+ TREE_OPERAND (OMP_DECLARE_MAPPER_CHECK (NODE), 0)
+#define OMP_DECLARE_MAPPER_DECL(NODE) \
+ TREE_OPERAND (OMP_DECLARE_MAPPER_CHECK (NODE), 1)
+#define OMP_DECLARE_MAPPER_CLAUSES(NODE) \
+ TREE_OPERAND (OMP_DECLARE_MAPPER_CHECK (NODE), 2)
+
#define OMP_SCAN_BODY(NODE) TREE_OPERAND (OMP_SCAN_CHECK (NODE), 0)
#define OMP_SCAN_CLAUSES(NODE) TREE_OPERAND (OMP_SCAN_CHECK (NODE), 1)
@@ -1646,6 +1653,29 @@ class auto_suppress_location_wrappers
!= UNKNOWN_LOCATION)
#define OMP_CLAUSE_LOCATION(NODE) (OMP_CLAUSE_CHECK (NODE))->omp_clause.locus
+#define OMP_CLAUSE_HAS_ITERATORS(NODE) \
+ ((OMP_CLAUSE_CODE (NODE) == OMP_CLAUSE_FROM \
+ || OMP_CLAUSE_CODE (NODE) == OMP_CLAUSE_TO \
+ || OMP_CLAUSE_CODE (NODE) == OMP_CLAUSE_MAP) \
+ && OMP_CLAUSE_ITERATORS (NODE))
+#define OMP_CLAUSE_ITERATORS(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_RANGE_CHECK (OMP_CLAUSE_CHECK (NODE), \
+ OMP_CLAUSE_FROM, \
+ OMP_CLAUSE_MAP), 2)
+
+#define OMP_ITERATORS_VAR(NODE) TREE_VEC_ELT (NODE, 0)
+#define OMP_ITERATORS_BEGIN(NODE) TREE_VEC_ELT (NODE, 1)
+#define OMP_ITERATORS_END(NODE) TREE_VEC_ELT (NODE, 2)
+#define OMP_ITERATORS_STEP(NODE) TREE_VEC_ELT (NODE, 3)
+#define OMP_ITERATORS_ORIG_STEP(NODE) TREE_VEC_ELT (NODE, 4)
+#define OMP_ITERATORS_BLOCK(NODE) TREE_VEC_ELT (NODE, 5)
+#define OMP_ITERATORS_LABEL(NODE) TREE_VEC_ELT (NODE, 6)
+#define OMP_ITERATORS_INDEX(NODE) TREE_VEC_ELT (NODE, 7)
+#define OMP_ITERATORS_ELEMS(NODE) TREE_VEC_ELT (NODE, 8)
+#define OMP_ITERATORS_COUNT(NODE) TREE_VEC_ELT (NODE, 9)
+
+#define OMP_ITERATORS_EXPANDED_P(NODE) (TREE_VEC_LENGTH (NODE) > 6)
+
/* True on OMP_FOR and other OpenMP/OpenACC looping constructs if the loop nest
is non-rectangular. */
#define OMP_FOR_NON_RECTANGULAR(NODE) \
@@ -1898,6 +1928,10 @@ class auto_suppress_location_wrappers
#define OMP_CLAUSE_MAP_READONLY(NODE) \
TREE_READONLY (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_MAP))
+/* Set if 'OMP_CLAUSE_DECL (NODE)' points to read-only memory. */
+#define OMP_CLAUSE_MAP_POINTS_TO_READONLY(NODE) \
+ TREE_CONSTANT (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_MAP))
+
/* Same as above, for use in OpenACC cache directives. */
#define OMP_CLAUSE__CACHE__READONLY(NODE) \
TREE_READONLY (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE__CACHE_))
@@ -1962,6 +1996,8 @@ class auto_suppress_location_wrappers
#define OMP_CLAUSE_REDUCTION_DECL_PLACEHOLDER(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_RANGE_CHECK (NODE, OMP_CLAUSE_REDUCTION, \
OMP_CLAUSE_IN_REDUCTION), 4)
+#define OMP_CLAUSE_REDUCTION_PRIVATE_DECL(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_REDUCTION), 5)
/* True if a REDUCTION clause may reference the original list item (omp_orig)
in its OMP_CLAUSE_REDUCTION_{,GIMPLE_}INIT. */
@@ -2029,6 +2065,15 @@ class auto_suppress_location_wrappers
#define OMP_CLAUSE_ALLOCATE_COMBINED(NODE) \
(OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATE)->base.public_flag)
+#define OMP_CLAUSE_USES_ALLOCATORS_ALLOCATOR(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_USES_ALLOCATORS), 0)
+
+#define OMP_CLAUSE_USES_ALLOCATORS_MEMSPACE(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_USES_ALLOCATORS), 1)
+
+#define OMP_CLAUSE_USES_ALLOCATORS_TRAITS(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_USES_ALLOCATORS), 2)
+
#define OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_TEAMS), 0)
@@ -2055,6 +2100,9 @@ class auto_suppress_location_wrappers
#define OMP_CLAUSE__SIMDUID__DECL(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE__SIMDUID_), 0)
+#define OMP_CLAUSE__OMPACC__SEQ(NODE) \
+ (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE__OMPACC_)->base.public_flag)
+
#define OMP_CLAUSE_SCHEDULE_KIND(NODE) \
(OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_SCHEDULE)->omp_clause.subcode.schedule_kind)
@@ -2118,6 +2166,18 @@ class auto_suppress_location_wrappers
#define OMP_TARGET_DEVICE_MATCHES_PROPERTIES(NODE) \
TREE_OPERAND (OMP_TARGET_DEVICE_MATCHES_CHECK (NODE), 1)
+#define OMP_CLAUSE__MAPPER_BINDING__ID(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, \
+ OMP_CLAUSE__MAPPER_BINDING_), 0)
+
+#define OMP_CLAUSE__MAPPER_BINDING__DECL(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, \
+ OMP_CLAUSE__MAPPER_BINDING_), 1)
+
+#define OMP_CLAUSE__MAPPER_BINDING__MAPPER(NODE) \
+ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, \
+ OMP_CLAUSE__MAPPER_BINDING_), 2)
+
/* SSA_NAME accessors. */
/* Whether SSA_NAME NODE is a virtual operand. This simply caches the
@@ -2208,6 +2268,12 @@ class auto_suppress_location_wrappers
#define OMP_CLAUSE_OPERAND(NODE, I) \
OMP_CLAUSE_ELT_CHECK (NODE, I)
+/* True if the clause decl NODE contains an OpenMP iterator. */
+#define OMP_ITERATOR_DECL_P(NODE) \
+ (TREE_CODE (NODE) == TREE_LIST \
+ && TREE_PURPOSE (NODE) \
+ && TREE_CODE (TREE_PURPOSE (NODE)) == TREE_VEC)
+
/* In a BLOCK (scope) node:
Variables declared in the scope NODE. */
#define BLOCK_VARS(NODE) (BLOCK_CHECK (NODE)->block.vars)
@@ -3365,6 +3431,13 @@ extern void decl_fini_priority_insert (tree, priority_type);
#define VAR_DECL_IS_VIRTUAL_OPERAND(NODE) \
(VAR_DECL_CHECK (NODE)->base.u.bits.saturating_flag)
+/* In a VAR_DECL, set for variables regarded as pointing to memory not written
+ to. SSA_NAME_POINTS_TO_READONLY_MEMORY gets set for SSA_NAMEs created from
+ such VAR_DECLs. Currently used by OpenACC 'readonly' modifier in copyin
+ clauses. */
+#define VAR_POINTS_TO_READONLY(NODE) \
+ (TREE_CHECK (NODE, VAR_DECL)->decl_common.decl_not_flexarray)
+
/* In a VAR_DECL, nonzero if this is a non-local frame structure. */
#define DECL_NONLOCAL_FRAME(NODE) \
(VAR_DECL_CHECK (NODE)->base.default_def_flag)
diff --git a/include/ChangeLog.omp b/include/ChangeLog.omp
new file mode 100644
index 0000000..74413c2
--- /dev/null
+++ b/include/ChangeLog.omp
@@ -0,0 +1,45 @@
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gomp-constants.h (gomp_map_kind): Add GOMP_MAP_TO_GRID,
+ GOMP_MAP_FROM_GRID, GOMP_MAP_GRID_DIM, GOMP_MAP_GRID_STRIDE map kinds.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gomp-constants.h (gomp_map_kind): Add GOMP_MAP_MAPPING_GROUP.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * gomp-constants.h (gomp_map_kind): Add GOMP_MAP_UNSET,
+ GOMP_MAP_PUSH_MAPPER_NAME, GOMP_MAP_POP_MAPPER_NAME artificial mapping
+ clause types.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * gomp-constants.h (GOMP_MAP_NONCONTIG_ARRAY_P): Tweak condition.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <thomas@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * gomp-constants.h (enum gomp_map_kind): Define
+ GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE} and GOMP_MAP_FLAG_SPECIAL_4.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ PR other/76739
+ * gomp-constants.h (GOMP_MAP_FLAG_SPECIAL_3): Define.
+ (enum gomp_map_kind): Add GOMP_MAP_NONCONTIG_ARRAY,
+ GOMP_MAP_NONCONTIG_ARRAY_TO, GOMP_MAP_NONCONTIG_ARRAY_FROM,
+ GOMP_MAP_NONCONTIG_ARRAY_TOFROM, GOMP_MAP_NONCONTIG_ARRAY_FORCE_TO,
+ GOMP_MAP_NONCONTIG_ARRAY_FORCE_FROM,
+ GOMP_MAP_NONCONTIG_ARRAY_FORCE_TOFROM,
+ GOMP_MAP_NONCONTIG_ARRAY_ALLOC, GOMP_MAP_NONCONTIG_ARRAY_FORCE_ALLOC,
+ GOMP_MAP_NONCONTIG_ARRAY_FORCE_PRESENT.
+ (GOMP_MAP_NONCONTIG_ARRAY_P): Define. \ No newline at end of file
diff --git a/include/gomp-constants.h b/include/gomp-constants.h
index 7d6b85f..0bcfd2c 100644
--- a/include/gomp-constants.h
+++ b/include/gomp-constants.h
@@ -176,6 +176,11 @@ enum gomp_map_kind
/* Decrement usage count and deallocate if zero. */
GOMP_MAP_RELEASE = (GOMP_MAP_FLAG_SPECIAL_2
| GOMP_MAP_DELETE),
+ /* Mapping kinds for allocatable arrays. */
+ GOMP_MAP_DECLARE_ALLOCATE = (GOMP_MAP_FLAG_SPECIAL_4
+ | GOMP_MAP_FORCE_TO),
+ GOMP_MAP_DECLARE_DEALLOCATE = (GOMP_MAP_FLAG_SPECIAL_4
+ | GOMP_MAP_FORCE_FROM),
/* The attach/detach mappings below use the OMP_CLAUSE_SIZE field as a
bias. This will typically be zero, except when mapping an array slice
with a non-zero base. In that case the bias will indicate the
@@ -188,6 +193,26 @@ enum gomp_map_kind
/* In OpenACC, detach a pointer to a mapped struct field. */
GOMP_MAP_FORCE_DETACH = (GOMP_MAP_DEEP_COPY
| GOMP_MAP_FLAG_FORCE | 1),
+ /* Mapping kinds for non-contiguous arrays. */
+ GOMP_MAP_NONCONTIG_ARRAY = (GOMP_MAP_FLAG_SPECIAL_3),
+ GOMP_MAP_NONCONTIG_ARRAY_TO = (GOMP_MAP_NONCONTIG_ARRAY
+ | GOMP_MAP_TO),
+ GOMP_MAP_NONCONTIG_ARRAY_FROM = (GOMP_MAP_NONCONTIG_ARRAY
+ | GOMP_MAP_FROM),
+ GOMP_MAP_NONCONTIG_ARRAY_TOFROM = (GOMP_MAP_NONCONTIG_ARRAY
+ | GOMP_MAP_TOFROM),
+ GOMP_MAP_NONCONTIG_ARRAY_FORCE_TO = (GOMP_MAP_NONCONTIG_ARRAY_TO
+ | GOMP_MAP_FLAG_FORCE),
+ GOMP_MAP_NONCONTIG_ARRAY_FORCE_FROM = (GOMP_MAP_NONCONTIG_ARRAY_FROM
+ | GOMP_MAP_FLAG_FORCE),
+ GOMP_MAP_NONCONTIG_ARRAY_FORCE_TOFROM = (GOMP_MAP_NONCONTIG_ARRAY_TOFROM
+ | GOMP_MAP_FLAG_FORCE),
+ GOMP_MAP_NONCONTIG_ARRAY_ALLOC = (GOMP_MAP_NONCONTIG_ARRAY
+ | GOMP_MAP_ALLOC),
+ GOMP_MAP_NONCONTIG_ARRAY_FORCE_ALLOC = (GOMP_MAP_NONCONTIG_ARRAY
+ | GOMP_MAP_FORCE_ALLOC),
+ GOMP_MAP_NONCONTIG_ARRAY_FORCE_PRESENT = (GOMP_MAP_NONCONTIG_ARRAY
+ | GOMP_MAP_FORCE_PRESENT),
/* Like GOMP_MAP_ATTACH, but allow attaching to zero-length array sections
(i.e. set to NULL when array section is not mapped) Currently only used
@@ -195,6 +220,9 @@ enum gomp_map_kind
GOMP_MAP_ATTACH_ZERO_LENGTH_ARRAY_SECTION
= (GOMP_MAP_DEEP_COPY | 2),
+ GOMP_MAP_TO_GRID = (GOMP_MAP_DEEP_COPY | 4),
+ GOMP_MAP_FROM_GRID = (GOMP_MAP_DEEP_COPY | 5),
+
/* Internal to GCC, not used in libgomp. */
/* Do not map, but pointer assign a pointer instead. */
GOMP_MAP_FIRSTPRIVATE_POINTER = (GOMP_MAP_LAST | 1),
@@ -209,7 +237,18 @@ enum gomp_map_kind
GOMP_MAP_PRESENT_ALLOC = (GOMP_MAP_LAST | 4),
GOMP_MAP_PRESENT_TO = (GOMP_MAP_LAST | 5),
GOMP_MAP_PRESENT_FROM = (GOMP_MAP_LAST | 6),
- GOMP_MAP_PRESENT_TOFROM = (GOMP_MAP_LAST | 7)
+ GOMP_MAP_PRESENT_TOFROM = (GOMP_MAP_LAST | 7),
+ /* Unset, used for "declare mapper" maps with no explicit data movement
+ specified. These use the movement specified at the invocation site. */
+ GOMP_MAP_UNSET = (GOMP_MAP_LAST | 8),
+ /* Used to record the name of a named mapper. */
+ GOMP_MAP_PUSH_MAPPER_NAME = (GOMP_MAP_LAST | 9),
+ GOMP_MAP_POP_MAPPER_NAME = (GOMP_MAP_LAST | 10),
+ /* Used to hold a TREE_LIST of grouped nodes in an 'omp declare mapper'
+ definition (only for Fortran at present). */
+ GOMP_MAP_MAPPING_GROUP = (GOMP_MAP_LAST | 11),
+ GOMP_MAP_GRID_DIM = (GOMP_MAP_LAST | 12),
+ GOMP_MAP_GRID_STRIDE = (GOMP_MAP_LAST | 13)
};
#define GOMP_MAP_COPY_TO_P(X) \
@@ -250,6 +289,9 @@ enum gomp_map_kind
(((X) & GOMP_MAP_FLAG_PRESENT) == GOMP_MAP_FLAG_PRESENT \
|| (X) == GOMP_MAP_FORCE_PRESENT)
+#define GOMP_MAP_NONCONTIG_ARRAY_P(X) \
+ (((X) & GOMP_MAP_NONCONTIG_ARRAY) != 0 \
+ && ((X) & GOMP_MAP_FLAG_SPECIAL_4) == 0)
/* Asynchronous behavior. Keep in sync with
libgomp/{openacc.h,openacc.f90,openacc_lib.h}:acc_async_t. */
diff --git a/libgcc/ChangeLog.omp b/libgcc/ChangeLog.omp
new file mode 100644
index 0000000..45b4742
--- /dev/null
+++ b/libgcc/ChangeLog.omp
@@ -0,0 +1,10 @@
+2025-05-15 Thomas Schwinge <tschwinge@baylibre.com>
+
+ Backported from master:
+ 2025-04-25 Thomas Schwinge <tschwinge@baylibre.com>
+
+ PR target/119853
+ PR target/119854
+ * config/gcn/crt0.c (_fini_array): Call
+ '__GCC_offload___cxa_finalize'.
+ * config/nvptx/gbl-ctors.c (__static_do_global_dtors): Likewise. \ No newline at end of file
diff --git a/libgcc/config/gcn/crt0.c b/libgcc/config/gcn/crt0.c
index dbd6749..cc23e21 100644
--- a/libgcc/config/gcn/crt0.c
+++ b/libgcc/config/gcn/crt0.c
@@ -24,6 +24,28 @@ typedef long long size_t;
/* Provide an entry point symbol to silence a linker warning. */
void _start() {}
+
+#define PR119369_fixed 0
+
+
+/* Host/device compatibility: '__cxa_finalize'. Dummy; if necessary,
+ overridden via libgomp 'target-cxa-dso-dtor.c'. */
+
+#if PR119369_fixed
+extern void __GCC_offload___cxa_finalize (void *) __attribute__((weak));
+#else
+void __GCC_offload___cxa_finalize (void *) __attribute__((weak));
+
+void __attribute__((weak))
+__GCC_offload___cxa_finalize (void *dso_handle __attribute__((unused)))
+{
+}
+#endif
+
+/* There are no DSOs; this is the main program. */
+static void * const __dso_handle = 0;
+
+
#ifdef USE_NEWLIB_INITFINI
extern void __libc_init_array (void) __attribute__((weak));
@@ -38,6 +60,11 @@ void _init_array()
__attribute__((amdgpu_hsa_kernel ()))
void _fini_array()
{
+#if PR119369_fixed
+ if (__GCC_offload___cxa_finalize)
+#endif
+ __GCC_offload___cxa_finalize (__dso_handle);
+
__libc_fini_array ();
}
@@ -70,6 +97,11 @@ void _init_array()
__attribute__((amdgpu_hsa_kernel ()))
void _fini_array()
{
+#if PR119369_fixed
+ if (__GCC_offload___cxa_finalize)
+#endif
+ __GCC_offload___cxa_finalize (__dso_handle);
+
size_t count;
size_t i;
diff --git a/libgcc/config/nvptx/gbl-ctors.c b/libgcc/config/nvptx/gbl-ctors.c
index 2626811..10954ee 100644
--- a/libgcc/config/nvptx/gbl-ctors.c
+++ b/libgcc/config/nvptx/gbl-ctors.c
@@ -31,6 +31,20 @@
extern int atexit (void (*function) (void));
+/* Host/device compatibility: '__cxa_finalize'. Dummy; if necessary,
+ overridden via libgomp 'target-cxa-dso-dtor.c'. */
+
+extern void __GCC_offload___cxa_finalize (void *);
+
+void __attribute__((weak))
+__GCC_offload___cxa_finalize (void *dso_handle __attribute__((unused)))
+{
+}
+
+/* There are no DSOs; this is the main program. */
+static void * const __dso_handle = 0;
+
+
/* Handler functions ('static', in contrast to the 'gbl-ctors.h'
prototypes). */
@@ -49,6 +63,8 @@ static void __static_do_global_dtors (void);
static void
__static_do_global_dtors (void)
{
+ __GCC_offload___cxa_finalize (__dso_handle);
+
func_ptr *p = __DTOR_LIST__;
++p;
for (; *p; ++p)
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
new file mode 100644
index 0000000..9823e58
--- /dev/null
+++ b/libgomp/ChangeLog.omp
@@ -0,0 +1,863 @@
+2025-05-16 Tobias Burnus <tburnus@baylibre.com>
+
+ Backported from master:
+ 2025-05-14 Tobias Burnus <tburnus@baylibre.com>
+
+ * target.c (gomp_attach_pointer): Return bool; accept additional
+ bool to optionally silence the fatal pointee-not-found error.
+ (gomp_map_vars_internal): If the pointee could not be found,
+ check whether it was mapped as GOMP_MAP_ZERO_LEN_ARRAY_SECTION.
+ * libgomp.h (gomp_attach_pointer): Update prototype.
+ * oacc-mem.c (acc_attach_async, goacc_enter_data_internal): Update
+ calls.
+ * testsuite/libgomp.c/target-map-zero-sized.c: New test.
+ * testsuite/libgomp.c/target-map-zero-sized-2.c: New test.
+ * testsuite/libgomp.c/target-map-zero-sized-3.c: New test.
+
+2025-05-15 Tobias Burnus <tburnus@baylibre.com>
+
+ Backported from master:
+ 2025-05-09 Tobias Burnus <tburnus@baylibre.com>
+
+ * testsuite/libgomp.c/interop-cuda-full.c: Use 'link' instead
+ of 'run' when the default device is "! offload_device_nvptx".
+ * testsuite/libgomp.c/interop-cuda-libonly.c: Likewise.
+ * testsuite/libgomp.c/interop-hip-nvidia-full.c: Likewise.
+ * testsuite/libgomp.c/interop-hip-nvidia-no-headers.c: Likewise.
+ * testsuite/libgomp.c/interop-hip-nvidia-no-hip-header.c: Likewise.
+ * testsuite/libgomp.fortran/interop-hip-nvidia-full.F90: Likewise.
+ * testsuite/libgomp.fortran/interop-hip-nvidia-no-module.F90: Likewise.
+ * testsuite/libgomp.c/interop-hip-amd-full.c: Use 'link' instead
+ of 'run' when the default device is "! offload_device_gcn".
+ * testsuite/libgomp.c/interop-hip-amd-no-hip-header.c: Likewise.
+ * testsuite/libgomp.fortran/interop-hip-amd-full.F90: Likewise.
+ * testsuite/libgomp.fortran/interop-hip-amd-no-module.F90: Likewise.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ * libgomp.texi: Mark need_device_addr as supported.
+ * testsuite/libgomp.c++/need-device-ptr.C: New.
+ * testsuite/libgomp.c-c++-common/dispatch-3.c: New.
+ * testsuite/libgomp.fortran/adjust-args-array-descriptor.f90: New.
+ * testsuite/libgomp.fortran/need-device-ptr.f90: New.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+
+ PR c++/119659
+ PR c++/118859
+ PR c++/119601
+ PR c++/119602
+ PR c++/119775
+ * libgomp.texi: Set 'adjust args' variadic arguments support to Y.
+
+2025-05-15 Andrew Stubbs <ams@baylibre.com>
+
+ Backported from master:
+ 2025-04-25 Andrew Stubbs <ams@baylibre.com>
+
+ * testsuite/libgomp.c/interop-hsa.c: New test.
+
+2025-05-15 Thomas Schwinge <tschwinge@baylibre.com>
+
+ Backported from master:
+ 2025-04-25 Thomas Schwinge <tschwinge@baylibre.com>
+
+ PR target/119853
+ PR target/119854
+ * target-cxa-dso-dtor.c: New.
+ * config/accel/target-cxa-dso-dtor.c: Likewise.
+ * Makefile.am (libgomp_la_SOURCES): Add it.
+ * Makefile.in: Regenerate.
+ * testsuite/libgomp.c++/target-cdtor-1.C: New.
+ * testsuite/libgomp.c++/target-cdtor-2.C: Likewise.
+
+2025-05-15 Thomas Schwinge <tschwinge@baylibre.com>
+
+ Backported from master:
+ 2025-04-25 Thomas Schwinge <tschwinge@baylibre.com>
+
+ * testsuite/libgomp.c-c++-common/target-cdtor-1.c: New.
+
+2025-05-15 Andrew Pinski <quic_apinski@quicinc.com>
+
+ Backported from master:
+ 2025-04-25 Andrew Pinski <quic_apinski@quicinc.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+
+ PR target/119737
+ * testsuite/libgomp.c++/target-exceptions-throw-1.C: Remove
+ PR119737 XFAILing.
+ * testsuite/libgomp.c++/target-exceptions-throw-2.C: Likewise.
+ * testsuite/libgomp.oacc-c++/exceptions-throw-1.C: Likewise.
+ * testsuite/libgomp.oacc-c++/exceptions-throw-2.C: Likewise.
+
+2025-05-15 Thomas Schwinge <tschwinge@baylibre.com>
+
+ Backported from master:
+ 2025-04-25 Thomas Schwinge <tschwinge@baylibre.com>
+
+ PR target/118794
+ * testsuite/libgomp.c++/target-exceptions-pr118794-1.C: Adjust for
+ 'targetm.arm_eabi_unwinder'.
+ * testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-GCN.C:
+ Likewise.
+ * testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-nvptx.C:
+ Likewise.
+
+2025-05-15 Tobias Burnus <tburnus@baylibre.com>
+
+ Backported from master:
+ 2025-04-24 Tobias Burnus <tburnus@baylibre.com>
+
+ * testsuite/lib/libgomp.exp
+ (check_effective_target_gomp_hip_header_nvidia): Compile with
+ "-Wno-deprecated-declarations".
+ * testsuite/libgomp.c/interop-hip-nvidia-full.c: Likewise.
+ * testsuite/libgomp.c/interop-hipblas-nvidia-full.c: Likewise.
+ * testsuite/libgomp.c/interop-hipblas.h: Add workarounds
+ when using the HIP headers with __HIP_PLATFORM_NVIDIA__.
+
+2025-05-15 Tobias Burnus <tburnus@baylibre.com>
+
+ Backported from master:
+ 2025-04-24 Tobias Burnus <tburnus@baylibre.com>
+
+ * testsuite/lib/libgomp.exp (check_effective_target_openacc_cublas,
+ check_effective_target_openacc_cudart): Update description as
+ the check requires more.
+ (check_effective_target_openacc_libcuda,
+ check_effective_target_openacc_libcublas,
+ check_effective_target_openacc_libcudart,
+ check_effective_target_gomp_hip_header_amd,
+ check_effective_target_gomp_hip_header_nvidia,
+ check_effective_target_gomp_hipfort_module,
+ check_effective_target_gomp_libamdhip64,
+ check_effective_target_gomp_libhipblas): New.
+ * testsuite/libgomp.c-c++-common/interop-2.c: New test.
+ * testsuite/libgomp.c/interop-cublas-full.c: New test.
+ * testsuite/libgomp.c/interop-cublas-libonly.c: New test.
+ * testsuite/libgomp.c/interop-cuda-full.c: New test.
+ * testsuite/libgomp.c/interop-cuda-libonly.c: New test.
+ * testsuite/libgomp.c/interop-hip-amd-full.c: New test.
+ * testsuite/libgomp.c/interop-hip-amd-no-hip-header.c: New test.
+ * testsuite/libgomp.c/interop-hip-nvidia-full.c: New test.
+ * testsuite/libgomp.c/interop-hip-nvidia-no-headers.c: New test.
+ * testsuite/libgomp.c/interop-hip-nvidia-no-hip-header.c: New test.
+ * testsuite/libgomp.c/interop-hip.h: New test.
+ * testsuite/libgomp.c/interop-hipblas-amd-full.c: New test.
+ * testsuite/libgomp.c/interop-hipblas-amd-no-hip-header.c: New test.
+ * testsuite/libgomp.c/interop-hipblas-nvidia-full.c: New test.
+ * testsuite/libgomp.c/interop-hipblas-nvidia-no-headers.c: New test.
+ * testsuite/libgomp.c/interop-hipblas-nvidia-no-hip-header.c: New test.
+ * testsuite/libgomp.c/interop-hipblas.h: New test.
+ * testsuite/libgomp.fortran/interop-hip-amd-full.F90: New test.
+ * testsuite/libgomp.fortran/interop-hip-amd-no-module.F90: New test.
+ * testsuite/libgomp.fortran/interop-hip-nvidia-full.F90: New test.
+ * testsuite/libgomp.fortran/interop-hip-nvidia-no-module.F90: New test.
+ * testsuite/libgomp.fortran/interop-hip.h: New test.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * testsuite/libgomp.fortran/allocatable-comp-iterators.f90: Add test
+ for non-const iterator boundaries.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * testsuite/libgomp.fortran/allocatable-comp-iterators.f90: New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * testsuite/libgomp.fortran/mapper-iterators-1.f90: New test.
+ * testsuite/libgomp.fortran/mapper-iterators-2.f90: New test.
+ * testsuite/libgomp.fortran/mapper-iterators-3.f90: New test.
+ * testsuite/libgomp.fortran/mapper-iterators-4.f90: New test.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * testsuite/libgomp.c-c++-common/mapper-iterators-1.c: New test.
+ * testsuite/libgomp.c-c++-common/mapper-iterators-2.c: New test.
+ * testsuite/libgomp.c-c++-common/mapper-iterators-3.c: New test.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * testsuite/libgomp.c-c++-common/target-map-iterators-4.c: New.
+ * testsuite/libgomp.c-c++-common/target-map-iterators-5.c: New.
+ * testsuite/libgomp.c-c++-common/target-update-iterators-4.c: New.
+ * testsuite/libgomp.fortran/target-map-iterators-4.f90: New.
+ * testsuite/libgomp.fortran/target-map-iterators-5.f90: New.
+ * testsuite/libgomp.fortran/target-update-iterators-4.f90: New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * testsuite/libgomp.fortran/target-update-iterators-1.f90: New.
+ * testsuite/libgomp.fortran/target-update-iterators-2.f90: New.
+ * testsuite/libgomp.fortran/target-update-iterators-3.f90: New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * target.c (kind_to_name): Handle GOMP_MAP_STRUCT and
+ GOMP_MAP_STRUCT_UNORD.
+ (gomp_add_map): New.
+ (gomp_merge_iterator_maps): Expand fields of a struct mapping
+ breadth-first.
+ * testsuite/libgomp.fortran/target-map-iterators-1.f90: New.
+ * testsuite/libgomp.fortran/target-map-iterators-2.f90: New.
+ * testsuite/libgomp.fortran/target-map-iterators-3.f90: New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * target.c (gomp_update): Call gomp_merge_iterator_maps. Free
+ allocated variables.
+ * testsuite/libgomp.c-c++-common/target-update-iterators-1.c: New.
+ * testsuite/libgomp.c-c++-common/target-update-iterators-2.c: New.
+ * testsuite/libgomp.c-c++-common/target-update-iterators-3.c: New.
+
+2025-05-15 Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Andrew Stubbs <ams@baylibre.com>
+
+ * target.c (kind_to_name): New.
+ (gomp_merge_iterator_maps): New.
+ (gomp_map_vars_internal): Call gomp_merge_iterator_maps. Copy
+ address of only the first iteration to target vars. Free allocated
+ variables.
+ * testsuite/libgomp.c-c++-common/target-map-iterators-1.c: New.
+ * testsuite/libgomp.c-c++-common/target-map-iterators-2.c: New.
+ * testsuite/libgomp.c-c++-common/target-map-iterators-3.c: New.
+
+2025-05-15 Thomas Schwinge <tschwinge@baylibre.com>
+
+ * testsuite/libgomp.oacc-c++/exceptions-bad_cast-3.C: Adjust.
+ * testsuite/libgomp.oacc-c++/exceptions-throw-3.C: Likewise.
+ * testsuite/libgomp.oacc-c++/pr119692-1-1.C: Likewise.
+ * testsuite/libgomp.oacc-c++/pr119692-1-2.C: Likewise.
+ * testsuite/libgomp.oacc-c++/pr119692-1-3.C: Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * acc_prof.h (_ACC_PROF_INFO_VERSION): Adjust to 201811.
+ * libgomp.texi (Enabling OpenACC): Adjust version
+ references to 2.7 from 2.6.
+ * openacc.f90 (module openacc): Adjust openacc_version to 201811.
+ * openacc_lib.h (openacc_version): Adjust openacc_version to 201811.
+ * testsuite/libgomp.oacc-c-c++-common/acc_prof-version-1.c:
+ Adjust test value to 201811.
+ * testsuite/libgomp.oacc-fortran/openacc_version-1.f: Adjust
+ test value to 201811.
+ * testsuite/libgomp.oacc-fortran/openacc_version-2.f90: Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-2.c: Adjust test.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-3.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-4.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-5.c: Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@baylibre.com>
+
+ * testsuite/libgomp.oacc-c-c++-common/reduction.h
+ (check_reduction_array_xx): New macro.
+ (operator_apply): Likewise.
+ (check_reduction_array_op): Likewise.
+ (check_reduction_arraysec_op): Likewise.
+ (function_apply): Likewise.
+ (check_reduction_array_macro): Likewise.
+ (check_reduction_arraysec_macro): Likewise.
+ (check_reduction_xxx_xx_all): Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-1.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-2.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-3.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-4.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-arrays-5.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-structs-1.c: New test.
+ * testsuite/libgomp.oacc-fortran/reduction-10.f90: New test.
+ * testsuite/libgomp.oacc-fortran/reduction-11.f90: New test.
+ * testsuite/libgomp.oacc-fortran/reduction-12.f90: New test.
+ * testsuite/libgomp.oacc-fortran/reduction-13.f90: New test.
+ * testsuite/libgomp.oacc-fortran/reduction-14.f90: New test.
+ * testsuite/libgomp.oacc-fortran/reduction-15.f90: New test.
+ * testsuite/libgomp.oacc-fortran/reduction-16.f90: New test.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+
+ * testsuite/libgomp.c-c++-common/delim-declare-variant-1.c: New.
+
+2025-05-15 Sandra Loosemore <sloosemore@baylibre.com>
+ Julian Brown <julian@codesourcery.com>
+ waffl3x <waffl3x@baylibre.com>
+
+ * testsuite/libgomp.c++/delim-declare-variant-1.C: New.
+ * testsuite/libgomp.c++/delim-declare-variant-2.C: New.
+ * testsuite/libgomp.c++/delim-declare-variant-7.C: New.
+
+2025-05-15 Paul-Antoine Arras <parras@baylibre.com>
+
+ * target.c (omp_target_memcpy_rect_worker): Require unit strides
+ and matching element size.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ Backported from master:
+ 2025-05-01 Tobias Burnus <tobias@codesourcery.com>
+
+ * testsuite/libgomp.fortran/allocate-8a.f90: New test.
+
+2025-05-15 waffl3x <waffl3x@baylibre.com>
+ Tobias Burnus <tobias@codesourcery.com>
+
+ * libgomp.texi: Document C++ support.
+ * testsuite/libgomp.c/allocate-4.c: Move to...
+ * testsuite/libgomp.c-c++-common/allocate-4.c: ...here.
+ * testsuite/libgomp.c/allocate-5.c: Move to...
+ * testsuite/libgomp.c-c++-common/allocate-5.c: ...here.
+ * testsuite/libgomp.c/allocate-6.c: Move to...
+ * testsuite/libgomp.c-c++-common/allocate-6.c: ...here.
+ * testsuite/libgomp.c++/allocate-2.C: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * target.c (omp_target_memcpy_rect_worker): Add 1D strided transfer
+ support.
+
+2025-05-15 Andrew Stubbs <ams@codesourcery.com>
+
+ * config/gcn/target.c (GOMP_target_ext): Add "signal" field.
+ Fix atomics race condition.
+ * config/nvptx/libgomp-nvptx.h (REV_OFFLOAD_QUEUE_SIZE): New define.
+ (struct rev_offload): Implement ring buffer.
+ * config/nvptx/target.c (GOMP_target_ext): Likewise.
+ * env.c (initialize_env): Read GOMP_REVERSE_OFFLOAD_THREADS.
+ * libgomp-plugin.c (GOMP_PLUGIN_target_rev): Replace "aq" parameter
+ with "signal" and "use_aq".
+ * libgomp-plugin.h (GOMP_PLUGIN_target_rev): Likewise.
+ * libgomp.h (gomp_target_rev): Likewise.
+ * plugin/plugin-gcn.c (process_reverse_offload): Add "signal".
+ (console_output): Pass signal value through.
+ * plugin/plugin-nvptx.c (GOMP_OFFLOAD_openacc_async_construct):
+ Attach new threads to the numbered device.
+ Change the flag to CU_STREAM_NON_BLOCKING.
+ (GOMP_OFFLOAD_run): Implement ring-buffer and remove signalling.
+ * target.c (gomp_target_rev): Rename to ...
+ (gomp_target_rev_internal): ... this, and change "dev_num" to
+ "devicep".
+ (gomp_target_rev_worker_thread): New function.
+ (gomp_target_rev): New function (old name).
+ * libgomp.texi: Document GOMP_REVERSE_OFFLOAD_THREADS.
+ * testsuite/libgomp.c/reverse-offload-threads-1.c: New test.
+ * testsuite/libgomp.c/reverse-offload-threads-2.c: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Andrew Stubbs <ams@baylibre.com>
+ Kwok Cheung Yeung <kcyeung@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * testsuite/libgomp.c-c++-common/declare-mapper-18.c: New test.
+ * testsuite/libgomp.fortran/declare-mapper-25.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-28.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * libgomp.h (omp_noncontig_array_desc): Add span field.
+ * target.c (omp_target_memcpy_rect_worker): Add span parameter. Update
+ forward declaration. Handle span != element_size.
+ (gomp_update): Handle bias in descriptor's size slot. Update calls to
+ omp_target_memcpy_rect_worker.
+ * testsuite/libgomp.fortran/noncontig-updates-1.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-2.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-3.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-4.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-5.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-6.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-7.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-8.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-9.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-10.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-11.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-12.f90: New test.
+ * testsuite/libgomp.fortran/noncontig-updates-13.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.c-c++-common/array-shaping-14.c: New test.
+ * testsuite/libgomp.c/array-shaping-1.c: New test.
+ * testsuite/libgomp.c/array-shaping-2.c: New test.
+ * testsuite/libgomp.c/array-shaping-3.c: New test.
+ * testsuite/libgomp.c/array-shaping-4.c: New test.
+ * testsuite/libgomp.c/array-shaping-5.c: New test.
+ * testsuite/libgomp.c/array-shaping-6.c: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * libgomp.h (omp_noncontig_array_desc): New struct.
+ * target.c (omp_target_memcpy_rect_worker): Add stride array
+ parameter. Forward declare. Add STRIDES parameter and strided
+ update support.
+ (gomp_update): Add noncontiguous (strided/shaped) update support.
+ * testsuite/libgomp.c++/array-shaping-1.C: New test.
+ * testsuite/libgomp.c++/array-shaping-2.C: New test.
+ * testsuite/libgomp.c++/array-shaping-3.C: New test.
+ * testsuite/libgomp.c++/array-shaping-4.C: New test.
+ * testsuite/libgomp.c++/array-shaping-5.C: New test.
+ * testsuite/libgomp.c++/array-shaping-6.C: New test.
+ * testsuite/libgomp.c++/array-shaping-7.C: New test.
+ * testsuite/libgomp.c++/array-shaping-8.C: New test.
+ * testsuite/libgomp.c++/array-shaping-9.C: New test.
+ * testsuite/libgomp.c++/array-shaping-10.C: New test.
+ * testsuite/libgomp.c++/array-shaping-11.C: New test.
+ * testsuite/libgomp.c++/array-shaping-12.C: New test.
+ * testsuite/libgomp.c++/array-shaping-13.C: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.fortran/declare-mapper-30.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-4.f90: Adjust test for new
+ lookup behaviour.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.fortran/declare-mapper-2.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-3.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-4.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-6.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-7.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-8.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-9.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-10.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-11.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-12.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-13.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-15.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-17.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-18.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-19.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-20.f90: New test.
+ * testsuite/libgomp.fortran/declare-mapper-21.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.c-c++-common/declare-mapper-9.c: Enable for C.
+ * testsuite/libgomp.c-c++-common/declare-mapper-10.c: Likewise.
+ * testsuite/libgomp.c-c++-common/declare-mapper-11.c: Likewise.
+ * testsuite/libgomp.c-c++-common/declare-mapper-12.c: Likewise.
+ * testsuite/libgomp.c-c++-common/declare-mapper-13.c: Likewise.
+ * testsuite/libgomp.c-c++-common/declare-mapper-14.c: Likewise.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.c++/declare-mapper-1.C: New test.
+ * testsuite/libgomp.c++/declare-mapper-2.C: New test.
+ * testsuite/libgomp.c++/declare-mapper-3.C: New test.
+ * testsuite/libgomp.c++/declare-mapper-4.C: New test.
+ * testsuite/libgomp.c++/declare-mapper-5.C: New test.
+ * testsuite/libgomp.c++/declare-mapper-6.C: New test.
+ * testsuite/libgomp.c++/declare-mapper-7.C: New test.
+ * testsuite/libgomp.c++/declare-mapper-8.C: New test.
+ * testsuite/libgomp.c-c++-common/declare-mapper-9.c: New test (only
+ enabled for C++ for now).
+ * testsuite/libgomp.c-c++-common/declare-mapper-10.c: Likewise.
+ * testsuite/libgomp.c-c++-common/declare-mapper-11.c: Likewise.
+ * testsuite/libgomp.c-c++-common/declare-mapper-12.c: Likewise.
+ * testsuite/libgomp.c-c++-common/declare-mapper-13.c: Likewise.
+ * testsuite/libgomp.c-c++-common/declare-mapper-14.c: Likewise.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * testsuite/libgomp.oacc-c-c++-common/implicit-mapping-1.c: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-1.f90: New
+ test.
+ * testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-2.f90: New
+ test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+ Sandra Loosemore <sandra@baylibre.com>
+
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90:
+ Remove xfails.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-1-runtime.f90:
+ Remove xfails.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90:
+ Remove xfails.
+ * testsuite/libgomp.oacc-fortran/declare-create-1.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-create-2.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-create-3.f90: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.oacc-c-c++-common/pr70828.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/pr70828-2.c: Likewise.
+ * testsuite/libgomp.oacc-fortran/pr70828.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/pr70828-2.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/pr70828-3.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/pr70828-4.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/pr70828-5.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/pr70828-6.f90: Likewise.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+
+ Backported from master:
+ 2023-05-19 Chung-Lin Tang <cltang@codesourcery.com>
+
+ * config/nvptx/team.c (__nvptx_omp_num_threads): New global variable in
+ shared memory.
+ * testsuite/libgomp.c-c++-common/for-17.c: New file.
+ * testsuite/libgomp.c-c++-common/for-18.c: New file.
+
+2025-05-15 Thomas Schwinge <thomas@codesourcery.com>
+
+ * libgomp.texi (AMD Radeon, nvptx): Document OpenMP 'pinned'
+ memory.
+
+2025-05-15 Thomas Schwinge <thomas@codesourcery.com>
+
+ * target.c (gomp_unmap_vars_internal): Queue splay-tree keys for
+ removal after main loop.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * testsuite/libgomp.fortran/target-enter-data-3a.f90: New test.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * testsuite/libgomp.fortran/target-13.f90: Update test.
+
+2025-05-15 Tobias Burnus <tobias@codesourcery.com>
+
+ * testsuite/libgomp.c++/c++.exp (check_effective_target_c,
+ check_effective_target_c++): Add.
+ * testsuite/libgomp.c/c.exp (check_effective_target_c,
+ check_effective_target_c++): Add.
+ * testsuite/libgomp.fortran/uses_allocators_2.f90: Remove 'sorry'.
+ * testsuite/libgomp.c-c++-common/uses_allocators-1.c: New test.
+ * testsuite/libgomp.c-c++-common/uses_allocators-2.c: New test.
+ * testsuite/libgomp.c-c++-common/uses_allocators-3.c: New test.
+ * testsuite/libgomp.c-c++-common/uses_allocators-4.c: New test.
+ * testsuite/libgomp.fortran/uses_allocators_3.f90: New test.
+ * testsuite/libgomp.fortran/uses_allocators_4.f90: New test.
+ * testsuite/libgomp.fortran/uses_allocators_5.f90: New test.
+ * testsuite/libgomp.fortran/uses_allocators_6.f90: New test.
+
+2025-05-15 Andrew Stubbs <ams@baylibre.com>
+
+ * Makefile.am (libgomp_la_SOURCES): Add usmpin-allocator.c.
+ * Makefile.in: Regenerate.
+ * config/linux/allocator.c: Include unistd.h.
+ (pin_ctx): New variable.
+ (ctxlock): New variable.
+ (linux_init_pin_ctx): New function.
+ (linux_memspace_alloc): Use usmpin-allocator for pinned memory.
+ (linux_memspace_free): Likewise.
+ (linux_memspace_realloc): Likewise.
+ * libgomp.h (usmpin_init_context): New prototype.
+ (usmpin_register_memory): New prototype.
+ (usmpin_alloc): New prototype.
+ (usmpin_free): New prototype.
+ (usmpin_realloc): New prototype.
+ * testsuite/libgomp.c/alloc-pinned-8.c: New test.
+ * usmpin-allocator.c: New file.
+
+2025-05-15 Andrew Stubbs <ams@baylibre.com>
+ Thomas Schwinge <thomas@codesourcery.com>
+
+ * config/linux/allocator.c: Include assert.h.
+ (using_device_for_page_locked): New variable.
+ (linux_memspace_alloc): Add init0 parameter. Support device pinning.
+ (linux_memspace_calloc): Set init0 to true.
+ (linux_memspace_free): Support device pinning.
+ (linux_memspace_realloc): Support device pinning.
+ (MEMSPACE_ALLOC): Set init0 to false.
+ * libgomp-plugin.h
+ (GOMP_OFFLOAD_page_locked_host_alloc): New prototype.
+ (GOMP_OFFLOAD_page_locked_host_free): Likewise.
+ * libgomp.h (gomp_page_locked_host_alloc): Likewise.
+ (gomp_page_locked_host_free): Likewise.
+ (struct gomp_device_descr): Add page_locked_host_alloc_func and
+ page_locked_host_free_func.
+ * libgomp.texi: Adjust the docs for the pinned trait.
+ * libgomp_g.h (GOMP_enable_pinned_mode): New prototype.
+ * plugin/plugin-nvptx.c
+ (GOMP_OFFLOAD_page_locked_host_alloc): New function.
+ (GOMP_OFFLOAD_page_locked_host_free): Likewise.
+ * target.c (device_for_page_locked): New variable.
+ (get_device_for_page_locked): New function.
+ (gomp_page_locked_host_alloc): Likewise.
+ (gomp_page_locked_host_free): Likewise.
+ (gomp_load_plugin_for_device): Add page_locked_host_alloc and
+ page_locked_host_free.
+ * testsuite/libgomp.c/alloc-pinned-1.c: Change expectations for NVPTX
+ devices.
+ * testsuite/libgomp.c/alloc-pinned-2.c: Likewise.
+ * testsuite/libgomp.c/alloc-pinned-3.c: Likewise.
+ * testsuite/libgomp.c/alloc-pinned-4.c: Likewise.
+ * testsuite/libgomp.c/alloc-pinned-5.c: Likewise.
+ * testsuite/libgomp.c/alloc-pinned-6.c: Likewise.
+
+2025-05-15 Andrew Stubbs <ams@baylibre.com>
+
+ * config/linux/allocator.c (always_pinned_mode): New variable.
+ (GOMP_enable_pinned_mode): New function.
+ (linux_memspace_alloc): Disable pinning when always_pinned_mode set.
+ (linux_memspace_calloc): Likewise.
+ (linux_memspace_free): Likewise.
+ (linux_memspace_realloc): Likewise.
+ * libgomp.map: Add GOMP_enable_pinned_mode.
+ * testsuite/libgomp.c/alloc-pinned-7.c: New test.
+ * testsuite/libgomp.c-c++-common/alloc-pinned-1.c: New test.
+
+2025-05-15 Kwok Cheung Yeung <kcy@codesourcery.com>
+
+ * testsuite/libgomp.c-c++-common/collapse-4.c: New.
+ * testsuite/libgomp.fortran/collapse5.f90: New.
+
+2025-05-15 Andrew Stubbs <ams@codesourcery.com>
+
+ * config/gcn/bar.h (gomp_barrier_init): Limit thread count to the
+ actual physical number.
+ * config/gcn/team.c (gomp_team_start): Don't attempt to set up
+ threads that do not exist.
+
+2025-05-15 Andrew Stubbs <ams@codesourcery.com>
+
+ * plugin/plugin-nvptx.c (GOMP_OFFLOAD_alloc): Remove early call to
+ nvptx_stacks_free.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.oacc-c-c++-common/loop-gwv-1.c: Adjust for loop
+ lowering changes.
+ * testsuite/libgomp.oacc-c-c++-common/loop-wv-1.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/loop-red-gwv-1.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/loop-red-wv-1.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/routine-gwv-1.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/routine-wv-1.c: Likewise.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <thomas@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ * libgomp.h (gomp_acc_declare_allocate): Remove prototype.
+ * oacc-mem.c (gomp_acc_declare_allocate): New function.
+ (find_group_last): Handle GOMP_MAP_DECLARE_ALLOCATE and
+ GOMP_MAP_DECLARE_DEALLOCATE groupings.
+ (goacc_enter_data_internal): Fix kind check for
+ GOMP_MAP_DECLARE_ALLOCATE. Pass new pointer argument to
+ gomp_acc_declare_allocate. Unlock mutex before calling
+ gomp_acc_declare_allocate and relock it afterwards.
+ (goacc_exit_data_internal): Unlock device mutex around
+ gomp_acc_declare_allocate call. Pass new pointer argument. Handle
+ group pointer mapping for deallocate.
+ * testsuite/libgomp.oacc-fortran/allocatable-scalar.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90:
+ Adjust.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-1-runtime.f90:
+ Likewise.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90:
+ Likewise.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90:
+ Adjust.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90:
+ Likewise.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1.f90:
+ New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Sandra Loosemore <sandra@baylibre.com>
+
+ * testsuite/libgomp.oacc-c++/privatized-ref-3.C: Add xfails.
+ * testsuite/libgomp.oacc-fortran/optional-private.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/privatized-ref-1.f95: Likewise.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Sandra Loosemore <sloosemore@baylibre.com>
+
+ * testsuite/libgomp.oacc-fortran/optional-reduction.f90: Remove
+ xfail on bogus warnings.
+ * testsuite/libgomp.oacc-fortran/parallel-reduction.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/pr70643.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/reduction-5.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/reduction-7.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/reference-reductions.f90: Likewise.
+
+2025-05-15 Thomas Schwinge <thomas@codesourcery.com>
+ Maciej W. Rozycki <macro@codesourcery.com>
+
+ * Makefile.am (libgomp_la_SOURCES): Add
+ oacc-profiling-acc_register_library.c.
+ * Makefile.in: Regenerate.
+ * libgomp.texi: Remove paragraph about acc_register_library.
+ * oacc-init.c (get_property_any): Add profiling code.
+ * oacc-parallel.c (GOACC_parallel_keyed_internal): Set device_api for
+ profiling.
+ * oacc-profiling-acc_register_library.c: New file.
+ * oacc-profiling.c (goacc_profiling_initialize): Call
+ acc_register_library. Avoid duplicate registration.
+ (acc_register_library): Remove.
+ * config/nvptx/oacc-profiling-acc_register_library.c:
+ New empty file.
+ * config/nvptx/oacc-profiling.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/acc_prof-dispatch-1.c: Remove
+ call to acc_register_library.
+ * testsuite/libgomp.oacc-c-c++-common/acc_prof-init-1.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/acc_prof-kernels-1.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/acc_prof-parallel-1.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/acc_prof-valid_bytes-1.c:
+ Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/acc_prof-version-1.c: Likewise.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Chung-Lin Tang <cltang@codesourcery.com>
+
+ * testsuite/libgomp.oacc-c-c++-common/privatize-reduction-1.c: New
+ test.
+ * testsuite/libgomp.oacc-c-c++-common/privatize-reduction-2.c: New
+ test.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+
+ * testsuite/libgomp.oacc-c-c++-common/loop-auto-1.c: Adjust test case
+ to conform to the new behavior of the auto clause in OpenACC 2.5.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+
+ * testsuite/libgomp.oacc-c++/firstprivate-int.C: New test.
+ * testsuite/libgomp.oacc-c-c++-common/firstprivate-int.c: New
+ test.
+ * testsuite/libgomp.oacc-c-c++-common/data-firstprivate-1.c: XFAIL
+ execution test.
+ * testsuite/libgomp.oacc-fortran/firstprivate-int.f90: New test.
+
+2025-05-15 Nathan Sidwell <nathan@acm.org>
+ Tom de Vries <tdevries@suse.de>
+ Thomas Schwinge <thomas@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+
+ * testsuite/libgomp.oacc-c-c++-common/loop-default-compile.c: New.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ James Norris <jnorris@codesourcery.com>
+ Tom de Vries <tom@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tburnus@baylibre.com>
+
+ * testsuite/libgomp.oacc-fortran/data-3.f90: Update parallel
+ regions to denote variables copyied in via acc enter data as
+ present.
+ * testsuite/libgomp.oacc-c-c++-common/subr.h: Reimplement.
+ * testsuite/libgomp.oacc-c-c++-common/subr.ptx: Regenerated PTX.
+ * testsuite/libgomp.oacc-c-c++-common/timer.h: Removed.
+ * testsuite/libgomp.oacc-c-c++-common/lib-69.c: Change async checks.
+ * testsuite/libgomp.oacc-c-c++-common/lib-70.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/lib-72.c: Rework kernel i/f and
+ change async checks.
+ * testsuite/libgomp.oacc-c-c++-common/lib-73.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/lib-74.c: Rework kernel i/f and
+ timing checks.
+ * testsuite/libgomp.oacc-c-c++-common/lib-75.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/lib-76.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/lib-78.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/lib-79.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/lib-81.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/lib-82.c: Likewise.
+ * testsuite/libgomp.oacc-c-c++-common/lib-93.c: New test.
+
+2025-05-15 Julian Brown <julian@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+ Nathan Sidwell <nathan@acm.org>
+
+ * testsuite/libgomp.oacc-c-c++-common/par-reduction-3.c: New.
+ * testsuite/libgomp.oacc-c-c++-common/reduction-cplx-flt-2.c: New.
+ * testsuite/libgomp.oacc-fortran/reduction-9.f90: New.
+
+2025-05-15 Cesar Philippidis <cesar@codesourcery.com>
+ James Norris <jnorris@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+ Tobias Burnus <tobias@codesourcery.com>
+ Thomas Schwinge <tschwinge@baylibre.com>
+
+ * oacc-parallel.c (GOACC_parallel_keyed): Handle Fortran deviceptr
+ clause.
+ (GOACC_data_start): Likewise.
+ * testsuite/libgomp.oacc-fortran/deviceptr-1.f90: New test.
+
+2025-05-15 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR other/76739
+ * target.c (gomp_map_vars_internal): Pass pre-allocated 'ptrblock'
+ to 'goacc_noncontig_array_create_ptrblock'.
+ * oacc-parallel.c (goacc_noncontig_array_create_ptrblock): Adjust.
+ * oacc-int.h (goacc_noncontig_array_create_ptrblock): Adjust.
+
+2025-05-15 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR other/76739
+ * oacc-parallel.c (GOACC_parallel_keyed): Given OpenACC 'async',
+ defer 'free' of non-contiguous array support data structures.
+ * target.c (gomp_map_vars_internal): Likewise.
+
+2025-05-15 Thomas Schwinge <thomas@codesourcery.com>
+
+ PR other/76739
+ * libgomp.h (goacc_map_vars): Add 'struct goacc_ncarray_info *'
+ formal parameter.
+ (gomp_map_vars_openacc): Remove.
+ * target.c (goacc_map_vars): Adjust.
+ (gomp_map_vars_openacc): Remove.
+ * oacc-mem.c (acc_map_data, goacc_enter_datum)
+ (goacc_enter_data_internal): Adjust.
+ * oacc-parallel.c (GOACC_parallel_keyed, GOACC_data_start):
+ Adjust.
+
+2025-05-15 Chung-Lin Tang <cltang@codesourcery.com>
+ Kwok Cheung Yeung <kcy@codesourcery.com>
+ Paul-Antoine Arras <parras@baylibre.com>
+
+ PR other/76739
+ * libgomp.h (gomp_map_vars_openacc): New function declaration.
+ * libgomp_g.h (GOACC_data_start): Add variadic '...' to declaration.
+ * oacc-int.h (struct goacc_ncarray_dim): New struct declaration.
+ (struct goacc_ncarray_descr_type): Likewise.
+ (struct goacc_ncarray): Likewise.
+ (struct goacc_ncarray_info): Likewise.
+ (goacc_noncontig_array_create_ptrblock): New function declaration.
+ * oacc-parallel.c (goacc_noncontig_array_count_rows): New function.
+ (goacc_noncontig_array_compute_sizes): Likewise.
+ (goacc_noncontig_array_fill_rows_1): Likewise.
+ (goacc_noncontig_array_fill_rows): Likewise.
+ (goacc_process_noncontiguous_arrays): Likewise.
+ (goacc_noncontig_array_create_ptrblock): Likewise.
+ (GOACC_parallel_keyed): Use goacc_process_noncontiguous_arrays to
+ handle non-contiguous array descriptors at end of varargs, adjust
+ to use gomp_map_vars_openacc.
+ (GOACC_data_start): Likewise. Adjust function type to accept varargs.
+ * target.c (gomp_map_vars_internal): Add struct goacc_ncarray_info *
+ nca_info parameter, add handling code for non-contiguous arrays.
+ (gomp_map_vars_openacc): Add new function for specialization of
+ gomp_map_vars_internal for OpenACC structured region usage.
+ * testsuite/libgomp.oacc-c-c++-common/noncontig_array-1.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/noncontig_array-2.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/noncontig_array-3.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/noncontig_array-4.c: New test.
+ * testsuite/libgomp.oacc-c-c++-common/noncontig_array-utils.h: Support
+ header for new tests. \ No newline at end of file
diff --git a/libgomp/Makefile.am b/libgomp/Makefile.am
index e3202ae..aece103 100644
--- a/libgomp/Makefile.am
+++ b/libgomp/Makefile.am
@@ -70,7 +70,8 @@ libgomp_la_SOURCES = alloc.c atomic.c barrier.c critical.c env.c error.c \
target.c splay-tree.c libgomp-plugin.c oacc-parallel.c oacc-host.c \
oacc-init.c oacc-mem.c oacc-async.c oacc-plugin.c oacc-cuda.c \
priority_queue.c affinity-fmt.c teams.c allocator.c oacc-profiling.c \
- oacc-target.c target-indirect.c
+ oacc-target.c target-indirect.c oacc-profiling-acc_register_library.c \
+ usmpin-allocator.c target-cxa-dso-dtor.c
include $(top_srcdir)/plugin/Makefrag.am
diff --git a/libgomp/Makefile.in b/libgomp/Makefile.in
index 2a0a842..89dc47c 100644
--- a/libgomp/Makefile.in
+++ b/libgomp/Makefile.in
@@ -219,7 +219,9 @@ am_libgomp_la_OBJECTS = alloc.lo atomic.lo barrier.lo critical.lo \
oacc-parallel.lo oacc-host.lo oacc-init.lo oacc-mem.lo \
oacc-async.lo oacc-plugin.lo oacc-cuda.lo priority_queue.lo \
affinity-fmt.lo teams.lo allocator.lo oacc-profiling.lo \
- oacc-target.lo target-indirect.lo $(am__objects_1)
+ oacc-target.lo target-indirect.lo \
+ oacc-profiling-acc_register_library.lo usmpin-allocator.lo \
+ target-cxa-dso-dtor.lo $(am__objects_1)
libgomp_la_OBJECTS = $(am_libgomp_la_OBJECTS)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
@@ -552,7 +554,9 @@ libgomp_la_SOURCES = alloc.c atomic.c barrier.c critical.c env.c \
oacc-parallel.c oacc-host.c oacc-init.c oacc-mem.c \
oacc-async.c oacc-plugin.c oacc-cuda.c priority_queue.c \
affinity-fmt.c teams.c allocator.c oacc-profiling.c \
- oacc-target.c target-indirect.c $(am__append_3)
+ oacc-target.c target-indirect.c \
+ oacc-profiling-acc_register_library.c usmpin-allocator.c \
+ target-cxa-dso-dtor.c $(am__append_3)
# Nvidia PTX OpenACC plugin.
@PLUGIN_NVPTX_TRUE@libgomp_plugin_nvptx_version_info = -version-info $(libtool_VERSION)
@@ -768,6 +772,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oacc-mem.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oacc-parallel.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oacc-plugin.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oacc-profiling-acc_register_library.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oacc-profiling.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oacc-target.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ordered.Plo@am__quote@
@@ -780,12 +785,14 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sem.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/single.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/splay-tree.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/target-cxa-dso-dtor.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/target-indirect.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/target.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/task.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/team.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/teams.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/time.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/usmpin-allocator.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/work.Plo@am__quote@
.c.o:
diff --git a/libgomp/acc_prof.h b/libgomp/acc_prof.h
index 635d0a1..07ce41b 100644
--- a/libgomp/acc_prof.h
+++ b/libgomp/acc_prof.h
@@ -117,9 +117,11 @@ typedef struct acc_prof_info
_ACC_PROF_VALID_BYTES_BASICTYPE (_acc_prof_int_t))
} acc_prof_info;
-/* We implement the OpenACC 2.6 Profiling Interface. */
+/* We implement the OpenACC 2.7 Profiling Interface, or at least according
+ to the OpenACC spec the number in the version field of acc_prof_info must
+ be _OPENACC. */
-#define _ACC_PROF_INFO_VERSION 201711
+#define _ACC_PROF_INFO_VERSION 201811
typedef enum acc_construct_t
{
diff --git a/libgomp/config/accel/target-cxa-dso-dtor.c b/libgomp/config/accel/target-cxa-dso-dtor.c
new file mode 100644
index 0000000..e40a5f0
--- /dev/null
+++ b/libgomp/config/accel/target-cxa-dso-dtor.c
@@ -0,0 +1,62 @@
+/* Host/device compatibility: Itanium C++ ABI, DSO Object Destruction API
+
+ Copyright (C) 2025 Free Software Foundation, Inc.
+
+ This file is part of the GNU Offloading and Multi Processing Library
+ (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+ more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+#include "libgomp.h"
+
+extern void __cxa_finalize (void *);
+
+/* See <https://itanium-cxx-abi.github.io/cxx-abi/abi.html#dso-dtor>.
+
+ Even if the device is '!DEFAULT_USE_CXA_ATEXIT', we may see '__cxa_atexit'
+ calls, referencing '__dso_handle', via a 'DEFAULT_USE_CXA_ATEXIT' host.
+ '__cxa_atexit' is provided by newlib, but use of '__dso_handle' for nvptx
+ results in 'ld' error:
+
+ unresolved symbol __dso_handle
+ collect2: error: ld returned 1 exit status
+ nvptx mkoffload: fatal error: [...]/x86_64-pc-linux-gnu-accel-nvptx-none-gcc returned 1 exit status
+
+ ..., or for GCN get an implicit definition (running with
+ '--trace-symbol=__dso_handle'):
+
+ ./a.xamdgcn-amdhsa.mkoffload.hsaco-a.xamdgcn-amdhsa.mkoffload.2.o: reference to __dso_handle
+ <internal>: definition of __dso_handle
+
+ ..., which might be fine, but let's just make it explicit. */
+
+/* There are no DSOs; this is the main program. */
+attribute_hidden void * const __dso_handle = 0;
+
+/* If this file gets linked in, that means that '__dso_handle' has been
+ referenced (for '__cxa_atexit'), and in that case, we also have to run
+ '__cxa_finalize'. Make that happen by overriding the weak libgcc dummy
+ function '__GCC_offload___cxa_finalize'. */
+
+void
+__GCC_offload___cxa_finalize (void *dso_handle)
+{
+ __cxa_finalize (dso_handle);
+}
diff --git a/libgomp/config/gcn/bar.h b/libgomp/config/gcn/bar.h
index b62d3af..4402b10 100644
--- a/libgomp/config/gcn/bar.h
+++ b/libgomp/config/gcn/bar.h
@@ -55,6 +55,9 @@ typedef unsigned int gomp_barrier_state_t;
static inline void gomp_barrier_init (gomp_barrier_t *bar, unsigned count)
{
+ unsigned actual_thread_count = __builtin_gcn_dim_size (1);
+ if (count > actual_thread_count)
+ count = actual_thread_count;
bar->total = count;
bar->awaited = count;
bar->awaited_final = count;
diff --git a/libgomp/config/gcn/target.c b/libgomp/config/gcn/target.c
index 1e98f1d..5327ad3 100644
--- a/libgomp/config/gcn/target.c
+++ b/libgomp/config/gcn/target.c
@@ -122,19 +122,38 @@ GOMP_target_ext (int device, void (*fn) (void *), size_t mapnum,
<= (index - 1024))
asm ("s_sleep 64");
+ /* In theory, it should be enough to write "written" with __ATOMIC_RELEASE,
+ and have the rest of the data flushed to memory automatically, but some
+ devices (gfx908) seem to have a race condition where the flushed data
+ arrives after the atomic data, and the host does the wrong thing.
+ If we just write everything atomically in the correct order then we're
+ safe. */
+
unsigned int slot = index % 1024;
- data->queue[slot].value_u64[0] = (uint64_t) fn;
- data->queue[slot].value_u64[1] = (uint64_t) mapnum;
- data->queue[slot].value_u64[2] = (uint64_t) hostaddrs;
- data->queue[slot].value_u64[3] = (uint64_t) sizes;
- data->queue[slot].value_u64[4] = (uint64_t) kinds;
- data->queue[slot].value_u64[5] = (uint64_t) GOMP_ADDITIONAL_ICVS.device_num;
-
- data->queue[slot].type = 4; /* Reverse offload. */
+ __atomic_store_n (&data->queue[slot].value_u64[0], (uint64_t) fn,
+ __ATOMIC_RELAXED);
+ __atomic_store_n (&data->queue[slot].value_u64[1], (uint64_t) mapnum,
+ __ATOMIC_RELAXED);
+ __atomic_store_n (&data->queue[slot].value_u64[2], (uint64_t) hostaddrs,
+ __ATOMIC_RELAXED);
+ __atomic_store_n (&data->queue[slot].value_u64[3], (uint64_t) sizes,
+ __ATOMIC_RELAXED);
+ __atomic_store_n (&data->queue[slot].value_u64[4], (uint64_t) kinds,
+ __ATOMIC_RELAXED);
+ __atomic_store_n (&data->queue[slot].value_u64[5],
+ (uint64_t) GOMP_ADDITIONAL_ICVS.device_num,
+ __ATOMIC_RELAXED);
+
+ volatile int signal = 0;
+ __atomic_store_n (&data->queue[slot].value_u64[6], (uint64_t) &signal,
+ __ATOMIC_RELAXED);
+
+ __atomic_store_n (&data->queue[slot].type, 4 /* Reverse offload. */,
+ __ATOMIC_RELAXED);
__atomic_store_n (&data->queue[slot].written, 1, __ATOMIC_RELEASE);
- /* Spinlock while the host catches up. */
- while (__atomic_load_n (&data->queue[slot].written, __ATOMIC_ACQUIRE) != 0)
+ /* Spinlock while the host runs the kernel. */
+ while (__atomic_load_n (&signal, __ATOMIC_ACQUIRE) == 0)
asm ("s_sleep 64");
}
diff --git a/libgomp/config/gcn/team.c b/libgomp/config/gcn/team.c
index 40827ce..939ee87 100644
--- a/libgomp/config/gcn/team.c
+++ b/libgomp/config/gcn/team.c
@@ -209,6 +209,10 @@ gomp_team_start (void (*fn) (void *), void *data, unsigned nthreads,
if (nthreads == 1)
return;
+ unsigned actual_thread_count = __builtin_gcn_dim_size (1);
+ if (nthreads > actual_thread_count)
+ nthreads = actual_thread_count;
+
/* Release existing idle threads. */
for (unsigned i = 1; i < nthreads; ++i)
{
diff --git a/libgomp/config/linux/allocator.c b/libgomp/config/linux/allocator.c
index 8dea959..845ee27 100644
--- a/libgomp/config/linux/allocator.c
+++ b/libgomp/config/linux/allocator.c
@@ -36,6 +36,11 @@
/* Implement malloc routines that can handle pinned memory on Linux.
+ Given that pinned memory is typically used to help host <-> device memory
+ transfers, we attempt to allocate such memory using a device (really:
+ libgomp plugin), but fall back to mmap plus mlock if no suitable device is
+ available.
+
It's possible to use mlock on any heap memory, but using munlock is
problematic if there are multiple pinned allocations on the same page.
Tracking all that manually would be possible, but adds overhead. This may
@@ -48,50 +53,147 @@
#define _GNU_SOURCE
#include <sys/mman.h>
+#include <unistd.h>
#include <string.h>
+#include <assert.h>
#include "libgomp.h"
#ifdef HAVE_INTTYPES_H
# include <inttypes.h> /* For PRIu64. */
#endif
+static bool always_pinned_mode = false;
+
+/* This function is called by the compiler when -foffload-memory=pinned
+ is used. */
+
+void
+GOMP_enable_pinned_mode ()
+{
+ if (mlockall (MCL_CURRENT | MCL_FUTURE) != 0)
+ gomp_error ("failed to pin all memory (ulimit too low?)");
+ else
+ always_pinned_mode = true;
+}
+
+static int using_device_for_page_locked
+ = /* uninitialized */ -1;
+
+
+static usmpin_ctx_p pin_ctx = NULL;
+static pthread_once_t ctxlock = PTHREAD_ONCE_INIT;
+
+static void
+linux_init_pin_ctx ()
+{
+ pin_ctx = usmpin_init_context ();
+}
+
static void *
-linux_memspace_alloc (omp_memspace_handle_t memspace, size_t size, int pin)
+linux_memspace_alloc (omp_memspace_handle_t memspace, size_t size, int pin,
+ bool init0)
{
- (void)memspace;
+ gomp_debug (0, "%s: memspace=%llu, size=%llu, pin=%d, init0=%d\n",
+ __FUNCTION__, (unsigned long long) memspace,
+ (unsigned long long) size, pin, init0);
+
+ void *addr = NULL;
+
+ /* Explicit pinning may not be required. */
+ pin = pin && !always_pinned_mode;
if (pin)
{
- /* Note that mmap always returns zeroed memory and is therefore also a
- suitable implementation of calloc. */
- void *addr = mmap (NULL, size, PROT_READ | PROT_WRITE,
- MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
- if (addr == MAP_FAILED)
- return NULL;
-
- if (mlock (addr, size))
+ int using_device
+ = __atomic_load_n (&using_device_for_page_locked,
+ MEMMODEL_RELAXED);
+ gomp_debug (0, " using_device=%d\n",
+ using_device);
+ if (using_device != 0)
{
+ using_device = gomp_page_locked_host_alloc (&addr, size);
+ int using_device_old
+ = __atomic_exchange_n (&using_device_for_page_locked,
+ using_device, MEMMODEL_RELAXED);
+ gomp_debug (0, " using_device=%d, using_device_old=%d\n",
+ using_device, using_device_old);
+ assert (using_device_old == -1
+ /* We shouldn't have concurrently changed our mind. */
+ || using_device_old == using_device);
+ }
+ if (using_device == 0)
+ {
+ static int pagesize = 0;
+ static void *addrhint = NULL;
+
+ if (!pagesize)
+ pagesize = sysconf(_SC_PAGE_SIZE);
+
+ while (1)
+ {
+ addr = usmpin_alloc (pin_ctx, size);
+ if (addr)
+ break;
+
+ gomp_debug (0, " mmap\n");
+
+ /* Round up to a whole page. */
+ size_t misalignment = size % pagesize;
+ size_t mmap_size = (misalignment > 0
+ ? size + pagesize - misalignment
+ : size);
+ void *newpage = mmap (addrhint, mmap_size, PROT_READ | PROT_WRITE,
+ MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);
+ if (newpage == MAP_FAILED)
+ break;
+ else
+ {
+ gomp_debug (0, " mlock\n");
+ if (mlock (newpage, size))
+ {
#ifdef HAVE_INTTYPES_H
- gomp_debug (0, "libgomp: failed to pin %"PRIu64" bytes of"
- " memory (ulimit too low?)\n", (uint64_t) size);
+ gomp_debug (0, "libgomp: failed to pin %"PRIu64" bytes"
+ " of memory (ulimit too low?)\n",
+ (uint64_t) size);
#else
- gomp_debug (0, "libgomp: failed to pin %lu bytes of"
- " memory (ulimit too low?)\n", (unsigned long) size);
+ gomp_debug (0, "libgomp: failed to pin %lu bytes of"
+ " memory (ulimit too low?)\n",
+ (unsigned long) size);
#endif
- munmap (addr, size);
- return NULL;
- }
+ munmap (newpage, size);
+ break;
+ }
- return addr;
+ addrhint = newpage + mmap_size;
+
+ pthread_once (&ctxlock, linux_init_pin_ctx);
+ usmpin_register_memory (pin_ctx, newpage, mmap_size);
+ }
+ }
+ }
}
else
- return malloc (size);
+ addr = malloc (size);
+
+ if (addr && init0)
+ {
+ gomp_debug (0, " init0\n");
+ memset (addr, 0, size);
+ }
+
+ return addr;
}
static void *
linux_memspace_calloc (omp_memspace_handle_t memspace, size_t size, int pin)
{
+ gomp_debug (0, "%s: memspace=%llu, size=%llu, pin=%d\n",
+ __FUNCTION__, (unsigned long long) memspace, (unsigned long long) size, pin);
+
+ /* Explicit pinning may not be required. */
+ pin = pin && !always_pinned_mode;
+
if (pin)
- return linux_memspace_alloc (memspace, size, pin);
+ return linux_memspace_alloc (memspace, size, pin, true);
else
return calloc (1, size);
}
@@ -100,10 +202,24 @@ static void
linux_memspace_free (omp_memspace_handle_t memspace, void *addr, size_t size,
int pin)
{
- (void)memspace;
+ gomp_debug (0, "%s: memspace=%llu, addr=%p, size=%llu, pin=%d\n",
+ __FUNCTION__, (unsigned long long) memspace, addr, (unsigned long long) size, pin);
+
+ /* Explicit pinning may not be required. */
+ pin = pin && !always_pinned_mode;
if (pin)
- munmap (addr, size);
+ {
+ int using_device
+ = __atomic_load_n (&using_device_for_page_locked,
+ MEMMODEL_RELAXED);
+ gomp_debug (0, " using_device=%d\n",
+ using_device);
+ if (using_device == 1)
+ gomp_page_locked_host_free (addr);
+ else
+ usmpin_free (pin_ctx, addr);
+ }
else
free (addr);
}
@@ -112,27 +228,45 @@ static void *
linux_memspace_realloc (omp_memspace_handle_t memspace, void *addr,
size_t oldsize, size_t size, int oldpin, int pin)
{
+ gomp_debug (0, "%s: memspace=%llu, addr=%p, oldsize=%llu, size=%llu, oldpin=%d, pin=%d\n",
+ __FUNCTION__, (unsigned long long) memspace, addr, (unsigned long long) oldsize, (unsigned long long) size, oldpin, pin);
+
+ /* Explicit pinning may not be required. */
+ pin = pin && !always_pinned_mode;
+
if (oldpin && pin)
{
- void *newaddr = mremap (addr, oldsize, size, MREMAP_MAYMOVE);
- if (newaddr == MAP_FAILED)
- return NULL;
+ int using_device
+ = __atomic_load_n (&using_device_for_page_locked,
+ MEMMODEL_RELAXED);
+ gomp_debug (0, " using_device=%d\n",
+ using_device);
- return newaddr;
- }
- else if (oldpin || pin)
- {
- void *newaddr = linux_memspace_alloc (memspace, size, pin);
- if (newaddr)
+ /* The device plugin API does not support realloc,
+ but the usmpin allocator does. */
+ if (using_device == 0)
{
- memcpy (newaddr, addr, oldsize < size ? oldsize : size);
- linux_memspace_free (memspace, addr, oldsize, oldpin);
+ /* This can fail if there is insufficient pinned memory free. */
+ void *newaddr = usmpin_realloc (pin_ctx, addr, size);
+ if (newaddr)
+ return newaddr;
}
-
- return newaddr;
}
+ else if (oldpin || pin)
+ /* Moving from pinned to unpinned memory cannot be done in-place. */
+ ;
else
return realloc (addr, size);
+
+ /* In-place reallocation failed. Fall back to copy. */
+ void *newaddr = linux_memspace_alloc (memspace, size, pin, false);
+ if (newaddr)
+ {
+ memcpy (newaddr, addr, oldsize < size ? oldsize : size);
+ linux_memspace_free (memspace, addr, oldsize, oldpin);
+ }
+
+ return newaddr;
}
static int
@@ -143,7 +277,7 @@ linux_memspace_validate (omp_memspace_handle_t, unsigned, int)
}
#define MEMSPACE_ALLOC(MEMSPACE, SIZE, PIN) \
- linux_memspace_alloc (MEMSPACE, SIZE, PIN)
+ linux_memspace_alloc (MEMSPACE, SIZE, PIN, false)
#define MEMSPACE_CALLOC(MEMSPACE, SIZE, PIN) \
linux_memspace_calloc (MEMSPACE, SIZE, PIN)
#define MEMSPACE_REALLOC(MEMSPACE, ADDR, OLDSIZE, SIZE, OLDPIN, PIN) \
diff --git a/libgomp/config/nvptx/libgomp-nvptx.h b/libgomp/config/nvptx/libgomp-nvptx.h
index 40586d3..fb1891b 100644
--- a/libgomp/config/nvptx/libgomp-nvptx.h
+++ b/libgomp/config/nvptx/libgomp-nvptx.h
@@ -25,20 +25,41 @@
/* This file contains defines and type definitions shared between the
nvptx target's libgomp.a and the plugin-nvptx.c, but that is only
- needef for this target. */
+ needed for this target. */
#ifndef LIBGOMP_NVPTX_H
#define LIBGOMP_NVPTX_H 1
#define GOMP_REV_OFFLOAD_VAR __gomp_rev_offload_var
+#define REV_OFFLOAD_QUEUE_SIZE 1024
struct rev_offload {
- uint64_t fn;
- uint64_t mapnum;
- uint64_t addrs;
- uint64_t sizes;
- uint64_t kinds;
- int32_t dev_num;
+ /* The target can grab a slot by incrementing "next_slot".
+ Each host thread may claim some slots for processing.
+ When the host processing is completed "consumed" indicates that the
+ corresponding slots in the ring-buffer "queue" are available for reuse.
+
+ Note that "next_slot" is an index, and "consumed"/"claimed" are counters,
+ so beware of the fence-posts. */
+ unsigned int next_slot;
+ unsigned int consumed;
+ unsigned int claimed;
+
+ struct rev_req {
+ /* The target writes an address to "signal" as the last item, which
+ indicates to the host that the record is completely written. The target
+ must not assume that it still owns the slot, after that. The signal
+ address is then used by the host to communicate that the reverse-offload
+ kernel has completed execution. */
+ volatile int *signal;
+
+ uint64_t fn;
+ uint64_t mapnum;
+ uint64_t addrs;
+ uint64_t sizes;
+ uint64_t kinds;
+ int32_t dev_num;
+ } queue[REV_OFFLOAD_QUEUE_SIZE];
};
#if (__SIZEOF_SHORT__ != 2 \
diff --git a/libgomp/config/nvptx/oacc-profiling-acc_register_library.c b/libgomp/config/nvptx/oacc-profiling-acc_register_library.c
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/libgomp/config/nvptx/oacc-profiling-acc_register_library.c
diff --git a/libgomp/config/nvptx/oacc-profiling.c b/libgomp/config/nvptx/oacc-profiling.c
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/libgomp/config/nvptx/oacc-profiling.c
diff --git a/libgomp/config/nvptx/target.c b/libgomp/config/nvptx/target.c
index 715d993..690db59 100644
--- a/libgomp/config/nvptx/target.c
+++ b/libgomp/config/nvptx/target.c
@@ -101,7 +101,6 @@ GOMP_target_ext (int device, void (*fn) (void *), size_t mapnum,
void **hostaddrs, size_t *sizes, unsigned short *kinds,
unsigned int flags, void **depend, void **args)
{
- static int lock = 0; /* == gomp_mutex_t lock; gomp_mutex_init (&lock); */
(void) flags;
(void) depend;
(void) args;
@@ -111,43 +110,57 @@ GOMP_target_ext (int device, void (*fn) (void *), size_t mapnum,
|| GOMP_REV_OFFLOAD_VAR == NULL)
return;
- gomp_mutex_lock (&lock);
-
- GOMP_REV_OFFLOAD_VAR->mapnum = mapnum;
- GOMP_REV_OFFLOAD_VAR->addrs = (uint64_t) hostaddrs;
- GOMP_REV_OFFLOAD_VAR->sizes = (uint64_t) sizes;
- GOMP_REV_OFFLOAD_VAR->kinds = (uint64_t) kinds;
- GOMP_REV_OFFLOAD_VAR->dev_num = GOMP_ADDITIONAL_ICVS.device_num;
-
- /* Set 'fn' to trigger processing on the host; wait for completion,
- which is flagged by setting 'fn' back to 0 on the host. */
- uint64_t addr_struct_fn = (uint64_t) &GOMP_REV_OFFLOAD_VAR->fn;
+ /* Reserve one slot. */
+ unsigned int index = __atomic_fetch_add (&GOMP_REV_OFFLOAD_VAR->next_slot,
+ 1, __ATOMIC_ACQUIRE);
+
+ if ((unsigned int) (index + 1) < GOMP_REV_OFFLOAD_VAR->consumed)
+ abort (); /* Overflow. */
+
+ /* Spinlock while the host catches up. */
+ if (index >= REV_OFFLOAD_QUEUE_SIZE)
+ while (__atomic_load_n (&GOMP_REV_OFFLOAD_VAR->consumed, __ATOMIC_ACQUIRE)
+ <= (index - REV_OFFLOAD_QUEUE_SIZE))
+ ; /* spin */
+
+ unsigned int slot = index % REV_OFFLOAD_QUEUE_SIZE;
+ GOMP_REV_OFFLOAD_VAR->queue[slot].fn = (uint64_t) fn;
+ GOMP_REV_OFFLOAD_VAR->queue[slot].mapnum = mapnum;
+ GOMP_REV_OFFLOAD_VAR->queue[slot].addrs = (uint64_t) hostaddrs;
+ GOMP_REV_OFFLOAD_VAR->queue[slot].sizes = (uint64_t) sizes;
+ GOMP_REV_OFFLOAD_VAR->queue[slot].kinds = (uint64_t) kinds;
+ GOMP_REV_OFFLOAD_VAR->queue[slot].dev_num = GOMP_ADDITIONAL_ICVS.device_num;
+
+ /* Set 'signal' to trigger processing on the host; the slot is now consumed
+ by the host, so we should not touch it again. */
+ volatile int signal = 0;
+ uint64_t addr_struct_signal = (uint64_t) &GOMP_REV_OFFLOAD_VAR->queue[slot].signal;
#if __PTX_SM__ >= 700
asm volatile ("st.global.release.sys.u64 [%0], %1;"
- : : "r"(addr_struct_fn), "r" (fn) : "memory");
+ : : "r"(addr_struct_signal), "r" (&signal) : "memory");
#else
__sync_synchronize (); /* membar.sys */
asm volatile ("st.volatile.global.u64 [%0], %1;"
- : : "r"(addr_struct_fn), "r" (fn) : "memory");
+ : : "r"(addr_struct_signal), "r" (&signal) : "memory");
#endif
+ /* The host signals completion by writing a non-zero value to the 'signal'
+ variable. */
#if __PTX_SM__ >= 700
- uint64_t fn2;
+ uint64_t signal2;
do
{
asm volatile ("ld.acquire.sys.global.u64 %0, [%1];"
- : "=r" (fn2) : "r" (addr_struct_fn) : "memory");
+ : "=r" (signal2) : "r" (&signal) : "memory");
}
- while (fn2 != 0);
+ while (signal2 == 0);
#else
/* ld.global.u64 %r64,[__gomp_rev_offload_var];
ld.u64 %r36,[%r64];
membar.sys; */
- while (__atomic_load_n (&GOMP_REV_OFFLOAD_VAR->fn, __ATOMIC_ACQUIRE) != 0)
+ while (__atomic_load_n (&signal, __ATOMIC_ACQUIRE) == 0)
; /* spin */
#endif
-
- gomp_mutex_unlock (&lock);
}
void
diff --git a/libgomp/config/nvptx/team.c b/libgomp/config/nvptx/team.c
index 4227344..e1a0d37 100644
--- a/libgomp/config/nvptx/team.c
+++ b/libgomp/config/nvptx/team.c
@@ -34,6 +34,9 @@
struct gomp_thread *nvptx_thrs __attribute__((shared,nocommon));
int __gomp_team_num __attribute__((shared,nocommon));
+/* Number of active target threads in team, used in ACC mode. */
+unsigned int __nvptx_omp_num_threads __attribute__((shared,nocommon));
+
static void gomp_thread_start (struct gomp_thread_pool *);
extern void build_indirect_map (void);
diff --git a/libgomp/env.c b/libgomp/env.c
index 626a753..f48a95e 100644
--- a/libgomp/env.c
+++ b/libgomp/env.c
@@ -124,6 +124,7 @@ size_t gomp_affinity_format_len;
char *goacc_device_type;
int goacc_device_num;
int goacc_default_dims[GOMP_DIM_MAX];
+int gomp_reverse_offload_threads = 8; /* Reasonable default. */
#ifndef LIBGOMP_OFFLOADED_ONLY
@@ -2489,6 +2490,11 @@ initialize_env (void)
handle_omp_display_env ();
+ /* Control the number of background threads reverse offload is permitted
+ to use. */
+ parse_int_secure ("GOMP_REVERSE_OFFLOAD_THREADS",
+ &gomp_reverse_offload_threads, false);
+
/* OpenACC. */
if (!parse_int ("ACC_DEVICE_NUM", getenv ("ACC_DEVICE_NUM"),
diff --git a/libgomp/libgomp-plugin.c b/libgomp/libgomp-plugin.c
index 5e2cb9b..edbdfb7 100644
--- a/libgomp/libgomp-plugin.c
+++ b/libgomp/libgomp-plugin.c
@@ -82,8 +82,8 @@ GOMP_PLUGIN_fatal (const char *msg, ...)
void
GOMP_PLUGIN_target_rev (uint64_t fn_ptr, uint64_t mapnum, uint64_t devaddrs_ptr,
uint64_t sizes_ptr, uint64_t kinds_ptr, int dev_num,
- struct goacc_asyncqueue *aq)
+ volatile int *signal, bool use_aq)
{
gomp_target_rev (fn_ptr, mapnum, devaddrs_ptr, sizes_ptr, kinds_ptr, dev_num,
- aq);
+ signal, use_aq);
}
diff --git a/libgomp/libgomp-plugin.h b/libgomp/libgomp-plugin.h
index 924fc1f..479264b 100644
--- a/libgomp/libgomp-plugin.h
+++ b/libgomp/libgomp-plugin.h
@@ -150,7 +150,7 @@ extern void GOMP_PLUGIN_fatal (const char *, ...)
__attribute__ ((noreturn, format (printf, 1, 2)));
extern void GOMP_PLUGIN_target_rev (uint64_t, uint64_t, uint64_t, uint64_t,
- uint64_t, int, struct goacc_asyncqueue *);
+ uint64_t, int, volatile int *, bool);
/* Prototypes for functions implemented by libgomp plugins. */
extern const char *GOMP_OFFLOAD_get_name (void);
@@ -167,6 +167,8 @@ extern int GOMP_OFFLOAD_load_image (int, unsigned, const void *,
extern bool GOMP_OFFLOAD_unload_image (int, unsigned, const void *);
extern void *GOMP_OFFLOAD_alloc (int, size_t);
extern bool GOMP_OFFLOAD_free (int, void *);
+extern bool GOMP_OFFLOAD_page_locked_host_alloc (void **, size_t);
+extern bool GOMP_OFFLOAD_page_locked_host_free (void *);
extern bool GOMP_OFFLOAD_dev2host (int, void *, const void *, size_t);
extern bool GOMP_OFFLOAD_host2dev (int, void *, const void *, size_t);
extern bool GOMP_OFFLOAD_dev2dev (int, void *, const void *, size_t);
diff --git a/libgomp/libgomp.h b/libgomp/libgomp.h
index 6030f9d..04f3c6d 100644
--- a/libgomp/libgomp.h
+++ b/libgomp/libgomp.h
@@ -620,6 +620,7 @@ extern struct gomp_offload_icv_list *gomp_offload_icv_list;
extern int goacc_device_num;
extern char *goacc_device_type;
extern int goacc_default_dims[GOMP_DIM_MAX];
+extern int gomp_reverse_offload_threads;
enum gomp_task_kind
{
@@ -1134,7 +1135,9 @@ extern void gomp_init_targets_once (void);
extern int gomp_get_num_devices (void);
extern bool gomp_target_task_fn (void *);
extern void gomp_target_rev (uint64_t, uint64_t, uint64_t, uint64_t, uint64_t,
- int, struct goacc_asyncqueue *);
+ int, volatile int *, bool);
+extern bool gomp_page_locked_host_alloc (void **, size_t);
+extern void gomp_page_locked_host_free (void *);
/* Splay tree definitions. */
typedef struct splay_tree_node_s *splay_tree_node;
@@ -1331,6 +1334,21 @@ struct target_mem_desc {
};
+/* A rectangular section of an array, for noncontiguous target update
+ operations. Must be kept in sync with
+ omp-low.cc:omp_noncontig_descriptor_type. */
+
+typedef struct {
+ size_t ndims;
+ size_t elemsize;
+ size_t span;
+ size_t *dim;
+ size_t *index;
+ size_t *length;
+ size_t *stride;
+} omp_noncontig_array_desc;
+
+
typedef struct acc_dispatch_t
{
/* Execute. */
@@ -1418,6 +1436,8 @@ struct gomp_device_descr
__typeof (GOMP_OFFLOAD_unload_image) *unload_image_func;
__typeof (GOMP_OFFLOAD_alloc) *alloc_func;
__typeof (GOMP_OFFLOAD_free) *free_func;
+ __typeof (GOMP_OFFLOAD_page_locked_host_alloc) *page_locked_host_alloc_func;
+ __typeof (GOMP_OFFLOAD_page_locked_host_free) *page_locked_host_free_func;
__typeof (GOMP_OFFLOAD_dev2host) *dev2host_func;
__typeof (GOMP_OFFLOAD_host2dev) *host2dev_func;
__typeof (GOMP_OFFLOAD_memcpy2d) *memcpy2d_func;
@@ -1458,8 +1478,6 @@ enum gomp_map_vars_kind
GOMP_MAP_VARS_ENTER_DATA = 8
};
-extern void gomp_acc_declare_allocate (bool, size_t, void **, size_t *,
- unsigned short *);
struct gomp_coalesce_buf;
extern void gomp_copy_host2dev (struct gomp_device_descr *,
struct goacc_asyncqueue *, void *, const void *,
@@ -1475,10 +1493,13 @@ extern bool gomp_attach_pointer (struct gomp_device_descr *,
extern void gomp_detach_pointer (struct gomp_device_descr *,
struct goacc_asyncqueue *, splay_tree_key,
uintptr_t, bool, struct gomp_coalesce_buf *);
+struct goacc_ncarray_info;
extern struct target_mem_desc *goacc_map_vars (struct gomp_device_descr *,
struct goacc_asyncqueue *,
size_t, void **, void **,
- size_t *, void *, bool,
+ size_t *, void *,
+ struct goacc_ncarray_info *,
+ bool,
enum gomp_map_vars_kind);
extern void goacc_unmap_vars (struct target_mem_desc *, bool,
struct goacc_asyncqueue *);
@@ -1663,4 +1684,14 @@ gomp_thread_to_pthread_t (struct gomp_thread *thr)
}
#endif
+/* usmpin-allocator.c */
+
+typedef struct usmpin_context *usmpin_ctx_p;
+
+usmpin_ctx_p usmpin_init_context ();
+void usmpin_register_memory (usmpin_ctx_p ctx, char *base, size_t size);
+void *usmpin_alloc (usmpin_ctx_p ctx, size_t size);
+void usmpin_free (usmpin_ctx_p ctx, void *addr);
+void *usmpin_realloc (usmpin_ctx_p ctx, void *addr, size_t newsize);
+
#endif /* LIBGOMP_H */
diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map
index eae2f53..6e2cdbf 100644
--- a/libgomp/libgomp.map
+++ b/libgomp/libgomp.map
@@ -406,6 +406,7 @@ GOMP_5.0.1 {
global:
GOMP_alloc;
GOMP_free;
+ GOMP_enable_pinned_mode;
} GOMP_5.0;
GOMP_5.1 {
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 6909c2b..658df0e 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -232,7 +232,7 @@ The OpenMP 4.5 specification is fully supported.
@tab Y @tab See also @ref{Memory allocation}
@item Memory management routines @tab Y @tab
@item @code{allocate} directive @tab P
- @tab C++ unsupported; see also @ref{Memory allocation}
+ @tab Stack and static variables; see also @ref{Memory allocation}
@item @code{allocate} clause @tab P @tab Clause has no effect on @code{target}
(@uref{https://gcc.gnu.org/PR113436,PR113436})
@item @code{use_device_addr} clause on @code{target data} @tab Y @tab
@@ -305,7 +305,7 @@ The OpenMP 4.5 specification is fully supported.
@item @code{strict} modifier in the @code{grainsize} and @code{num_tasks}
clauses of the @code{taskloop} construct @tab Y @tab
@item @code{align} clause in @code{allocate} directive @tab P
- @tab Only C and Fortran
+ @tab Supported
@item @code{align} modifier in @code{allocate} clause @tab Y @tab
@item @code{thread_limit} clause to @code{target} construct @tab Y @tab
@item @code{has_device_addr} clause to @code{target} construct @tab Y @tab
@@ -484,7 +484,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@item Support for pure directives in Fortran's @code{do concurrent} @tab N @tab
@item All inarguable clauses take now an optional Boolean argument @tab N @tab
@item The @code{adjust_args} clause was extended to specify the argument by position
- and supports variadic arguments @tab N @tab
+ and supports variadic arguments @tab Y @tab
@item For Fortran, @emph{locator list} can be also function reference with
data pointer result @tab N @tab
@item Concept of @emph{assumed-size arrays} in C and C++
@@ -543,7 +543,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
@item New @code{partitioner} value to @code{partition} allocator trait
@tab N @tab
@item Semicolon-separated list to @code{uses_allocators} @tab N @tab
-@item New @code{need_device_addr} modifier to @code{adjust_args} clause @tab N @tab
+@item New @code{need_device_addr} modifier to @code{adjust_args} clause @tab Y @tab
@item @code{interop} clause to @code{dispatch} @tab Y @tab
@item Scope requirement changes for @code{declare_target} @tab N @tab
@item @code{message} and @code{severity} clauses to @code{parallel} directive
@@ -3912,6 +3912,7 @@ variable is not set.
* GOMP_STACKSIZE:: Set default thread stack size
* GOMP_SPINCOUNT:: Set the busy-wait spin count
* GOMP_RTEMS_THREAD_POOLS:: Set the RTEMS specific thread pools
+* GOMP_REVERSE_OFFLOAD_THREADS:: Set the maximum number of host threads
@end menu
@@ -4677,6 +4678,22 @@ pools available and their worker threads run at priority four.
+@node GOMP_REVERSE_OFFLOAD_THREADS
+@section @env{GOMP_REVERSE_OFFLOAD_THREADS} -- Set the maximum number of host threads
+@cindex Environment Variable
+@table @asis
+@item @emph{Description}
+Set the maximum number of threads that may be used to run reverse offload
+code sections (host code nested within offload regions, declared using
+@code{#pragma omp target device(ancestor:1)}). The value should be a non-zero
+positive integer. The default is 8 threads.
+
+The threads are created on demand, up to the maximum number given, and are
+destroyed when no reverse offload requests remain.
+@end table
+
+
+
@c ---------------------------------------------------------------------
@c Enabling OpenACC
@c ---------------------------------------------------------------------
@@ -4695,7 +4712,7 @@ See @uref{https://gcc.gnu.org/wiki/OpenACC} for more information.
A complete description of all OpenACC directives accepted may be found in
the @uref{https://www.openacc.org, OpenACC} Application Programming
-Interface manual, version 2.6.
+Interface manual, version 2.7.
@@ -4707,7 +4724,7 @@ Interface manual, version 2.6.
@chapter OpenACC Runtime Library Routines
The runtime routines described here are defined by section 3 of the OpenACC
-specifications in version 2.6.
+specifications in version 2.7.
They have C linkage, and do not throw exceptions.
Generally, they are available only for the host, with the exception of
@code{acc_on_device}, which is available for both the host and the
@@ -4802,7 +4819,7 @@ for the device type specified in @var{devicetype}.
@end multitable
@item @emph{Reference}:
-@uref{https://www.openacc.org, OpenACC specification v2.6}, section
+@uref{https://www.openacc.org, OpenACC specification v2.7}, section
3.2.1.
@end table
@@ -6074,7 +6091,7 @@ Function for library registration.
@chapter OpenACC Environment Variables
The variables @env{ACC_DEVICE_TYPE} and @env{ACC_DEVICE_NUM}
-are defined by section 4 of the OpenACC specification in version 2.0.
+are defined by section 4 of the OpenACC specification in version 2.6.
The variable @env{ACC_PROFLIB}
is defined by section 4 of the OpenACC specification in version 2.6.
@@ -6377,14 +6394,6 @@ We just handle one case specially, as required by CUDA 9.0
@code{acc_ev_device_init_start}, @code{acc_ev_device_init_end}
callbacks.
-We're not yet implementing initialization via a
-@code{acc_register_library} function that is either statically linked
-in, or dynamically via @env{LD_PRELOAD}.
-Initialization via @code{acc_register_library} functions dynamically
-loaded via the @env{ACC_PROFLIB} environment variable does work, as
-does directly calling @code{acc_prof_register},
-@code{acc_prof_unregister}, @code{acc_prof_lookup}.
-
As currently there are no inquiry functions defined, calls to
@code{acc_prof_lookup} always returns @code{NULL}.
@@ -6803,8 +6812,9 @@ a @code{nearest} allocation.
Additional notes regarding the traits:
@itemize
-@item The @code{pinned} trait is supported on Linux hosts, but is subject to
- the OS @code{ulimit}/@code{rlimit} locked memory settings.
+@item The @code{pinned} trait is supported on Linux hosts, but is usually
+ subject to the OS @code{ulimit}/@code{rlimit} locked memory settings (see
+ @ref{Offload-Target Specifics} for exceptions).
@item The default for the @code{pool_size} trait is no pool and for every
(re)allocation the associated library routine is called, which might
internally use a memory pool.
@@ -6896,6 +6906,9 @@ The implementation remark:
does not support XNACK, consider using @code{ROCR_VISIBLE_DEVICES} to
enable only the APU. If not supported, all AMD GPU devices are removed
from the list of available devices (``host fallback'').
+@item OpenMP @emph{pinned} memory (@code{omp_atk_pinned},
+ @code{ompx_pinned_mem_alloc}, for example)
+ is allocated via @code{mmap}, @code{mlock}.
@item The available stack size can be changed using the @code{GCN_STACK_SIZE}
environment variable; the default is 32 kiB per thread.
@item Low-latency memory (@code{omp_low_lat_mem_space}) is supported when the
@@ -6911,6 +6924,12 @@ The implementation remark:
@code{omp_thread_mem_alloc}, all use low-latency memory as first
preference, and fall back to main graphics memory when the low-latency
pool is exhausted.
+@item Pinned memory allocated using @code{omp_alloc} with the
+ @code{ompx_gnu_pinned_mem_alloc} allocator or the @code{pinned} trait is
+ obtained via the CUDA API when an NVPTX device is present. This provides
+ a performance boost for NVPTX offload code and also allows unlimited use
+ of pinned memory regardless of the OS @code{ulimit}/@code{rlimit}
+ settings.
@item The OpenMP routines @code{omp_target_memcpy_rect} and
@code{omp_target_memcpy_rect_async} and the @code{target update}
directive for non-contiguous list items use the 3D memory-copy function
@@ -7054,6 +7073,11 @@ The implementation remark:
@uref{https://docs.nvidia.com/cuda/cuda-c-programming-guide/index.html#um-requirements}}
otherwise, all nvptx device are removed from the list of available
devices (``host fallback'').
+@item OpenMP @emph{pinned} memory (@code{omp_atk_pinned},
+ @code{ompx_pinned_mem_alloc}, for example)
+ is allocated via @code{cuMemHostAlloc} (CUDA Driver API).
+ This potentially helps optimization of host <-> device data
+ transfers.
@item The default per-warp stack size is 128 kiB; see also @code{-msoft-stack}
in the GCC manual.
@item Low-latency memory (@code{omp_low_lat_mem_space}) is supported when the
diff --git a/libgomp/libgomp_g.h b/libgomp/libgomp_g.h
index 8993ec6..cdc4fc8 100644
--- a/libgomp/libgomp_g.h
+++ b/libgomp/libgomp_g.h
@@ -375,6 +375,7 @@ extern bool GOMP_is_alloc (void *);
extern void *GOMP_alloc (size_t, size_t, uintptr_t);
extern void GOMP_free (void *, uintptr_t);
+extern void GOMP_enable_pinned_mode (void);
/* error.c */
@@ -402,7 +403,7 @@ extern void GOACC_parallel_keyed (int, void (*) (void *), size_t,
extern void GOACC_parallel (int, void (*) (void *), size_t, void **, size_t *,
unsigned short *, int, int, int, int, int, ...);
extern void GOACC_data_start (int, size_t, void **, size_t *,
- unsigned short *);
+ unsigned short *, ...);
extern void GOACC_data_end (void);
extern void GOACC_update (int, size_t, void **, size_t *,
unsigned short *, int, int, ...);
diff --git a/libgomp/oacc-init.c b/libgomp/oacc-init.c
index 3856f85..5fb1bb8 100644
--- a/libgomp/oacc-init.c
+++ b/libgomp/oacc-init.c
@@ -810,6 +810,16 @@ get_property_any (int ord, acc_device_t d, acc_device_property_t prop)
if (d == acc_device_current && thr && thr->dev)
return thr->dev->openacc.get_property_func (thr->dev->target_id, prop);
+ acc_prof_info prof_info;
+ acc_api_info api_info;
+ bool profiling_p = GOACC_PROFILING_SETUP_P (thr, &prof_info, &api_info);
+
+ if (profiling_p)
+ {
+ prof_info.device_type = d;
+ prof_info.device_number = ord;
+ }
+
gomp_mutex_lock (&acc_device_lock);
struct gomp_device_descr *dev = resolve_device (d, true);
@@ -830,7 +840,16 @@ get_property_any (int ord, acc_device_t d, acc_device_property_t prop)
assert (dev);
- return dev->openacc.get_property_func (dev->target_id, prop);
+ union goacc_property_value propval =
+ dev->openacc.get_property_func (dev->target_id, prop);
+
+ if (profiling_p)
+ {
+ thr->prof_info = NULL;
+ thr->api_info = NULL;
+ }
+
+ return propval;
}
size_t
diff --git a/libgomp/oacc-int.h b/libgomp/oacc-int.h
index 85b91dd..a24de9d 100644
--- a/libgomp/oacc-int.h
+++ b/libgomp/oacc-int.h
@@ -165,6 +165,58 @@ bool _goacc_profiling_setup_p (struct goacc_thread *,
void goacc_profiling_dispatch (acc_prof_info *, acc_event_info *,
acc_api_info *);
+/* Definitions for data structures describing OpenACC non-contiguous arrays
+ (Note: interfaces with compiler)
+
+ The compiler generates a descriptor for each such array, places the
+ descriptor on stack, and passes the address of the descriptor to the libgomp
+ runtime as a normal map argument. The runtime then processes the array
+ data structure setup, and replaces the argument with the new actual
+ array address for the child function.
+
+ Care must be taken such that the struct field and layout assumptions
+ of struct goacc_ncarray_dim, goacc_ncarray_descr_type inside the compiler
+ be consistant with the below declarations. */
+
+struct goacc_ncarray_dim {
+ size_t base;
+ size_t length;
+ size_t elem_size;
+ size_t is_array;
+};
+
+struct goacc_ncarray_descr_type
+{
+ size_t ndims;
+ struct goacc_ncarray_dim dims[];
+};
+
+/* Internal non-contiguous array info struct, used only here inside the runtime. */
+
+struct goacc_ncarray
+{
+ struct goacc_ncarray_descr_type *descr;
+ void *ptr;
+ size_t map_index;
+ size_t ptrblock_size;
+ void **data_rows;
+ void **tgt_data_rows;
+ size_t data_row_num;
+ size_t data_row_size;
+};
+
+struct goacc_ncarray_info
+{
+ size_t num_data_rows, num_ncarray;
+ void **data_rows;
+ void **tgt_data_rows;
+ struct goacc_ncarray ncarray[];
+};
+
+extern void goacc_noncontig_array_create_ptrblock (struct goacc_ncarray *,
+ void *, void *);
+
+
#ifdef HAVE_ATTRIBUTE_VISIBILITY
# pragma GCC visibility pop
#endif
diff --git a/libgomp/oacc-mem.c b/libgomp/oacc-mem.c
index 0482ed3..a00ea16 100644
--- a/libgomp/oacc-mem.c
+++ b/libgomp/oacc-mem.c
@@ -403,7 +403,7 @@ acc_map_data (void *h, void *d, size_t s)
struct target_mem_desc *tgt
= goacc_map_vars (acc_dev, NULL, mapnum, &hostaddrs, &devaddrs, &sizes,
- &kinds, true, GOMP_MAP_VARS_ENTER_DATA);
+ &kinds, NULL, true, GOMP_MAP_VARS_ENTER_DATA);
assert (tgt);
assert (tgt->list_count == 1);
splay_tree_key n = tgt->list[0].key;
@@ -568,7 +568,7 @@ goacc_enter_datum (void **hostaddrs, size_t *sizes, void *kinds, int async)
struct target_mem_desc *tgt
= goacc_map_vars (acc_dev, aq, mapnum, hostaddrs, NULL, sizes,
- kinds, true, GOMP_MAP_VARS_ENTER_DATA);
+ kinds, NULL, true, GOMP_MAP_VARS_ENTER_DATA);
assert (tgt);
assert (tgt->list_count == 1);
n = tgt->list[0].key;
@@ -925,6 +925,35 @@ acc_update_self_async (void *h, size_t s, int async)
update_dev_host (0, h, s, async);
}
+/* Implement "declare allocate" and "declare deallocate" operations. The
+ device lock must not be held before calling this function. */
+
+static void
+gomp_acc_declare_allocate (bool allocate, bool pointer, void **hostaddrs,
+ size_t *sizes, unsigned short *kinds)
+{
+ gomp_debug (0, " %s: processing\n", __FUNCTION__);
+
+ if (allocate)
+ {
+ /* Allocate memory for the array data. */
+ uintptr_t data = (uintptr_t) acc_create (hostaddrs[0], sizes[0]);
+
+ if (pointer)
+ {
+ /* Update the PSET. */
+ acc_update_device (hostaddrs[1], sizes[1]);
+ void *pset = acc_deviceptr (hostaddrs[1]);
+ acc_memcpy_to_device (pset, &data, sizeof (uintptr_t));
+ }
+ }
+ else
+ /* Deallocate memory for the array data. */
+ acc_delete (hostaddrs[0], sizes[0]);
+
+ gomp_debug (0, " %s: end\n", __FUNCTION__);
+}
+
void
acc_attach_async (void **hostaddr, int async)
{
@@ -1056,6 +1085,28 @@ find_group_last (int pos, size_t mapnum, size_t *sizes, unsigned short *kinds)
case GOMP_MAP_ATTACH:
break;
+ case GOMP_MAP_DECLARE_ALLOCATE:
+ case GOMP_MAP_DECLARE_DEALLOCATE:
+ {
+ /* The "declare allocate" and "declare deallocate" mappings can be
+ used to specify either a scalar allocatable (which just appears as
+ GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE} by itself), or an array
+ allocatable (which appears as that directive followed by a
+ GOMP_MAP_TO_PSET and one (or more?) GOMP_MAP_POINTER mappings. */
+ if (pos + 1 >= mapnum)
+ break;
+
+ unsigned char kind1 = kinds[pos + 1] & 0xff;
+ if (kind1 != GOMP_MAP_TO_PSET)
+ break;
+
+ pos++;
+
+ while (pos + 1 < mapnum && (kinds[pos + 1] & 0xff) == GOMP_MAP_POINTER)
+ pos++;
+ }
+ break;
+
default:
/* GOMP_MAP_ALWAYS_POINTER can only appear directly after some other
mapping. */
@@ -1121,7 +1172,14 @@ goacc_enter_data_internal (struct gomp_device_descr *acc_dev, size_t mapnum,
n = lookup_host (acc_dev, hostaddrs[i], size);
- if (n && struct_p)
+ if ((kinds[i] & 0xff) == GOMP_MAP_DECLARE_ALLOCATE)
+ {
+ gomp_mutex_unlock (&acc_dev->lock);
+ gomp_acc_declare_allocate (true, group_last > i, &hostaddrs[i],
+ &sizes[i], &kinds[i]);
+ gomp_mutex_lock (&acc_dev->lock);
+ }
+ else if (n && struct_p)
{
for (size_t j = i + 1; j <= group_last; j++)
{
@@ -1206,7 +1264,7 @@ goacc_enter_data_internal (struct gomp_device_descr *acc_dev, size_t mapnum,
gomp_mutex_unlock (&acc_dev->lock);
struct target_mem_desc *tgt_ __attribute__((unused))
= goacc_map_vars (acc_dev, aq, groupnum, &hostaddrs[i], NULL,
- &sizes[i], &kinds[i], true,
+ &sizes[i], &kinds[i], NULL, true,
GOMP_MAP_VARS_ENTER_DATA);
assert (tgt_ == NULL);
gomp_mutex_lock (&acc_dev->lock);
@@ -1257,7 +1315,7 @@ goacc_enter_data_internal (struct gomp_device_descr *acc_dev, size_t mapnum,
struct target_mem_desc *tgt
= goacc_map_vars (acc_dev, aq, groupnum, &hostaddrs[i], NULL,
- &sizes[i], &kinds[i], true,
+ &sizes[i], &kinds[i], NULL, true,
GOMP_MAP_VARS_ENTER_DATA);
assert (tgt);
@@ -1365,6 +1423,24 @@ goacc_exit_data_internal (struct gomp_device_descr *acc_dev, size_t mapnum,
reference counts ('n->refcount', 'n->dynamic_refcount'). */
break;
+ case GOMP_MAP_DECLARE_DEALLOCATE:
+ {
+ bool deallocate_pointer
+ = i + 1 < mapnum && (kinds[i + 1] & 0xff) == GOMP_MAP_TO_PSET;
+ gomp_mutex_unlock (&acc_dev->lock);
+ gomp_acc_declare_allocate (false, deallocate_pointer,
+ &hostaddrs[i], &sizes[i], &kinds[i]);
+ gomp_mutex_lock (&acc_dev->lock);
+ if (deallocate_pointer)
+ {
+ i++;
+ while (i + 1 < mapnum
+ && (kinds[i + 1] & 0xff) == GOMP_MAP_POINTER)
+ i++;
+ }
+ }
+ break;
+
default:
gomp_fatal (">>>> goacc_exit_data_internal UNHANDLED kind 0x%.2x",
kind);
diff --git a/libgomp/oacc-parallel.c b/libgomp/oacc-parallel.c
index 388cabd..a1fb11b 100644
--- a/libgomp/oacc-parallel.c
+++ b/libgomp/oacc-parallel.c
@@ -36,7 +36,7 @@
#include <string.h>
#include <stdarg.h>
#include <assert.h>
-
+#include <stdio.h>
/* In the ABI, the GOACC_FLAGs are encoded as an inverted bitmask, so that we
continue to support the following two legacy values. */
@@ -46,6 +46,171 @@ _Static_assert (GOACC_FLAGS_UNMARSHAL (GOMP_DEVICE_HOST_FALLBACK)
== GOACC_FLAG_HOST_FALLBACK,
"legacy GOMP_DEVICE_HOST_FALLBACK broken");
+static size_t
+goacc_noncontig_array_count_rows (struct goacc_ncarray_descr_type *descr)
+{
+ size_t nrows = 1;
+ for (size_t d = 0; d < descr->ndims - 1; d++)
+ nrows *= descr->dims[d].length / sizeof (void *);
+ return nrows;
+}
+
+static void
+goacc_noncontig_array_compute_sizes (struct goacc_ncarray *nca)
+{
+ size_t d, n = 1;
+ struct goacc_ncarray_descr_type *descr = nca->descr;
+
+ nca->ptrblock_size = 0;
+ for (d = 0; d < descr->ndims - 1; d++)
+ {
+ size_t dim_count = descr->dims[d].length / descr->dims[d].elem_size;
+ size_t dim_ptrblock_size = (descr->dims[d + 1].is_array
+ ? 0 : descr->dims[d].length * n);
+ nca->ptrblock_size += dim_ptrblock_size;
+ n *= dim_count;
+ }
+ nca->data_row_num = n;
+ nca->data_row_size = descr->dims[d].length;
+}
+
+static void
+goacc_noncontig_array_fill_rows_1 (struct goacc_ncarray_descr_type *descr, void *nca,
+ size_t d, void ***row_ptr, size_t *count)
+{
+ if (d < descr->ndims - 1)
+ {
+ size_t elsize = descr->dims[d].elem_size;
+ size_t n = descr->dims[d].length / elsize;
+ void *p = nca + descr->dims[d].base;
+ for (size_t i = 0; i < n; i++)
+ {
+ void *ptr = p + i * elsize;
+ /* Deref if next dimension is not array. */
+ if (!descr->dims[d + 1].is_array)
+ ptr = *((void **) ptr);
+ goacc_noncontig_array_fill_rows_1 (descr, ptr, d + 1, row_ptr, count);
+ }
+ }
+ else
+ {
+ **row_ptr = nca + descr->dims[d].base;
+ *row_ptr += 1;
+ *count += 1;
+ }
+}
+
+static size_t
+goacc_noncontig_array_fill_rows (struct goacc_ncarray *nca)
+{
+ size_t count = 0;
+ void **p = nca->data_rows;
+ goacc_noncontig_array_fill_rows_1 (nca->descr, nca->ptr, 0, &p, &count);
+ return count;
+}
+
+static struct goacc_ncarray_info *
+goacc_process_noncontiguous_arrays (size_t mapnum, void **hostaddrs,
+ unsigned short *kinds, va_list* ap)
+{
+ size_t i, nr, num_data_rows = 0, num_ncarray = 0, curr_row_start = 0;
+ struct goacc_ncarray_descr_type *descr;
+
+ /* We need to go over *ap twice, so preserve *ap state here. */
+ va_list itr;
+ va_copy (itr, *ap);
+ for (i = 0; i < mapnum; i++)
+ if (GOMP_MAP_NONCONTIG_ARRAY_P (kinds[i] & 0xff))
+ {
+ descr = va_arg (itr, struct goacc_ncarray_descr_type *);
+ num_data_rows += goacc_noncontig_array_count_rows (descr);
+ num_ncarray += 1;
+ }
+ else
+ break;
+
+ /* Allocate the entire info struct, array entries, and row pointer
+ arrays in one large block. */
+ struct goacc_ncarray_info *nca_info
+ = gomp_malloc (sizeof (struct goacc_ncarray_info)
+ + sizeof (struct goacc_ncarray) * num_ncarray
+ + sizeof (void *) * num_data_rows * 2);
+ nca_info->num_data_rows = num_data_rows;
+ nca_info->num_ncarray = num_ncarray;
+ nca_info->data_rows = (void **) (nca_info->ncarray + num_ncarray);
+ nca_info->tgt_data_rows = nca_info->data_rows + num_data_rows;
+
+ struct goacc_ncarray *curr_ncarray = nca_info->ncarray;
+ for (i = 0; i < mapnum; i++)
+ if (GOMP_MAP_NONCONTIG_ARRAY_P (kinds[i] & 0xff))
+ {
+ descr = va_arg (*ap, struct goacc_ncarray_descr_type *);
+ curr_ncarray->descr = descr;
+ curr_ncarray->ptr = hostaddrs[i];
+ curr_ncarray->map_index = i;
+
+ goacc_noncontig_array_compute_sizes (curr_ncarray);
+
+ curr_ncarray->data_rows = nca_info->data_rows + curr_row_start;
+ curr_ncarray->tgt_data_rows = nca_info->tgt_data_rows + curr_row_start;
+
+ nr = goacc_noncontig_array_fill_rows (curr_ncarray);
+ assert (nr == curr_ncarray->data_row_num);
+ curr_row_start += nr;
+ curr_ncarray += 1;
+ }
+ else
+ break;
+
+ return nca_info;
+}
+
+void
+goacc_noncontig_array_create_ptrblock (struct goacc_ncarray *nca,
+ void *ptrblock,
+ void *tgt_ptrblock_addr)
+{
+ struct goacc_ncarray_descr_type *descr = nca->descr;
+ void **tgt_data_rows = nca->tgt_data_rows;
+ void **curr_dim_ptrblock = (void **) ptrblock;
+ size_t n = 1;
+
+ for (size_t d = 0; d < descr->ndims - 1; d++)
+ {
+ int curr_dim_len = descr->dims[d].length;
+ int next_dim_len = descr->dims[d + 1].length;
+ int curr_dim_num = curr_dim_len / sizeof (void *);
+ size_t next_dim_bias = descr->dims[d + 1].base;
+
+ void *next_dim_ptrblock
+ = (void *)(curr_dim_ptrblock + n * curr_dim_num);
+
+ for (int b = 0; b < n; b++)
+ for (int i = 0; i < curr_dim_num; i++)
+ {
+ if (d < descr->ndims - 2)
+ {
+ void *ptr = (next_dim_ptrblock
+ + b * curr_dim_num * next_dim_len
+ + i * next_dim_len);
+ void *tgt_ptr = (tgt_ptrblock_addr
+ + (ptr - ptrblock) - next_dim_bias);
+ curr_dim_ptrblock[b * curr_dim_num + i] = tgt_ptr;
+ }
+ else
+ {
+ curr_dim_ptrblock[b * curr_dim_num + i]
+ = tgt_data_rows[b * curr_dim_num + i] - next_dim_bias;
+ }
+ void *addr = &curr_dim_ptrblock[b * curr_dim_num + i];
+ assert (ptrblock <= addr && addr < ptrblock + nca->ptrblock_size);
+ }
+
+ n *= curr_dim_num;
+ curr_dim_ptrblock = next_dim_ptrblock;
+ }
+ assert (n == nca->data_row_num);
+}
/* Handle the mapping pair that are presented when a
deviceptr clause is used with Fortran. */
@@ -115,6 +280,7 @@ GOACC_parallel_keyed (int flags_m, void (*fn) (void *),
int async = GOMP_ASYNC_SYNC;
unsigned dims[GOMP_DIM_MAX];
unsigned tag;
+ struct goacc_ncarray_info *nca_info = NULL;
#ifdef HAVE_INTTYPES_H
gomp_debug (0, "%s: mapnum=%"PRIu64", hostaddrs=%p, size=%p, kinds=%p\n",
@@ -201,6 +367,8 @@ GOACC_parallel_keyed (int flags_m, void (*fn) (void *),
fn (hostaddrs);
goto out_prof;
}
+ else if (profiling_p)
+ api_info.device_api = acc_device_api_cuda;
/* Default: let the runtime choose. */
for (i = 0; i != GOMP_DIM_MAX; i++)
@@ -250,13 +418,22 @@ GOACC_parallel_keyed (int flags_m, void (*fn) (void *),
break;
}
+ /*case GOMP_LAUNCH_NONCONTIG_ARRAYS:
+ nca_info = goacc_process_noncontiguous_arrays (mapnum, hostaddrs,
+ kinds, &ap);
+ break;*/
+
default:
gomp_fatal ("unrecognized offload code '%d',"
" libgomp is too old", GOMP_LAUNCH_CODE (tag));
}
}
+
+ if (mapnum > 0 && GOMP_MAP_NONCONTIG_ARRAY_P (kinds[0] & 0xff))
+ nca_info = goacc_process_noncontiguous_arrays (mapnum, hostaddrs, kinds, &ap);
+
va_end (ap);
-
+
if (!(acc_dev->capabilities & GOMP_OFFLOAD_CAP_NATIVE_EXEC))
{
k.host_start = (uintptr_t) fn;
@@ -292,8 +469,12 @@ GOACC_parallel_keyed (int flags_m, void (*fn) (void *),
goacc_aq aq = get_goacc_asyncqueue (async);
struct target_mem_desc *tgt
- = goacc_map_vars (acc_dev, aq, mapnum, hostaddrs, NULL, sizes, kinds, true,
- GOMP_MAP_VARS_TARGET);
+ = goacc_map_vars (acc_dev, aq, mapnum, hostaddrs, NULL, sizes, kinds,
+ nca_info, true, GOMP_MAP_VARS_TARGET);
+ if (aq == NULL)
+ free (nca_info);
+ else
+ acc_dev->openacc.async.queue_callback_func (aq, free, nca_info);
if (profiling_p)
{
@@ -362,7 +543,7 @@ GOACC_parallel (int flags_m, void (*fn) (void *),
void
GOACC_data_start (int flags_m, size_t mapnum,
- void **hostaddrs, size_t *sizes, unsigned short *kinds)
+ void **hostaddrs, size_t *sizes, unsigned short *kinds, ...)
{
int flags = GOACC_FLAGS_UNMARSHAL (flags_m);
@@ -447,6 +628,8 @@ GOACC_data_start (int flags_m, size_t mapnum,
if (profiling_p)
goacc_profiling_dispatch (&prof_info, &enter_data_event_info, &api_info);
+ handle_ftn_pointers (mapnum, hostaddrs, sizes, kinds);
+
/* Host fallback or 'do nothing'. */
if ((acc_dev->capabilities & GOMP_OFFLOAD_CAP_SHARED_MEM)
|| (flags & GOACC_FLAG_HOST_FALLBACK)
@@ -454,16 +637,26 @@ GOACC_data_start (int flags_m, size_t mapnum,
{
prof_info.device_type = acc_device_host;
api_info.device_type = prof_info.device_type;
- tgt = goacc_map_vars (NULL, NULL, 0, NULL, NULL, NULL, NULL, true, 0);
+ tgt = goacc_map_vars (NULL, NULL, 0, NULL, NULL, NULL, NULL, NULL, true, 0);
tgt->prev = thr->mapped_data;
thr->mapped_data = tgt;
goto out_prof;
}
+ struct goacc_ncarray_info *nca_info = NULL;
+ if (mapnum > 0 && GOMP_MAP_NONCONTIG_ARRAY_P (kinds[0] & 0xff))
+ {
+ va_list ap;
+ va_start (ap, kinds);
+ nca_info = goacc_process_noncontiguous_arrays (mapnum, hostaddrs, kinds, &ap);
+ va_end (ap);
+ }
+
gomp_debug (0, " %s: prepare mappings\n", __FUNCTION__);
tgt = goacc_map_vars (acc_dev, NULL, mapnum, hostaddrs, NULL, sizes, kinds,
- true, 0);
+ nca_info, true, 0);
+ free (nca_info);
gomp_debug (0, " %s: mappings prepared\n", __FUNCTION__);
tgt->prev = thr->mapped_data;
thr->mapped_data = tgt;
diff --git a/libgomp/oacc-profiling-acc_register_library.c b/libgomp/oacc-profiling-acc_register_library.c
new file mode 100644
index 0000000..f6b482b
--- /dev/null
+++ b/libgomp/oacc-profiling-acc_register_library.c
@@ -0,0 +1,39 @@
+/* Copyright (C) 2017 Free Software Foundation, Inc.
+
+ Contributed by Mentor Embedded.
+
+ This file is part of the GNU Offloading and Multi Processing Library
+ (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+ more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+/* This file provides an stub acc_register_library function. It's in a
+ separate file so that this function can easily be overridden when linking
+ statically. */
+
+#include "libgomp.h"
+#include "acc_prof.h"
+
+void
+acc_register_library (acc_prof_reg reg, acc_prof_reg unreg,
+ acc_prof_lookup_func lookup)
+{
+ gomp_debug (0, "dummy %s\n", __FUNCTION__);
+}
diff --git a/libgomp/oacc-profiling.c b/libgomp/oacc-profiling.c
index f98cc0a..d6cc9ce 100644
--- a/libgomp/oacc-profiling.c
+++ b/libgomp/oacc-profiling.c
@@ -104,7 +104,12 @@ goacc_profiling_initialize (void)
for (int i = 0; i < acc_ev_last; ++i)
goacc_prof_callbacks_enabled[i] = true;
-
+ /* We are to invoke an external acc_register_library routine, defaulting to
+ our stub oacc-profiling-acc_register_library.c:acc_register_library
+ implementation. */
+ gomp_debug (0, "%s: calling acc_register_library\n", __FUNCTION__);
+ //TODO.
+ acc_register_library (acc_prof_register, acc_prof_unregister, NULL);
#ifdef PLUGIN_SUPPORT
char *acc_proflibs = secure_getenv ("ACC_PROFLIB");
while (acc_proflibs != NULL && acc_proflibs[0] != '\0')
@@ -141,10 +146,20 @@ goacc_profiling_initialize (void)
= dlsym (dl_handle, "acc_register_library");
if (a_r_l == NULL)
goto dl_fail;
- gomp_debug (0, " %s: calling %s:acc_register_library\n",
- __FUNCTION__, acc_proflib);
- a_r_l (acc_prof_register, acc_prof_unregister,
- acc_prof_lookup);
+ /* Avoid duplicate registration, for example if the same shared
+ library is specified in LD_PRELOAD and ACC_PROFLIB -- which
+ TAU 2.26 does when using "tau_exec -openacc". */
+ if (a_r_l != acc_register_library)
+ {
+ gomp_debug (0, " %s: calling %s:acc_register_library\n",
+ __FUNCTION__, acc_proflib);
+ //TODO.
+ a_r_l (acc_prof_register, acc_prof_unregister, NULL);
+ }
+ else
+ gomp_debug (0, " %s: skipping duplicate"
+ " %s:acc_register_library\n",
+ __FUNCTION__, acc_proflib);
}
else
{
@@ -487,13 +502,6 @@ acc_prof_lookup (const char *name)
return NULL;
}
-void
-acc_register_library (acc_prof_reg reg, acc_prof_reg unreg,
- acc_prof_lookup_func lookup)
-{
- gomp_fatal ("TODO");
-}
-
/* Prepare to dispatch events? */
bool
diff --git a/libgomp/openacc.f90 b/libgomp/openacc.f90
index 8ef107e..a3d7bcb 100644
--- a/libgomp/openacc.f90
+++ b/libgomp/openacc.f90
@@ -798,7 +798,7 @@ module openacc
public :: acc_memcpy_to_device, acc_memcpy_to_device_async
public :: acc_memcpy_from_device, acc_memcpy_from_device_async
- integer, parameter :: openacc_version = 201711
+ integer, parameter :: openacc_version = 201811
interface acc_get_num_devices
procedure :: acc_get_num_devices_h
diff --git a/libgomp/openacc_lib.h b/libgomp/openacc_lib.h
index b0d287e..d830574 100644
--- a/libgomp/openacc_lib.h
+++ b/libgomp/openacc_lib.h
@@ -70,7 +70,7 @@
integer (acc_handle_kind), parameter :: acc_async_noval = -1
integer (acc_handle_kind), parameter :: acc_async_sync = -2
- integer, parameter :: openacc_version = 201711
+ integer, parameter :: openacc_version = 201811
interface acc_get_num_devices
function acc_get_num_devices_h (devicetype)
diff --git a/libgomp/plugin/plugin-gcn.c b/libgomp/plugin/plugin-gcn.c
index 4b42a59..b39a94b 100644
--- a/libgomp/plugin/plugin-gcn.c
+++ b/libgomp/plugin/plugin-gcn.c
@@ -2026,11 +2026,12 @@ create_kernel_dispatch (struct kernel_info *kernel, int num_teams,
static void
process_reverse_offload (uint64_t fn, uint64_t mapnum, uint64_t hostaddrs,
- uint64_t sizes, uint64_t kinds, uint64_t dev_num64)
+ uint64_t sizes, uint64_t kinds, uint64_t dev_num64,
+ uint64_t signal)
{
int dev_num = dev_num64;
GOMP_PLUGIN_target_rev (fn, mapnum, hostaddrs, sizes, kinds, dev_num,
- NULL);
+ (volatile int *) signal, false);
}
/* Output any data written to console output from the kernel. It is expected
@@ -2080,7 +2081,8 @@ console_output (struct kernel_info *kernel, struct kernargs *kernargs,
case 4:
process_reverse_offload (data->value_u64[0], data->value_u64[1],
data->value_u64[2], data->value_u64[3],
- data->value_u64[4], data->value_u64[5]);
+ data->value_u64[4], data->value_u64[5],
+ data->value_u64[6]);
break;
default: printf ("GCN print buffer error!\n"); break;
}
diff --git a/libgomp/plugin/plugin-nvptx.c b/libgomp/plugin/plugin-nvptx.c
index a5cf859..a6c8198 100644
--- a/libgomp/plugin/plugin-nvptx.c
+++ b/libgomp/plugin/plugin-nvptx.c
@@ -1799,8 +1799,6 @@ GOMP_OFFLOAD_alloc (int ord, size_t size)
ptx_dev->free_blocks = NULL;
pthread_mutex_unlock (&ptx_dev->free_blocks_lock);
- nvptx_stacks_free (ptx_dev, false);
-
while (blocks)
{
tmp = blocks->next;
@@ -1828,6 +1826,48 @@ GOMP_OFFLOAD_free (int ord, void *ptr)
&& nvptx_free (ptr, ptx_devices[ord]));
}
+bool
+GOMP_OFFLOAD_page_locked_host_alloc (void **ptr, size_t size)
+{
+ GOMP_PLUGIN_debug (0, "nvptx %s: ptr=%p, size=%llu\n",
+ __FUNCTION__, ptr, (unsigned long long) size);
+
+ if (size == 0)
+ {
+ /* Special case to ensure omp_alloc specification compliance. */
+ *ptr = NULL;
+ GOMP_PLUGIN_debug (0, " -> *ptr=null\n");
+ return true;
+ }
+
+ CUresult r;
+
+ unsigned int flags = 0;
+ /* Given 'CU_DEVICE_ATTRIBUTE_UNIFIED_ADDRESSING', we don't need
+ 'flags |= CU_MEMHOSTALLOC_PORTABLE;' here. */
+ r = CUDA_CALL_NOCHECK (cuMemHostAlloc, ptr, size, flags);
+ if (r == CUDA_ERROR_OUT_OF_MEMORY)
+ *ptr = NULL;
+ else if (r != CUDA_SUCCESS)
+ {
+ GOMP_PLUGIN_error ("cuMemHostAlloc error: %s", cuda_error (r));
+ return false;
+ }
+ GOMP_PLUGIN_debug (0, " -> *ptr=%p\n",
+ *ptr);
+ return true;
+}
+
+bool
+GOMP_OFFLOAD_page_locked_host_free (void *ptr)
+{
+ GOMP_PLUGIN_debug (0, "nvptx %s: ptr=%p\n",
+ __FUNCTION__, ptr);
+
+ CUDA_CALL (cuMemFreeHost, ptr);
+ return true;
+}
+
void
GOMP_OFFLOAD_openacc_exec (void (*fn) (void *),
size_t mapnum __attribute__((unused)),
@@ -1939,9 +1979,10 @@ nvptx_goacc_asyncqueue_construct (unsigned int flags)
}
struct goacc_asyncqueue *
-GOMP_OFFLOAD_openacc_async_construct (int device __attribute__((unused)))
+GOMP_OFFLOAD_openacc_async_construct (int device)
{
- return nvptx_goacc_asyncqueue_construct (CU_STREAM_DEFAULT);
+ nvptx_attach_host_thread_to_device (device);
+ return nvptx_goacc_asyncqueue_construct (CU_STREAM_NON_BLOCKING);
}
static bool
@@ -2815,17 +2856,68 @@ GOMP_OFFLOAD_run (int ord, void *tgt_fn, void *tgt_vars, void **args)
else if (r != CUDA_ERROR_NOT_READY)
GOMP_PLUGIN_fatal ("cuStreamQuery error: %s", cuda_error (r));
- if (__atomic_load_n (&ptx_dev->rev_data->fn, __ATOMIC_ACQUIRE) != 0)
+ struct rev_offload *rev_metadata = ptx_dev->rev_data;
+
+ /* Claim a portion of the ring buffer to process on this iteration.
+ Don't mark them as consumed until all the data has been read out. */
+ unsigned int consumed = __atomic_load_n (&rev_metadata->consumed,
+ __ATOMIC_ACQUIRE);
+ unsigned int from = __atomic_load_n (&rev_metadata->claimed,
+ __ATOMIC_RELAXED);
+ unsigned int to = __atomic_load_n (&rev_metadata->next_slot,
+ __ATOMIC_RELAXED);
+
+ if (consumed > to)
+ {
+ /* Overflow happens when we exceed UINTMAX requests. */
+ GOMP_PLUGIN_fatal ("NVPTX reverse offload buffer overflowed.\n");
+ }
+
+ to = MIN(to, consumed + REV_OFFLOAD_QUEUE_SIZE / 2);
+ if (to <= from)
+ /* Nothing to do; poll again. */
+ goto poll_again;
+
+ if (!__atomic_compare_exchange_n (&rev_metadata->claimed, &from, to,
+ false,
+ __ATOMIC_ACQUIRE, __ATOMIC_RELAXED))
+ /* Collision with another thread ... go around again. */
+ goto poll_again;
+
+ unsigned int index;
+ for (index = from; index < to; index++)
{
- struct rev_offload *rev_data = ptx_dev->rev_data;
+ int slot = index % REV_OFFLOAD_QUEUE_SIZE;
+
+ /* Wait while the target finishes filling in the slot. */
+ while (__atomic_load_n (&ptx_dev->rev_data->queue[slot].signal,
+ __ATOMIC_ACQUIRE) == 0)
+ ; /* spin */
+
+ /* Pass the request to libgomp; this will queue the request and
+ return right away, without waiting for the kernel to run. */
+ struct rev_req *rev_data = &ptx_dev->rev_data->queue[slot];
GOMP_PLUGIN_target_rev (rev_data->fn, rev_data->mapnum,
rev_data->addrs, rev_data->sizes,
rev_data->kinds, rev_data->dev_num,
- reverse_offload_aq);
- if (!nvptx_goacc_asyncqueue_synchronize (reverse_offload_aq))
- exit (EXIT_FAILURE);
- __atomic_store_n (&rev_data->fn, 0, __ATOMIC_RELEASE);
+ rev_data->signal, true);
+
+ /* Ensure that the slot doesn't trigger early, when reused. */
+ __atomic_store_n (&rev_data->signal, 0, __ATOMIC_RELEASE);
}
+
+ /* The data is now consumed so release the slots for reuse. */
+ unsigned int consumed_so_far = from;
+ while (!__atomic_compare_exchange_n (&rev_metadata->consumed,
+ &consumed_so_far, to, false,
+ __ATOMIC_RELEASE, __ATOMIC_RELAXED))
+ {
+ /* Another thread didn't consume all it claimed yet.... */
+ consumed_so_far = from;
+ usleep (1);
+ }
+
+poll_again:
usleep (1);
}
else
diff --git a/libgomp/target-cxa-dso-dtor.c b/libgomp/target-cxa-dso-dtor.c
new file mode 100644
index 0000000..d1a898d
--- /dev/null
+++ b/libgomp/target-cxa-dso-dtor.c
@@ -0,0 +1,3 @@
+/* Host/device compatibility: Itanium C++ ABI, DSO Object Destruction API */
+
+/* Nothing needed here. */
diff --git a/libgomp/target.c b/libgomp/target.c
index 9674ff4..01434f8 100644
--- a/libgomp/target.c
+++ b/libgomp/target.c
@@ -990,15 +990,155 @@ gomp_map_val (struct target_mem_desc *tgt, void **hostaddrs, size_t i)
}
}
+static const char *
+kind_to_name (unsigned short kind)
+{
+ if (GOMP_MAP_IMPLICIT_P (kind))
+ kind &= ~GOMP_MAP_IMPLICIT;
+
+ switch (kind & 0xff)
+ {
+ case GOMP_MAP_ALLOC: return "GOMP_MAP_ALLOC";
+ case GOMP_MAP_FIRSTPRIVATE: return "GOMP_MAP_FIRSTPRIVATE";
+ case GOMP_MAP_FIRSTPRIVATE_INT: return "GOMP_MAP_FIRSTPRIVATE_INT";
+ case GOMP_MAP_TO: return "GOMP_MAP_TO";
+ case GOMP_MAP_TO_PSET: return "GOMP_MAP_TO_PSET";
+ case GOMP_MAP_FROM: return "GOMP_MAP_FROM";
+ case GOMP_MAP_TOFROM: return "GOMP_MAP_TOFROM";
+ case GOMP_MAP_POINTER: return "GOMP_MAP_POINTER";
+ case GOMP_MAP_ATTACH: return "GOMP_MAP_ATTACH";
+ case GOMP_MAP_DETACH: return "GOMP_MAP_DETACH";
+ case GOMP_MAP_STRUCT: return "GOMP_MAP_STRUCT";
+ case GOMP_MAP_STRUCT_UNORD: return "GOMP_MAP_STRUCT_UNORD";
+ default: return "unknown";
+ }
+}
+
+static void
+gomp_add_map (size_t idx, size_t *new_idx,
+ void ***hostaddrs, size_t **sizes, unsigned short **skinds,
+ void ***new_hostaddrs, size_t **new_sizes,
+ unsigned short **new_kinds, size_t *iterator_count)
+{
+ if ((*sizes)[idx] == SIZE_MAX)
+ {
+ uintptr_t *iterator_array = (*hostaddrs)[idx];
+ size_t count = *iterator_array++;
+ for (size_t i = 0; i < count; i++)
+ {
+ (*new_hostaddrs)[*new_idx] = (void *) *iterator_array++;
+ (*new_sizes)[*new_idx] = *iterator_array++;
+ (*new_kinds)[*new_idx] = (*skinds)[idx];
+ iterator_count[*new_idx] = i + 1;
+ gomp_debug (1,
+ "Expanding map %u <%s>: "
+ "hostaddrs[%u] = %p, sizes[%u] = %lu\n",
+ (int) idx, kind_to_name ((*new_kinds)[*new_idx]),
+ (int) *new_idx, (*new_hostaddrs)[*new_idx],
+ (int) *new_idx, (unsigned long) (*new_sizes)[*new_idx]);
+ (*new_idx)++;
+ }
+ }
+ else
+ {
+ (*new_hostaddrs)[*new_idx] = (*hostaddrs)[idx];
+ (*new_sizes)[*new_idx] = (*sizes)[idx];
+ (*new_kinds)[*new_idx] = (*skinds)[idx];
+ iterator_count[*new_idx] = 0;
+ (*new_idx)++;
+ }
+}
+
+
+/* Map entries containing expanded iterators will be flattened and merged into
+ HOSTADDRS, SIZES and KINDS, and MAPNUM updated. Returns true if there are
+ any iterators found. ITERATOR_COUNT holds the iteration count of the
+ iterator that generates each map (0 if not generated from an iterator).
+ HOSTADDRS, SIZES, KINDS and ITERATOR_COUNT must be freed afterwards if any
+ merging occurs. */
+
+static bool
+gomp_merge_iterator_maps (size_t *mapnum, void ***hostaddrs, size_t **sizes,
+ void **kinds, size_t **iterator_count)
+{
+ bool iterator_p = false;
+ size_t map_count = 0;
+ unsigned short **skinds = (unsigned short **) kinds;
+
+ for (size_t i = 0; i < *mapnum; i++)
+ if ((*sizes)[i] == SIZE_MAX)
+ {
+ uintptr_t *iterator_array = (*hostaddrs)[i];
+ map_count += iterator_array[0];
+ iterator_p = true;
+ }
+ else
+ map_count++;
+
+ if (!iterator_p)
+ return false;
+
+ gomp_debug (1,
+ "Expanding iterator maps - number of map entries: %u -> %u\n",
+ (int) *mapnum, (int) map_count);
+ void **new_hostaddrs = (void **) gomp_malloc (map_count * sizeof (void *));
+ size_t *new_sizes = (size_t *) gomp_malloc (map_count * sizeof (size_t));
+ unsigned short *new_kinds
+ = (unsigned short *) gomp_malloc (map_count * sizeof (unsigned short));
+ size_t new_idx = 0;
+ *iterator_count = (size_t *) gomp_malloc (map_count * sizeof (size_t));
+
+ for (size_t i = 0; i < *mapnum; i++)
+ {
+ int map_type = get_kind (true, *skinds, i) & 0xff;
+ if (map_type == GOMP_MAP_STRUCT || map_type == GOMP_MAP_STRUCT_UNORD)
+ {
+ size_t field_count = (*sizes)[i];
+ size_t idx_i = new_idx;
+
+ gomp_add_map (i, &new_idx, hostaddrs, sizes, skinds,
+ &new_hostaddrs, &new_sizes, &new_kinds,
+ *iterator_count);
+
+ for (size_t j = i + 1; j <= i + field_count; j++)
+ {
+ if ((*sizes)[j] == SIZE_MAX)
+ {
+ uintptr_t *iterator_array = (*hostaddrs)[j];
+ size_t count = iterator_array[0];
+ new_sizes[idx_i] += count - 1;
+ }
+ gomp_add_map (j, &new_idx, hostaddrs, sizes, skinds,
+ &new_hostaddrs, &new_sizes, &new_kinds,
+ *iterator_count);
+ }
+ gomp_debug (1, "Map %u: new field count = %lu\n",
+ (int) i, (unsigned long) new_sizes[idx_i]);
+ i += field_count;
+ }
+ else
+ gomp_add_map (i, &new_idx, hostaddrs, sizes, skinds,
+ &new_hostaddrs, &new_sizes, &new_kinds, *iterator_count);
+ }
+
+ *mapnum = map_count;
+ *hostaddrs = new_hostaddrs;
+ *sizes = new_sizes;
+ *kinds = new_kinds;
+
+ return true;
+}
+
static inline __attribute__((always_inline)) struct target_mem_desc *
gomp_map_vars_internal (struct gomp_device_descr *devicep,
struct goacc_asyncqueue *aq, size_t mapnum,
void **hostaddrs, void **devaddrs, size_t *sizes,
- void *kinds, bool short_mapkind,
- htab_t *refcount_set,
+ void *kinds, struct goacc_ncarray_info *nca_info,
+ bool short_mapkind, htab_t *refcount_set,
enum gomp_map_vars_kind pragma_kind)
{
size_t i, tgt_align, tgt_size, not_found_cnt = 0;
+ size_t nca_data_row_num = (nca_info ? nca_info->num_data_rows : 0);
bool has_firstprivate = false;
bool has_always_ptrset = false;
bool openmp_p = (pragma_kind & GOMP_MAP_VARS_OPENACC) == 0;
@@ -1006,9 +1146,15 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep,
const int typemask = short_mapkind ? 0xff : 0x7;
struct splay_tree_s *mem_map = &devicep->mem_map;
struct splay_tree_key_s cur_node;
+ bool iterators_p = false;
+ size_t *iterator_count = NULL;
+ if (short_mapkind)
+ iterators_p = gomp_merge_iterator_maps (&mapnum, &hostaddrs, &sizes,
+ &kinds, &iterator_count);
struct target_mem_desc *tgt
- = gomp_malloc (sizeof (*tgt) + sizeof (tgt->list[0]) * mapnum);
- tgt->list_count = mapnum;
+ = gomp_malloc (sizeof (*tgt)
+ + sizeof (tgt->list[0]) * (mapnum + nca_data_row_num));
+ tgt->list_count = mapnum + nca_data_row_num;
tgt->refcount = (pragma_kind & GOMP_MAP_VARS_ENTER_DATA) ? 0 : 1;
tgt->device_descr = devicep;
tgt->prev = NULL;
@@ -1162,6 +1308,28 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep,
has_firstprivate = true;
continue;
}
+ else if (GOMP_MAP_NONCONTIG_ARRAY_P (kind & typemask))
+ {
+ /* Ignore non-contiguous arrays for now, we process them together
+ later. */
+ tgt->list[i].key = NULL;
+ tgt->list[i].offset = 0;
+ not_found_cnt++;
+
+ /* The map for the non-contiguous array itself is never copied from
+ during unmapping, its the data rows that count. Set copy-from
+ flags to false here. */
+ tgt->list[i].copy_from = false;
+ tgt->list[i].always_copy_from = false;
+ tgt->list[i].is_attach = false;
+
+ size_t align = (size_t) 1 << (kind >> rshift);
+ if (tgt_align < align)
+ tgt_align = align;
+
+ continue;
+ }
+
cur_node.host_start = (uintptr_t) hostaddrs[i];
if (!GOMP_MAP_POINTER_P (kind & typemask))
cur_node.host_end = cur_node.host_start + sizes[i];
@@ -1297,6 +1465,45 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep,
}
}
+ /* For non-contiguous arrays. Each data row is one target item, separated
+ from the normal map clause items, hence we order them after mapnum. */
+ if (nca_info)
+ {
+ struct target_var_desc *next_var_desc = &tgt->list[mapnum];
+ for (i = 0; i < nca_info->num_ncarray; i++)
+ {
+ struct goacc_ncarray *nca = &nca_info->ncarray[i];
+ int kind = get_kind (short_mapkind, kinds, nca->map_index);
+ size_t align = (size_t) 1 << (kind >> rshift);
+ tgt_size = (tgt_size + align - 1) & ~(align - 1);
+ tgt_size += nca->ptrblock_size;
+
+ for (size_t j = 0; j < nca->data_row_num; j++)
+ {
+ struct target_var_desc *row_desc = next_var_desc++;
+ void *row = nca->data_rows[j];
+ cur_node.host_start = (uintptr_t) row;
+ cur_node.host_end = cur_node.host_start + nca->data_row_size;
+ splay_tree_key n = splay_tree_lookup (mem_map, &cur_node);
+ if (n)
+ {
+ assert (n->refcount != REFCOUNT_LINK);
+ gomp_map_vars_existing (devicep, aq, n, &cur_node, row_desc,
+ kind & typemask, false, false,
+ /* TODO: cbuf? */ NULL,
+ refcount_set);
+ }
+ else
+ {
+ tgt_size = (tgt_size + align - 1) & ~(align - 1);
+ tgt_size += nca->data_row_size;
+ not_found_cnt++;
+ }
+ }
+ }
+ assert (next_var_desc == &tgt->list[mapnum + nca_info->num_data_rows]);
+ }
+
if (devaddrs)
{
if (mapnum != 1)
@@ -1643,6 +1850,15 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep,
default:
break;
}
+
+ if (GOMP_MAP_NONCONTIG_ARRAY_P (kind & typemask))
+ {
+ tgt->list[i].key = &array->key;
+ tgt->list[i].key->tgt = tgt;
+ array++;
+ continue;
+ }
+
splay_tree_key k = &array->key;
k->host_start = (uintptr_t) hostaddrs[i];
if (!GOMP_MAP_POINTER_P (kind & typemask))
@@ -1879,18 +2095,120 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep,
array++;
}
}
+
+ /* Processing of non-contiguous array rows. */
+ if (nca_info)
+ {
+ struct target_var_desc *next_var_desc = &tgt->list[mapnum];
+ for (i = 0; i < nca_info->num_ncarray; i++)
+ {
+ struct goacc_ncarray *nca = &nca_info->ncarray[i];
+ int kind = get_kind (short_mapkind, kinds, nca->map_index);
+ size_t align = (size_t) 1 << (kind >> rshift);
+ tgt_size = (tgt_size + align - 1) & ~(align - 1);
+
+ assert (nca->ptr == hostaddrs[nca->map_index]);
+
+ /* For the map of the non-contiguous array itself, adjust so that
+ the passed device address points to the beginning of the
+ ptrblock. Remember to adjust the first-dimension's bias here. */
+ tgt->list[nca->map_index].key->tgt_offset
+ = tgt_size - nca->descr->dims[0].base;
+
+ void *target_ptrblock = (void*) tgt->tgt_start + tgt_size;
+ tgt_size += nca->ptrblock_size;
+
+ /* Add splay key for each data row in current non-contiguous
+ array. */
+ for (size_t j = 0; j < nca->data_row_num; j++)
+ {
+ struct target_var_desc *row_desc = next_var_desc++;
+ void *row = nca->data_rows[j];
+ cur_node.host_start = (uintptr_t) row;
+ cur_node.host_end = cur_node.host_start + nca->data_row_size;
+ splay_tree_key k = splay_tree_lookup (mem_map, &cur_node);
+ if (k)
+ {
+ assert (k->refcount != REFCOUNT_LINK);
+ gomp_map_vars_existing (devicep, aq, k, &cur_node, row_desc,
+ kind & typemask, false, false,
+ cbufp, refcount_set);
+ }
+ else
+ {
+ tgt->refcount++;
+ tgt_size = (tgt_size + align - 1) & ~(align - 1);
+
+ k = &array->key;
+ k->host_start = (uintptr_t) row;
+ k->host_end = k->host_start + nca->data_row_size;
+
+ k->tgt = tgt;
+ k->refcount = 1;
+ k->dynamic_refcount = 0;
+ k->aux = NULL;
+ k->tgt_offset = tgt_size;
+
+ tgt_size += nca->data_row_size;
+
+ row_desc->key = k;
+ row_desc->copy_from
+ = GOMP_MAP_COPY_FROM_P (kind & typemask);
+ row_desc->always_copy_from
+ = GOMP_MAP_COPY_FROM_P (kind & typemask);
+ row_desc->is_attach = false;
+ row_desc->offset = 0;
+ row_desc->length = nca->data_row_size;
+
+ array->left = NULL;
+ array->right = NULL;
+ splay_tree_insert (mem_map, array);
+
+ if (GOMP_MAP_COPY_TO_P (kind & typemask))
+ gomp_copy_host2dev (devicep, aq,
+ (void *) tgt->tgt_start + k->tgt_offset,
+ (void *) k->host_start,
+ nca->data_row_size, false,
+ cbufp);
+ array++;
+ }
+ nca->tgt_data_rows[j]
+ = (void *) (k->tgt->tgt_start + k->tgt_offset);
+ }
+
+ /* Now we have the target memory allocated, and target offsets of all
+ row blocks assigned and calculated, we can construct the
+ accelerator side ptrblock and copy it in. */
+ if (nca->ptrblock_size)
+ {
+ void *ptrblock = gomp_malloc (nca->ptrblock_size);
+ goacc_noncontig_array_create_ptrblock
+ (nca, ptrblock, target_ptrblock);
+ gomp_copy_host2dev (devicep, aq, target_ptrblock, ptrblock,
+ nca->ptrblock_size, false, cbufp);
+ if (aq)
+ /* Free once the transfer has completed. */
+ devicep->openacc.async.queue_callback_func (aq, free, ptrblock);
+ else
+ free (ptrblock);
+ }
+ }
+ }
}
if (pragma_kind & GOMP_MAP_VARS_TARGET)
{
+ size_t map_num = 0;
for (i = 0; i < mapnum; i++)
- {
- cur_node.tgt_offset = gomp_map_val (tgt, hostaddrs, i);
- gomp_copy_host2dev (devicep, aq,
- (void *) (tgt->tgt_start + i * sizeof (void *)),
- (void *) &cur_node.tgt_offset, sizeof (void *),
- true, cbufp);
- }
+ if (!iterator_count || iterator_count[i] <= 1)
+ {
+ cur_node.tgt_offset = gomp_map_val (tgt, hostaddrs, i);
+ gomp_copy_host2dev (devicep, aq,
+ (void *) (tgt->tgt_start + map_num * sizeof (void *)),
+ (void *) &cur_node.tgt_offset, sizeof (void *),
+ true, cbufp);
+ map_num++;
+ }
}
if (cbufp)
@@ -1922,6 +2240,15 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep,
}
gomp_mutex_unlock (&devicep->lock);
+
+ if (iterators_p)
+ {
+ free (hostaddrs);
+ free (sizes);
+ free (kinds);
+ free (iterator_count);
+ }
+
return tgt;
}
@@ -1942,8 +2269,8 @@ gomp_map_vars (struct gomp_device_descr *devicep, size_t mapnum,
struct target_mem_desc *tgt;
tgt = gomp_map_vars_internal (devicep, NULL, mapnum, hostaddrs, devaddrs,
- sizes, kinds, short_mapkind, refcount_set,
- pragma_kind);
+ sizes, kinds, NULL, short_mapkind,
+ refcount_set, pragma_kind);
if (local_refcount_set)
htab_free (local_refcount_set);
@@ -1954,11 +2281,12 @@ attribute_hidden struct target_mem_desc *
goacc_map_vars (struct gomp_device_descr *devicep,
struct goacc_asyncqueue *aq, size_t mapnum,
void **hostaddrs, void **devaddrs, size_t *sizes,
- void *kinds, bool short_mapkind,
+ void *kinds, struct goacc_ncarray_info *nca_info,
+ bool short_mapkind,
enum gomp_map_vars_kind pragma_kind)
{
return gomp_map_vars_internal (devicep, aq, mapnum, hostaddrs, devaddrs,
- sizes, kinds, short_mapkind, NULL,
+ sizes, kinds, nca_info, short_mapkind, NULL,
GOMP_MAP_VARS_OPENACC | pragma_kind);
}
@@ -2112,6 +2440,9 @@ gomp_unmap_vars_internal (struct target_mem_desc *tgt, bool do_copyfrom,
false, NULL);
}
+ size_t nrmvars = 0;
+ splay_tree_key remove_vars[tgt->list_count];
+
for (i = 0; i < tgt->list_count; i++)
{
splay_tree_key k = tgt->list[i].key;
@@ -2133,17 +2464,22 @@ gomp_unmap_vars_internal (struct target_mem_desc *tgt, bool do_copyfrom,
(void *) (k->tgt->tgt_start + k->tgt_offset
+ tgt->list[i].offset),
tgt->list[i].length);
+ /* Queue all removals together for processing below.
+ See also 'gomp_exit_data'. */
if (do_remove)
- {
- struct target_mem_desc *k_tgt __attribute__((unused)) = k->tgt;
- bool is_tgt_unmapped __attribute__((unused))
- = gomp_remove_var (devicep, k);
- /* It would be bad if TGT got unmapped while we're still iterating
- over its LIST_COUNT, and also expect to use it in the following
- code. */
- assert (!is_tgt_unmapped
- || k_tgt != tgt);
- }
+ remove_vars[nrmvars++] = k;
+ }
+
+ for (i = 0; i < nrmvars; i++)
+ {
+ splay_tree_key k = remove_vars[i];
+ struct target_mem_desc *k_tgt __attribute__((unused)) = k->tgt;
+ bool is_tgt_unmapped __attribute__((unused))
+ = gomp_remove_var (devicep, k);
+ /* It would be bad if TGT got unmapped while we're still iterating over
+ its LIST_COUNT, and also expect to use it in the following code. */
+ assert (!is_tgt_unmapped
+ || k_tgt != tgt);
}
if (aq)
@@ -2181,6 +2517,14 @@ goacc_unmap_vars (struct target_mem_desc *tgt, bool do_copyfrom,
gomp_unmap_vars_internal (tgt, do_copyfrom, NULL, aq);
}
+static int
+omp_target_memcpy_rect_worker (void *, const void *, size_t, size_t, int,
+ const size_t *, const size_t *, const size_t *,
+ const size_t *, const size_t *, const size_t *,
+ struct gomp_device_descr *,
+ struct gomp_device_descr *, size_t *tmp_size,
+ void **tmp);
+
static void
gomp_update (struct gomp_device_descr *devicep, size_t mapnum, void **hostaddrs,
size_t *sizes, void *kinds, bool short_mapkind)
@@ -2188,6 +2532,8 @@ gomp_update (struct gomp_device_descr *devicep, size_t mapnum, void **hostaddrs,
size_t i;
struct splay_tree_key_s cur_node;
const int typemask = short_mapkind ? 0xff : 0x7;
+ bool iterators_p = false;
+ size_t *iterator_count = NULL;
if (!devicep)
return;
@@ -2195,6 +2541,10 @@ gomp_update (struct gomp_device_descr *devicep, size_t mapnum, void **hostaddrs,
if (mapnum == 0)
return;
+ if (short_mapkind)
+ iterators_p = gomp_merge_iterator_maps (&mapnum, &hostaddrs, &sizes,
+ &kinds, &iterator_count);
+
gomp_mutex_lock (&devicep->lock);
if (devicep->state == GOMP_DEVICE_FINALIZED)
{
@@ -2203,91 +2553,143 @@ gomp_update (struct gomp_device_descr *devicep, size_t mapnum, void **hostaddrs,
}
for (i = 0; i < mapnum; i++)
- if (sizes[i])
- {
- cur_node.host_start = (uintptr_t) hostaddrs[i];
- cur_node.host_end = cur_node.host_start + sizes[i];
- splay_tree_key n = splay_tree_lookup (&devicep->mem_map, &cur_node);
- if (n)
- {
- int kind = get_kind (short_mapkind, kinds, i);
- if (n->host_start > cur_node.host_start
- || n->host_end < cur_node.host_end)
- {
- gomp_mutex_unlock (&devicep->lock);
- gomp_fatal ("Trying to update [%p..%p) object when "
- "only [%p..%p) is mapped",
- (void *) cur_node.host_start,
- (void *) cur_node.host_end,
- (void *) n->host_start,
- (void *) n->host_end);
- }
+ {
+ int kind = get_kind (short_mapkind, kinds, i);
+ if ((kind & typemask) == GOMP_MAP_TO_GRID
+ || (kind & typemask) == GOMP_MAP_FROM_GRID)
+ {
+ omp_noncontig_array_desc *desc
+ = (omp_noncontig_array_desc *) hostaddrs[i + 1];
+ size_t bias = sizes[i + 1];
+ cur_node.host_start = (uintptr_t) hostaddrs[i] + bias;
+ cur_node.host_end = cur_node.host_start + sizes[i];
+ splay_tree_key n = splay_tree_lookup (&devicep->mem_map, &cur_node);
+ if (n)
+ {
+ if (n->aux && n->aux->attach_count)
+ {
+ gomp_mutex_unlock (&devicep->lock);
+ gomp_error ("noncontiguous update with attached pointers");
+ return;
+ }
+ void *devaddr = (void *) (n->tgt->tgt_start + n->tgt_offset
+ + cur_node.host_start
+ - n->host_start
+ - bias);
+ size_t tmp_size = 0;
+ void *tmp = NULL;
+ if ((kind & typemask) == GOMP_MAP_TO_GRID)
+ omp_target_memcpy_rect_worker (devaddr, hostaddrs[i],
+ desc->elemsize, desc->span,
+ desc->ndims, desc->length,
+ desc->stride, desc->index,
+ desc->index, desc->dim,
+ desc->dim, devicep,
+ NULL, &tmp_size, &tmp);
+ else
+ omp_target_memcpy_rect_worker (hostaddrs[i], devaddr,
+ desc->elemsize, desc->span,
+ desc->ndims, desc->length,
+ desc->stride, desc->index,
+ desc->index, desc->dim,
+ desc->dim, NULL,
+ devicep, &tmp_size, &tmp);
+ }
+ i++;
+ }
+ else if (sizes[i])
+ {
+ cur_node.host_start = (uintptr_t) hostaddrs[i];
+ cur_node.host_end = cur_node.host_start + sizes[i];
+ splay_tree_key n = splay_tree_lookup (&devicep->mem_map, &cur_node);
+ if (n)
+ {
+ if (n->host_start > cur_node.host_start
+ || n->host_end < cur_node.host_end)
+ {
+ gomp_mutex_unlock (&devicep->lock);
+ gomp_fatal ("Trying to update [%p..%p) object when "
+ "only [%p..%p) is mapped",
+ (void *) cur_node.host_start,
+ (void *) cur_node.host_end,
+ (void *) n->host_start,
+ (void *) n->host_end);
+ }
- if (n->aux && n->aux->attach_count)
- {
- uintptr_t addr = cur_node.host_start;
- while (addr < cur_node.host_end)
- {
- /* We have to be careful not to overwrite still attached
- pointers during host<->device updates. */
- size_t i = (addr - cur_node.host_start) / sizeof (void *);
- if (n->aux->attach_count[i] == 0)
- {
- void *devaddr = (void *) (n->tgt->tgt_start
- + n->tgt_offset
- + addr - n->host_start);
- if (GOMP_MAP_COPY_TO_P (kind & typemask))
- gomp_copy_host2dev (devicep, NULL,
- devaddr, (void *) addr,
- sizeof (void *), false, NULL);
- if (GOMP_MAP_COPY_FROM_P (kind & typemask))
- gomp_copy_dev2host (devicep, NULL,
- (void *) addr, devaddr,
- sizeof (void *));
- }
- addr += sizeof (void *);
- }
- }
- else
- {
- void *hostaddr = (void *) cur_node.host_start;
- void *devaddr = (void *) (n->tgt->tgt_start + n->tgt_offset
- + cur_node.host_start
- - n->host_start);
- size_t size = cur_node.host_end - cur_node.host_start;
-
- if (GOMP_MAP_COPY_TO_P (kind & typemask))
- gomp_copy_host2dev (devicep, NULL, devaddr, hostaddr, size,
- false, NULL);
- if (GOMP_MAP_COPY_FROM_P (kind & typemask))
- gomp_copy_dev2host (devicep, NULL, hostaddr, devaddr, size);
- }
- }
- else
- {
- int kind = get_kind (short_mapkind, kinds, i);
+ if (n->aux && n->aux->attach_count)
+ {
+ uintptr_t addr = cur_node.host_start;
+ while (addr < cur_node.host_end)
+ {
+ /* We have to be careful not to overwrite still attached
+ pointers during host<->device updates. */
+ size_t i = (addr - cur_node.host_start) / sizeof (void *);
+ if (n->aux->attach_count[i] == 0)
+ {
+ void *devaddr = (void *) (n->tgt->tgt_start
+ + n->tgt_offset
+ + addr - n->host_start);
+ if (GOMP_MAP_COPY_TO_P (kind & typemask))
+ gomp_copy_host2dev (devicep, NULL,
+ devaddr, (void *) addr,
+ sizeof (void *), false, NULL);
+ if (GOMP_MAP_COPY_FROM_P (kind & typemask))
+ gomp_copy_dev2host (devicep, NULL,
+ (void *) addr, devaddr,
+ sizeof (void *));
+ }
+ addr += sizeof (void *);
+ }
+ }
+ else
+ {
+ void *hostaddr = (void *) cur_node.host_start;
+ void *devaddr = (void *) (n->tgt->tgt_start + n->tgt_offset
+ + cur_node.host_start
+ - n->host_start);
+ size_t size = cur_node.host_end - cur_node.host_start;
+
+ if (GOMP_MAP_COPY_TO_P (kind & typemask))
+ gomp_copy_host2dev (devicep, NULL, devaddr, hostaddr, size,
+ false, NULL);
+ if (GOMP_MAP_COPY_FROM_P (kind & typemask))
+ gomp_copy_dev2host (devicep, NULL, hostaddr, devaddr, size);
+ }
+ }
+ else
+ {
+ int kind = get_kind (short_mapkind, kinds, i);
- if (GOMP_MAP_PRESENT_P (kind))
- {
- /* We already looked up the memory region above and it
- was missing. */
- gomp_mutex_unlock (&devicep->lock);
+ if (GOMP_MAP_PRESENT_P (kind))
+ {
+ /* We already looked up the memory region above and it
+ was missing. */
+ gomp_mutex_unlock (&devicep->lock);
#ifdef HAVE_INTTYPES_H
- gomp_fatal ("present clause: not present on the device "
- "(addr: %p, size: %"PRIu64" (0x%"PRIx64"), "
- "dev: %d)", (void *) hostaddrs[i],
- (uint64_t) sizes[i], (uint64_t) sizes[i],
- devicep->target_id);
+ gomp_fatal ("present clause: not present on the device "
+ "(addr: %p, size: %"PRIu64" (0x%"PRIx64"), "
+ "dev: %d)", (void *) hostaddrs[i],
+ (uint64_t) sizes[i], (uint64_t) sizes[i],
+ devicep->target_id);
#else
- gomp_fatal ("present clause: not present on the device "
- "(addr: %p, size: %lu (0x%lx), dev: %d)",
- (void *) hostaddrs[i], (unsigned long) sizes[i],
- (unsigned long) sizes[i], devicep->target_id);
+ gomp_fatal ("present clause: not present on the device "
+ "(addr: %p, size: %lu (0x%lx), dev: %d)",
+ (void *) hostaddrs[i], (unsigned long) sizes[i],
+ (unsigned long) sizes[i], devicep->target_id);
#endif
- }
- }
- }
+ }
+ }
+ }
+ }
gomp_mutex_unlock (&devicep->lock);
+
+ if (iterators_p)
+ {
+ free (hostaddrs);
+ free (sizes);
+ free (kinds);
+ free (iterator_count);
+ }
}
static struct gomp_offload_icv_list *
@@ -3481,16 +3883,18 @@ gomp_map_cdata_lookup (struct cpy_data *d, uint64_t *devaddrs,
tgt_start, tgt_end);
}
-/* Handle reverse offload. This is called by the device plugins for a
- reverse offload; it is not called if the outer target runs on the host.
+/* Handle reverse offload. This is called by the host worker thread to
+ execute a single reverse offload request; it is not called if the outer
+ target runs on the host.
The mapping is simplified device-affecting constructs (except for target
with device(ancestor:1)) must not be encountered; in particular not
target (enter/exit) data. */
-void
-gomp_target_rev (uint64_t fn_ptr, uint64_t mapnum, uint64_t devaddrs_ptr,
- uint64_t sizes_ptr, uint64_t kinds_ptr, int dev_num,
- struct goacc_asyncqueue *aq)
+static void
+gomp_target_rev_internal (uint64_t fn_ptr, uint64_t mapnum,
+ uint64_t devaddrs_ptr, uint64_t sizes_ptr,
+ uint64_t kinds_ptr, struct gomp_device_descr *devicep,
+ struct goacc_asyncqueue *aq)
{
/* Return early if there is no offload code. */
if (sizeof (OFFLOAD_PLUGINS) == sizeof (""))
@@ -3507,7 +3911,6 @@ gomp_target_rev (uint64_t fn_ptr, uint64_t mapnum, uint64_t devaddrs_ptr,
unsigned short *kinds;
const bool short_mapkind = true;
const int typemask = short_mapkind ? 0xff : 0x7;
- struct gomp_device_descr *devicep = resolve_device (dev_num, false);
reverse_splay_tree_key n;
struct reverse_splay_tree_key_s k;
@@ -3918,6 +4321,134 @@ gomp_target_rev (uint64_t fn_ptr, uint64_t mapnum, uint64_t devaddrs_ptr,
}
}
+static struct target_rev_queue_s
+{
+ uint64_t fn_ptr;
+ uint64_t mapnum;
+ uint64_t devaddrs_ptr;
+ uint64_t sizes_ptr;
+ uint64_t kinds_ptr;
+ struct gomp_device_descr *devicep;
+
+ volatile int *signal;
+ bool use_aq;
+
+ struct target_rev_queue_s *next;
+} *target_rev_queue_head = NULL, *target_rev_queue_last = NULL;
+static gomp_mutex_t target_rev_queue_lock = 0;
+static int target_rev_thread_count = 0;
+
+static void *
+gomp_target_rev_worker_thread (void *)
+{
+ struct target_rev_queue_s *rev_kernel = NULL;
+ struct goacc_asyncqueue *aq = NULL;
+ struct gomp_device_descr *aq_devicep;
+
+ while (1)
+ {
+ gomp_mutex_lock (&target_rev_queue_lock);
+
+ /* Take a reverse-offload kernel request from the queue. */
+ rev_kernel = target_rev_queue_head;
+ if (rev_kernel)
+ {
+ target_rev_queue_head = rev_kernel->next;
+ if (target_rev_queue_head == NULL)
+ target_rev_queue_last = NULL;
+ }
+
+ if (rev_kernel == NULL)
+ {
+ target_rev_thread_count--;
+ gomp_mutex_unlock (&target_rev_queue_lock);
+ break;
+ }
+ gomp_mutex_unlock (&target_rev_queue_lock);
+
+ /* Ensure we have a suitable device queue for the memory transfers. */
+ if (rev_kernel->use_aq)
+ {
+ if (aq && aq_devicep != rev_kernel->devicep)
+ {
+ aq_devicep->openacc.async.destruct_func (aq);
+ aq = NULL;
+ }
+
+ if (!aq)
+ {
+ aq_devicep = rev_kernel->devicep;
+ aq = aq_devicep->openacc.async.construct_func (aq_devicep->target_id);
+ }
+ }
+
+ /* Run the kernel on the host. */
+ gomp_target_rev_internal (rev_kernel->fn_ptr, rev_kernel->mapnum,
+ rev_kernel->devaddrs_ptr, rev_kernel->sizes_ptr,
+ rev_kernel->kinds_ptr, rev_kernel->devicep, aq);
+
+ /* Signal the device that the reverse-offload is completed. */
+ int one = 1;
+ gomp_copy_host2dev (rev_kernel->devicep, aq, (void*)rev_kernel->signal,
+ &one, sizeof (one), false, NULL);
+
+ /* We're done with this request. */
+ free (rev_kernel);
+
+ /* Loop around and see if another request is waiting. */
+ }
+
+ if (aq)
+ aq_devicep->openacc.async.destruct_func (aq);
+
+ return NULL;
+}
+
+void
+gomp_target_rev (uint64_t fn_ptr, uint64_t mapnum, uint64_t devaddrs_ptr,
+ uint64_t sizes_ptr, uint64_t kinds_ptr, int dev_num,
+ volatile int *signal, bool use_aq)
+{
+ struct gomp_device_descr *devicep = resolve_device (dev_num, false);
+
+ /* Create a new queue node. */
+ struct target_rev_queue_s *newreq = gomp_malloc (sizeof (*newreq));
+ newreq->fn_ptr = fn_ptr;
+ newreq->mapnum = mapnum;
+ newreq->devaddrs_ptr = devaddrs_ptr;
+ newreq->sizes_ptr = sizes_ptr;
+ newreq->kinds_ptr = kinds_ptr;
+ newreq->devicep = devicep;
+ newreq->signal = signal;
+ newreq->use_aq = use_aq;
+ newreq->next = NULL;
+
+ gomp_mutex_lock (&target_rev_queue_lock);
+
+ /* Enqueue the reverse-offload request. */
+ if (target_rev_queue_last)
+ {
+ target_rev_queue_last->next = newreq;
+ target_rev_queue_last = newreq;
+ }
+ else
+ target_rev_queue_last = target_rev_queue_head = newreq;
+
+ /* Launch a new thread to process the request asynchronously.
+ If the thread pool limit has been reached then an existing thread will
+ pick up the job when it is ready. */
+ if (target_rev_thread_count < gomp_reverse_offload_threads)
+ {
+ target_rev_thread_count++;
+ gomp_mutex_unlock (&target_rev_queue_lock);
+
+ pthread_t t;
+ pthread_create (&t, NULL, gomp_target_rev_worker_thread, NULL);
+ }
+ else
+ gomp_mutex_unlock (&target_rev_queue_lock);
+}
+
/* Host fallback for GOMP_target_data{,_ext} routines. */
static void
@@ -4114,7 +4645,7 @@ gomp_exit_data (struct gomp_device_descr *devicep, size_t mapnum,
false, NULL);
}
- int nrmvars = 0;
+ size_t nrmvars = 0;
splay_tree_key remove_vars[mapnum];
for (i = 0; i < mapnum; i++)
@@ -4177,10 +4708,6 @@ gomp_exit_data (struct gomp_device_descr *devicep, size_t mapnum,
errors if we still have following element siblings to copy back.
While we're at it, it also seems more disciplined to simply
queue all removals together for processing below.
-
- Structured block unmapping (i.e. gomp_unmap_vars_internal) should
- not have this problem, since they maintain an additional
- tgt->refcount = 1 reference to the target_mem_desc to start with.
*/
if (do_remove)
remove_vars[nrmvars++] = k;
@@ -4195,7 +4722,7 @@ gomp_exit_data (struct gomp_device_descr *devicep, size_t mapnum,
}
}
- for (int i = 0; i < nrmvars; i++)
+ for (i = 0; i < nrmvars; i++)
gomp_remove_var (devicep, remove_vars[i]);
gomp_mutex_unlock (&devicep->lock);
@@ -4497,6 +5024,140 @@ omp_target_free (void *device_ptr, int device_num)
gomp_mutex_unlock (&devicep->lock);
}
+/* Device (really: libgomp plugin) to use for paged-locked memory. We
+ assume there is either none or exactly one such device for the lifetime of
+ the process. */
+
+static struct gomp_device_descr *device_for_page_locked
+ = /* uninitialized */ (void *) -1;
+
+static struct gomp_device_descr *
+get_device_for_page_locked (void)
+{
+ gomp_debug (0, "%s\n",
+ __FUNCTION__);
+
+ struct gomp_device_descr *device;
+#ifdef HAVE_SYNC_BUILTINS
+ device
+ = __atomic_load_n (&device_for_page_locked, MEMMODEL_RELAXED);
+ if (device == (void *) -1)
+ {
+ gomp_debug (0, " init\n");
+
+ gomp_init_targets_once ();
+
+ device = NULL;
+ for (int i = 0; i < num_devices; ++i)
+ {
+ gomp_debug (0, " i=%d, target_id=%d\n",
+ i, devices[i].target_id);
+
+ /* We consider only the first device of potentially several of the
+ same type as this functionality is not specific to an individual
+ offloading device, but instead relates to the host-side
+ implementation of the respective offloading implementation. */
+ if (devices[i].target_id != 0)
+ continue;
+
+ if (!devices[i].page_locked_host_alloc_func)
+ continue;
+
+ gomp_debug (0, " found device: %p (%s)\n",
+ &devices[i], devices[i].name);
+ if (device)
+ gomp_fatal ("Unclear how %s and %s libgomp plugins may"
+ " simultaneously provide functionality"
+ " for page-locked memory",
+ device->name, devices[i].name);
+ else
+ device = &devices[i];
+ }
+
+ struct gomp_device_descr *device_old
+ = __atomic_exchange_n (&device_for_page_locked, device,
+ MEMMODEL_RELAXED);
+ gomp_debug (0, " old device_for_page_locked: %p\n",
+ device_old);
+ assert (device_old == (void *) -1
+ /* We shouldn't have concurrently found a different or no
+ device. */
+ || device_old == device);
+ }
+#else /* !HAVE_SYNC_BUILTINS */
+ gomp_debug (0, " not implemented for '!HAVE_SYNC_BUILTINS'\n");
+ (void) &device_for_page_locked;
+ device = NULL;
+#endif /* HAVE_SYNC_BUILTINS */
+
+ gomp_debug (0, " -> device=%p (%s)\n",
+ device, device ? device->name : "[none]");
+ return device;
+}
+
+/* Allocate page-locked host memory.
+ Returns whether we have a device capable of that. */
+
+attribute_hidden bool
+gomp_page_locked_host_alloc (void **ptr, size_t size)
+{
+ gomp_debug (0, "%s: ptr=%p, size=%llu\n",
+ __FUNCTION__, ptr, (unsigned long long) size);
+
+ struct gomp_device_descr *device = get_device_for_page_locked ();
+ gomp_debug (0, " device=%p (%s)\n",
+ device, device ? device->name : "[none]");
+ if (device)
+ {
+ gomp_mutex_lock (&device->lock);
+ if (device->state == GOMP_DEVICE_UNINITIALIZED)
+ gomp_init_device (device);
+ else if (device->state == GOMP_DEVICE_FINALIZED)
+ {
+ gomp_mutex_unlock (&device->lock);
+ gomp_fatal ("Device %s used for for page-locked memory is finalized",
+ device->name);
+ }
+ gomp_mutex_unlock (&device->lock);
+
+ if (!device->page_locked_host_alloc_func (ptr, size))
+ gomp_fatal ("Failed to allocate page-locked host memory"
+ " via %s libgomp plugin",
+ device->name);
+ }
+ return device != NULL;
+}
+
+/* Free page-locked host memory.
+ This must only be called if 'gomp_page_locked_host_alloc' returned
+ 'true'. */
+
+attribute_hidden void
+gomp_page_locked_host_free (void *ptr)
+{
+ gomp_debug (0, "%s: ptr=%p\n",
+ __FUNCTION__, ptr);
+
+ struct gomp_device_descr *device = get_device_for_page_locked ();
+ gomp_debug (0, " device=%p (%s)\n",
+ device, device ? device->name : "[none]");
+ assert (device);
+
+ gomp_mutex_lock (&device->lock);
+ assert (device->state != GOMP_DEVICE_UNINITIALIZED);
+ if (device->state == GOMP_DEVICE_FINALIZED)
+ {
+ gomp_mutex_unlock (&device->lock);
+ return;
+ }
+ gomp_mutex_unlock (&device->lock);
+
+ if (!device->page_locked_host_free_func (ptr))
+ gomp_fatal ("Failed to free page-locked host memory"
+ " via %s libgomp plugin",
+ device->name);
+}
+
int
omp_target_is_present (const void *ptr, int device_num)
{
@@ -4683,7 +5344,8 @@ omp_target_memcpy_async (void *dst, const void *src, size_t length,
static int
omp_target_memcpy_rect_worker (void *dst, const void *src, size_t element_size,
- int num_dims, const size_t *volume,
+ size_t span, int num_dims, const size_t *volume,
+ const size_t *strides,
const size_t *dst_offsets,
const size_t *src_offsets,
const size_t *dst_dimensions,
@@ -4697,7 +5359,7 @@ omp_target_memcpy_rect_worker (void *dst, const void *src, size_t element_size,
size_t j, dst_off, src_off, length;
int i, ret;
- if (num_dims == 1)
+ if (num_dims == 1 && (!strides || (strides[0] == 1 && element_size == span)))
{
if (__builtin_mul_overflow (element_size, volume[0], &length)
|| __builtin_mul_overflow (element_size, dst_offsets[0], &dst_off)
@@ -4751,9 +5413,74 @@ omp_target_memcpy_rect_worker (void *dst, const void *src, size_t element_size,
}
return ret ? 0 : EINVAL;
}
+ else if (num_dims == 1 && strides)
+ {
+ size_t stride;
+
+ assert ((src_devicep == NULL || dst_devicep == NULL)
+ && (src_devicep != NULL || dst_devicep != NULL));
+
+ if (__builtin_mul_overflow (span, dst_offsets[0], &dst_off)
+ || __builtin_mul_overflow (span, src_offsets[0], &src_off))
+ return EINVAL;
+
+ if (__builtin_mul_overflow (span, strides[0], &stride))
+ return EINVAL;
+
+ if (((src_devicep && src_devicep->memcpy2d_func)
+ || (dst_devicep && dst_devicep->memcpy2d_func))
+ && (stride % element_size) == 0)
+ {
+ /* Try using memcpy2d for a 1-dimensional strided access. Here we
+ treat the transfer as a 2-dimensional array, where the inner
+ dimension is calculated to be (stride in bytes) / element_size.
+ Indices/offsets are adjusted so the source/destination pointers
+ point to the first element to be transferred, to make the sums
+ easier. (There are some configurations of 2D strided accesses
+ that memcpy3d could handle similarly, but those are probably rare
+ and are unimplemented for now.) */
+
+ /* If stride is element size, this is a contiguous transfer and
+ should have been handled above. */
+ assert (stride > element_size);
+
+ int dst_id = dst_devicep ? dst_devicep->target_id : -1;
+ int src_id = src_devicep ? src_devicep->target_id : -1;
+ void *subarray_src = (char *) src + src_off;
+ void *subarray_dst = (char *) dst + dst_off;
+
+ struct gomp_device_descr *devp = dst_devicep ? dst_devicep
+ : src_devicep;
+ ret = devp->memcpy2d_func (dst_id, src_id, element_size, volume[0],
+ subarray_dst, 0, 0, stride, subarray_src,
+ 0, 0, stride);
+ if (ret != -1)
+ return ret ? 0 : EINVAL;
+ }
+
+ for (i = 0, ret = 1; i < volume[0] && ret; i++)
+ {
+ if (src_devicep == NULL)
+ ret = dst_devicep->host2dev_func (dst_devicep->target_id,
+ (char *) dst + dst_off,
+ (const char *) src + src_off,
+ element_size);
+ else if (dst_devicep == NULL)
+ ret = src_devicep->dev2host_func (src_devicep->target_id,
+ (char *) dst + dst_off,
+ (const char *) src + src_off,
+ element_size);
+ dst_off += stride;
+ src_off += stride;
+ }
+ return ret ? 0 : EINVAL;
+ }
/* host->device, device->host and intra device. */
if (num_dims == 2
+ && (!strides || (strides[0] == 1
+ && strides[1] == 1
+ && element_size == span))
&& ((src_devicep
&& src_devicep == dst_devicep
&& src_devicep->memcpy2d_func)
@@ -4780,6 +5507,10 @@ omp_target_memcpy_rect_worker (void *dst, const void *src, size_t element_size,
return ret ? 0 : EINVAL;
}
else if (num_dims == 3
+ && (!strides || (strides[0] == 1
+ && strides[1] == 1
+ && strides[2] == 1
+ && element_size == span))
&& ((src_devicep
&& src_devicep == dst_devicep
&& src_devicep->memcpy3d_func)
@@ -4815,13 +5546,19 @@ omp_target_memcpy_rect_worker (void *dst, const void *src, size_t element_size,
if (__builtin_mul_overflow (dst_slice, dst_offsets[0], &dst_off)
|| __builtin_mul_overflow (src_slice, src_offsets[0], &src_off))
return EINVAL;
+ if (strides
+ && (__builtin_mul_overflow (dst_slice, strides[0], &dst_slice)
+ || __builtin_mul_overflow (src_slice, strides[0], &src_slice)))
+ return EINVAL;
for (j = 0; j < volume[0]; j++)
{
ret = omp_target_memcpy_rect_worker ((char *) dst + dst_off,
(const char *) src + src_off,
- element_size, num_dims - 1,
- volume + 1, dst_offsets + 1,
- src_offsets + 1, dst_dimensions + 1,
+ element_size, span, num_dims - 1,
+ volume + 1,
+ strides ? strides + 1 : NULL,
+ dst_offsets + 1, src_offsets + 1,
+ dst_dimensions + 1,
src_dimensions + 1, dst_devicep,
src_devicep, tmp_size, tmp);
if (ret)
@@ -4870,8 +5607,8 @@ omp_target_memcpy_rect_copy (void *dst, const void *src,
gomp_mutex_lock (&src_devicep->lock);
if (lock_dst)
gomp_mutex_lock (&dst_devicep->lock);
- int ret = omp_target_memcpy_rect_worker (dst, src, element_size, num_dims,
- volume, dst_offsets, src_offsets,
+ int ret = omp_target_memcpy_rect_worker (dst, src, element_size, element_size, num_dims,
+ volume, NULL, dst_offsets, src_offsets,
dst_dimensions, src_dimensions,
dst_devicep, src_devicep,
&tmp_size, &tmp);
@@ -5536,6 +6273,8 @@ gomp_load_plugin_for_device (struct gomp_device_descr *device,
DLSYM (unload_image);
DLSYM (alloc);
DLSYM (free);
+ DLSYM_OPT (page_locked_host_alloc, page_locked_host_alloc);
+ DLSYM_OPT (page_locked_host_free, page_locked_host_free);
DLSYM (dev2host);
DLSYM (host2dev);
DLSYM_OPT (memcpy2d, memcpy2d);
diff --git a/libgomp/testsuite/libgomp.c++/allocate-2.C b/libgomp/testsuite/libgomp.c++/allocate-2.C
new file mode 100644
index 0000000..f79cada
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/allocate-2.C
@@ -0,0 +1,329 @@
+/* { dg-do run } */
+/* { dg-additional-options "-fdump-tree-omplower" } */
+
+/* For the 4 vars in omp_parallel, 4 in omp_target and 1 of 2 in each of no_alloc{,2}_func. */
+/* { dg-final { scan-tree-dump-times "__builtin_GOMP_alloc \\(" 10 "omplower" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(" 10 "omplower" } } */
+
+#include <omp.h>
+
+
+void
+check_int (int *x, int y)
+{
+ if (*x != y)
+ __builtin_abort ();
+}
+
+void
+check_ptr (int **x, int *y)
+{
+ if (*x != y)
+ __builtin_abort ();
+}
+
+
+template<typename t>
+t
+no_alloc_func ()
+{
+ /* There is no __builtin_GOMP_alloc / __builtin_GOMP_free as
+ allocator == omp_default_mem_alloc (known at compile time. */
+ t no_alloc, alloc_has_align = 3;
+ #pragma omp allocate(no_alloc) allocator(omp_default_mem_alloc)
+ /* But this one is allocated because of align. */
+ #pragma omp allocate(alloc_has_align) allocator(omp_default_mem_alloc) align(sizeof(t))
+ no_alloc = 7;
+ return no_alloc + alloc_has_align;
+}
+
+template<typename t>
+t
+no_alloc2_func()
+{
+ /* There is no __builtin_GOMP_alloc / __builtin_GOMP_free as
+ no_alloc2 is TREE_UNUSED. But there is for is_alloc2. */
+ t no_alloc2, is_alloc2;
+ #pragma omp allocate(no_alloc2, is_alloc2)
+ is_alloc2 = 7;
+ return is_alloc2;
+}
+
+
+template<typename t>
+void
+omp_parallel ()
+{
+ int n = 6;
+ t iii = 5, jjj[5], kkk[n];
+ t *ptr = (t *) 0x1234;
+ #pragma omp allocate(iii, jjj, kkk, ptr)
+
+ for (int i = 0; i < 5; i++)
+ jjj[i] = 3*i;
+ for (int i = 0; i < 6; i++)
+ kkk[i] = 7*i;
+
+ #pragma omp parallel default(none) firstprivate(iii, jjj, kkk, ptr) if(0)
+ {
+ if (iii != 5)
+ __builtin_abort();
+ iii = 7;
+ check_int (&iii, 7);
+ for (int i = 0; i < 5; i++)
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ for (int i = 0; i < 6; i++)
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ for (int i = 0; i < 5; i++)
+ jjj[i] = 4*i;
+ for (int i = 0; i < 6; i++)
+ kkk[i] = 8*i;
+ for (int i = 0; i < 5; i++)
+ check_int (&jjj[i], 4*i);
+ for (int i = 0; i < 6; i++)
+ check_int (&kkk[i], 8*i);
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ ptr = (int *) 0xabcd;
+ if (ptr != (int *) 0xabcd)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0xabcd);
+ }
+ if (iii != 5)
+ __builtin_abort ();
+ check_int (&iii, 5);
+ for (int i = 0; i < 5; i++)
+ {
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ check_int (&jjj[i], 3*i);
+ }
+ for (int i = 0; i < 6; i++)
+ {
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ check_int (&kkk[i], 7*i);
+ }
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0x1234);
+
+ #pragma omp parallel default(firstprivate) if(0)
+ {
+ if (iii != 5)
+ __builtin_abort();
+ iii = 7;
+ check_int (&iii, 7);
+ for (int i = 0; i < 5; i++)
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ for (int i = 0; i < 6; i++)
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ for (int i = 0; i < 5; i++)
+ jjj[i] = 4*i;
+ for (int i = 0; i < 6; i++)
+ kkk[i] = 8*i;
+ for (int i = 0; i < 5; i++)
+ check_int (&jjj[i], 4*i);
+ for (int i = 0; i < 6; i++)
+ check_int (&kkk[i], 8*i);
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ ptr = (int *) 0xabcd;
+ if (ptr != (int *) 0xabcd)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0xabcd);
+ }
+ if (iii != 5)
+ __builtin_abort ();
+ check_int (&iii, 5);
+ for (int i = 0; i < 5; i++)
+ {
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ check_int (&jjj[i], 3*i);
+ }
+ for (int i = 0; i < 6; i++)
+ {
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ check_int (&kkk[i], 7*i);
+ }
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0x1234);
+}
+
+
+template<typename t>
+void
+omp_target ()
+{
+ int n = 6;
+ t iii = 5, jjj[5], kkk[n];
+ t *ptr = (int *) 0x1234;
+ #pragma omp allocate(iii, jjj, kkk, ptr)
+
+ for (int i = 0; i < 5; i++)
+ jjj[i] = 3*i;
+ for (int i = 0; i < 6; i++)
+ kkk[i] = 7*i;
+
+ #pragma omp target defaultmap(none) firstprivate(iii, jjj, kkk, ptr)
+ {
+ if (iii != 5)
+ __builtin_abort();
+ iii = 7;
+ check_int (&iii, 7);
+ for (int i = 0; i < 5; i++)
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ for (int i = 0; i < 6; i++)
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ for (int i = 0; i < 5; i++)
+ jjj[i] = 4*i;
+ for (int i = 0; i < 6; i++)
+ kkk[i] = 8*i;
+ for (int i = 0; i < 5; i++)
+ check_int (&jjj[i], 4*i);
+ for (int i = 0; i < 6; i++)
+ check_int (&kkk[i], 8*i);
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ ptr = (int *) 0xabcd;
+ if (ptr != (int *) 0xabcd)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0xabcd);
+ }
+ if (iii != 5)
+ __builtin_abort ();
+ check_int (&iii, 5);
+ for (int i = 0; i < 5; i++)
+ {
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ check_int (&jjj[i], 3*i);
+ }
+ for (int i = 0; i < 6; i++)
+ {
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ check_int (&kkk[i], 7*i);
+ }
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0x1234);
+
+ #pragma omp target defaultmap(firstprivate)
+ {
+ if (iii != 5)
+ __builtin_abort();
+ iii = 7;
+ check_int (&iii, 7);
+ for (int i = 0; i < 5; i++)
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ for (int i = 0; i < 6; i++)
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ for (int i = 0; i < 5; i++)
+ jjj[i] = 4*i;
+ for (int i = 0; i < 6; i++)
+ kkk[i] = 8*i;
+ for (int i = 0; i < 5; i++)
+ check_int (&jjj[i], 4*i);
+ for (int i = 0; i < 6; i++)
+ check_int (&kkk[i], 8*i);
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ ptr = (int *) 0xabcd;
+ if (ptr != (int *) 0xabcd)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0xabcd);
+ }
+ if (iii != 5)
+ __builtin_abort ();
+ check_int (&iii, 5);
+ for (int i = 0; i < 5; i++)
+ {
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ check_int (&jjj[i], 3*i);
+ }
+ for (int i = 0; i < 6; i++)
+ {
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ check_int (&kkk[i], 7*i);
+ }
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0x1234);
+
+ #pragma omp target defaultmap(tofrom)
+ {
+ if (iii != 5)
+ __builtin_abort();
+ iii = 7;
+ check_int (&iii, 7);
+ for (int i = 0; i < 5; i++)
+ if (jjj[i] != 3*i)
+ __builtin_abort ();
+ for (int i = 0; i < 6; i++)
+ if (kkk[i] != 7*i)
+ __builtin_abort ();
+ for (int i = 0; i < 5; i++)
+ jjj[i] = 4*i;
+ for (int i = 0; i < 6; i++)
+ kkk[i] = 8*i;
+ for (int i = 0; i < 5; i++)
+ check_int (&jjj[i], 4*i);
+ for (int i = 0; i < 6; i++)
+ check_int (&kkk[i], 8*i);
+ if (ptr != (int *) 0x1234)
+ __builtin_abort ();
+ ptr = (int *) 0xabcd;
+ if (ptr != (int *) 0xabcd)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0xabcd);
+ }
+
+ if (iii != 7)
+ __builtin_abort ();
+ check_int (&iii, 7);
+ for (int i = 0; i < 5; i++)
+ {
+ if (jjj[i] != 4*i)
+ __builtin_abort ();
+ check_int (&jjj[i], 4*i);
+ }
+ for (int i = 0; i < 6; i++)
+ {
+ if (kkk[i] != 8*i)
+ __builtin_abort ();
+ check_int (&kkk[i], 8*i);
+ }
+ if (ptr != (int *) 0xabcd)
+ __builtin_abort ();
+ check_ptr (&ptr, (int *) 0xabcd);
+}
+
+int
+foo()
+{
+ return no_alloc_func<int>() + no_alloc2_func<int>();
+}
+
+int
+main ()
+{
+ omp_parallel<int> ();
+ omp_target<int> ();
+ if (foo() != 10 + 7)
+ __builtin_abort ();
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-1.C b/libgomp/testsuite/libgomp.c++/array-shaping-1.C
new file mode 100644
index 0000000..6ff5f94
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-1.C
@@ -0,0 +1,469 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <string.h>
+#include <assert.h>
+
+volatile int yy = 4, zz = 2, str_str = 2;
+
+template<typename T>
+void foo()
+{
+ T *arr;
+ int x = 5;
+ T arr2d[10][10];
+
+ arr = new T[100];
+
+ /* Update whole reshaped array. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < x; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i ^ j;
+
+#pragma omp target update to(([10][x]) arr)
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j < x)
+ assert (arr[j * 10 + i] == i ^ j);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Strided update. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ arr[j * 5 + i] = i + j;
+
+#pragma omp target update to(([5][5]) arr[0:3][0:3:2])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ if (j < 3 && (i & 1) == 0 && i < 6)
+ assert (arr[j * 5 + i] == i + j);
+ else
+ assert (arr[j * 5 + i] == 0);
+
+
+ /* Reshaped update, contiguous. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ arr[j * 5 + i] = 2 * j + i;
+
+#pragma omp target update to(([5][5]) arr[0:5][0:5])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ if (j < 5 && i < 5)
+ assert (arr[j * 5 + i] == 2 * j + i);
+ else
+ assert (arr[j * 5 + i] == 0);
+
+
+ /* Strided update on actual array. */
+
+ memset (arr2d, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr2d)
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr2d[j][i] = j + 2 * i;
+
+#pragma omp target update to(arr2d[0:5:2][5:2])
+
+#pragma omp target exit data map(from: arr2d)
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if ((j & 1) == 0 && i >= 5 && i < 7)
+ assert (arr2d[j][i] == j + 2 * i);
+ else
+ assert (arr2d[j][i] == 0);
+
+
+ /* Update with non-constant bounds. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = (2 * j) ^ i;
+
+ x = 3;
+ int y = yy, z = zz, str = str_str;
+ /* This is actually [0:3:2] [4:2:2]. */
+#pragma omp target update to(([10][10]) arr[0:x:2][y:z:str])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if ((j & 1) == 0 && j < 6 && (i & 1) == 0 && i >= 4 && i < 8)
+ assert (arr[j * 10 + i] == (2 * j) ^ i);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Update with full "major" dimension. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j;
+
+#pragma omp target update to(([10][10]) arr[0:10][3:1])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (i == 3)
+ assert (arr[j * 10 + i] == i + j);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Update with full "minor" dimension. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = 3 * (i + j);
+
+#pragma omp target update to(([10][10]) arr[3:2][0:10])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5)
+ assert (arr[j * 10 + i] == 3 * (i + j));
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Rectangle update. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = 5 * (i + j);
+
+#pragma omp target update to(([10][10]) arr[3:2][0:9])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5 && i < 9)
+ assert (arr[j * 10 + i] == 5 * (i + j));
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* One-dimensional strided update. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ arr[i] = i + 99;
+
+#pragma omp target update to(([100]) arr[3:33:3])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ if (i >= 3 && ((i - 3) % 3) == 0)
+ assert (arr[i] == i + 99);
+ else
+ assert (arr[i] == 0);
+
+
+ /* One-dimensional strided update without explicit array shape. */
+
+ memset (arr, 0, 100 * sizeof (T));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ arr[i] = i + 121;
+
+#pragma omp target update to(arr[3:33:3])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ if (i >= 3 && ((i - 3) % 3) == 0)
+ assert (arr[i] == i + 121);
+ else
+ assert (arr[i] == 0);
+
+ delete[] arr;
+}
+
+int main()
+{
+ int *arr;
+ int x = 5;
+ int arr2d[10][10];
+
+ arr = new int[100];
+
+ /* Update whole reshaped array. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < x; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i ^ j;
+
+#pragma omp target update to(([10][x]) arr)
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j < x)
+ assert (arr[j * 10 + i] == i ^ j);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Strided update. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ arr[j * 5 + i] = i + j;
+
+#pragma omp target update to(([5][5]) arr[0:3][0:3:2])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ if (j < 3 && (i & 1) == 0 && i < 6)
+ assert (arr[j * 5 + i] == i + j);
+ else
+ assert (arr[j * 5 + i] == 0);
+
+
+ /* Reshaped update, contiguous. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ arr[j * 5 + i] = 2 * j + i;
+
+#pragma omp target update to(([5][5]) arr[0:5][0:5])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ if (j < 5 && i < 5)
+ assert (arr[j * 5 + i] == 2 * j + i);
+ else
+ assert (arr[j * 5 + i] == 0);
+
+
+ /* Strided update on actual array. */
+
+ memset (arr2d, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr2d)
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr2d[j][i] = j + 2 * i;
+
+#pragma omp target update to(arr2d[0:5:2][5:2])
+
+#pragma omp target exit data map(from: arr2d)
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if ((j & 1) == 0 && i >= 5 && i < 7)
+ assert (arr2d[j][i] == j + 2 * i);
+ else
+ assert (arr2d[j][i] == 0);
+
+
+ /* Update with non-constant bounds. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = (2 * j) ^ i;
+
+ x = 3;
+ int y = yy, z = zz, str = str_str;
+ /* This is actually [0:3:2] [4:2:2]. */
+#pragma omp target update to(([10][10]) arr[0:x:2][y:z:str])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if ((j & 1) == 0 && j < 6 && (i & 1) == 0 && i >= 4 && i < 8)
+ assert (arr[j * 10 + i] == (2 * j) ^ i);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Update with full "major" dimension. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j;
+
+#pragma omp target update to(([10][10]) arr[0:10][3:1])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (i == 3)
+ assert (arr[j * 10 + i] == i + j);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Update with full "minor" dimension. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = 3 * (i + j);
+
+#pragma omp target update to(([10][10]) arr[3:2][0:10])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5)
+ assert (arr[j * 10 + i] == 3 * (i + j));
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Rectangle update. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = 5 * (i + j);
+
+#pragma omp target update to(([10][10]) arr[3:2][0:9])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5 && i < 9)
+ assert (arr[j * 10 + i] == 5 * (i + j));
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* One-dimensional strided update. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ arr[i] = i + 99;
+
+#pragma omp target update to(([100]) arr[3:33:3])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ if (i >= 3 && ((i - 3) % 3) == 0)
+ assert (arr[i] == i + 99);
+ else
+ assert (arr[i] == 0);
+
+
+ /* One-dimensional strided update without explicit array shape. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ arr[i] = i + 121;
+
+#pragma omp target update to(arr[3:33:3])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ if (i >= 3 && ((i - 3) % 3) == 0)
+ assert (arr[i] == i + 121);
+ else
+ assert (arr[i] == 0);
+
+ delete[] arr;
+
+ foo<long> ();
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-10.C b/libgomp/testsuite/libgomp.c++/array-shaping-10.C
new file mode 100644
index 0000000..648f02d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-10.C
@@ -0,0 +1,61 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+#define N 10
+
+template<typename T>
+void foo ()
+{
+ T tarr[N * N];
+
+ memset (tarr, 0, N * N * sizeof (T));
+
+#pragma omp target enter data map(to: tarr)
+
+#pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ tarr[i * N + j] = 2 * (i + j);
+ }
+
+ /* An array, but cast to a pointer, then reshaped. */
+#pragma omp target update from(([N][N]) ((T *) &tarr[0])[4:3][5:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 5; j < 8; j++)
+ assert (tarr[i * N + j] == 2 * (i + j));
+
+#pragma omp target exit data map(delete: tarr)
+}
+
+int main ()
+{
+ int iarr[N * N];
+
+ memset (iarr, 0, N * N * sizeof (int));
+
+#pragma omp target enter data map(to: iarr)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ iarr[i * 10 + j] = i + j;
+ }
+
+ /* An array, but cast to a pointer, then reshaped. */
+#pragma omp target update from(([10][10]) ((int *) &iarr[0])[4:3][4:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 4; j < 7; j++)
+ assert (iarr[i * 10 + j] == i + j);
+
+#pragma omp target exit data map(delete: iarr)
+
+ foo<unsigned short> ();
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-11.C b/libgomp/testsuite/libgomp.c++/array-shaping-11.C
new file mode 100644
index 0000000..6b15bd6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-11.C
@@ -0,0 +1,63 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+#define N 10
+
+template<typename T>
+void foo ()
+{
+ T tarr_real[N * N];
+ T (&tarr)[N * N] = tarr_real;
+
+ memset (tarr, 0, N * N * sizeof (T));
+
+#pragma omp target enter data map(to: tarr)
+
+#pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ tarr[i * N + j] = 2 * (i + j);
+ }
+
+ /* A ref to an array, but cast to a pointer, then reshaped. */
+#pragma omp target update from(([N][N]) ((T *) &tarr[0])[4:3][5:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 5; j < 8; j++)
+ assert (tarr[i * N + j] == 2 * (i + j));
+
+#pragma omp target exit data map(delete: tarr)
+}
+
+int main ()
+{
+ int iarr_real[N * N];
+ int (&iarr)[N * N] = iarr_real;
+
+ memset (iarr, 0, N * N * sizeof (int));
+
+#pragma omp target enter data map(to: iarr)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ iarr[i * 10 + j] = i + j;
+ }
+
+ /* A ref to an array, but cast to a pointer, then reshaped. */
+#pragma omp target update from(([10][10]) ((int *) &iarr[0])[4:3][4:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 4; j < 7; j++)
+ assert (iarr[i * 10 + j] == i + j);
+
+#pragma omp target exit data map(delete: iarr)
+
+ foo<unsigned short> ();
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-12.C b/libgomp/testsuite/libgomp.c++/array-shaping-12.C
new file mode 100644
index 0000000..103c99a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-12.C
@@ -0,0 +1,65 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+#define N 10
+
+template<typename T>
+void foo ()
+{
+ T tarr_real[N * N];
+ T *tarrp = &tarr_real[0];
+ T **tarrpp = &tarrp;
+
+ memset (tarrp, 0, N * N * sizeof (T));
+
+#pragma omp target enter data map(to: tarr_real)
+
+#pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ tarrp[i * N + j] = 2 * (i + j);
+ }
+
+ /* A pointer with an extra indirection. */
+#pragma omp target update from(([N][N]) (*tarrpp)[4:3][5:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 5; j < 8; j++)
+ assert (tarrp[i * N + j] == 2 * (i + j));
+
+#pragma omp target exit data map(delete: tarr_real)
+}
+
+int main ()
+{
+ int iarr_real[N * N];
+ int *iarrp = &iarr_real[0];
+ int **iarrpp = &iarrp;
+
+ memset (iarrp, 0, N * N * sizeof (int));
+
+#pragma omp target enter data map(to: iarr_real)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ iarrp[i * 10 + j] = i + j;
+ }
+
+ /* A pointer with an extra indirection. */
+#pragma omp target update from(([10][10]) (*iarrpp)[4:3][4:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 4; j < 7; j++)
+ assert (iarrp[i * 10 + j] == i + j);
+
+#pragma omp target exit data map(delete: iarr_real)
+
+ foo<unsigned short> ();
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-13.C b/libgomp/testsuite/libgomp.c++/array-shaping-13.C
new file mode 100644
index 0000000..29345ca
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-13.C
@@ -0,0 +1,89 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+#define N 10
+
+template<typename T>
+void foo ()
+{
+ T *tptr = new T[N * N * N];
+
+ memset (tptr, 0, N * N * N * sizeof (T));
+
+#pragma omp target enter data map(to: tptr[0:N*N*N])
+
+#pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ tptr[i * N * N + 4 * N + j] = 2 * (i + j);
+ }
+
+ /* An array ref between two array sections. */
+#pragma omp target update from(([N][N][N]) tptr[4:3][4][5:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 5; j < 8; j++)
+ assert (tptr[i * N * N + 4 * N + j] == 2 * (i + j));
+
+ memset (tptr, 0, N * N * N * sizeof (T));
+
+ for (int i = 0; i < N; i++)
+ tptr[2 * N * N + i * N + 4] = 4 * i;
+
+ /* Array section between two array refs. */
+#pragma omp target update to(([N][N][N]) tptr[2][3:6][4])
+
+#pragma omp target exit data map(from: tptr[0:N*N*N])
+
+ for (int i = 3; i < 9; i++)
+ assert (tptr[2 * N * N + i * N + 4] == 4 * i);
+
+#pragma omp target exit data map(delete: tptr[0:N*N*N])
+
+ delete[] tptr;
+}
+
+int main ()
+{
+ int *iptr = new int[N * N * N];
+
+ memset (iptr, 0, N * N * N * sizeof (int));
+
+#pragma omp target enter data map(to: iptr[0:N*N*N])
+
+#pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ iptr[i * N * N + 4 * N + j] = i + j;
+ }
+
+ /* An array ref between two array sections. */
+#pragma omp target update from(([N][N][N]) iptr[2:3][4][6:3])
+
+ for (int i = 2; i < 5; i++)
+ for (int j = 6; j < 9; j++)
+ assert (iptr[i * N * N + 4 * N + j] == i + j);
+
+ memset (iptr, 0, N * N * N * sizeof (int));
+
+ for (int i = 0; i < N; i++)
+ iptr[2 * N * N + i * N + 4] = 3 * i;
+
+ /* Array section between two array refs. */
+#pragma omp target update to(([N][N][N]) iptr[2][3:6][4])
+
+#pragma omp target exit data map(from: iptr[0:N*N*N])
+
+ for (int i = 3; i < 9; i++)
+ assert (iptr[2 * N * N + i * N + 4] == 3 * i);
+
+ delete[] iptr;
+
+ foo<unsigned long> ();
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-2.C b/libgomp/testsuite/libgomp.c++/array-shaping-2.C
new file mode 100644
index 0000000..027543e8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-2.C
@@ -0,0 +1,38 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <string.h>
+#include <assert.h>
+
+template<typename T>
+void foo (T *w)
+{
+ memset (w, 0, sizeof (T) * 100);
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ w[j * 10 + i] = i + j;
+
+#pragma omp target update to(([10][10]) w[3:2][1:8])
+
+#pragma omp target exit data map(from: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5 && i >= 1 && i < 9)
+ assert (w[j * 10 + i] == i + j);
+ else
+ assert (w[j * 10 + i] == 0);
+}
+
+int main()
+{
+ int *arr = new int[100];
+
+ foo<int> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-3.C b/libgomp/testsuite/libgomp.c++/array-shaping-3.C
new file mode 100644
index 0000000..09ff04b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-3.C
@@ -0,0 +1,38 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <string.h>
+#include <assert.h>
+
+template<int C, int D>
+void foo (double *w)
+{
+ memset (w, 0, sizeof (double) * 100);
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ w[j * 10 + i] = i * 3 + j * 2;
+
+#pragma omp target update to(([C][D]) w[3:2][1:8])
+
+#pragma omp target exit data map(from: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5 && i >= 1 && i < 9)
+ assert (w[j * 10 + i] == i * 3 + j * 2);
+ else
+ assert (w[j * 10 + i] == 0.0f);
+}
+
+int main()
+{
+ double *arr = new double[100];
+
+ foo<10, 10> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-4.C b/libgomp/testsuite/libgomp.c++/array-shaping-4.C
new file mode 100644
index 0000000..efa115e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-4.C
@@ -0,0 +1,38 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <string.h>
+#include <assert.h>
+
+template<auto C, auto D>
+void foo (double *w)
+{
+ memset (w, 0, sizeof (double) * 100);
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ w[j * 10 + i] = i * 2 + j * 3;
+
+#pragma omp target update to(([C][D]) w[3:2][1:8])
+
+#pragma omp target exit data map(from: w[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5 && i >= 1 && i < 9)
+ assert (w[j * 10 + i] == i * 2 + j * 3);
+ else
+ assert (w[j * 10 + i] == 0.0f);
+}
+
+int main()
+{
+ double *arr = new double[100];
+
+ foo<10, 10> (arr);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-5.C b/libgomp/testsuite/libgomp.c++/array-shaping-5.C
new file mode 100644
index 0000000..7046a13
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-5.C
@@ -0,0 +1,38 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <string.h>
+#include <assert.h>
+
+template<typename T, auto C>
+void foo (T *w, int e, int f, int g)
+{
+ memset (w, 0, sizeof (T) * 100);
+
+#pragma omp target enter data map(to: w[:100])
+
+ for (int j = 0; j < e; j++)
+ for (int i = 0; i < C; i++)
+ w[j * C + i] = i + j;
+
+#pragma omp target update to(([e][C]) w[3:2][f:g])
+
+#pragma omp target exit data map(from: w[:100])
+
+ for (int j = 0; j < e; j++)
+ for (int i = 0; i < C; i++)
+ if (j >= 3 && j < 5 && i >= f && i < f + g)
+ assert (w[j * C + i] == i + j);
+ else
+ assert (w[j * C + i] == 0.0f);
+}
+
+int main()
+{
+ float *arr = new float[100];
+
+ foo<float, 10> (arr, 10, 1, 8);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-6.C b/libgomp/testsuite/libgomp.c++/array-shaping-6.C
new file mode 100644
index 0000000..b960b5e5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-6.C
@@ -0,0 +1,54 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+template<typename T>
+void foo (T *&aref)
+{
+#pragma omp target enter data map(to: aref[:100])
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ aref[i * 10 + j] = i + j;
+ }
+
+#pragma omp target update from(([10][10]) aref[2:3:2][7:3])
+
+ for (int i = 2; i < 8; i += 2)
+ for (int j = 7; j < 10; j++)
+ assert (aref[i * 10 + j] == i + j);
+
+#pragma omp target exit data map(delete: aref[:100])
+}
+
+int main()
+{
+ float *arr = new float[100];
+ float *&w = arr;
+
+ memset (arr, 0, 100 * sizeof (float));
+
+#pragma omp target enter data map(to: w[:100])
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ w[i * 10 + j] = i + j;
+ }
+
+#pragma omp target update from(([10][10]) w[4:3][4:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 4; j < 7; j++)
+ assert (w[i * 10 + j] == i + j);
+
+#pragma omp target exit data map(delete: w[:100])
+
+ foo<float> (arr);
+
+ delete[] arr;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-7.C b/libgomp/testsuite/libgomp.c++/array-shaping-7.C
new file mode 100644
index 0000000..b6193f8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-7.C
@@ -0,0 +1,54 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+template<typename T>
+void foo (T (&aref)[10][10])
+{
+#pragma omp target enter data map(to: aref)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ aref[i][j] = i + j;
+ }
+
+#pragma omp target update from(aref[2:3:2][7:3])
+
+ for (int i = 2; i < 8; i += 2)
+ for (int j = 7; j < 10; j++)
+ assert (aref[i][j] == i + j);
+
+#pragma omp target exit data map(delete: aref)
+}
+
+int main()
+{
+ float arr2d[10][10];
+ float (&w)[10][10] = arr2d;
+
+ memset (&arr2d, 0, 100 * sizeof (float));
+
+#pragma omp target enter data map(to: w)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ w[i][j] = i + j;
+ }
+
+#pragma omp target update from(w[4:3][4:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 4; j < 7; j++)
+ assert (w[i][j] == i + j);
+
+#pragma omp target exit data map(delete: w)
+
+ foo<float> (arr2d);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-8.C b/libgomp/testsuite/libgomp.c++/array-shaping-8.C
new file mode 100644
index 0000000..a96cf3c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-8.C
@@ -0,0 +1,65 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+template<typename T>
+struct C {
+ T *&aptr;
+
+ C(T *&aptr_1) : aptr(aptr_1)
+ {
+ }
+};
+
+template<typename T>
+void foo (T *c)
+{
+#pragma omp target enter data map(to: c->aptr, c->aptr[:100])
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ c->aptr[i * 10 + j] = i + j;
+ }
+
+#pragma omp target update from(([10][10]) c->aptr[2:3:2][7:3])
+
+ for (int i = 2; i < 8; i += 2)
+ for (int j = 7; j < 10; j++)
+ assert (c->aptr[i * 10 + j] == i + j);
+
+#pragma omp target exit data map(delete: c->aptr, c->aptr[:100])
+}
+
+int main()
+{
+ float *arr = new float[100];
+ C<float> cvar(arr);
+
+ memset (arr, 0, 100 * sizeof (float));
+
+#pragma omp target enter data map(to: cvar.aptr, cvar.aptr[:100])
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ cvar.aptr[i * 10 + j] = i + j;
+ }
+
+#pragma omp target update from(([10][10]) cvar.aptr[4:3][4:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 4; j < 7; j++)
+ assert (cvar.aptr[i * 10 + j] == i + j);
+
+#pragma omp target exit data map(delete: cvar.aptr, cvar.aptr[:100])
+
+ foo<C<float> > (&cvar);
+
+ delete[] arr;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/array-shaping-9.C b/libgomp/testsuite/libgomp.c++/array-shaping-9.C
new file mode 100644
index 0000000..786fe9d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/array-shaping-9.C
@@ -0,0 +1,95 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+#define N 10
+
+struct B {
+ int (&aref)[N][N];
+
+ B(int (&aref1)[N][N]) : aref(aref1)
+ {
+ }
+};
+
+template<typename T, int S>
+struct C {
+ T (&aref)[S][S];
+
+ C(T (&aref1)[S][S]) : aref(aref1)
+ {
+ }
+};
+
+template<typename T>
+void foo (T *c)
+{
+#pragma omp target enter data map(to: c->aref)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ c->aref[i][j] = 2 * (i + j);
+ }
+
+#pragma omp target update from(c->aref[2:3:2][7:3])
+
+ for (int i = 2; i < 8; i += 2)
+ for (int j = 7; j < 10; j++)
+ assert (c->aref[i][j] == 2 * (i + j));
+
+#pragma omp target exit data map(delete: c->aref)
+}
+
+int main()
+{
+ int iarr[N][N];
+ float farr[N][N];
+ B bvar(iarr);
+ C<float, N> cvar(farr);
+
+ memset (iarr, 0, N * N * sizeof (int));
+ memset (farr, 0, N * N * sizeof (float));
+
+#pragma omp target enter data map(to: bvar.aref)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ bvar.aref[i][j] = i + j;
+ }
+
+#pragma omp target update from(bvar.aref[4:3][4:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 4; j < 7; j++)
+ assert (bvar.aref[i][j] == i + j);
+
+#pragma omp target exit data map(delete: bvar.aref)
+
+#pragma omp target enter data map(to: cvar.aref)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ cvar.aref[i][j] = i + j;
+ }
+
+#pragma omp target update from(cvar.aref[4:3][4:3])
+
+ for (int i = 4; i < 7; i++)
+ for (int j = 4; j < 7; j++)
+ assert (cvar.aref[i][j] == i + j);
+
+#pragma omp target exit data map(delete: cvar.aref)
+
+ memset (farr, 0, N * N * sizeof (float));
+
+ foo<C<float, N> > (&cvar);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/c++.exp b/libgomp/testsuite/libgomp.c++/c++.exp
index ed096e1..5be949b 100644
--- a/libgomp/testsuite/libgomp.c++/c++.exp
+++ b/libgomp/testsuite/libgomp.c++/c++.exp
@@ -1,6 +1,15 @@
load_lib libgomp-dg.exp
load_gcc_lib gcc-dg.exp
+proc check_effective_target_c { } {
+ return 0
+}
+
+proc check_effective_target_c++ { } {
+ return 1
+}
+
+
if { $blddir != "" } {
set libstdc++_library_path "../libstdc++-v3/src/.libs"
set shlib_ext [get_shlib_extension]
diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-1.C b/libgomp/testsuite/libgomp.c++/declare-mapper-1.C
new file mode 100644
index 0000000..aba4f42
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare-mapper-1.C
@@ -0,0 +1,87 @@
+// { dg-do run }
+
+#include <cstdlib>
+#include <cassert>
+
+#define N 64
+
+struct points
+{
+ double *x;
+ double *y;
+ double *z;
+ size_t len;
+};
+
+#pragma omp declare mapper(points p) map(to:p.x, p.y, p.z) \
+ map(p.x[0:p.len]) \
+ map(p.y[0:p.len]) \
+ map(p.z[0:p.len])
+
+struct shape
+{
+ points tmp;
+ points *pts;
+ int metadata[128];
+};
+
+#pragma omp declare mapper(shape s) map(tofrom:s.pts, *s.pts) map(alloc:s.tmp)
+
+void
+alloc_points (points *pts, size_t sz)
+{
+ pts->x = new double[sz];
+ pts->y = new double[sz];
+ pts->z = new double[sz];
+ pts->len = sz;
+ for (int i = 0; i < sz; i++)
+ pts->x[i] = pts->y[i] = pts->z[i] = 0;
+}
+
+int main (int argc, char *argv[])
+{
+ shape myshape;
+ points mypts;
+
+ myshape.pts = &mypts;
+
+ alloc_points (&myshape.tmp, N);
+ myshape.pts = new points;
+ alloc_points (myshape.pts, N);
+
+ #pragma omp target map(myshape)
+ {
+ for (int i = 0; i < N; i++)
+ {
+ myshape.pts->x[i]++;
+ myshape.pts->y[i]++;
+ myshape.pts->z[i]++;
+ }
+ }
+
+ for (int i = 0; i < N; i++)
+ {
+ assert (myshape.pts->x[i] == 1);
+ assert (myshape.pts->y[i] == 1);
+ assert (myshape.pts->z[i] == 1);
+ }
+
+ #pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ {
+ myshape.pts->x[i]++;
+ myshape.pts->y[i]++;
+ myshape.pts->z[i]++;
+ }
+ }
+
+ for (int i = 0; i < N; i++)
+ {
+ assert (myshape.pts->x[i] == 2);
+ assert (myshape.pts->y[i] == 2);
+ assert (myshape.pts->z[i] == 2);
+ }
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-2.C b/libgomp/testsuite/libgomp.c++/declare-mapper-2.C
new file mode 100644
index 0000000..d848fdb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare-mapper-2.C
@@ -0,0 +1,55 @@
+// { dg-do run }
+
+#include <cassert>
+
+#define N 256
+
+struct doublebuf
+{
+ int buf_a[N][N];
+ int buf_b[N][N];
+};
+
+#pragma omp declare mapper(lo:doublebuf b) map(b.buf_a[0:N/2][0:N]) \
+ map(b.buf_b[0:N/2][0:N])
+
+#pragma omp declare mapper(hi:doublebuf b) map(b.buf_a[N/2:N/2][0:N]) \
+ map(b.buf_b[N/2:N/2][0:N])
+
+int main (int argc, char *argv[])
+{
+ doublebuf db;
+
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ db.buf_a[i][j] = db.buf_b[i][j] = 0;
+
+ #pragma omp target map(mapper(lo), tofrom:db)
+ {
+ for (int i = 0; i < N / 2; i++)
+ for (int j = 0; j < N; j++)
+ {
+ db.buf_a[i][j]++;
+ db.buf_b[i][j]++;
+ }
+ }
+
+ #pragma omp target map(mapper(hi), tofrom:db)
+ {
+ for (int i = N / 2; i < N; i++)
+ for (int j = 0; j < N; j++)
+ {
+ db.buf_a[i][j]++;
+ db.buf_b[i][j]++;
+ }
+ }
+
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ {
+ assert (db.buf_a[i][j] == 1);
+ assert (db.buf_b[i][j] == 1);
+ }
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-3.C b/libgomp/testsuite/libgomp.c++/declare-mapper-3.C
new file mode 100644
index 0000000..ea9b7de
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare-mapper-3.C
@@ -0,0 +1,63 @@
+// { dg-do run }
+
+#include <cstdlib>
+#include <cassert>
+
+struct S {
+ int *myarr;
+};
+
+#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[0:20])
+
+namespace A {
+#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[0:100])
+}
+
+namespace B {
+#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[100:100])
+}
+
+namespace A
+{
+ void incr_a (S my_s)
+ {
+#pragma omp target
+ {
+ for (int i = 0; i < 100; i++)
+ my_s.myarr[i]++;
+ }
+ }
+}
+
+namespace B
+{
+ void incr_b (S my_s)
+ {
+#pragma omp target
+ {
+ for (int i = 100; i < 200; i++)
+ my_s.myarr[i]++;
+ }
+ }
+}
+
+int main (int argc, char *argv[])
+{
+ S my_s;
+
+ my_s.myarr = (int *) calloc (200, sizeof (int));
+
+#pragma omp target
+ {
+ for (int i = 0; i < 20; i++)
+ my_s.myarr[i]++;
+ }
+
+ A::incr_a (my_s);
+ B::incr_b (my_s);
+
+ for (int i = 0; i < 200; i++)
+ assert (my_s.myarr[i] == (i < 20) ? 2 : 1);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-4.C b/libgomp/testsuite/libgomp.c++/declare-mapper-4.C
new file mode 100644
index 0000000..f194e63
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare-mapper-4.C
@@ -0,0 +1,63 @@
+// { dg-do run }
+
+#include <cstdlib>
+#include <cassert>
+
+struct S {
+ int *myarr;
+};
+
+#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[0:20])
+
+namespace A {
+#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[0:100])
+}
+
+namespace B {
+#pragma omp declare mapper (S s) map(to:s.myarr) map (tofrom: s.myarr[100:100])
+}
+
+namespace A
+{
+ void incr_a (S &my_s)
+ {
+#pragma omp target
+ {
+ for (int i = 0; i < 100; i++)
+ my_s.myarr[i]++;
+ }
+ }
+}
+
+namespace B
+{
+ void incr_b (S &my_s)
+ {
+#pragma omp target
+ {
+ for (int i = 100; i < 200; i++)
+ my_s.myarr[i]++;
+ }
+ }
+}
+
+int main (int argc, char *argv[])
+{
+ S my_s;
+
+ my_s.myarr = (int *) calloc (200, sizeof (int));
+
+#pragma omp target
+ {
+ for (int i = 0; i < 20; i++)
+ my_s.myarr[i]++;
+ }
+
+ A::incr_a (my_s);
+ B::incr_b (my_s);
+
+ for (int i = 0; i < 200; i++)
+ assert (my_s.myarr[i] == (i < 20) ? 2 : 1);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-5.C b/libgomp/testsuite/libgomp.c++/declare-mapper-5.C
new file mode 100644
index 0000000..0030de8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare-mapper-5.C
@@ -0,0 +1,52 @@
+// { dg-do run }
+
+#include <cassert>
+
+struct S
+{
+ int *myarr;
+ int len;
+};
+
+class C
+{
+ S smemb;
+#pragma omp declare mapper (custom:S s) map(to:s.myarr) \
+ map(tofrom:s.myarr[0:s.len])
+
+public:
+ C(int l)
+ {
+ smemb.myarr = new int[l];
+ smemb.len = l;
+ for (int i = 0; i < l; i++)
+ smemb.myarr[i] = 0;
+ }
+ void bump();
+ void check();
+};
+
+void
+C::bump ()
+{
+#pragma omp target map(mapper(custom), tofrom: smemb)
+ {
+ for (int i = 0; i < smemb.len; i++)
+ smemb.myarr[i]++;
+ }
+}
+
+void
+C::check ()
+{
+ for (int i = 0; i < smemb.len; i++)
+ assert (smemb.myarr[i] == 1);
+}
+
+int main (int argc, char *argv[])
+{
+ C test (100);
+ test.bump ();
+ test.check ();
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-6.C b/libgomp/testsuite/libgomp.c++/declare-mapper-6.C
new file mode 100644
index 0000000..14ed10d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare-mapper-6.C
@@ -0,0 +1,37 @@
+// { dg-do run }
+
+#include <cassert>
+
+template <typename T>
+void adjust (T param)
+{
+#pragma omp declare mapper (T x) map(to:x.len, x.base) \
+ map(tofrom:x.base[0:x.len])
+
+#pragma omp target
+ for (int i = 0; i < param.len; i++)
+ param.base[i]++;
+}
+
+struct S {
+ int len;
+ int *base;
+};
+
+int main (int argc, char *argv[])
+{
+ S a;
+
+ a.len = 100;
+ a.base = new int[a.len];
+
+ for (int i = 0; i < a.len; i++)
+ a.base[i] = 0;
+
+ adjust (a);
+
+ for (int i = 0; i < a.len; i++)
+ assert (a.base[i] == 1);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-7.C b/libgomp/testsuite/libgomp.c++/declare-mapper-7.C
new file mode 100644
index 0000000..ab63209
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare-mapper-7.C
@@ -0,0 +1,48 @@
+// { dg-do run }
+
+#include <cassert>
+
+struct S
+{
+ int *myarr;
+};
+
+struct T
+{
+ S *s;
+};
+
+#pragma omp declare mapper (s100: S x) map(to: x.myarr) \
+ map(tofrom: x.myarr[0:100])
+
+void
+bump (T t)
+{
+ /* Here we have an implicit/default mapper invoking a named mapper. We
+ need to make sure that can be located properly at gimplification
+ time. */
+#pragma omp declare mapper (T t) map(to:t.s) map(mapper(s100), tofrom: t.s[0])
+
+#pragma omp target
+ for (int i = 0; i < 100; i++)
+ t.s->myarr[i]++;
+}
+
+int main (int argc, char *argv[])
+{
+ S my_s;
+ T my_t;
+
+ my_s.myarr = new int[100];
+ my_t.s = &my_s;
+
+ for (int i = 0; i < 100; i++)
+ my_s.myarr[i] = 0;
+
+ bump (my_t);
+
+ for (int i = 0; i < 100; i++)
+ assert (my_s.myarr[i] == 1);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/declare-mapper-8.C b/libgomp/testsuite/libgomp.c++/declare-mapper-8.C
new file mode 100644
index 0000000..3818e52
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/declare-mapper-8.C
@@ -0,0 +1,61 @@
+// { dg-do run }
+
+#include <cassert>
+
+struct S
+{
+ int *myarr;
+ int len;
+};
+
+template<typename T>
+class C
+{
+ T memb;
+#pragma omp declare mapper (T t) map(to:t.len, t.myarr) \
+ map(tofrom:t.myarr[0:t.len])
+
+public:
+ C(int sz);
+ ~C();
+ void bump();
+ void check();
+};
+
+template<typename T>
+C<T>::C(int sz)
+{
+ memb.myarr = new int[sz];
+ for (int i = 0; i < sz; i++)
+ memb.myarr[i] = 0;
+ memb.len = sz;
+}
+
+template<typename T>
+C<T>::~C()
+{
+ delete[] memb.myarr;
+}
+
+template<typename T>
+void C<T>::bump()
+{
+#pragma omp target map(memb)
+ for (int i = 0; i < memb.len; i++)
+ memb.myarr[i]++;
+}
+
+template<typename T>
+void C<T>::check()
+{
+ for (int i = 0; i < memb.len; i++)
+ assert (memb.myarr[i] == 1);
+}
+
+int main(int argc, char *argv[])
+{
+ C<S> c_int(100);
+ c_int.bump();
+ c_int.check();
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c++/delim-declare-variant-1.C b/libgomp/testsuite/libgomp.c++/delim-declare-variant-1.C
new file mode 100644
index 0000000..bf146dd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/delim-declare-variant-1.C
@@ -0,0 +1,29 @@
+/* { dg-additional-options "-foffload=disable" } */
+
+/* Check that variants within a "begin declare variant" directive
+ are attached to the correct overloaded function. */
+
+int f (int x) { return x; }
+
+#pragma omp begin declare variant match (implementation={vendor("gnu")})
+int f (int x) { return -1; }
+#pragma omp end declare variant
+
+int f (int x, int y) { return x * y; }
+
+#pragma omp begin declare variant match (construct={target})
+int f (int x, int y) { return -2; }
+#pragma omp end declare variant
+
+int f (int x, int y, int z) { return x * y * z; }
+
+#pragma omp begin declare variant match (device={kind("host")})
+int f (int x, int y, int z) { return -3; }
+#pragma omp end declare variant
+
+int main (void)
+{
+ if (f (10) != -1) __builtin_abort ();
+ if (f (10, 20) != 200) __builtin_abort (); /* no match on this one */
+ if (f (10, 20, 30) != -3) __builtin_abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/delim-declare-variant-2.C b/libgomp/testsuite/libgomp.c++/delim-declare-variant-2.C
new file mode 100644
index 0000000..6641768
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/delim-declare-variant-2.C
@@ -0,0 +1,37 @@
+/* Check that "omp begin declare variant" works on methods in a
+ class declaration. */
+
+class test1 {
+
+ private:
+ int n;
+ static int m;
+
+ public:
+
+ void set_n (int x) { n = x; }
+ int get_n (void) { return n; }
+
+ static void set_m (int x) { m = x; }
+ static int get_m (void) { return m; }
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ int get_n (void) { return n * 2; }
+ static int get_m (void) { return m * 2; }
+ #pragma omp end declare variant
+
+ #pragma omp begin declare variant match (construct={target})
+ int get_n (void) { return this->n * 2; }
+ #pragma omp end declare variant
+};
+
+int test1::m;
+
+int main (void)
+{
+ test1 t1;
+ t1.set_n (10);
+ if (t1.get_n () != 20) __builtin_abort ();
+ test1::set_m (1);
+ if (test1::get_m () != 2) __builtin_abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/delim-declare-variant-7.C b/libgomp/testsuite/libgomp.c++/delim-declare-variant-7.C
new file mode 100644
index 0000000..60cc5d8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/delim-declare-variant-7.C
@@ -0,0 +1,39 @@
+/* Check that "omp begin declare variant" works on methods in a template
+ class declaration. */
+
+template <typename T>
+class test1 {
+
+ private:
+ T n;
+ static T m;
+
+ public:
+
+ void set_n (T x) { n = x; }
+ T get_n (void) { return n; }
+
+ static void set_m (T x) { m = x; }
+ static T get_m (void) { return m; }
+
+ #pragma omp begin declare variant match (implementation={vendor("gnu")})
+ T get_n (void) { return n * 2; }
+ static T get_m (void) { return m * 2; }
+ #pragma omp end declare variant
+
+ #pragma omp begin declare variant match (construct={target})
+ T get_n (void) { return this->n * 2; }
+ #pragma omp end declare variant
+};
+
+template <typename T>
+T test1<T>::m;
+
+int main (void)
+{
+ test1<int> t1;
+ t1.set_n (10);
+ if (t1.get_n () != 20) __builtin_abort ();
+ test1<int>::set_m (1);
+ if (test1<int>::get_m () != 2) __builtin_abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/need-device-ptr.C b/libgomp/testsuite/libgomp.c++/need-device-ptr.C
new file mode 100644
index 0000000..d7babff
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/need-device-ptr.C
@@ -0,0 +1,175 @@
+// Test the need_device_ptr and need_device_addr modifiers to the adjust_args clause
+
+#include <omp.h>
+
+void fptr_var (int *x1, int *x2, int *x3, int **x3a, int *x4, int *x5, int *x6, int **x6a)
+{
+ #pragma omp target is_device_ptr (x1)
+ { if (*x1 != 1) __builtin_abort (); *x1 *= -1; }
+
+ #pragma omp target is_device_ptr (x2)
+ { if (*x2 != 2) __builtin_abort (); *x2 *= -1; }
+
+ #pragma omp target is_device_ptr (x3)
+ { if (*x3 != 3) __builtin_abort (); *x3 *= -1; }
+
+ #pragma omp target is_device_ptr (x3a)
+ { if (**x3a != 30) __builtin_abort (); **x3a *= -1; }
+
+ #pragma omp target is_device_ptr (x4)
+ { if (*x4 != 4) __builtin_abort (); *x4 *= -1; }
+
+ #pragma omp target is_device_ptr (x5)
+ { if (*x5 != 5) __builtin_abort (); *x5 *= -1; }
+
+ #pragma omp target is_device_ptr (x6)
+ { if (*x6 != 6) __builtin_abort (); *x6 *= -1; }
+
+ #pragma omp target is_device_ptr (x6a)
+ { if (**x6a != 60) __builtin_abort (); **x6a *= -1; }
+}
+
+#pragma omp declare variant(fptr_var) match(construct={dispatch}) adjust_args (need_device_ptr : 1:8)
+void fptr (int *x1, int *x2, int *x3, int **x3a, int *x4, int *x5, int *x6, int **x6a);
+
+void faddr_var (int &x1, int &x2, int &x3, int *&x3a, int &x4, int &x5, int &x6, int *&x6a)
+{
+ #pragma omp target has_device_addr (x1)
+ { if (x1 != 1) __builtin_abort (); x1 *= -1; }
+
+ #pragma omp target has_device_addr (x2)
+ { if (x2 != 2) __builtin_abort (); x2 *= -1; }
+
+ #pragma omp target has_device_addr (x3)
+ { if (x3 != 3) __builtin_abort (); x3 *= -1; }
+
+ #pragma omp target has_device_addr (x3a)
+ { if (*x3a != 30) __builtin_abort (); *x3a *= -1; }
+
+ #pragma omp target has_device_addr (x4)
+ { if (x4 != 4) __builtin_abort (); x4 *= -1; }
+
+ #pragma omp target has_device_addr (x5)
+ { if (x5 != 5) __builtin_abort (); x5 *= -1; }
+
+ #pragma omp target has_device_addr (x6)
+ { if (x6 != 6) __builtin_abort (); x6 *= -1; }
+
+ #pragma omp target has_device_addr (x6a)
+ { if (*x6a != 60) __builtin_abort (); *x6a *= -1; }
+}
+
+#pragma omp declare variant(faddr_var) match(construct={dispatch}) adjust_args (need_device_addr : 1:8)
+void faddr (int &x1, int &x2, int &x3, int *&, int &x4, int &x5, int &x6, int *&);
+
+void caller_ptr(int x, int &y, int *z, int *zptr)
+{
+ int a = 4;
+ int bval = 5;
+ int &b = bval;
+ int *c = (int*) __builtin_malloc (sizeof (int));
+ int *cptr;
+ *c = 6;
+
+ zptr = (int *) omp_target_alloc (sizeof (int), omp_get_default_device ());
+ cptr = (int *) omp_target_alloc (sizeof (int), omp_get_default_device ());
+
+ #pragma omp target is_device_ptr(cptr, zptr)
+ {
+ *zptr = 30;
+ *cptr = 60;
+ }
+
+ #pragma omp target enter data map(x, a, b, c[:1], cptr, zptr)
+
+ #pragma omp dispatch
+ fptr (&x, &y, z, &zptr, &a, &b, c, &cptr);
+
+ #pragma omp target exit data map(x, a, b, c[:1], cptr, zptr)
+ #pragma omp target update from(y, z[:1])
+
+ if (x != -1) __builtin_abort ();
+ if (y != -2) __builtin_abort ();
+ if (*z != -3) __builtin_abort ();
+
+ if (a != -4) __builtin_abort ();
+ if (b != -5) __builtin_abort ();
+ if (*c != -6) __builtin_abort ();
+
+ #pragma omp target is_device_ptr(cptr, zptr)
+ {
+ if (*zptr != -30) __builtin_abort ();
+ if (*cptr != -60) __builtin_abort ();
+ }
+
+ __builtin_free (c);
+ omp_target_free (cptr, omp_get_default_device ());
+ omp_target_free (zptr, omp_get_default_device ());
+}
+
+void caller_addr(int x, int &y, int *z, int *zptr)
+{
+ int a = 4;
+ int bval = 5;
+ int &b = bval;
+ int *c = (int*) __builtin_malloc (sizeof (int));
+ int *cptr;
+ *c = 6;
+
+ zptr = (int *) omp_target_alloc (sizeof (int), omp_get_default_device ());
+ cptr = (int *) omp_target_alloc (sizeof (int), omp_get_default_device ());
+
+ #pragma omp target is_device_ptr(cptr, zptr)
+ {
+ *zptr = 30;
+ *cptr = 60;
+ }
+
+ #pragma omp target enter data map(x, a, b, c[:1], cptr, zptr)
+
+ #pragma omp dispatch
+ faddr (x, y, *z, zptr, a, b, *c, cptr);
+
+ #pragma omp target exit data map(x, a, b, c[:1], cptr, zptr)
+ #pragma omp target update from(y, z[:1])
+
+ if (x != -1) __builtin_abort ();
+ if (y != -2) __builtin_abort ();
+ if (*z != -3) __builtin_abort ();
+
+ if (a != -4) __builtin_abort ();
+ if (b != -5) __builtin_abort ();
+ if (*c != -6) __builtin_abort ();
+
+ #pragma omp target is_device_ptr(cptr, zptr)
+ {
+ if (*zptr != -30) __builtin_abort ();
+ if (*cptr != -60) __builtin_abort ();
+ }
+
+
+ __builtin_free (c);
+}
+
+int
+main ()
+{
+ int x = 1;
+ int yval = 2;
+ int &y = yval;
+ int *z = (int *) __builtin_malloc (sizeof (int));
+ int *zptr;
+ *z = 3;
+
+ #pragma omp target data map(y, z[:1])
+ caller_ptr (x, y, z, zptr);
+
+ x = 1;
+ y = 2;
+ *z = 3;
+
+ #pragma omp target data map(y, z[:1], zptr)
+ caller_addr (x, y, z, zptr);
+
+ __builtin_free (z);
+}
diff --git a/libgomp/testsuite/libgomp.c++/target-cdtor-1.C b/libgomp/testsuite/libgomp.c++/target-cdtor-1.C
new file mode 100644
index 0000000..ecb029e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/target-cdtor-1.C
@@ -0,0 +1,104 @@
+/* Offloaded C++ objects construction and destruction. */
+
+/* { dg-additional-options -fdump-tree-optimized-raw-asmname }
+ { dg-additional-options -foffload-options=-fdump-tree-optimized-raw-asmname } */
+
+#include <omp.h>
+#include <vector>
+
+#pragma omp declare target
+
+struct S
+{
+ int x;
+
+ S()
+ : x(-1)
+ {
+ __builtin_printf("%s, %d, %d\n", __FUNCTION__, x, omp_is_initial_device());
+ }
+ S(int x)
+ : x(x)
+ {
+ __builtin_printf("%s, %d, %d\n", __FUNCTION__, x, omp_is_initial_device());
+ }
+ ~S()
+ {
+ __builtin_printf("%s, %d, %d\n", __FUNCTION__, x, omp_is_initial_device());
+ }
+};
+
+#pragma omp end declare target
+
+S sH1(7);
+
+#pragma omp declare target
+
+S sHD1(5);
+
+std::vector<S> svHD1(2);
+
+#pragma omp end declare target
+
+S sH2(3);
+
+int main()
+{
+ int c = 0;
+
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+
+#pragma omp target map(c)
+ {
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+ }
+
+#pragma omp target map(c)
+ {
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+ }
+
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+
+ return 0;
+}
+
+/* Verify '__cxa_atexit' calls.
+
+ For the host, there are four expected calls:
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, } 4 optimized { target cxa_atexit } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZN1SD1Ev, \&sH1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZN1SD1Ev, \&sHD1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZNSt6vectorI1SSaIS0_EED1Ev, \&svHD1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZN1SD1Ev, \&sH2, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+
+ For the device, there are two expected calls:
+ { dg-final { scan-offload-tree-dump-times {gimple_call <__cxa_atexit, } 2 optimized { target cxa_atexit } } }
+ { dg-final { scan-offload-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZN1SD1Ev, \&sHD1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+ { dg-final { scan-offload-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZNSt6vectorI1SSaIS0_EED1Ev, \&svHD1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+*/
+
+/* C++ objects are constructed in order of appearance (..., and destructed in reverse order).
+ { dg-output {S, 7, 1[\r\n]+} }
+ { dg-output {S, 5, 1[\r\n]+} }
+ { dg-output {S, -1, 1[\r\n]+} }
+ { dg-output {S, -1, 1[\r\n]+} }
+ { dg-output {S, 3, 1[\r\n]+} }
+ { dg-output {main:1, 1[\r\n]+} }
+ { dg-output {S, 5, 0[\r\n]+} { target offload_device } }
+ { dg-output {S, -1, 0[\r\n]+} { target offload_device } }
+ { dg-output {S, -1, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:2, 1[\r\n]+} { target { ! offload_device } } }
+ { dg-output {main:2, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:3, 1[\r\n]+} { target { ! offload_device } } }
+ { dg-output {main:3, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:4, 1[\r\n]+} }
+ { dg-output {~S, -1, 0[\r\n]+} { target offload_device } }
+ { dg-output {~S, -1, 0[\r\n]+} { target offload_device } }
+ { dg-output {~S, 5, 0[\r\n]+} { target offload_device } }
+ { dg-output {~S, 3, 1[\r\n]+} }
+ { dg-output {~S, -1, 1[\r\n]+} }
+ { dg-output {~S, -1, 1[\r\n]+} }
+ { dg-output {~S, 5, 1[\r\n]+} }
+ { dg-output {~S, 7, 1[\r\n]+} }
+*/
diff --git a/libgomp/testsuite/libgomp.c++/target-cdtor-2.C b/libgomp/testsuite/libgomp.c++/target-cdtor-2.C
new file mode 100644
index 0000000..75e48ca
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/target-cdtor-2.C
@@ -0,0 +1,140 @@
+/* Offloaded 'constructor' and 'destructor' functions, and C++ objects construction and destruction. */
+
+/* { dg-require-effective-target init_priority } */
+
+/* { dg-additional-options -fdump-tree-optimized-raw-asmname }
+ { dg-additional-options -foffload-options=-fdump-tree-optimized-raw-asmname } */
+
+#include <omp.h>
+#include <vector>
+
+#pragma omp declare target
+
+struct S
+{
+ int x;
+
+ S()
+ : x(-1)
+ {
+ __builtin_printf("%s, %d, %d\n", __FUNCTION__, x, omp_is_initial_device());
+ }
+ S(int x)
+ : x(x)
+ {
+ __builtin_printf("%s, %d, %d\n", __FUNCTION__, x, omp_is_initial_device());
+ }
+ ~S()
+ {
+ __builtin_printf("%s, %d, %d\n", __FUNCTION__, x, omp_is_initial_device());
+ }
+};
+
+#pragma omp end declare target
+
+S sH1 __attribute__((init_priority(1500))) (7);
+
+#pragma omp declare target
+
+S sHD1 __attribute__((init_priority(2000))) (5);
+
+std::vector<S> svHD1 __attribute__((init_priority(1000))) (2);
+
+static void
+__attribute__((constructor(20000)))
+initDH1()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+static void
+__attribute__((destructor(20000)))
+finiDH1()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+#pragma omp end declare target
+
+S sH2 __attribute__((init_priority(500))) (3);
+
+static void
+__attribute__((constructor(10000)))
+initH1()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+static void
+__attribute__((destructor(10000)))
+finiH1()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+int main()
+{
+ int c = 0;
+
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+
+#pragma omp target map(c)
+ {
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+ }
+
+#pragma omp target map(c)
+ {
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+ }
+
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+
+ return 0;
+}
+
+/* Verify '__cxa_atexit' calls.
+
+ For the host, there are four expected calls:
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, } 4 optimized { target cxa_atexit } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZN1SD1Ev, \&sH1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZN1SD1Ev, \&sHD1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZNSt6vectorI1SSaIS0_EED1Ev, \&svHD1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZN1SD1Ev, \&sH2, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+
+ For the device, there are two expected calls:
+ { dg-final { scan-offload-tree-dump-times {gimple_call <__cxa_atexit, } 2 optimized { target cxa_atexit } } }
+ { dg-final { scan-offload-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZN1SD1Ev, \&sHD1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+ { dg-final { scan-offload-tree-dump-times {gimple_call <__cxa_atexit, NULL, _ZNSt6vectorI1SSaIS0_EED1Ev, \&svHD1, \&__dso_handle>} 1 optimized { target cxa_atexit } } }
+*/
+
+/* Defined order in which 'constructor' functions, and 'destructor' functions are run, and C++ objects are constructed (..., and destructed in reverse order).
+ { dg-output {S, 3, 1[\r\n]+} }
+ { dg-output {S, -1, 1[\r\n]+} }
+ { dg-output {S, -1, 1[\r\n]+} }
+ { dg-output {S, 7, 1[\r\n]+} }
+ { dg-output {S, 5, 1[\r\n]+} }
+ { dg-output {initH1, 1[\r\n]+} }
+ { dg-output {initDH1, 1[\r\n]+} }
+ { dg-output {main:1, 1[\r\n]+} }
+ { dg-output {S, -1, 0[\r\n]+} { target offload_device } }
+ { dg-output {S, -1, 0[\r\n]+} { target offload_device } }
+ { dg-output {S, 5, 0[\r\n]+} { target offload_device } }
+ { dg-output {initDH1, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:2, 1[\r\n]+} { target { ! offload_device } } }
+ { dg-output {main:2, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:3, 1[\r\n]+} { target { ! offload_device } } }
+ { dg-output {main:3, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:4, 1[\r\n]+} }
+ { dg-output {~S, 5, 0[\r\n]+} { target offload_device } }
+ { dg-output {~S, -1, 0[\r\n]+} { target offload_device } }
+ { dg-output {~S, -1, 0[\r\n]+} { target offload_device } }
+ { dg-output {finiDH1, 0[\r\n]+} { target offload_device } }
+ { dg-output {~S, 5, 1[\r\n]+} }
+ { dg-output {~S, 7, 1[\r\n]+} }
+ { dg-output {~S, -1, 1[\r\n]+} }
+ { dg-output {~S, -1, 1[\r\n]+} }
+ { dg-output {~S, 3, 1[\r\n]+} }
+ { dg-output {finiDH1, 1[\r\n]+} }
+ { dg-output {finiH1, 1[\r\n]+} }
+*/
diff --git a/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-GCN.C b/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-GCN.C
index 3cdedf4..d4dccf1 100644
--- a/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-GCN.C
+++ b/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-GCN.C
@@ -14,8 +14,10 @@
/* In this specific C++ arrangement, distilled from PR118794, GCC synthesizes
'__builtin_eh_pointer', '__builtin_unwind_resume' calls as dead code in 'f':
- { dg-final { scan-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized } }
- { dg-final { scan-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized } }
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized { target { ! { arm_eabi || tic6x-*-* } } } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized { target { ! { arm_eabi || tic6x-*-* } } } } }
+ ..., just 'targetm.arm_eabi_unwinder' is different:
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_cxa_end_cleanup, } 1 optimized { target { arm_eabi || tic6x-*-* } } } }
{ dg-final { only_for_offload_target amdgcn-amdhsa scan-offload-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized } }
{ dg-final { only_for_offload_target amdgcn-amdhsa scan-offload-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized } }
Given '-O0' and '-foffload-options=-mno-fake-exceptions', offload compilation fails:
diff --git a/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-nvptx.C b/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-nvptx.C
index ef996cf..724e34b 100644
--- a/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-nvptx.C
+++ b/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1-offload-sorry-nvptx.C
@@ -14,8 +14,10 @@
/* In this specific C++ arrangement, distilled from PR118794, GCC synthesizes
'__builtin_eh_pointer', '__builtin_unwind_resume' calls as dead code in 'f':
- { dg-final { scan-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized } }
- { dg-final { scan-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized } }
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized { target { ! { arm_eabi || tic6x-*-* } } } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized { target { ! { arm_eabi || tic6x-*-* } } } } }
+ ..., just 'targetm.arm_eabi_unwinder' is different:
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_cxa_end_cleanup, } 1 optimized { target { arm_eabi || tic6x-*-* } } } }
{ dg-final { only_for_offload_target nvptx-none scan-offload-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized } }
{ dg-final { only_for_offload_target nvptx-none scan-offload-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized } }
Given '-O0' and '-foffload-options=-mno-fake-exceptions', offload compilation fails:
diff --git a/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1.C b/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1.C
index 24e3d07..24eb7a5 100644
--- a/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1.C
+++ b/libgomp/testsuite/libgomp.c++/target-exceptions-pr118794-1.C
@@ -51,7 +51,9 @@ int main()
/* In this specific C++ arrangement, distilled from PR118794, GCC synthesizes
'__builtin_eh_pointer', '__builtin_unwind_resume' calls as dead code in 'f':
- { dg-final { scan-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized } }
- { dg-final { scan-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized } }
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized { target { ! { arm_eabi || tic6x-*-* } } } } }
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized { target { ! { arm_eabi || tic6x-*-* } } } } }
+ ..., just 'targetm.arm_eabi_unwinder' is different:
+ { dg-final { scan-tree-dump-times {gimple_call <__builtin_cxa_end_cleanup, } 1 optimized { target { arm_eabi || tic6x-*-* } } } }
{ dg-final { scan-offload-tree-dump-times {gimple_call <__builtin_eh_pointer, } 1 optimized } }
{ dg-final { scan-offload-tree-dump-times {gimple_call <__builtin_unwind_resume, } 1 optimized } } */
diff --git a/libgomp/testsuite/libgomp.c++/target-exceptions-throw-1.C b/libgomp/testsuite/libgomp.c++/target-exceptions-throw-1.C
index 2467061..a4e7a10 100644
--- a/libgomp/testsuite/libgomp.c++/target-exceptions-throw-1.C
+++ b/libgomp/testsuite/libgomp.c++/target-exceptions-throw-1.C
@@ -4,9 +4,6 @@
{ dg-additional-options -fexceptions } */
/* { dg-additional-options -fdump-tree-optimized-raw }
{ dg-additional-options -foffload-options=-fdump-tree-optimized-raw } */
-/* { dg-bogus {Size expression must be absolute\.} PR119737 { target offload_target_amdgcn xfail *-*-* } 0 }
- { dg-ice PR119737 { offload_target_amdgcn } }
- { dg-excess-errors {'mkoffload' failures etc.} { xfail offload_target_amdgcn } } */
#include "../libgomp.oacc-c++/exceptions-throw-1.C"
diff --git a/libgomp/testsuite/libgomp.c++/target-exceptions-throw-2.C b/libgomp/testsuite/libgomp.c++/target-exceptions-throw-2.C
index e85e6c3..97f4845 100644
--- a/libgomp/testsuite/libgomp.c++/target-exceptions-throw-2.C
+++ b/libgomp/testsuite/libgomp.c++/target-exceptions-throw-2.C
@@ -4,9 +4,6 @@
{ dg-additional-options -fexceptions } */
/* { dg-additional-options -fdump-tree-optimized-raw }
{ dg-additional-options -foffload-options=-fdump-tree-optimized-raw } */
-/* { dg-bogus {Size expression must be absolute\.} PR119737 { target offload_target_amdgcn xfail *-*-* } 0 }
- { dg-ice PR119737 { offload_target_amdgcn } }
- { dg-excess-errors {'mkoffload' failures etc.} { xfail offload_target_amdgcn } } */
#include "../libgomp.oacc-c++/exceptions-throw-2.C"
diff --git a/libgomp/testsuite/libgomp.c-c++-common/alloc-pinned-1.c b/libgomp/testsuite/libgomp.c-c++-common/alloc-pinned-1.c
new file mode 100644
index 0000000..7733395
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/alloc-pinned-1.c
@@ -0,0 +1,28 @@
+/* { dg-do run } */
+/* { dg-additional-options "-foffload-memory=pinned" } */
+/* { dg-skip-if "Pinning not implemented on this host" { ! *-*-linux-gnu* } } */
+
+#if __cplusplus
+#define EXTERNC extern "C"
+#else
+#define EXTERNC
+#endif
+
+/* Intercept the libgomp initialization call to check it happens. */
+
+int good = 0;
+
+EXTERNC void
+GOMP_enable_pinned_mode ()
+{
+ good = 1;
+}
+
+int
+main ()
+{
+ if (!good)
+ __builtin_exit (1);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/allocate-4.c b/libgomp/testsuite/libgomp.c-c++-common/allocate-4.c
index e81cc40..706c851 100644
--- a/libgomp/testsuite/libgomp.c/allocate-4.c
+++ b/libgomp/testsuite/libgomp.c-c++-common/allocate-4.c
@@ -1,6 +1,3 @@
-/* TODO: move to ../libgomp.c-c++-common once C++ is implemented. */
-/* NOTE: { target c } is unsupported with with the C compiler. */
-
/* { dg-do run } */
/* { dg-additional-options "-fdump-tree-gimple" } */
diff --git a/libgomp/testsuite/libgomp.c/allocate-5.c b/libgomp/testsuite/libgomp.c-c++-common/allocate-5.c
index beaf164..3bbe78d 100644
--- a/libgomp/testsuite/libgomp.c/allocate-5.c
+++ b/libgomp/testsuite/libgomp.c-c++-common/allocate-5.c
@@ -1,6 +1,3 @@
-/* TODO: move to ../libgomp.c-c++-common once C++ is implemented. */
-/* NOTE: { target c } is unsupported with with the C compiler. */
-
/* { dg-do run } */
/* { dg-additional-options "-fdump-tree-gimple" } */
diff --git a/libgomp/testsuite/libgomp.c/allocate-6.c b/libgomp/testsuite/libgomp.c-c++-common/allocate-6.c
index 6d7278c..669581b 100644
--- a/libgomp/testsuite/libgomp.c/allocate-6.c
+++ b/libgomp/testsuite/libgomp.c-c++-common/allocate-6.c
@@ -1,6 +1,3 @@
-/* TODO: move to ../libgomp.c-c++-common once C++ is implemented. */
-/* NOTE: { target c } is unsupported with with the C compiler. */
-
/* { dg-do run } */
/* { dg-additional-options "-fdump-tree-omplower" } */
diff --git a/libgomp/testsuite/libgomp.c-c++-common/array-shaping-14.c b/libgomp/testsuite/libgomp.c-c++-common/array-shaping-14.c
new file mode 100644
index 0000000..4ca6f79
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/array-shaping-14.c
@@ -0,0 +1,34 @@
+/* { dg-do run { target offload_device_nonshared_as } } */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+
+typedef struct {
+ int *ptr;
+} S;
+
+int main(void)
+{
+ S q;
+ q.ptr = (int *) calloc (9 * 11, sizeof (int));
+
+#pragma omp target enter data map(to: q.ptr, q.ptr[0:9*11])
+
+#pragma omp target
+ for (int i = 0; i < 9*11; i++)
+ q.ptr[i] = i;
+
+#pragma omp target update from(([9][11]) q.ptr[3:3:2][1:4:3])
+
+ for (int j = 0; j < 9; j++)
+ for (int i = 0; i < 11; i++)
+ if (j >= 3 && j <= 7 && ((j - 3) % 2) == 0
+ && i >= 1 && i <= 10 && ((i - 1) % 3) == 0)
+ assert (q.ptr[j * 11 + i] == j * 11 + i);
+ else
+ assert (q.ptr[j * 11 + i] == 0);
+
+#pragma omp target exit data map(release: q.ptr, q.ptr[0:9*11])
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/collapse-4.c b/libgomp/testsuite/libgomp.c-c++-common/collapse-4.c
new file mode 100644
index 0000000..c0af29f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/collapse-4.c
@@ -0,0 +1,23 @@
+/* { dg-do run } */
+
+#include <stdlib.h>
+
+int
+main (void)
+{
+ int i, j;
+ int count = 0;
+
+ #pragma omp parallel for collapse(2)
+ for (i = 0; i < 80000; i++)
+ for (j = 0; j < 80000; j++)
+ if (i == 66666 && j == 77777)
+ /* In the collapsed loop space, this is iteration
+ 66666*80000+77777==5,333,357,777. If the type of the iterator
+ for the collapsed loop is only a 32-bit unsigned int, then this
+ iteration will exceed its maximum range and be skipped. */
+ count++;
+
+ if (count != 1)
+ abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c
new file mode 100644
index 0000000..ca5aef4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-10.c
@@ -0,0 +1,60 @@
+/* { dg-do run } */
+
+#include <string.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#define N 64
+
+typedef struct {
+ int *arr;
+ int size;
+} B;
+
+#pragma omp declare mapper (mapB : B myb) map(to: myb.size, myb.arr) \
+ map(tofrom: myb.arr[0:myb.size])
+
+struct A {
+ int *arr1;
+ B *arr2;
+ int arr3[N];
+};
+
+int
+main (int argc, char *argv[])
+{
+ struct A var;
+
+ memset (&var, 0, sizeof var);
+ var.arr1 = (int *) calloc (N, sizeof (int));
+ var.arr2 = (B *) malloc (sizeof (B));
+ var.arr2->arr = (int *) calloc (N, sizeof (float));
+ var.arr2->size = N;
+
+ {
+ #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr2) \
+ map(tofrom: x.arr1[0:N]) \
+ map(mapper(mapB), tofrom: x.arr2[0:1])
+ #pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ {
+ var.arr1[i]++;
+ var.arr2->arr[i]++;
+ }
+ }
+ }
+
+ for (int i = 0; i < N; i++)
+ {
+ assert (var.arr1[i] == 1);
+ assert (var.arr2->arr[i] == 1);
+ assert (var.arr3[i] == 0);
+ }
+
+ free (var.arr1);
+ free (var.arr2->arr);
+ free (var.arr2);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c
new file mode 100644
index 0000000..942d6a5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-11.c
@@ -0,0 +1,59 @@
+/* { dg-do run } */
+
+#include <string.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#define N 64
+
+typedef struct B_tag {
+ int *arr;
+ int size;
+} B;
+
+#pragma omp declare mapper (B myb) map(to: myb.size, myb.arr) \
+ map(tofrom: myb.arr[0:myb.size])
+
+struct A {
+ int *arr1;
+ B *arr2;
+ int arr3[N];
+};
+
+int
+main (int argc, char *argv[])
+{
+ struct A var;
+
+ memset (&var, 0, sizeof var);
+ var.arr1 = (int *) calloc (N, sizeof (int));
+ var.arr2 = (B *) malloc (sizeof (B));
+ var.arr2->arr = (int *) calloc (N, sizeof (int));
+ var.arr2->size = N;
+
+ {
+ #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr2) \
+ map(tofrom: x.arr1[0:N]) map(tofrom: x.arr2[0:1])
+ #pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ {
+ var.arr1[i]++;
+ var.arr2->arr[i]++;
+ }
+ }
+ }
+
+ for (int i = 0; i < N; i++)
+ {
+ assert (var.arr1[i] == 1);
+ assert (var.arr2->arr[i] == 1);
+ assert (var.arr3[i] == 0);
+ }
+
+ free (var.arr1);
+ free (var.arr2->arr);
+ free (var.arr2);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c
new file mode 100644
index 0000000..cbedee5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-12.c
@@ -0,0 +1,87 @@
+/* { dg-do run } */
+
+#include <string.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#define N 64
+
+typedef struct {
+ int *arr;
+ int size;
+} B;
+
+#pragma omp declare mapper (samename : B myb) map(to: myb.size, myb.arr) \
+ map(tofrom: myb.arr[0:myb.size])
+
+typedef struct {
+ int *arr;
+ int size;
+} C;
+
+
+struct A {
+ int *arr1;
+ B *arr2;
+ C *arr3;
+};
+
+int
+main (int argc, char *argv[])
+{
+ struct A var;
+
+ memset (&var, 0, sizeof var);
+ var.arr1 = (int *) calloc (N, sizeof (int));
+ var.arr2 = (B *) malloc (sizeof (B));
+ var.arr2->arr = (int *) calloc (N, sizeof (int));
+ var.arr2->size = N;
+ var.arr3 = (C *) malloc (sizeof (C));
+ var.arr3->arr = (int *) calloc (N, sizeof (int));
+ var.arr3->size = N;
+
+ {
+ #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr2) \
+ map(tofrom: x.arr1[0:N]) \
+ map(mapper(samename), tofrom: x.arr2[0:1])
+ #pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ {
+ var.arr1[i]++;
+ var.arr2->arr[i]++;
+ }
+ }
+ }
+
+ {
+ #pragma omp declare mapper (samename : C myc) map(to: myc.size, myc.arr) \
+ map(tofrom: myc.arr[0:myc.size])
+ #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr3) \
+ map(tofrom: x.arr1[0:N]) \
+ map(mapper(samename), tofrom: *x.arr3)
+ #pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ {
+ var.arr1[i]++;
+ var.arr3->arr[i]++;
+ }
+ }
+ }
+
+ for (int i = 0; i < N; i++)
+ {
+ assert (var.arr1[i] == 2);
+ assert (var.arr2->arr[i] == 1);
+ assert (var.arr3->arr[i] == 1);
+ }
+
+ free (var.arr1);
+ free (var.arr2->arr);
+ free (var.arr2);
+ free (var.arr3->arr);
+ free (var.arr3);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c
new file mode 100644
index 0000000..c4784eb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-13.c
@@ -0,0 +1,55 @@
+/* { dg-do run } */
+
+#include <assert.h>
+
+struct T {
+ int a;
+ int b;
+ int c;
+};
+
+void foo (void)
+{
+ struct T x;
+ x.a = x.b = x.c = 0;
+
+#pragma omp target
+ {
+ x.a++;
+ x.c++;
+ }
+
+ assert (x.a == 1);
+ assert (x.b == 0);
+ assert (x.c == 1);
+}
+
+// An identity mapper. This should do the same thing as the default!
+#pragma omp declare mapper (struct T v) map(v)
+
+void bar (void)
+{
+ struct T x;
+ x.a = x.b = x.c = 0;
+
+#pragma omp target
+ {
+ x.b++;
+ }
+
+#pragma omp target map(x)
+ {
+ x.a++;
+ }
+
+ assert (x.a == 1);
+ assert (x.b == 1);
+ assert (x.c == 0);
+}
+
+int main (int argc, char *argv[])
+{
+ foo ();
+ bar ();
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c
new file mode 100644
index 0000000..3e6027e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-14.c
@@ -0,0 +1,57 @@
+/* { dg-do run } */
+
+#include <stdlib.h>
+#include <assert.h>
+
+struct Z {
+ int *arr;
+};
+
+void baz (struct Z *zarr, int len)
+{
+#pragma omp declare mapper (struct Z myvar) map(to: myvar.arr) \
+ map(tofrom: myvar.arr[0:len])
+ zarr[0].arr = (int *) calloc (len, sizeof (int));
+ zarr[5].arr = (int *) calloc (len, sizeof (int));
+
+#pragma omp target map(zarr, *zarr)
+ {
+ for (int i = 0; i < len; i++)
+ zarr[0].arr[i]++;
+ }
+
+#pragma omp target map(zarr, zarr[5])
+ {
+ for (int i = 0; i < len; i++)
+ zarr[5].arr[i]++;
+ }
+
+#pragma omp target map(zarr[5])
+ {
+ for (int i = 0; i < len; i++)
+ zarr[5].arr[i]++;
+ }
+
+#pragma omp target map(zarr, zarr[5:1])
+ {
+ for (int i = 0; i < len; i++)
+ zarr[5].arr[i]++;
+ }
+
+ for (int i = 0; i < len; i++)
+ assert (zarr[0].arr[i] == 1);
+
+ for (int i = 0; i < len; i++)
+ assert (zarr[5].arr[i] == 3);
+
+ free (zarr[5].arr);
+ free (zarr[0].arr);
+}
+
+int
+main (int argc, char *argv[])
+{
+ struct Z myzarr[10];
+ baz (myzarr, 256);
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-18.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-18.c
new file mode 100644
index 0000000..50f37cb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-18.c
@@ -0,0 +1,33 @@
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+
+typedef struct {
+ int *ptr;
+} S;
+
+int main(void)
+{
+#pragma omp declare mapper(grid: S x) map(([9][11]) x.ptr[3:3:2][1:4:3])
+ S q;
+ q.ptr = (int *) calloc (9 * 11, sizeof (int));
+
+#pragma omp target enter data map(to: q.ptr, q.ptr[0:9*11])
+
+#pragma omp target
+ for (int i = 0; i < 9*11; i++)
+ q.ptr[i] = i;
+
+#pragma omp target update from(mapper(grid): q)
+
+ for (int j = 0; j < 9; j++)
+ for (int i = 0; i < 11; i++)
+ if (j >= 3 && j <= 7 && ((j - 3) % 2) == 0
+ && i >= 1 && i <= 10 && ((i - 1) % 3) == 0)
+ assert (q.ptr[j * 11 + i] == j * 11 + i);
+ else
+ assert (q.ptr[j * 11 + i] == 0);
+
+#pragma omp target exit data map(release: q.ptr, q.ptr[0:9*11])
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c
new file mode 100644
index 0000000..324d535
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/declare-mapper-9.c
@@ -0,0 +1,62 @@
+/* { dg-do run } */
+
+#include <string.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#define N 64
+
+struct A {
+ int *arr1;
+ float *arr2;
+ int arr3[N];
+};
+
+int
+main (int argc, char *argv[])
+{
+ struct A var;
+
+ memset (&var, 0, sizeof var);
+ var.arr1 = (int *) calloc (N, sizeof (int));
+ var.arr2 = (float *) calloc (N, sizeof (float));
+
+ {
+ #pragma omp declare mapper (struct A x) map(to: x.arr1) \
+ map(tofrom: x.arr1[0:N])
+ #pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ var.arr1[i]++;
+ }
+ }
+
+ {
+ #pragma omp declare mapper (struct A x) map(to: x.arr2) \
+ map(tofrom: x.arr2[0:N])
+ #pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ var.arr2[i]++;
+ }
+ }
+
+ {
+ #pragma omp declare mapper (struct A x) map(tofrom: x.arr3[0:N])
+ #pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ var.arr3[i]++;
+ }
+ }
+
+ for (int i = 0; i < N; i++)
+ {
+ assert (var.arr1[i] == 1);
+ assert (var.arr2[i] == 1);
+ assert (var.arr3[i] == 1);
+ }
+
+ free (var.arr1);
+ free (var.arr2);
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/delim-declare-variant-1.c b/libgomp/testsuite/libgomp.c-c++-common/delim-declare-variant-1.c
new file mode 100644
index 0000000..916f8a6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/delim-declare-variant-1.c
@@ -0,0 +1,45 @@
+/* Check basic functionality for the delimited form of "declare variant"
+ - no error re duplicate definitions
+ - variants are registered and correctly resolved at call site. */
+
+int foo (int a)
+{
+ return a;
+}
+
+int bar (int x)
+{
+ return x;
+}
+
+#pragma omp begin declare variant match (construct={target})
+int foo (int a)
+{
+ return a + 1;
+}
+
+int bar (int x)
+{
+ return x * 2;
+}
+#pragma omp end declare variant
+
+/* Because of the high score value, this variant for "bar" should always be
+ selected even when the one above also matches. */
+#pragma omp begin declare variant match (implementation={vendor(score(10000):"gnu")})
+int bar (int x)
+{
+ return x * 4;
+}
+#pragma omp end declare variant
+
+int main (void)
+{
+ if (foo (42) != 42) __builtin_abort ();
+ if (bar (3) != 12) __builtin_abort ();
+#pragma omp target
+ {
+ if (foo (42) != 43) __builtin_abort ();
+ if (bar (3) != 12) __builtin_abort ();
+ }
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/dispatch-3.c b/libgomp/testsuite/libgomp.c-c++-common/dispatch-3.c
new file mode 100644
index 0000000..2c41e3c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/dispatch-3.c
@@ -0,0 +1,35 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+/* PR c++/118859 */
+
+void f_var(int *y) {
+ #pragma omp target is_device_ptr(y)
+ {
+ if (*y != 5)
+ __builtin_abort ();
+ *y += 10;
+ }
+}
+#pragma omp declare variant(f_var) match(construct={dispatch}) adjust_args(need_device_ptr : 1)
+void f(int *);
+
+static void test()
+{
+ int x = 5;
+ #pragma omp target enter data map(x)
+
+ #pragma omp dispatch
+ f(&x);
+
+ #pragma omp target exit data map(x)
+ if (x != 15)
+ __builtin_abort ();
+}
+
+int main()
+{
+ test();
+}
+
+// { dg-final { scan-tree-dump "D\\.\[0-9\]+ = __builtin_omp_get_mapped_ptr \\(&x, D\\.\[0-9\]+\\);" "gimple" } }
+// { dg-final { scan-tree-dump "f_var \\(D\\.\[0-9\]+\\);" "gimple" } }
diff --git a/libgomp/testsuite/libgomp.c-c++-common/for-17.c b/libgomp/testsuite/libgomp.c-c++-common/for-17.c
new file mode 100644
index 0000000..9771aaf
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/for-17.c
@@ -0,0 +1,69 @@
+/* { dg-options "-fopenmp-target=acc" } */
+/* { dg-additional-options "-std=gnu99" { target c } } */
+
+#define M(x, y, z) O(x, y, z)
+#define O(x, y, z) x ## _ ## y ## _ ## z
+
+#define DO_PRAGMA(x) _Pragma (#x)
+
+#undef OMPFROM
+#undef OMPTO
+#define OMPFROM(v) DO_PRAGMA (omp target update from(v))
+#define OMPTO(v) DO_PRAGMA (omp target update to(v))
+
+#pragma omp declare target
+
+#define OMPTGT DO_PRAGMA (omp target)
+#define F parallel for
+#define G pf
+#define S
+#define N(x) M(x, G, ompacc)
+#include "for-2.h"
+#undef S
+#undef N
+#undef F
+#undef G
+#undef OMPTGT
+
+#pragma omp end declare target
+
+#define F target parallel for
+#define G tpf
+#define S
+#define N(x) M(x, G, ompacc)
+#include "for-2.h"
+#undef S
+#undef N
+#undef F
+#undef G
+
+#define F target teams distribute
+#define G ttd
+#define S
+#define N(x) M(x, G, ompacc)
+#include "for-2.h"
+#undef S
+#undef N
+#undef F
+#undef G
+
+#define F target teams distribute parallel for
+#define G ttdpf
+#define S
+#define N(x) M(x, G, ompacc)
+#include "for-2.h"
+#undef S
+#undef N
+#undef F
+#undef G
+
+int
+main ()
+{
+ if (test_pf_ompacc ()
+ || test_tpf_ompacc ()
+ || test_ttd_ompacc ()
+ || test_ttdpf_ompacc ())
+ __builtin_abort ();
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/for-18.c b/libgomp/testsuite/libgomp.c-c++-common/for-18.c
new file mode 100644
index 0000000..2486d3a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/for-18.c
@@ -0,0 +1,5 @@
+/* { dg-options "-fopenmp-target=acc" } */
+/* { dg-additional-options "-std=gnu99" {target c } } */
+
+#define CONDNE
+#include "for-17.c"
diff --git a/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-1.c b/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-1.c
new file mode 100644
index 0000000..1938237
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-1.c
@@ -0,0 +1,83 @@
+/* { dg-do run } */
+
+#include <string.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+
+#define DIM1 4
+#define DIM2 16
+
+struct S {
+ int *arr1;
+ float *arr2;
+ size_t len;
+};
+
+size_t
+mkarray (struct S arr[])
+{
+ size_t sum = 0;
+
+ for (int i = 0; i < DIM1; i++)
+ {
+ memset (&arr[i], 0, sizeof (struct S));
+ arr[i].len = DIM2;
+ arr[i].arr1 = (int *) calloc (arr[i].len, sizeof (int));
+ for (int j = 0; j < DIM2; j++)
+ {
+ size_t value = (i + 1) * (j + 1);
+ sum += value;
+ arr[i].arr1[j] = value;
+ }
+ }
+
+ return sum;
+}
+
+int main ()
+{
+ struct S arr[DIM1];
+ size_t sum = 0xdeadbeef;
+ size_t expected = mkarray (arr);
+
+ #pragma omp declare mapper (struct S x) \
+ map(to: x.arr1[0:DIM2]) \
+ map(to: x.arr2[0:DIM2]) \
+ map(to: x.len)
+
+ #pragma omp target map(iterator(int i=0:DIM1), to: arr[i]) map(from: sum)
+ {
+ sum = 0;
+#ifdef DEBUG
+ __builtin_printf ("&sum: %p\n", &sum);
+#endif
+ for (int i = 0; i < DIM1; i++)
+ {
+#ifdef DEBUG
+ __builtin_printf ("&arr[%d] = %p\n", i, &arr[i]);
+ __builtin_printf ("arr[%d].len = %d\n", i, arr[i].len);
+ __builtin_printf ("arr[%d].arr1 = %p\n", i, arr[i].arr1);
+ __builtin_printf ("arr[%d].arr2 = %p\n", i, arr[i].arr2);
+#endif
+ for (int j = 0; j < DIM2; j++)
+ {
+#ifdef DEBUG
+ __builtin_printf ("(i=%d,j=%d): %p\n", i, j, &arr[i].arr1[j]);
+ __builtin_printf ("(i=%d,j=%d): %d\n", i, j, arr[i].arr1[j]);
+#endif
+ sum += arr[i].arr1[j];
+#ifdef DEBUG
+ __builtin_printf ("sum: %ld\n", sum);
+#endif
+ }
+ }
+ }
+
+#ifdef DEBUG
+ __builtin_printf ("&sum: %p\n", &sum);
+ __builtin_printf ("sum:%zd (expected: %zd)\n", sum, expected);
+#endif
+
+ return sum != expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-2.c b/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-2.c
new file mode 100644
index 0000000..76f00fb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-2.c
@@ -0,0 +1,81 @@
+/* { dg-do run } */
+
+#include <string.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+
+#define DIM1 4
+#define DIM2 16
+
+#ifdef DEBUG
+#undef DEBUG
+#define DEBUG(...) __builtin_printf (__VA_ARGS__)
+#else
+#define DEBUG(...)
+#endif
+
+struct S {
+ int *arr1;
+ float *arr2;
+ size_t len;
+};
+
+size_t
+mkarray (struct S arr[])
+{
+ size_t sum = 0;
+
+ for (int i = 0; i < DIM1; i++)
+ {
+ memset (&arr[i], 0, sizeof (struct S));
+ arr[i].len = DIM2;
+ arr[i].arr1 = (int *) calloc (arr[i].len, sizeof (int));
+ for (int j = 0; j < DIM2; j++)
+ {
+ size_t value = (i + 1) * (j + 1);
+ sum += value;
+ arr[i].arr1[j] = value;
+ }
+ }
+
+ return sum;
+}
+
+int main ()
+{
+ struct S arr[DIM1];
+ size_t sum = 0xdeadbeef;
+ size_t expected = mkarray (arr);
+
+ #pragma omp declare mapper (struct S x) \
+ map(to: x.arr1[0:DIM2]) \
+ map(to: x.arr2[0:DIM2]) \
+ map(to: x.len)
+
+ /* This should be equivalent to map(iterator(int i=0:DIM1), to: arr[i]) */
+ #pragma omp target map(iterator(int i=0:DIM1:2, j=0:2), to: arr[i+j]) map(from: sum)
+ {
+ sum = 0;
+ DEBUG ("&sum: %p\n", &sum);
+ for (int i = 0; i < DIM1; i++)
+ {
+ DEBUG ("&arr[%d] = %p\n", i, &arr[i]);
+ DEBUG ("arr[%d].len = %d\n", i, arr[i].len);
+ DEBUG ("arr[%d].arr1 = %p\n", i, arr[i].arr1);
+ DEBUG ("arr[%d].arr2 = %p\n", i, arr[i].arr2);
+ for (int j = 0; j < DIM2; j++)
+ {
+ DEBUG ("(i=%d,j=%d): %p\n", i, j, &arr[i].arr1[j]);
+ DEBUG ("(i=%d,j=%d): %d\n", i, j, arr[i].arr1[j]);
+ sum += arr[i].arr1[j];
+ DEBUG ("sum: %ld\n", sum);
+ }
+ }
+ }
+
+ DEBUG ("&sum: %p\n", &sum);
+ DEBUG ("sum:%zd (expected: %zd)\n", sum, expected);
+
+ return sum != expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-3.c b/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-3.c
new file mode 100644
index 0000000..9d67c38
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/mapper-iterators-3.c
@@ -0,0 +1,98 @@
+/* { dg-do run } */
+
+#include <string.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#define N 64
+#define DIM 4
+
+#ifdef DEBUG
+#undef DEBUG
+#define DEBUG(...) __builtin_printf (__VA_ARGS__)
+#else
+#define DEBUG(...)
+#endif
+
+typedef struct {
+ int *arr;
+ int size;
+} B;
+
+#pragma omp declare mapper (mapB : B myb) map(to: myb.size, myb.arr) \
+ map(tofrom: myb.arr[0:myb.size+1])
+
+struct A {
+ int *arr1;
+ B *arr2;
+ int arr3[N];
+};
+
+int
+main (int argc, char *argv[])
+{
+ struct A var[DIM];
+
+ for (int i=0; i < DIM; i++)
+ {
+ memset (&var[i], 0, sizeof var[i]);
+ var[i].arr1 = (int *) calloc (N, sizeof (int));
+ var[i].arr2 = (B *) malloc (sizeof (B));
+ var[i].arr2->arr = (int *) calloc (N+1, sizeof (float));
+ var[i].arr2->size = N+1;
+ DEBUG ("host &var[%d]:%p\n", i, &var[i]);
+ DEBUG ("host var[%d].arr1:%p\n", i, var[i].arr1);
+ DEBUG ("host var[%d].arr2:%p\n", i, var[i].arr2);
+ DEBUG ("host var[%d].arr2->arr:%p\n", i, var[i].arr2->arr);
+ DEBUG ("host var[%d].arr2->size:%d\n", i, var[i].arr2->size);
+ }
+
+ {
+ #pragma omp declare mapper (struct A x) map(to: x.arr1, x.arr2) \
+ map(tofrom: x.arr1[0:N]) \
+ map(mapper(mapB), tofrom: x.arr2[0:1])
+ #pragma omp target map(iterator(int i=0:DIM), tofrom: var[i])
+ {
+ for (int i = 0; i < DIM; i++)
+ {
+ DEBUG ("&var[%d]:%p\n", i, &var[i]);
+ DEBUG ("var[%d].arr1:%p\n", i, var[i].arr1);
+ DEBUG ("var[%d].arr2:%p\n", i, var[i].arr2);
+ if (var[i].arr2)
+ {
+ DEBUG ("var[%d].arr2->arr:%p\n", i, var[i].arr2->arr);
+ DEBUG ("var[%d].arr2->size:%d\n", i, var[i].arr2->size);
+ }
+ for (int j = 0; j < N; j++)
+ {
+ DEBUG ("&var[%d].arr1[%d]:%p\n", i, j, &var[i].arr1[j]);
+ var[i].arr1[j]++;
+ if (var[i].arr2)
+ {
+ DEBUG ("&var[%d].arr2->arr[%d]:%p\n", i, j, &var[i].arr2->arr[j]);
+ var[i].arr2->arr[j]++;
+ }
+ else
+ DEBUG ("SKIP arr2\n");
+ }
+ }
+ }
+ }
+
+ for (int i = 0; i < DIM; i++)
+ for (int j = 0; j < N; j++)
+ {
+ assert (var[i].arr1[j] == 1);
+ assert (var[i].arr2->arr[j] == 1);
+ assert (var[i].arr3[j] == 0);
+ }
+
+ for (int i = 0; i < DIM; i++)
+ {
+ free (var[i].arr1);
+ free (var[i].arr2->arr);
+ free (var[i].arr2);
+ }
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-cdtor-1.c b/libgomp/testsuite/libgomp.c-c++-common/target-cdtor-1.c
new file mode 100644
index 0000000..e6099cf
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-cdtor-1.c
@@ -0,0 +1,89 @@
+/* Offloaded 'constructor' and 'destructor' functions. */
+
+#include <omp.h>
+
+#pragma omp declare target
+
+static void
+__attribute__((constructor))
+initHD1()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+static void
+__attribute__((constructor))
+initHD2()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+static void
+__attribute__((destructor))
+finiHD1()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+static void
+__attribute__((destructor))
+finiHD2()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+#pragma omp end declare target
+
+static void
+__attribute__((constructor))
+initH1()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+static void
+__attribute__((destructor))
+finiH2()
+{
+ __builtin_printf("%s, %d\n", __FUNCTION__, omp_is_initial_device());
+}
+
+int main()
+{
+ int c = 0;
+
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+
+#pragma omp target map(c)
+ {
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+ }
+
+#pragma omp target map(c)
+ {
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+ }
+
+ __builtin_printf("%s:%d, %d\n", __FUNCTION__, ++c, omp_is_initial_device());
+
+ return 0;
+}
+
+/* The order is undefined, in which same-priority 'constructor' functions, and 'destructor' functions are run.
+ { dg-output {init[^,]+, 1[\r\n]+} }
+ { dg-output {init[^,]+, 1[\r\n]+} }
+ { dg-output {init[^,]+, 1[\r\n]+} }
+ { dg-output {main:1, 1[\r\n]+} }
+ { dg-output {initHD[^,]+, 0[\r\n]+} { target offload_device } }
+ { dg-output {initHD[^,]+, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:2, 1[\r\n]+} { target { ! offload_device } } }
+ { dg-output {main:2, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:3, 1[\r\n]+} { target { ! offload_device } } }
+ { dg-output {main:3, 0[\r\n]+} { target offload_device } }
+ { dg-output {main:4, 1[\r\n]+} }
+ { dg-output {finiHD[^,]+, 0[\r\n]+} { target offload_device } }
+ { dg-output {finiHD[^,]+, 0[\r\n]+} { target offload_device } }
+ { dg-output {fini[^,]+, 1[\r\n]+} }
+ { dg-output {fini[^,]+, 1[\r\n]+} }
+ { dg-output {fini[^,]+, 1[\r\n]+} }
+*/
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-1.c b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-1.c
new file mode 100644
index 0000000..b3d87f2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-1.c
@@ -0,0 +1,47 @@
+/* { dg-do run } */
+/* { dg-require-effective-target offload_device_nonshared_as } */
+
+/* Test transfer of dynamically-allocated arrays to target using map
+ iterators. */
+
+#include <stdlib.h>
+
+#define DIM1 8
+#define DIM2 15
+
+int mkarray (int *x[])
+{
+ int expected = 0;
+
+ for (int i = 0; i < DIM1; i++)
+ {
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] = rand ();
+ expected += x[i][j];
+ }
+ }
+
+ return expected;
+}
+
+int main (void)
+{
+ int *x[DIM1];
+ int y;
+
+ int expected = mkarray (x);
+
+ #pragma omp target enter data map(to: x)
+ #pragma omp target map(iterator(i=0:DIM1), to: x[i][:DIM2]) \
+ map(from: y)
+ {
+ y = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ y += x[i][j];
+ }
+
+ return y - expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-2.c b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-2.c
new file mode 100644
index 0000000..8569b55
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-2.c
@@ -0,0 +1,44 @@
+/* { dg-do run } */
+/* { dg-require-effective-target offload_device_nonshared_as } */
+
+/* Test transfer of dynamically-allocated arrays from target using map
+ iterators. */
+
+#include <stdlib.h>
+
+#define DIM1 8
+#define DIM2 15
+
+void mkarray (int *x[])
+{
+ for (int i = 0; i < DIM1; i++)
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+}
+
+int main (void)
+{
+ int *x[DIM1];
+ int y, expected;
+
+ mkarray (x);
+
+ #pragma omp target enter data map(alloc: x)
+ #pragma omp target map(iterator(i=0:DIM1), from: x[i][:DIM2]) \
+ map(from: expected)
+ {
+ expected = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] = (i+1) * (j+1);
+ expected += x[i][j];
+ }
+ }
+
+ y = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ y += x[i][j];
+
+ return y - expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-3.c b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-3.c
new file mode 100644
index 0000000..be30fa65d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-3.c
@@ -0,0 +1,56 @@
+/* { dg-do run } */
+/* { dg-require-effective-target offload_device_nonshared_as } */
+
+/* Test transfer of dynamically-allocated arrays to target using map
+ iterators, with multiple iterators and function calls in the iterator
+ expression. */
+
+#include <stdlib.h>
+
+#define DIM1 16
+#define DIM2 15
+
+int mkarrays (int *x[], int *y[])
+{
+ int expected = 0;
+
+ for (int i = 0; i < DIM1; i++)
+ {
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+ y[i] = (int *) malloc (sizeof (int));
+ *y[i] = rand ();
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] = rand ();
+ expected += x[i][j] * *y[i];
+ }
+ }
+
+ return expected;
+}
+
+int f (int i, int j)
+{
+ return i * 4 + j;
+}
+
+int main (void)
+{
+ int *x[DIM1], *y[DIM1];
+ int sum;
+
+ int expected = mkarrays (x, y);
+
+ #pragma omp target enter data map(to: x, y)
+ #pragma omp target map(iterator(i=0:DIM1/4, j=0:4), to: x[f(i, j)][:DIM2]) \
+ map(iterator(i=0:DIM1), to: y[i][:1]) \
+ map(from: sum)
+ {
+ sum = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j] * y[i][0];
+ }
+
+ return sum - expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-4.c b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-4.c
new file mode 100644
index 0000000..6217367
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-4.c
@@ -0,0 +1,48 @@
+/* { dg-do run } */
+/* { dg-require-effective-target offload_device_nonshared_as } */
+
+/* Test transfer of dynamically-allocated arrays to target using map
+ iterators with non-constant bounds. */
+
+#include <stdlib.h>
+
+#define DIM1 8
+#define DIM2 15
+
+int mkarray (int *x[], int *dim1)
+{
+ int expected = 0;
+ *dim1 = DIM1;
+ for (int i = 0; i < DIM1; i++)
+ {
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] = rand ();
+ expected += x[i][j];
+ }
+ }
+
+ return expected;
+}
+
+int main (void)
+{
+ int *x[DIM1];
+ int y;
+ int dim1;
+
+ int expected = mkarray (x, &dim1);
+
+ #pragma omp target enter data map(to: x)
+ #pragma omp target map(iterator(i=0:dim1), to: x[i][:DIM2]) \
+ map(from: y)
+ {
+ y = 0;
+ for (int i = 0; i < dim1; i++)
+ for (int j = 0; j < DIM2; j++)
+ y += x[i][j];
+ }
+
+ return y - expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-5.c b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-5.c
new file mode 100644
index 0000000..54b4818
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-map-iterators-5.c
@@ -0,0 +1,59 @@
+/* { dg-do run } */
+/* { dg-require-effective-target offload_device_nonshared_as } */
+
+/* Test transfer of dynamically-allocated arrays to target using map
+ iterators, with multiple iterators, function calls and non-constant
+ bounds in the iterator expression. */
+
+#include <stdlib.h>
+
+#define DIM1 16
+#define DIM2 15
+
+int mkarrays (int *x[], int *y[], int *dim1)
+{
+ int expected = 0;
+
+ *dim1 = DIM1;
+ for (int i = 0; i < DIM1; i++)
+ {
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+ y[i] = (int *) malloc (sizeof (int));
+ *y[i] = rand ();
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] = rand ();
+ expected += x[i][j] * *y[i];
+ }
+ }
+
+ return expected;
+}
+
+int f (int i, int j)
+{
+ return i * 4 + j;
+}
+
+int main (void)
+{
+ int *x[DIM1], *y[DIM1];
+ int sum;
+
+ int dim1;
+ int expected = mkarrays (x, y, &dim1);
+ int dim1_4 = dim1 / 4;
+
+ #pragma omp target enter data map(to: x, y)
+ #pragma omp target map(iterator(i=0:dim1_4, j=0:4), to: x[f(i, j)][:DIM2]) \
+ map(iterator(i=0:dim1), to: y[i][:1]) \
+ map(from: sum)
+ {
+ sum = 0;
+ for (int i = 0; i < dim1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j] * y[i][0];
+ }
+
+ return sum - expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-1.c b/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-1.c
new file mode 100644
index 0000000..5a4cad5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-1.c
@@ -0,0 +1,65 @@
+/* { dg-do run } */
+
+/* Test target enter data and target update to the target using map
+ iterators. */
+
+#include <stdlib.h>
+
+#define DIM1 8
+#define DIM2 15
+
+int mkarray (int *x[])
+{
+ int expected = 0;
+ for (int i = 0; i < DIM1; i++)
+ {
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] = rand ();
+ expected += x[i][j];
+ }
+ }
+
+ return expected;
+}
+
+int main (void)
+{
+ int *x[DIM1];
+ int sum;
+ int expected = mkarray (x);
+
+ #pragma omp target enter data map(to: x[:DIM1])
+ #pragma omp target enter data map(iterator(i=0:DIM1), to: x[i][:DIM2])
+ #pragma omp target map(from: sum)
+ {
+ sum = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j];
+ }
+
+ if (sum != expected)
+ return 1;
+
+ expected = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] *= rand ();
+ expected += x[i][j];
+ }
+
+ #pragma omp target update to(iterator(i=0:DIM1): x[i][:DIM2])
+
+ #pragma omp target map(from: sum)
+ {
+ sum = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j];
+ }
+
+ return sum != expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-2.c b/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-2.c
new file mode 100644
index 0000000..93438d0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-2.c
@@ -0,0 +1,58 @@
+/* { dg-do run } */
+/* { dg-require-effective-target offload_device_nonshared_as } */
+
+/* Test target enter data and target update from the target using map
+ iterators. */
+
+#include <stdlib.h>
+
+#define DIM1 8
+#define DIM2 15
+
+void mkarray (int *x[])
+{
+ for (int i = 0; i < DIM1; i++)
+ {
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+ for (int j = 0; j < DIM2; j++)
+ x[i][j] = 0;
+ }
+}
+
+int main (void)
+{
+ int *x[DIM1];
+ int sum, expected;
+
+ mkarray (x);
+
+ #pragma omp target enter data map(alloc: x[:DIM1])
+ #pragma omp target enter data map(iterator(i=0:DIM1), to: x[i][:DIM2])
+ #pragma omp target map(from: expected)
+ {
+ expected = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] = (i + 1) * (j + 2);
+ expected += x[i][j];
+ }
+ }
+
+ /* Host copy of x should remain unchanged. */
+ sum = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j];
+ if (sum != 0)
+ return 1;
+
+ #pragma omp target update from(iterator(i=0:DIM1): x[i][:DIM2])
+
+ /* Host copy should now be updated. */
+ sum = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j];
+ return sum - expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-3.c b/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-3.c
new file mode 100644
index 0000000..a70b21c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-3.c
@@ -0,0 +1,67 @@
+/* { dg-do run } */
+/* { dg-require-effective-target offload_device_nonshared_as } */
+
+/* Test target enter data and target update to the target using map
+ iterators with a function. */
+
+#include <stdlib.h>
+
+#define DIM1 8
+#define DIM2 15
+
+void mkarray (int *x[])
+{
+ for (int i = 0; i < DIM1; i++)
+ {
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+ for (int j = 0; j < DIM2; j++)
+ x[i][j] = rand ();
+ }
+}
+
+int f (int i)
+{
+ return i * 2;
+}
+
+int main (void)
+{
+ int *x[DIM1], x_new[DIM1][DIM2];
+ int sum, expected;
+
+ mkarray (x);
+
+ #pragma omp target enter data map(alloc: x[:DIM1])
+ #pragma omp target enter data map(iterator(i=0:DIM1), to: x[i][:DIM2])
+
+ /* Update x on host. */
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ {
+ x_new[i][j] = x[i][j];
+ x[i][j] = (i + 1) * (j + 2);
+ }
+
+ /* Update a subset of x on target. */
+ #pragma omp target update to(iterator(i=0:DIM1/2): x[f (i)][:DIM2])
+
+ #pragma omp target map(from: sum)
+ {
+ sum = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j];
+ }
+
+ /* Calculate expected value on host. */
+ for (int i = 0; i < DIM1/2; i++)
+ for (int j = 0; j < DIM2; j++)
+ x_new[f (i)][j] = x[f (i)][j];
+
+ expected = 0;
+ for (int i = 0; i < DIM1; i++)
+ for (int j = 0; j < DIM2; j++)
+ expected += x_new[i][j];
+
+ return sum - expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-4.c b/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-4.c
new file mode 100644
index 0000000..810b881
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-update-iterators-4.c
@@ -0,0 +1,66 @@
+/* { dg-do run } */
+
+/* Test target enter data and target update to the target using map
+ iterators with non-constant bounds. */
+
+#include <stdlib.h>
+
+#define DIM1 8
+#define DIM2 15
+
+int mkarray (int *x[], int *dim1)
+{
+ int expected = 0;
+ *dim1 = DIM1;
+ for (int i = 0; i < DIM1; i++)
+ {
+ x[i] = (int *) malloc (DIM2 * sizeof (int));
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] = rand ();
+ expected += x[i][j];
+ }
+ }
+
+ return expected;
+}
+
+int main (void)
+{
+ int *x[DIM1];
+ int sum, dim1;
+ int expected = mkarray (x, &dim1);
+
+ #pragma omp target enter data map(to: x[:DIM1])
+ #pragma omp target enter data map(iterator(i=0:dim1), to: x[i][:DIM2])
+ #pragma omp target map(from: sum)
+ {
+ sum = 0;
+ for (int i = 0; i < dim1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j];
+ }
+
+ if (sum != expected)
+ return 1;
+
+ expected = 0;
+ for (int i = 0; i < dim1; i++)
+ for (int j = 0; j < DIM2; j++)
+ {
+ x[i][j] *= rand ();
+ expected += x[i][j];
+ }
+
+ #pragma omp target update to(iterator(i=0:dim1): x[i][:DIM2])
+
+ #pragma omp target map(from: sum)
+ {
+ sum = 0;
+ for (int i = 0; i < dim1; i++)
+ for (int j = 0; j < DIM2; j++)
+ sum += x[i][j];
+ }
+
+ return sum != expected;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-1.c b/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-1.c
new file mode 100644
index 0000000..21074a3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-1.c
@@ -0,0 +1,53 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" } */
+
+#include <omp.h>
+
+omp_alloctrait_key_t k;
+omp_alloctrait_value_t v;
+
+int main (void)
+{
+ omp_allocator_handle_t foo, bar;
+ const omp_alloctrait_t foo_traits[] = { { omp_atk_pinned, omp_atv_true },
+ { omp_atk_partition, omp_atv_nearest } };
+ #pragma omp target
+ ;
+ #pragma omp target uses_allocators (bar)
+ ;
+ #pragma omp target uses_allocators (foo (foo_traits))
+ ;
+ #pragma omp target uses_allocators (foo (foo_traits), bar (foo_traits))
+ ;
+ #pragma omp target uses_allocators (memspace(omp_high_bw_mem_space) : foo)
+ ;
+ #pragma omp target uses_allocators (traits(foo_traits) : bar)
+ ;
+ #pragma omp target parallel uses_allocators (memspace(omp_high_bw_mem_space), traits(foo_traits) : bar)
+ ;
+ #pragma omp target parallel uses_allocators (traits(foo_traits), memspace(omp_high_bw_mem_space) : bar) uses_allocators(foo)
+ {
+ void *p = omp_alloc ((unsigned long) 32, bar);
+ omp_free (p, bar);
+ }
+ return 0;
+}
+
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(\\), traits\\(\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(foo: memspace\\(\\), traits\\(foo_traits\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(\\), traits\\(foo_traits\\)\\) uses_allocators\\(foo: memspace\\(\\), traits\\(foo_traits\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(foo: memspace\\(omp_high_bw_mem_space\\), traits\\(\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(\\), traits\\(foo_traits\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(omp_high_bw_mem_space\\), traits\\(foo_traits\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(omp_high_bw_mem_space\\), traits\\(foo_traits\\)\\) uses_allocators\\(foo: memspace\\(\\), traits\\(\\)\\)" "original" } } */
+
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(\\), traits\\(\\)\\) private\\(bar\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(foo: memspace\\(\\), traits\\(foo_traits\\)\\) private\\(foo\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(\\), traits\\(foo_traits\\)\\) uses_allocators\\(foo: memspace\\(\\), traits\\(foo_traits\\)\\) private\\(bar\\) private\\(foo\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(foo: memspace\\(omp_high_bw_mem_space\\), traits\\(\\)\\) private\\(foo\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(\\), traits\\(foo_traits\\)\\) private\\(bar\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(omp_high_bw_mem_space\\), traits\\(foo_traits\\)\\) private\\(bar\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(omp_high_bw_mem_space\\), traits\\(foo_traits\\)\\) uses_allocators\\(foo: memspace\\(\\), traits\\(\\)\\) private\\(bar\\) private\\(foo\\)" "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_init_allocator" 9 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_destroy_allocator" 9 "gimple" } } */
diff --git a/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-2.c b/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-2.c
new file mode 100644
index 0000000..f350c0a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-2.c
@@ -0,0 +1,39 @@
+/* { dg-do compile } */
+
+#include <omp.h>
+
+omp_alloctrait_key_t k;
+omp_alloctrait_value_t v;
+
+int main (void)
+{
+ omp_allocator_handle_t foo, bar;
+ const omp_alloctrait_t traits_array[] = { { omp_atk_pinned, omp_atv_true },
+ { omp_atk_partition, omp_atv_nearest } };
+
+ #pragma omp target uses_allocators (baz) /* { dg-error "'baz' undeclared .first use in this function." "" { target c } } */
+ ; /* { dg-error "'baz' has not been declared" "" { target c++ } .-1 } */
+ #pragma omp target uses_allocators (foo (xyz)) /* { dg-error "'xyz' undeclared .first use in this function." "" { target c } } */
+ ; /* { dg-error "'xyz' has not been declared" "" { target c++ } .-1 } */
+ #pragma omp target uses_allocators (foo (traits_array), baz (traits_array)) /* { dg-error "'baz' has not been declared" "" { target c++ } } */
+ ;
+ #pragma omp target uses_allocators (memspace(omp_no_such_space) : foo) /* { dg-error "'omp_no_such_space' undeclared .first use in this function." "" { target c } } */
+ ; /* { dg-error "'omp_no_such_space' has not been declared" "" { target c++ } .-1 } */
+ #pragma omp target uses_allocators (memspace(1) : foo) /* { dg-error "expected identifier before numeric constant" } */
+ ; /* { dg-error "expected '\\\)' before ':' token" "" { target c } .-1 } */
+ #pragma omp target uses_allocators (memspace(omp_no_such_space) : foo, bar) /* { dg-error "'uses_allocators' clause only accepts a single allocator when using modifiers" } */
+ ; /* { dg-error "'omp_no_such_space' has not been declared" "" { target c++ } .-1 } */
+ #pragma omp target uses_allocators (traits(xyz) : bar) /* { dg-error "traits array must be of 'const omp_alloctrait_t \\\[\\\]' type" "" { target c } } */
+ ; /* { dg-error "'xyz' has not been declared" "" { target c++ } .-1 } */
+ #pragma omp target uses_allocators (memspace(omp_high_bw_mem_space), traits(traits_array), memspace (omp_no_such_space) : bar) /* { dg-error "duplicate 'memspace' modifier" } */
+ ;
+ #pragma omp target uses_allocators (traitz(traits_array), memspace(omp_high_bw_mem_space) : bar) /* { dg-error "unknown modifier 'traitz'" } */
+ ;
+ #pragma omp target uses_allocators (omp_null_allocator) /* { dg-error "'omp_null_allocator' cannot be used in 'uses_allocators' clause" } */
+ ;
+ #pragma omp target uses_allocators (memspace(omp_high_bw_mem_space) : foo, bar) /* { dg-error "'uses_allocators' clause only accepts a single allocator when using modifiers" } */
+ ;
+ #pragma omp target uses_allocators (memspace(omp_high_bw_mem_space) : foo(foo_traits)) /* { dg-error "legacy 'foo\\\(foo_traits\\\)' traits syntax not allowed in 'uses_allocators' clause when using modifiers" } */
+ ;
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-3.c b/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-3.c
new file mode 100644
index 0000000..de9ab92
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-3.c
@@ -0,0 +1,37 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" } */
+
+#include <omp.h>
+
+int main (void)
+{
+ omp_allocator_handle_t memspace, traits;
+ const omp_alloctrait_t mytraits[] = { { omp_atk_pinned, omp_atv_true },
+ { omp_atk_partition, omp_atv_nearest } };
+ #pragma omp target uses_allocators (memspace)
+ ;
+ #pragma omp target uses_allocators (traits)
+ ;
+ #pragma omp target uses_allocators (traits, memspace)
+ ;
+ #pragma omp target uses_allocators (traits (mytraits))
+ ;
+ #pragma omp target uses_allocators (memspace (mytraits), omp_default_mem_alloc)
+ ;
+ return 0;
+}
+
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(memspace: memspace\\(\\), traits\\(\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(traits: memspace\\(\\), traits\\(\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(memspace: memspace\\(\\), traits\\(\\)\\) uses_allocators\\(traits: memspace\\(\\), traits\\(\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(traits: memspace\\(\\), traits\\(mytraits\\)\\)" "original" } } */
+/* { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(memspace: memspace\\(\\), traits\\(mytraits\\)\\)" "original" } } */
+
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(memspace: memspace\\(\\), traits\\(\\)\\) private\\(memspace\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(traits: memspace\\(\\), traits\\(\\)\\) private\\(traits\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(memspace: memspace\\(\\), traits\\(\\)\\) uses_allocators\\(traits: memspace\\(\\), traits\\(\\)\\) private\\(traits\\) private\\(memspace\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(traits: memspace\\(\\), traits\\(mytraits\\)\\) private\\(traits\\)" "gimple" } } */
+/* { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(memspace: memspace\\(\\), traits\\(mytraits\\)\\) private\\(memspace\\)" "gimple" } } */
+
+/* { dg-final { scan-tree-dump-times "__builtin_omp_init_allocator" 6 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "__builtin_omp_destroy_allocator" 6 "gimple" } } */
diff --git a/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-4.c b/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-4.c
new file mode 100644
index 0000000..5942a0d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/uses_allocators-4.c
@@ -0,0 +1,53 @@
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#include <stdint.h>
+#include <omp.h>
+
+int
+main ()
+{
+ int x, *xbuf[10];
+ omp_allocator_handle_t my_alloc;
+ const omp_alloctrait_t trait[1]= {{omp_atk_alignment,128}};
+
+ #pragma omp target uses_allocators(omp_low_lat_mem_alloc) map(tofrom: x, xbuf) defaultmap(none)
+ #pragma omp parallel allocate(allocator(omp_low_lat_mem_alloc), align(128): x, xbuf) if(0) firstprivate(x, xbuf)
+ {
+ if ((uintptr_t) &x % 128 != 0)
+ __builtin_abort ();
+ if ((uintptr_t) xbuf % 128 != 0)
+ __builtin_abort ();
+ }
+
+ my_alloc = (omp_allocator_handle_t) 0xABCD;
+
+ #pragma omp target uses_allocators(traits(trait): my_alloc) defaultmap(none) map(tofrom: x, xbuf)
+ #pragma omp parallel allocate(allocator(my_alloc): x, xbuf) if(0) firstprivate(x, xbuf)
+ {
+ if ((uintptr_t) &x % 128 != 0)
+ __builtin_abort ();
+ if ((uintptr_t) xbuf % 128 != 0)
+ __builtin_abort ();
+ }
+
+ if (my_alloc != (omp_allocator_handle_t) 0xABCD)
+ __builtin_abort ();
+
+ /* The following creates an allocator with empty traits + default mem space. */
+ #pragma omp target uses_allocators(my_alloc) map(tofrom: x, xbuf) defaultmap(none)
+ #pragma omp parallel allocate(allocator(my_alloc), align(128): x, xbuf) if(0) firstprivate(x, xbuf)
+ {
+ if ((uintptr_t) &x % 128 != 0)
+ __builtin_abort ();
+ if ((uintptr_t) xbuf % 128 != 0)
+ __builtin_abort ();
+ }
+
+ if (my_alloc != (omp_allocator_handle_t) 0xABCD)
+ __builtin_abort ();
+
+ return 0;
+}
+
+/* { dg-final { scan-tree-dump-times "#pragma omp target .*private\\(my_alloc\\).*uses_allocators\\(my_alloc: memspace\\(\\), traits\\(trait\\)\\)" 1 "gimple" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp target .*private\\(my_alloc\\).*uses_allocators\\(my_alloc: memspace\\(\\), traits\\(\\)\\)" 1 "gimple" } } */
diff --git a/libgomp/testsuite/libgomp.c/alloc-pinned-1.c b/libgomp/testsuite/libgomp.c/alloc-pinned-1.c
index 672f245..693f903 100644
--- a/libgomp/testsuite/libgomp.c/alloc-pinned-1.c
+++ b/libgomp/testsuite/libgomp.c/alloc-pinned-1.c
@@ -2,6 +2,8 @@
/* { dg-skip-if "Pinning not implemented on this host" { ! *-*-linux-gnu* } } */
+/* { dg-additional-options -DOFFLOAD_DEVICE_NVPTX { target offload_device_nvptx } } */
+
/* Test that pinned memory works. */
#include <stdio.h>
@@ -63,10 +65,16 @@ verify0 (char *p, size_t s)
int
main ()
{
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* Go big or go home.
+ The OS ulimit does not affect memory locked via CUDA for NVPTX devices. */
+ const int SIZE = 40 * 1024 * 1024;
+#else
/* Allocate at least a page each time, allowing space for overhead,
but stay within the ulimit. */
const int SIZE = PAGE_SIZE - 128;
CHECK_SIZE (SIZE * 5); // This is intended to help diagnose failures
+#endif
const omp_alloctrait_t traits[] = {
{ omp_atk_pinned, 1 }
@@ -88,21 +96,39 @@ main ()
abort ();
int amount = get_pinned_mem ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (amount != 0)
+ abort ();
+#else
if (amount == 0)
abort ();
+#endif
p = omp_realloc (p, SIZE * 2, allocator, allocator);
int amount2 = get_pinned_mem ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (amount2 != 0)
+ abort ();
+#else
if (amount2 <= amount)
abort ();
+#endif
/* SIZE*2 ensures that it doesn't slot into the space possibly
vacated by realloc. */
p = omp_calloc (1, SIZE * 2, allocator);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (get_pinned_mem () != 0)
+ abort ();
+#else
if (get_pinned_mem () <= amount2)
abort ();
+#endif
verify0 (p, SIZE * 2);
diff --git a/libgomp/testsuite/libgomp.c/alloc-pinned-2.c b/libgomp/testsuite/libgomp.c/alloc-pinned-2.c
index b6d1d83..e7ac64e 100644
--- a/libgomp/testsuite/libgomp.c/alloc-pinned-2.c
+++ b/libgomp/testsuite/libgomp.c/alloc-pinned-2.c
@@ -2,6 +2,8 @@
/* { dg-skip-if "Pinning not implemented on this host" { ! *-*-linux-gnu* } } */
+/* { dg-additional-options -DOFFLOAD_DEVICE_NVPTX { target offload_device_nvptx } } */
+
/* Test that pinned memory works (pool_size code path). */
#include <stdio.h>
@@ -63,10 +65,16 @@ verify0 (char *p, size_t s)
int
main ()
{
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* Go big or go home.
+ The OS ulimit does not affect memory locked via CUDA for NVPTX devices. */
+ const int SIZE = 40 * 1024 * 1024;
+#else
/* Allocate at least a page each time, allowing space for overhead,
but stay within the ulimit. */
const int SIZE = PAGE_SIZE - 128;
CHECK_SIZE (SIZE * 5); // This is intended to help diagnose failures
+#endif
const omp_alloctrait_t traits[] = {
{ omp_atk_pinned, 1 },
@@ -89,16 +97,28 @@ main ()
abort ();
int amount = get_pinned_mem ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (amount != 0)
+ abort ();
+#else
if (amount == 0)
abort ();
+#endif
p = omp_realloc (p, SIZE * 2, allocator, allocator);
if (!p)
abort ();
int amount2 = get_pinned_mem ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (amount2 != 0)
+ abort ();
+#else
if (amount2 <= amount)
abort ();
+#endif
/* SIZE*2 ensures that it doesn't slot into the space possibly
vacated by realloc. */
@@ -106,8 +126,14 @@ main ()
if (!p)
abort ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (get_pinned_mem () != 0)
+ abort ();
+#else
if (get_pinned_mem () <= amount2)
abort ();
+#endif
verify0 (p, SIZE * 2);
diff --git a/libgomp/testsuite/libgomp.c/alloc-pinned-3.c b/libgomp/testsuite/libgomp.c/alloc-pinned-3.c
index 11dc818..250cb55 100644
--- a/libgomp/testsuite/libgomp.c/alloc-pinned-3.c
+++ b/libgomp/testsuite/libgomp.c/alloc-pinned-3.c
@@ -1,5 +1,7 @@
/* { dg-do run } */
+/* { dg-additional-options -DOFFLOAD_DEVICE_NVPTX { target offload_device_nvptx } } */
+
/* Test that pinned memory fails correctly. */
#include <stdio.h>
@@ -75,8 +77,15 @@ verify0 (char *p, size_t s)
int
main ()
{
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* Go big or go home.
+ The OS ulimit does not affect memory locked via CUDA for NVPTX devices. */
+ const int SIZE = 40 * 1024 * 1024;
+#else
/* This needs to be large enough to cover multiple pages. */
const int SIZE = PAGE_SIZE * 4;
+#endif
+ const int PIN_LIMIT = PAGE_SIZE * 2;
/* Pinned memory, no fallback. */
const omp_alloctrait_t traits1[] = {
@@ -101,23 +110,34 @@ main ()
#endif
/* Ensure that the limit is smaller than the allocation. */
- set_pin_limit (SIZE / 2);
+ set_pin_limit (PIN_LIMIT);
// Sanity check
if (get_pinned_mem () != 0)
abort ();
- // Should fail
void *p1 = omp_alloc (SIZE, allocator1);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'.
+ if (!p1)
+ abort ();
+#else
+ // Should fail
if (p1)
abort ();
+#endif
- // Should fail
void *p2 = omp_calloc (1, SIZE, allocator1);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'.
+ if (!p2)
+ abort ();
+#else
+ // Should fail
if (p2)
abort ();
+#endif
- // Should fall back
void *p3 = omp_alloc (SIZE, allocator2);
if (!p3)
abort ();
@@ -128,16 +148,29 @@ main ()
abort ();
verify0 (p4, SIZE);
- // Should fail to realloc
void *notpinned = omp_alloc (SIZE, omp_default_mem_alloc);
void *p5 = omp_realloc (notpinned, SIZE, allocator1, omp_default_mem_alloc);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'; does reallocate.
+ if (!notpinned || !p5 || p5 == notpinned)
+ abort ();
+#else
+ // Should fail to realloc
if (!notpinned || p5)
abort ();
+#endif
- // Should fall back to no realloc needed
+#ifdef OFFLOAD_DEVICE_NVPTX
+ void *p6 = omp_realloc (p5, SIZE, allocator2, allocator1);
+ // Does reallocate.
+ if (p5 == p6)
+ abort ();
+#else
void *p6 = omp_realloc (notpinned, SIZE, allocator2, omp_default_mem_alloc);
+ // Should fall back to no realloc needed
if (p6 != notpinned)
abort ();
+#endif
// No memory should have been pinned
int amount = get_pinned_mem ();
diff --git a/libgomp/testsuite/libgomp.c/alloc-pinned-4.c b/libgomp/testsuite/libgomp.c/alloc-pinned-4.c
index 2ecd01f..b7a9966 100644
--- a/libgomp/testsuite/libgomp.c/alloc-pinned-4.c
+++ b/libgomp/testsuite/libgomp.c/alloc-pinned-4.c
@@ -1,5 +1,7 @@
/* { dg-do run } */
+/* { dg-additional-options -DOFFLOAD_DEVICE_NVPTX { target offload_device_nvptx } } */
+
/* Test that pinned memory fails correctly, pool_size code path. */
#include <stdio.h>
@@ -75,8 +77,15 @@ verify0 (char *p, size_t s)
int
main ()
{
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* Go big or go home.
+ The OS ulimit does not affect memory locked via CUDA for NVPTX devices. */
+ const int SIZE = 40 * 1024 * 1024;
+#else
/* This needs to be large enough to cover multiple pages. */
const int SIZE = PAGE_SIZE * 4;
+#endif
+ const int PIN_LIMIT = PAGE_SIZE * 2;
/* Pinned memory, no fallback. */
const omp_alloctrait_t traits1[] = {
@@ -103,21 +112,33 @@ main ()
#endif
/* Ensure that the limit is smaller than the allocation. */
- set_pin_limit (SIZE / 2);
+ set_pin_limit (PIN_LIMIT);
// Sanity check
if (get_pinned_mem () != 0)
abort ();
- // Should fail
void *p = omp_alloc (SIZE, allocator1);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'.
+ if (!p)
+ abort ();
+#else
+ // Should fail
if (p)
abort ();
+#endif
- // Should fail
p = omp_calloc (1, SIZE, allocator1);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'.
+ if (!p)
+ abort ();
+#else
+ // Should fail
if (p)
abort ();
+#endif
// Should fall back
p = omp_alloc (SIZE, allocator2);
@@ -130,16 +151,29 @@ main ()
abort ();
verify0 (p, SIZE);
- // Should fail to realloc
void *notpinned = omp_alloc (SIZE, omp_default_mem_alloc);
p = omp_realloc (notpinned, SIZE, allocator1, omp_default_mem_alloc);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'; does reallocate.
+ if (!notpinned || !p || p == notpinned)
+ abort ();
+#else
+ // Should fail to realloc
if (!notpinned || p)
abort ();
+#endif
- // Should fall back to no realloc needed
+#ifdef OFFLOAD_DEVICE_NVPTX
+ void *p_ = omp_realloc (p, SIZE, allocator2, allocator1);
+ // Does reallocate.
+ if (p_ == p)
+ abort ();
+#else
p = omp_realloc (notpinned, SIZE, allocator2, omp_default_mem_alloc);
+ // Should fall back to no realloc needed
if (p != notpinned)
abort ();
+#endif
// No memory should have been pinned
int amount = get_pinned_mem ();
diff --git a/libgomp/testsuite/libgomp.c/alloc-pinned-5.c b/libgomp/testsuite/libgomp.c/alloc-pinned-5.c
index 0ba2feb..cc77764 100644
--- a/libgomp/testsuite/libgomp.c/alloc-pinned-5.c
+++ b/libgomp/testsuite/libgomp.c/alloc-pinned-5.c
@@ -2,6 +2,8 @@
/* { dg-skip-if "Pinning not implemented on this host" { ! *-*-linux-gnu* } } */
+/* { dg-additional-options -DOFFLOAD_DEVICE_NVPTX { target offload_device_nvptx } } */
+
/* Test that ompx_gnu_pinned_mem_alloc works. */
#include <stdio.h>
@@ -63,10 +65,16 @@ verify0 (char *p, size_t s)
int
main ()
{
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* Go big or go home.
+ The OS ulimit does not affect memory locked via CUDA for NVPTX devices. */
+ const int SIZE = 40 * 1024 * 1024;
+#else
/* Allocate at least a page each time, allowing space for overhead,
but stay within the ulimit. */
const int SIZE = PAGE_SIZE - 128;
CHECK_SIZE (SIZE * 5);
+#endif
// Sanity check
if (get_pinned_mem () != 0)
@@ -77,22 +85,40 @@ main ()
abort ();
int amount = get_pinned_mem ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (amount != 0)
+ abort ();
+#else
if (amount == 0)
abort ();
+#endif
p = omp_realloc (p, SIZE * 2, ompx_gnu_pinned_mem_alloc,
ompx_gnu_pinned_mem_alloc);
int amount2 = get_pinned_mem ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (amount2 != 0)
+ abort ();
+#else
if (amount2 <= amount)
abort ();
+#endif
/* SIZE*2 ensures that it doesn't slot into the space possibly
vacated by realloc. */
p = omp_calloc (1, SIZE * 2, ompx_gnu_pinned_mem_alloc);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (get_pinned_mem () != 0)
+ abort ();
+#else
if (get_pinned_mem () <= amount2)
abort ();
+#endif
verify0 (p, SIZE * 2);
diff --git a/libgomp/testsuite/libgomp.c/alloc-pinned-6.c b/libgomp/testsuite/libgomp.c/alloc-pinned-6.c
index 99f1269..6dd5544 100644
--- a/libgomp/testsuite/libgomp.c/alloc-pinned-6.c
+++ b/libgomp/testsuite/libgomp.c/alloc-pinned-6.c
@@ -1,4 +1,5 @@
/* { dg-do run } */
+/* { dg-additional-options -DOFFLOAD_DEVICE_NVPTX { target offload_device_nvptx } } */
/* Test that ompx_gnu_pinned_mem_alloc fails correctly. */
@@ -66,32 +67,57 @@ set_pin_limit (int size)
int
main ()
{
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* Go big or go home.
+ The OS ulimit does not affect memory locked via CUDA for NVPTX devices. */
+ const int SIZE = 40 * 1024 * 1024;
+#else
/* Allocate at least a page each time, but stay within the ulimit. */
const int SIZE = PAGE_SIZE * 4;
+#endif
+ const int PIN_LIMIT = PAGE_SIZE*2;
/* Ensure that the limit is smaller than the allocation. */
- set_pin_limit (SIZE / 2);
+ set_pin_limit (PIN_LIMIT);
// Sanity check
if (get_pinned_mem () != 0)
abort ();
- // Should fail
void *p = omp_alloc (SIZE, ompx_gnu_pinned_mem_alloc);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'.
+ if (!p)
+ abort ();
+#else
+ // Should fail
if (p)
abort ();
+#endif
- // Should fail
p = omp_calloc (1, SIZE, ompx_gnu_pinned_mem_alloc);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'.
+ if (!p)
+ abort ();
+#else
+ // Should fail
if (p)
abort ();
+#endif
- // Should fail to realloc
void *notpinned = omp_alloc (SIZE, omp_default_mem_alloc);
p = omp_realloc (notpinned, SIZE, ompx_gnu_pinned_mem_alloc,
omp_default_mem_alloc);
+#ifdef OFFLOAD_DEVICE_NVPTX
+ // Doesn't care about 'set_pin_limit'; does reallocate.
+ if (!notpinned || !p || p == notpinned)
+ abort ();
+#else
+ // Should fail to realloc
if (!notpinned || p)
abort ();
+#endif
// No memory should have been pinned
int amount = get_pinned_mem ();
diff --git a/libgomp/testsuite/libgomp.c/alloc-pinned-7.c b/libgomp/testsuite/libgomp.c/alloc-pinned-7.c
new file mode 100644
index 0000000..44652aa
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/alloc-pinned-7.c
@@ -0,0 +1,63 @@
+/* { dg-do run } */
+/* { dg-additional-options "-foffload-memory=pinned" } */
+
+/* { dg-skip-if "Pinning not implemented on this host" { ! *-*-linux-gnu* } } */
+
+/* Test that -foffload-memory=pinned works. */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef __linux__
+#include <sys/types.h>
+#include <unistd.h>
+
+#include <sys/mman.h>
+
+int
+get_pinned_mem ()
+{
+ int pid = getpid ();
+ char buf[100];
+ sprintf (buf, "/proc/%d/status", pid);
+
+ FILE *proc = fopen (buf, "r");
+ if (!proc)
+ abort ();
+ while (fgets (buf, 100, proc))
+ {
+ int val;
+ if (sscanf (buf, "VmLck: %d", &val))
+ {
+ fclose (proc);
+ return val;
+ }
+ }
+ abort ();
+}
+#else
+int
+get_pinned_mem ()
+{
+ return 0;
+}
+
+#define mlockall(...) 0
+#endif
+
+#include <omp.h>
+
+int
+main ()
+{
+ // Sanity check
+ if (get_pinned_mem () == 0)
+ {
+ /* -foffload-memory=pinned has failed, but maybe that's because
+ isufficient pinned memory was available. */
+ if (mlockall (MCL_CURRENT | MCL_FUTURE) == 0)
+ abort ();
+ }
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/alloc-pinned-8.c b/libgomp/testsuite/libgomp.c/alloc-pinned-8.c
new file mode 100644
index 0000000..0fc737b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/alloc-pinned-8.c
@@ -0,0 +1,122 @@
+/* { dg-do run } */
+
+/* { dg-skip-if "Pinning not implemented on this host" { ! *-*-linux-gnu* } } */
+
+/* { dg-additional-options -DOFFLOAD_DEVICE_NVPTX { target offload_device_nvptx } } */
+
+/* Test that pinned memory works for small allocations. */
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef __linux__
+#include <sys/types.h>
+#include <unistd.h>
+
+#include <sys/mman.h>
+#include <sys/resource.h>
+
+#define PAGE_SIZE sysconf(_SC_PAGESIZE)
+#define CHECK_SIZE(SIZE) { \
+ struct rlimit limit; \
+ if (getrlimit (RLIMIT_MEMLOCK, &limit) \
+ || limit.rlim_cur <= SIZE) \
+ fprintf (stderr, "insufficient lockable memory; please increase ulimit\n"); \
+ }
+
+int
+get_pinned_mem ()
+{
+ int pid = getpid ();
+ char buf[100];
+ sprintf (buf, "/proc/%d/status", pid);
+
+ FILE *proc = fopen (buf, "r");
+ if (!proc)
+ abort ();
+ while (fgets (buf, 100, proc))
+ {
+ int val;
+ if (sscanf (buf, "VmLck: %d", &val))
+ {
+ fclose (proc);
+ return val;
+ }
+ }
+ abort ();
+}
+#else
+#error "OS unsupported"
+#endif
+
+static void
+verify0 (char *p, size_t s)
+{
+ for (size_t i = 0; i < s; ++i)
+ if (p[i] != 0)
+ abort ();
+}
+
+#include <omp.h>
+
+int
+main ()
+{
+ /* Choose a small size where all our allocations fit on one page. */
+ const int SIZE = 10;
+#ifndef OFFLOAD_DEVICE_NVPTX
+ CHECK_SIZE (SIZE*4);
+#endif
+
+ const omp_alloctrait_t traits[] = {
+ { omp_atk_pinned, 1 }
+ };
+ omp_allocator_handle_t allocator = omp_init_allocator (omp_default_mem_space, 1, traits);
+
+ // Sanity check
+ if (get_pinned_mem () != 0)
+ abort ();
+
+ void *p = omp_alloc (SIZE, allocator);
+ if (!p)
+ abort ();
+
+ int amount = get_pinned_mem ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (amount != 0)
+ abort ();
+#else
+ if (amount == 0)
+ abort ();
+#endif
+
+ p = omp_realloc (p, SIZE * 2, allocator, allocator);
+
+ int amount2 = get_pinned_mem ();
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (amount2 != 0)
+ abort ();
+#else
+ /* A small allocation should not allocate another page. */
+ if (amount2 != amount)
+ abort ();
+#endif
+
+ p = omp_calloc (1, SIZE, allocator);
+
+#ifdef OFFLOAD_DEVICE_NVPTX
+ /* This doesn't show up as process 'VmLck'ed memory. */
+ if (get_pinned_mem () != 0)
+ abort ();
+#else
+ /* A small allocation should not allocate another page. */
+ if (get_pinned_mem () != amount2)
+ abort ();
+#endif
+
+ verify0 (p, SIZE);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/array-shaping-1.c b/libgomp/testsuite/libgomp.c/array-shaping-1.c
new file mode 100644
index 0000000..808c5f9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/array-shaping-1.c
@@ -0,0 +1,236 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <string.h>
+#include <assert.h>
+#include <stdlib.h>
+
+volatile int yy = 4, zz = 2, str_str = 2;
+
+int main()
+{
+ int *arr;
+ int x = 5;
+ int arr2d[10][10];
+
+ arr = calloc (100, sizeof (int));
+
+ /* Update whole reshaped array. */
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < x; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i ^ j;
+
+#pragma omp target update to(([10][x]) arr)
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j < x)
+ assert (arr[j * 10 + i] == i ^ j);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Strided update. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ arr[j * 5 + i] = i + j;
+
+#pragma omp target update to(([5][5]) arr[0:3][0:3:2])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ if (j < 3 && (i & 1) == 0 && i < 6)
+ assert (arr[j * 5 + i] == i + j);
+ else
+ assert (arr[j * 5 + i] == 0);
+
+
+ /* Reshaped update, contiguous. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ arr[j * 5 + i] = 2 * j + i;
+
+#pragma omp target update to(([5][5]) arr[0:5][0:5])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 20; j++)
+ for (int i = 0; i < 5; i++)
+ if (j < 5 && i < 5)
+ assert (arr[j * 5 + i] == 2 * j + i);
+ else
+ assert (arr[j * 5 + i] == 0);
+
+
+ /* Strided update on actual array. */
+
+ memset (arr2d, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr2d)
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr2d[j][i] = j + 2 * i;
+
+#pragma omp target update to(arr2d[0:5:2][5:2])
+
+#pragma omp target exit data map(from: arr2d)
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if ((j & 1) == 0 && i >= 5 && i < 7)
+ assert (arr2d[j][i] == j + 2 * i);
+ else
+ assert (arr2d[j][i] == 0);
+
+
+ /* Update with non-constant bounds. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = (2 * j) ^ i;
+
+ x = 3;
+ int y = yy, z = zz, str = str_str;
+ /* This is actually [0:3:2] [4:2:2]. */
+#pragma omp target update to(([10][10]) arr[0:x:2][y:z:str])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if ((j & 1) == 0 && j < 6 && (i & 1) == 0 && i >= 4 && i < 8)
+ assert (arr[j * 10 + i] == (2 * j) ^ i);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Update with full "major" dimension. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = i + j;
+
+#pragma omp target update to(([10][10]) arr[0:10][3:1])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (i == 3)
+ assert (arr[j * 10 + i] == i + j);
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Update with full "minor" dimension. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = 3 * (i + j);
+
+#pragma omp target update to(([10][10]) arr[3:2][0:10])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5)
+ assert (arr[j * 10 + i] == 3 * (i + j));
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* Rectangle update. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ arr[j * 10 + i] = 5 * (i + j);
+
+#pragma omp target update to(([10][10]) arr[3:2][0:9])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int j = 0; j < 10; j++)
+ for (int i = 0; i < 10; i++)
+ if (j >= 3 && j < 5 && i < 9)
+ assert (arr[j * 10 + i] == 5 * (i + j));
+ else
+ assert (arr[j * 10 + i] == 0);
+
+
+ /* One-dimensional strided update. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ arr[i] = i + 99;
+
+#pragma omp target update to(([100]) arr[3:33:3])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ if (i >= 3 && ((i - 3) % 3) == 0)
+ assert (arr[i] == i + 99);
+ else
+ assert (arr[i] == 0);
+
+
+ /* One-dimensional strided update without explicit array shape. */
+
+ memset (arr, 0, 100 * sizeof (int));
+
+#pragma omp target enter data map(to: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ arr[i] = i + 121;
+
+#pragma omp target update to(arr[3:33:3])
+
+#pragma omp target exit data map(from: arr[:100])
+
+ for (int i = 0; i < 100; i++)
+ if (i >= 3 && ((i - 3) % 3) == 0)
+ assert (arr[i] == i + 121);
+ else
+ assert (arr[i] == 0);
+
+ free (arr);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/array-shaping-2.c b/libgomp/testsuite/libgomp.c/array-shaping-2.c
new file mode 100644
index 0000000..42a6e0c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/array-shaping-2.c
@@ -0,0 +1,39 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <stdlib.h>
+
+typedef struct {
+ int *aptr;
+} C;
+
+int main()
+{
+ C cvar;
+
+ cvar.aptr = calloc (100, sizeof (float));
+
+#pragma omp target enter data map(to: cvar.aptr, cvar.aptr[:100])
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ cvar.aptr[i * 10 + j] = i + j;
+ }
+
+#pragma omp target update from(([10][10]) cvar.aptr[4:3][4:3])
+
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ if (i >= 4 && i < 7 && j >= 4 && j < 7)
+ assert (cvar.aptr[i * 10 + j] == i + j);
+ else
+ assert (cvar.aptr[i * 10 + j] == 0);
+
+#pragma omp target exit data map(delete: cvar.aptr, cvar.aptr[:100])
+
+ free (cvar.aptr);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/array-shaping-3.c b/libgomp/testsuite/libgomp.c/array-shaping-3.c
new file mode 100644
index 0000000..5dda2e3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/array-shaping-3.c
@@ -0,0 +1,42 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define N 10
+
+typedef struct {
+ int arr[N][N];
+} B;
+
+int main()
+{
+ B *bvar = malloc (sizeof (B));
+
+ memset (bvar, 0, sizeof (B));
+
+#pragma omp target enter data map(to: bvar->arr)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ bvar->arr[i][j] = i + j;
+ }
+
+#pragma omp target update from(bvar->arr[4:3][4:3])
+
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ if (i >= 4 && i < 7 && j >= 4 && j < 7)
+ assert (bvar->arr[i][j] == i + j);
+ else
+ assert (bvar->arr[i][j] == 0);
+
+#pragma omp target exit data map(delete: bvar->arr)
+
+ free (bvar);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/array-shaping-4.c b/libgomp/testsuite/libgomp.c/array-shaping-4.c
new file mode 100644
index 0000000..2b9e694
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/array-shaping-4.c
@@ -0,0 +1,36 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+#define N 10
+
+int main ()
+{
+ int iarr[N * N];
+
+ memset (iarr, 0, N * N * sizeof (int));
+
+#pragma omp target enter data map(to: iarr)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ iarr[i * 10 + j] = i + j;
+ }
+
+ /* An array, but cast to a pointer, then reshaped. */
+#pragma omp target update from(([10][10]) ((int *) &iarr[0])[4:3][4:3])
+
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ if (i >= 4 && i < 7 && j >= 4 && j < 7)
+ assert (iarr[i * 10 + j] == i + j);
+ else
+ assert (iarr[i * 10 + j] == 0);
+
+#pragma omp target exit data map(delete: iarr)
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/array-shaping-5.c b/libgomp/testsuite/libgomp.c/array-shaping-5.c
new file mode 100644
index 0000000..1034682
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/array-shaping-5.c
@@ -0,0 +1,38 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <string.h>
+
+#define N 10
+
+int main ()
+{
+ int iarr_real[N * N];
+ int *iarrp = &iarr_real[0];
+ int **iarrpp = &iarrp;
+
+ memset (iarrp, 0, N * N * sizeof (int));
+
+#pragma omp target enter data map(to: iarr_real)
+
+#pragma omp target
+ {
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ iarrp[i * 10 + j] = i + j;
+ }
+
+ /* A pointer with an extra indirection. */
+#pragma omp target update from(([10][10]) (*iarrpp)[4:3][4:3])
+
+ for (int i = 0; i < 10; i++)
+ for (int j = 0; j < 10; j++)
+ if (i >= 4 && i < 7 && j >= 4 && j < 7)
+ assert (iarrp[i * 10 + j] == i + j);
+ else
+ assert (iarrp[i * 10 + j] == 0);
+
+#pragma omp target exit data map(delete: iarr_real)
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/array-shaping-6.c b/libgomp/testsuite/libgomp.c/array-shaping-6.c
new file mode 100644
index 0000000..5938823
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/array-shaping-6.c
@@ -0,0 +1,45 @@
+// { dg-do run { target offload_device_nonshared_as } }
+
+#include <assert.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define N 10
+
+int main ()
+{
+ int *iptr = calloc (N * N * N, sizeof (int));
+
+#pragma omp target enter data map(to: iptr[0:N*N*N])
+
+#pragma omp target
+ {
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ iptr[i * N * N + 4 * N + j] = i + j;
+ }
+
+ /* An array ref between two array sections. */
+#pragma omp target update from(([N][N][N]) iptr[2:3][4][6:3])
+
+ for (int i = 2; i < 5; i++)
+ for (int j = 6; j < 9; j++)
+ assert (iptr[i * N * N + 4 * N + j] == i + j);
+
+ memset (iptr, 0, N * N * N * sizeof (int));
+
+ for (int i = 0; i < N; i++)
+ iptr[2 * N * N + i * N + 4] = 3 * i;
+
+ /* Array section between two array refs. */
+#pragma omp target update to(([N][N][N]) iptr[2][3:6][4])
+
+#pragma omp target exit data map(from: iptr[0:N*N*N])
+
+ for (int i = 3; i < 9; i++)
+ assert (iptr[2 * N * N + i * N + 4] == 3 * i);
+
+ free (iptr);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/c.exp b/libgomp/testsuite/libgomp.c/c.exp
index aae2824..4b59957 100644
--- a/libgomp/testsuite/libgomp.c/c.exp
+++ b/libgomp/testsuite/libgomp.c/c.exp
@@ -3,6 +3,14 @@ load_gcc_lib gcc-dg.exp
lappend ALWAYS_CFLAGS "compiler=$GCC_UNDER_TEST"
+proc check_effective_target_c { } {
+ return 1
+}
+
+proc check_effective_target_c++ { } {
+ return 0
+}
+
# If a testcase doesn't have special options, use these.
if ![info exists DEFAULT_CFLAGS] then {
set DEFAULT_CFLAGS "-O2"
diff --git a/libgomp/testsuite/libgomp.c/reverse-offload-threads-1.c b/libgomp/testsuite/libgomp.c/reverse-offload-threads-1.c
new file mode 100644
index 0000000..fa74a8e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/reverse-offload-threads-1.c
@@ -0,0 +1,26 @@
+/* { dg-do run } */
+/* { dg-additional-options "-foffload-options=nvptx-none=-misa=sm_35" { target { offload_target_nvptx } } } */
+
+/* Test that the reverse offload message buffers can cope with a lot of
+ requests. */
+
+#pragma omp requires reverse_offload
+
+int main ()
+{
+ #pragma omp target teams distribute parallel for collapse(2)
+ for (int i=0; i < 100; i++)
+ for (int j=0; j < 16; j++)
+ {
+ int val = 0;
+ #pragma omp target device ( ancestor:1 ) firstprivate(i,j) map(from:val)
+ {
+ val = i + j;
+ }
+
+ if (val != i + j)
+ __builtin_abort ();
+ }
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c/reverse-offload-threads-2.c b/libgomp/testsuite/libgomp.c/reverse-offload-threads-2.c
new file mode 100644
index 0000000..05a2571
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/reverse-offload-threads-2.c
@@ -0,0 +1,31 @@
+/* { dg-do run } */
+/* { dg-additional-options "-foffload-options=nvptx-none=-misa=sm_35" { target { offload_target_nvptx } } } */
+
+/* Test that the reverse offload message buffers can cope with multiple
+ requests from multiple kernels. */
+
+#pragma omp requires reverse_offload
+
+int main ()
+{
+ for (int n=0; n < 5; n++)
+ {
+ #pragma omp target teams distribute parallel for nowait collapse(2)
+ for (int i=0; i < 32; i++)
+ for (int j=0; j < 16; j++)
+ {
+ int val = 0;
+ #pragma omp target device ( ancestor:1 ) firstprivate(i,j) map(from:val)
+ {
+ val = i + j;
+ }
+
+ if (val != i + j)
+ __builtin_abort ();
+ }
+ }
+
+#pragma omp taskwait
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.fortran/adjust-args-array-descriptor.f90 b/libgomp/testsuite/libgomp.fortran/adjust-args-array-descriptor.f90
new file mode 100644
index 0000000..dd9b57b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/adjust-args-array-descriptor.f90
@@ -0,0 +1,89 @@
+! Test array descriptor handling with the need_device_addr modifier to adjust_args
+
+module m
+ use iso_c_binding
+ implicit none (type, external)
+
+ integer :: case = 0
+contains
+ subroutine var_array_alloc(x)
+ integer, allocatable :: x(:)
+ !$omp target has_device_addr(x)
+ block
+ if (size(x) /= 3) stop 1
+ if (any (x /= [1,2,3])) stop 2
+ x = x * (-1)
+ end block
+ end
+
+ subroutine base_array_alloc(x)
+ !$omp declare variant(var_array_alloc) match(construct={dispatch}) adjust_args(need_device_addr : x)
+ integer, allocatable :: x(:)
+ error stop
+ end
+
+ subroutine var_array_nonalloc(x)
+ integer :: x(:)
+ !$omp target has_device_addr(x)
+ block
+ if (size(x) /= 4) stop 3
+ if (any (x /= [11,22,33,44])) stop 4
+ x = x * (-1)
+ end block
+ end
+
+ subroutine base_array_nonalloc(x)
+ !$omp declare variant(var_array_nonalloc) match(construct={dispatch}) adjust_args(need_device_addr : x)
+ integer :: x(:)
+ error stop
+ end
+
+ subroutine test_array_alloc(y)
+ integer, allocatable :: y(:)
+ !$omp target enter data map(y)
+
+
+ ! Direct call (for testing; value check fails if both are enabled
+ ! !$omp target data use_device_addr(y)
+ ! call var_array_alloc (y)
+ ! !$omp end target data
+
+ !$omp dispatch
+ call base_array_alloc (y)
+
+ !$omp target exit data map(y)
+
+ if (size(y) /= 3) stop 3
+ if (any (y /= [-1,-2,-3])) stop 1
+ end
+
+ subroutine test_array_nonalloc()
+ integer :: y(4)
+ y = [11,22,33,44]
+
+ !$omp target enter data map(y)
+
+ ! Direct call (for testing; value check fails if both are enabled
+ !!$omp target data use_device_addr(y)
+ ! call var_array_nonalloc (y)
+ !!$omp end target data
+
+ !$omp dispatch
+ call base_array_nonalloc (y)
+
+ !$omp target exit data map(y)
+
+ if (size(y) /= 4) stop 3
+ if (any (y /= [-11,-22,-33,-44])) stop 1
+ end
+end module
+
+use m
+implicit none
+integer, allocatable :: z(:)
+
+z = [1,2,3]
+call test_array_alloc(z)
+call test_array_nonalloc()
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90 b/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
new file mode 100644
index 0000000..120236a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
@@ -0,0 +1,61 @@
+implicit none
+integer, parameter :: N = 16
+type t
+ integer, allocatable :: a, b(:)
+end type t
+type(t) :: x(N), y(N), z(N)
+integer :: i, j
+integer :: lo = 3, hi = N
+
+!$omp target map(iterator (it=1:N), to: x(it))
+ do i = 1, N
+ if (allocated(x(i)%a)) stop 1
+ if (allocated(x(i)%b)) stop 2
+ end do
+!$omp end target
+
+do i = 1, N
+ allocate(x(i)%a, x(i)%b(-4:6))
+ x(i)%b(:) = [(i, i=-4,6)]
+end do
+
+!$omp target map(iterator (it=2:N), to: x(it))
+ do i = 2, N
+ if (.not. allocated(x(i)%a)) stop 3
+ if (.not. allocated(x(i)%b)) stop 4
+ if (lbound(x(i)%b,1) /= -4) stop 5
+ if (ubound(x(i)%b,1) /= 6) stop 6
+ if (any (x(i)%b /= [(i, i=-4,6)])) stop 7
+ end do
+!$omp end target
+
+!$omp target enter data map(iterator (it=3:N), to: y(it), z(it))
+
+!$omp target map(iterator (it=3:N), to: y(it), z(it))
+ do i = 3, N
+ if (allocated(y(i)%b)) stop 8
+ if (allocated(z(i)%b)) stop 9
+ end do
+!$omp end target
+
+do i = 1, N
+ allocate(y(i)%b(5), z(i)%b(3))
+ y(i)%b = 42
+ z(i)%b = 99
+end do
+
+!$omp target map(iterator (it=3:N), to: y(it))
+ do i = 3, N
+ if (.not.allocated(y(i)%b)) stop 10
+ if (any (y(i)%b /= 42)) stop 11
+ end do
+!$omp end target
+
+!$omp target map(iterator (it=lo:hi), always, tofrom: z(it))
+ do i = 3, N
+ if (.not.allocated(z(i)%b)) stop 12
+ if (any (z(i)%b /= 99)) stop 13
+ end do
+!$omp end target
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/collapse5.f90 b/libgomp/testsuite/libgomp.fortran/collapse5.f90
new file mode 100644
index 0000000..5632d9b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/collapse5.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+
+program collapse5
+ implicit none
+
+ integer :: i, j
+ integer :: count = 0
+
+ !$omp parallel do collapse (2)
+ do i = 1, 80000
+ do j = 1, 80000
+ if (i .eq. 66666 .and. j .eq. 77777) then
+ ! In the collapsed loop space, this is iteration
+ ! 66666*80000+77777==5,333,357,777. If the type of the iterator
+ ! for the collapsed loop is only a 32-bit unsigned int, then this
+ ! iteration will exceed its maximum range and be skipped.
+ count = count + 1
+ end if
+ end do
+ end do
+
+ if (count .ne. 1) stop 1
+end
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90
new file mode 100644
index 0000000..801becc
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-10.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t), dimension (:), pointer :: tarr
+end type u
+
+type(u) :: myu
+type(t), dimension (12), target :: myarray
+
+!$omp declare mapper (t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(to: x%tarr) map(x%tarr(1))
+
+myu%tarr => myarray
+
+myu%tarr(1)%arr1(1) = 1
+
+! We can't do this: we have a mapper for "t" elements, and this implicitly maps
+! the whole array.
+!!$omp target map(tofrom:myu%tarr)
+!myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1
+!!$omp end target
+
+! ...but we can do this, because we're just mapping an element of the "t"
+! array. We still need to map the actual "myu%tarr" descriptor.
+!$omp target map(to:myu%tarr) map(myu%tarr(1)%arr1(1:4))
+myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1
+!$omp end target
+
+if (myu%tarr(1)%arr1(1).ne.3) stop 1
+
+end program myprog
+
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90
new file mode 100644
index 0000000..0fc424a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-11.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t) :: t_elem
+end type u
+
+type(u) :: myu
+
+!$omp declare mapper (t :: x) map(x%arr1(5:8))
+!$omp declare mapper (tmapper: t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(mapper(tmapper), tofrom: x%t_elem)
+
+myu%t_elem%arr1(1) = 1
+myu%t_elem%arr1(5) = 1
+
+! Different ways of invoking nested mappers, named vs. unnamed
+
+!$omp target map(tofrom:myu%t_elem)
+myu%t_elem%arr1(5) = myu%t_elem%arr1(5) + 1
+!$omp end target
+
+!$omp target map(tofrom:myu)
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+if (myu%t_elem%arr1(1).ne.3) stop 1
+if (myu%t_elem%arr1(5).ne.2) stop 2
+
+end program myprog
+
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90
new file mode 100644
index 0000000..a475501
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-12.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t) :: t_elem
+end type u
+
+type(u) :: myu
+
+!$omp declare mapper (tmapper: t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(mapper(tmapper), tofrom: x%t_elem)
+
+myu%t_elem%arr1(1) = 1
+
+!$omp target map(tofrom:myu%t_elem)
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+!$omp target map(tofrom:myu)
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myu%t_elem%arr1(1) = myu%t_elem%arr1(1) + 1
+!$omp end target
+
+if (myu%t_elem%arr1(1).ne.4) stop 1
+
+end program myprog
+
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90
new file mode 100644
index 0000000..3cae0fe
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-13.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+
+module mymod
+type S
+integer :: a
+integer :: b
+integer :: c
+end type S
+
+!$omp declare mapper (S :: x) map(x%c)
+end module mymod
+
+program myprog
+use mymod
+type T
+integer :: a
+integer :: b
+integer :: c
+end type T
+
+type(S) :: mys
+type(T) :: myt
+
+!$omp declare mapper (T :: x) map(x%b)
+
+myt%a = 0
+myt%b = 0
+myt%c = 0
+mys%a = 0
+mys%b = 0
+mys%c = 0
+
+!$omp target
+myt%b = myt%b + 1
+!$omp end target
+
+!$omp target
+mys%c = mys%c + 1
+!$omp end target
+
+!$omp target
+myt%b = myt%b + 2
+mys%c = mys%c + 3
+!$omp end target
+
+if (myt%b.ne.3) stop 1
+if (mys%c.ne.4) stop 2
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90
new file mode 100644
index 0000000..eb0dd5f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-15.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+program myprog
+
+type A
+character(len=20) :: string1
+character(len=:), pointer :: string2
+end type A
+
+!$omp declare mapper (A :: x) map(to:x%string1) map(from:x%string2)
+
+type(A) :: var
+
+allocate(character(len=20) :: var%string2)
+
+var%string1 = "hello world"
+
+!$omp target map(to:var%string1) map(from:var%string2)
+var%string2 = var%string1
+!$omp end target
+
+if (var%string2.ne."hello world") stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90
new file mode 100644
index 0000000..c215971
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-17.f90
@@ -0,0 +1,92 @@
+! { dg-do run }
+
+program myprog
+
+type A
+integer :: x
+integer :: y(20)
+integer, dimension(:), pointer :: z
+end type A
+
+integer, target :: arr1(20), arr2(20)
+type(A) :: p, q
+
+p%y = 0
+q%y = 0
+
+p%z => arr1
+q%z => arr2
+
+call mysub (p, q)
+
+if (p%z(1).ne.1) stop 1
+if (q%z(1).ne.1) stop 2
+
+p%y = 0
+q%y = 0
+p%z = 0
+q%z = 0
+
+call mysub2 (p, q)
+
+if (p%z(1).ne.1) stop 3
+if (q%z(1).ne.1) stop 4
+
+p%y = 0
+q%y = 0
+p%z = 0
+q%z = 0
+
+call mysub3 (p, q)
+
+if (p%z(1).ne.1) stop 5
+if (q%z(1).ne.1) stop 6
+
+contains
+
+subroutine mysub(arg1, arg2)
+implicit none
+type(A), intent(inout) :: arg1
+type(A), intent(inout) :: arg2
+
+!$omp declare mapper (A :: x) map(always, to:x) map(tofrom:x%z(:))
+
+!$omp target
+arg1%y(1) = arg1%y(1) + 1
+arg1%z = arg1%y
+arg2%y(1) = arg2%y(1) + 1
+arg2%z = arg2%y
+!$omp end target
+end subroutine mysub
+
+subroutine mysub2(arg1, arg2)
+implicit none
+type(A), intent(inout) :: arg1
+type(A), intent(inout) :: arg2
+
+!$omp declare mapper (A :: x) map(to:x) map(from:x%z(:))
+
+!$omp target
+arg1%y(1) = arg1%y(1) + 1
+arg1%z = arg1%y
+arg2%y(1) = arg2%y(1) + 1
+arg2%z = arg2%y
+!$omp end target
+end subroutine mysub2
+
+subroutine mysub3(arg1, arg2)
+implicit none
+type(A), intent(inout) :: arg1
+type(A), intent(inout) :: arg2
+
+!$omp declare mapper (A :: x) map(to:x) map(from:x%z(:))
+
+!$omp target map(arg1, arg2)
+arg1%y(1) = arg1%y(1) + 1
+arg1%z = arg1%y
+arg2%y(1) = arg2%y(1) + 1
+arg2%z = arg2%y
+!$omp end target
+end subroutine mysub3
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90
new file mode 100644
index 0000000..a333b68
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-18.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+
+module mymod
+type F
+integer :: a, b, c
+integer, dimension(10) :: d
+end type F
+
+type G
+integer :: x, y
+type(F), pointer :: myf
+integer :: z
+end type G
+
+! Check that nested mappers work inside modules.
+
+!$omp declare mapper (F :: f) map(to: f%b) map(f%d)
+!$omp declare mapper (G :: g) map(tofrom: g%myf)
+
+end module mymod
+
+program myprog
+use mymod
+
+type(F), target :: ftmp
+type(G) :: gvar
+
+gvar%myf => ftmp
+
+gvar%myf%d = 0
+
+!$omp target map(gvar%myf)
+gvar%myf%d(1) = gvar%myf%d(1) + 1
+!$omp end target
+
+!$omp target map(gvar)
+gvar%myf%d(1) = gvar%myf%d(1) + 1
+!$omp end target
+
+!$omp target
+gvar%myf%d(1) = gvar%myf%d(1) + 1
+!$omp end target
+
+if (gvar%myf%d(1).ne.3) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90
new file mode 100644
index 0000000..d864975
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-19.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program myprog
+type F
+integer :: a, b, c
+integer, dimension(10) :: d
+end type F
+
+type(F), pointer :: myf
+
+!$omp declare mapper (F :: f) map(f%d)
+
+allocate(myf)
+
+myf%d = 0
+
+!$omp target map(myf)
+myf%d(1) = myf%d(1) + 1
+!$omp end target
+
+!$omp target
+myf%d(1) = myf%d(1) + 1
+!$omp end target
+
+if (myf%d(1).ne.2) stop 1
+
+deallocate(myf)
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90
new file mode 100644
index 0000000..ec1c0ec
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+program myprog
+type s
+ integer :: c
+ integer :: d(99)
+end type s
+
+type t
+ type(s) :: mys
+end type t
+
+type u
+ type(t) :: myt
+end type u
+
+type(u) :: myu
+
+!$omp declare mapper (t :: x) map(tofrom: x%mys%c) map(x%mys%d(1:x%mys%c))
+
+myu%myt%mys%c = 1
+myu%myt%mys%d = 0
+
+!$omp target map(tofrom: myu%myt)
+myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1
+myu%myt%mys%c = myu%myt%mys%c + 2
+!$omp end target
+
+if (myu%myt%mys%d(1).ne.1) stop 1
+if (myu%myt%mys%c.ne.3) stop 2
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90
new file mode 100644
index 0000000..2068828
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-20.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program myprog
+type F
+integer :: a, b, c
+integer, dimension(10) :: d
+end type F
+
+type(F), allocatable :: myf
+
+!$omp declare mapper (F :: f) map(f)
+
+allocate(myf)
+
+myf%d = 0
+
+!$omp target map(myf)
+myf%d(1) = myf%d(1) + 1
+!$omp end target
+
+!$omp target
+myf%d(1) = myf%d(1) + 1
+!$omp end target
+
+if (myf%d(1).ne.2) stop 1
+
+deallocate(myf)
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-21.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-21.f90
new file mode 100644
index 0000000..4b8db8b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-21.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+program myprog
+
+type A
+character(len=20) :: string1
+character(len=:), allocatable :: string2
+end type A
+
+!$omp declare mapper (A :: x) map(to:x%string1) map(from:x%string2)
+
+type(A) :: var
+
+allocate(character(len=20) :: var%string2)
+
+var%string1 = "hello world"
+
+!$omp target
+var%string2 = var%string1
+!$omp end target
+
+if (var%string2.ne."hello world") stop 1
+
+end program myprog
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 0000000..dc1f527
--- /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 0000000..6561dec
--- /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
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90
new file mode 100644
index 0000000..517096d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-3.f90
@@ -0,0 +1,33 @@
+program myprog
+type s
+ integer :: c
+ integer :: d(99)
+end type s
+
+type t
+ type(s) :: mys
+end type t
+
+type u
+ type(t) :: myt
+end type u
+
+type(u) :: myu
+
+!$omp declare mapper (s :: x) map(tofrom: x%c, x%d(1:x%c))
+!$omp declare mapper (t :: x) map(tofrom: x%mys)
+!$omp declare mapper (u :: x) map(tofrom: x%myt)
+
+myu%myt%mys%c = 1
+myu%myt%mys%d = 0
+
+! Nested mappers.
+
+!$omp target map(tofrom: myu)
+myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1
+!$omp end target
+
+if (myu%myt%mys%c.ne.1) stop 1
+if (myu%myt%mys%d(1).ne.1) stop 2
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90
new file mode 100644
index 0000000..bfac28c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+type t
+integer :: x, y
+integer, allocatable :: arr(:)
+end type t
+
+!$omp declare mapper (t :: x) map(x%arr)
+
+type(t) :: var
+
+allocate(var%arr(1:20))
+
+var%arr = 0
+
+! The mapper named literally 'default' should be the default mapper, i.e.
+! the same as the unnamed mapper defined above.
+!$omp target map(mapper(default), tofrom: var)
+var%arr(5) = 5
+!$omp end target
+
+if (var%arr(5).ne.5) stop 1
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90
new file mode 100644
index 0000000..266845f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+
+program myprog
+type s
+ integer :: c
+ integer, allocatable :: d(:)
+end type s
+
+type t
+ type(s) :: mys
+end type t
+
+type u
+ type(t) :: myt
+end type u
+
+type(u) :: myu
+
+! Here, the mappers are declared out of order, but earlier ones can still
+! trigger mappers defined later. Implementation-wise, this happens during
+! resolution, but from the user perspective it appears to happen at
+! instantiation time -- at which point all mappers are visible. I think
+! that makes sense.
+!$omp declare mapper (u :: x) map(tofrom: x%myt)
+!$omp declare mapper (t :: x) map(tofrom: x%mys)
+!$omp declare mapper (s :: x) map(tofrom: x%c, x%d(1:x%c))
+
+allocate(myu%myt%mys%d(1:20))
+
+myu%myt%mys%c = 1
+myu%myt%mys%d = 0
+
+!$omp target map(tofrom: myu)
+myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1
+!$omp end target
+
+! Note: we only mapped the first element of the array 'd'.
+if (myu%myt%mys%d(1).ne.1) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90
new file mode 100644
index 0000000..9ebf8da
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-6.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+
+program myprog
+type bounds
+ integer :: lo
+ integer :: hi
+end type bounds
+
+integer, allocatable :: myarr(:)
+type(bounds) :: b
+
+! Use the placeholder variable, but not at the top level.
+!$omp declare mapper (bounds :: x) map(tofrom: myarr(x%lo:x%hi))
+
+allocate (myarr(1:100))
+
+b%lo = 4
+b%hi = 6
+
+myarr = 0
+
+!$omp target map(tofrom: b)
+myarr(5) = myarr(5) + 1
+!$omp end target
+
+if (myarr(5).ne.1) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90
new file mode 100644
index 0000000..6297c8e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-7.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program myprog
+type s
+ integer :: a
+ integer :: b
+end type s
+
+type t
+ type(s) :: mys
+end type t
+
+type(t) :: myt
+
+! Identity mapper
+
+!$omp declare mapper (s :: x) map(tofrom: x)
+!$omp declare mapper (t :: x) map(tofrom: x%mys)
+
+myt%mys%a = 0
+myt%mys%b = 0
+
+!$omp target map(tofrom: myt)
+myt%mys%a = myt%mys%a + 1
+!$omp end target
+
+if (myt%mys%a.ne.1) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90
new file mode 100644
index 0000000..254486b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-8.f90
@@ -0,0 +1,115 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ integer, dimension (9) :: arr1
+end type u
+type v
+ integer, dimension (10) :: arr1
+end type v
+type w
+ integer, dimension (11) :: arr1
+end type w
+type y
+ integer, dimension(:), pointer :: ptr1
+end type y
+type z
+ integer, dimension(:), pointer :: ptr1
+end type z
+
+!$omp declare mapper (t::x) map(tofrom:x%arr1)
+!$omp declare mapper (u::x) map(tofrom:x%arr1(:))
+!$omp declare mapper (v::x) map(always,tofrom:x%arr1(1:3))
+!$omp declare mapper (w::x) map(tofrom:x%arr1(1))
+!$omp declare mapper (y::x) map(tofrom:x%ptr1)
+!$omp declare mapper (z::x) map(to:x%ptr1) map(tofrom:x%ptr1(1:3))
+
+type(t) :: myt
+type(u) :: myu
+type(v) :: myv
+type(w) :: myw
+type(y) :: myy
+integer, target, dimension(8) :: arrtgt
+type(z) :: myz
+integer, target, dimension(8) :: arrtgt2
+
+myy%ptr1 => arrtgt
+myz%ptr1 => arrtgt2
+
+myt%arr1 = 0
+
+!$omp target map(myt)
+myt%arr1(1) = myt%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myt%arr1(1) = myt%arr1(1) + 1
+!$omp end target
+
+if (myt%arr1(1).ne.2) stop 1
+
+myu%arr1 = 0
+
+!$omp target map(tofrom:myu%arr1(:))
+myu%arr1(1) = myu%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myu%arr1(1) = myu%arr1(1) + 1
+!$omp end target
+
+if (myu%arr1(1).ne.2) stop 2
+
+myv%arr1 = 0
+
+!$omp target map(always,tofrom:myv%arr1(1:3))
+myv%arr1(1) = myv%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myv%arr1(1) = myv%arr1(1) + 1
+!$omp end target
+
+if (myv%arr1(1).ne.2) stop 3
+
+myw%arr1 = 0
+
+!$omp target map(tofrom:myw%arr1(1))
+myw%arr1(1) = myw%arr1(1) + 1
+!$omp end target
+
+!$omp target
+myw%arr1(1) = myw%arr1(1) + 1
+!$omp end target
+
+if (myw%arr1(1).ne.2) stop 4
+
+myy%ptr1 = 0
+
+!$omp target map(tofrom:myy%ptr1)
+myy%ptr1(1) = myy%ptr1(1) + 1
+!$omp end target
+
+!$omp target map(to:myy%ptr1) map(tofrom:myy%ptr1(1:2))
+myy%ptr1(1) = myy%ptr1(1) + 1
+!$omp end target
+
+!$omp target
+myy%ptr1(1) = myy%ptr1(1) + 1
+!$omp end target
+
+if (myy%ptr1(1).ne.3) stop 5
+
+myz%ptr1(1) = 0
+
+!$omp target
+myz%ptr1(1) = myz%ptr1(1) + 1
+!$omp end target
+
+if (myz%ptr1(1).ne.1) stop 6
+
+end program myprog
+
diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90
new file mode 100644
index 0000000..deaf30b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-9.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t), dimension (:), pointer :: tarr
+end type u
+
+type(u) :: myu
+type(t), dimension (1), target :: myarray
+
+!$omp declare mapper (named: t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(to: x%tarr) map(mapper(named), tofrom: x%tarr(1))
+
+myu%tarr => myarray
+myu%tarr(1)%arr1 = 0
+
+! Unnamed mapper invoking named mapper
+
+!$omp target
+myu%tarr(1)%arr1(1) = myu%tarr(1)%arr1(1) + 1
+!$omp end target
+
+if (myu%tarr(1)%arr1(1).ne.1) stop 1
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/mapper-iterators-1.f90 b/libgomp/testsuite/libgomp.fortran/mapper-iterators-1.f90
new file mode 100644
index 0000000..d0f2bc3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/mapper-iterators-1.f90
@@ -0,0 +1,38 @@
+program myprog
+ type t
+ integer :: size
+ integer :: arr(99)
+ end type t
+
+ type u
+ type(t) :: myt
+ end type u
+
+ integer :: i, j
+ integer, parameter :: N = 10
+ type(u) :: x(N)
+
+ !$omp declare mapper (t :: x) map(tofrom: x%size, x%arr(1:x%size))
+ !$omp declare mapper (u :: x) map(tofrom: x%myt)
+
+ do i = 1, N
+ x(i)%myt%size = 99
+ do j = 1, 99
+ x(i)%myt%arr(j) = i*j
+ end do
+ end do
+
+ !$omp target map(iterator(i=1:N), tofrom: x(i))
+ do i = 1, N
+ do j = 1, 99
+ x(i)%myt%arr(j) = x(i)%myt%arr(j) + 1
+ end do
+ end do
+ !$omp end target
+
+ do i = 1, N
+ do j = 1, 99
+ if (x(i)%myt%arr(j) /= i*j + 1) stop 1
+ end do
+ end do
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/mapper-iterators-2.f90 b/libgomp/testsuite/libgomp.fortran/mapper-iterators-2.f90
new file mode 100644
index 0000000..a28f7cb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/mapper-iterators-2.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+
+program myprog
+type t
+ integer, dimension (8) :: arr1
+end type t
+type u
+ type(t) :: t_elem
+end type u
+
+integer :: i
+integer, parameter :: N = 10
+type(u) :: myu(N)
+
+!$omp declare mapper (t :: x) map(x%arr1(5:8))
+!$omp declare mapper (tmapper: t :: x) map(x%arr1(1:4))
+!$omp declare mapper (u :: x) map(mapper(tmapper), tofrom: x%t_elem)
+
+do i = 1, N
+ myu(i)%t_elem%arr1(1) = 1
+ myu(i)%t_elem%arr1(5) = 1
+end do
+
+! Different ways of invoking nested mappers, named vs. unnamed
+
+!$omp target map(iterator (n=1:N) tofrom:myu(n)%t_elem)
+do i = 1, N
+ myu(i)%t_elem%arr1(5) = myu(i)%t_elem%arr1(5) + 1
+end do
+!$omp end target
+
+!$omp target map(iterator (n=1:N) tofrom:myu(n))
+do i = 1, N
+ myu(i)%t_elem%arr1(1) = myu(i)%t_elem%arr1(1) + 1
+end do
+!$omp end target
+
+!$omp target
+do i = 1, N
+ myu(i)%t_elem%arr1(1) = myu(i)%t_elem%arr1(1) + 1
+end do
+!$omp end target
+
+do i = 1, N
+ if (myu(i)%t_elem%arr1(1).ne.3) stop 1
+ if (myu(i)%t_elem%arr1(5).ne.2) stop 2
+end do
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/mapper-iterators-3.f90 b/libgomp/testsuite/libgomp.fortran/mapper-iterators-3.f90
new file mode 100644
index 0000000..c550e73
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/mapper-iterators-3.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+program myprog
+
+type A
+character(len=20) :: string1
+character(len=:), pointer :: string2
+end type A
+
+integer, parameter :: N = 8
+integer :: i
+
+!$omp declare mapper (A :: x) map(to:x%string1) map(from:x%string2)
+
+type(A) :: var(N)
+
+do i = 1, N
+ allocate(character(len=20) :: var(i)%string2)
+
+ var(i)%string1 = "hello world"
+end do
+
+!$omp target map(iterator (n=1:N) to:var(n)%string1) map(iterator (n=1:N) from:var(n)%string2)
+do i = 1, N
+ var(i)%string2 = var(i)%string1
+end do
+!$omp end target
+
+do i = 1, N
+ if (var(i)%string2.ne."hello world") stop 1
+end do
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/mapper-iterators-4.f90 b/libgomp/testsuite/libgomp.fortran/mapper-iterators-4.f90
new file mode 100644
index 0000000..21db835
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/mapper-iterators-4.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+
+module mymod
+type F
+integer :: a, b, c
+integer, dimension(10) :: d
+end type F
+
+type G
+integer :: x, y
+type(F), pointer :: myf
+integer :: z
+end type G
+
+! Check that nested mappers work inside modules.
+
+!$omp declare mapper (F :: f) map(to: f%b) map(f%d)
+!$omp declare mapper (G :: g) map(tofrom: g%myf)
+
+end module mymod
+
+program myprog
+use mymod
+
+integer, parameter :: N = 8
+integer :: i
+
+type(F), target :: ftmp(N)
+type(G) :: gvar(N)
+
+do i = 1, N
+ gvar(i)%myf => ftmp(i)
+ gvar(i)%myf%d = 0
+end do
+
+!$omp target map(iterator (n=1:N) tofrom: gvar(n)%myf)
+do i = 1, N
+ gvar(i)%myf%d(1) = gvar(i)%myf%d(1) + 1
+end do
+!$omp end target
+
+!$omp target map(iterator (n=1:N) tofrom: gvar(n))
+do i = 1, N
+ gvar(i)%myf%d(1) = gvar(i)%myf%d(1) + 1
+end do
+!$omp end target
+
+do i = 1, N
+ if (gvar(i)%myf%d(1).ne.2) stop 1
+end do
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/need-device-ptr.f90 b/libgomp/testsuite/libgomp.fortran/need-device-ptr.f90
new file mode 100644
index 0000000..c75688c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/need-device-ptr.f90
@@ -0,0 +1,132 @@
+! Comprehensive non-array testcase for need_device_ptr / need_device_addr
+
+module m
+ use iso_c_binding
+ implicit none (type, external)
+
+ integer :: case = 0
+contains
+ subroutine var_ptr_f(n, x, y, z)
+ integer, value :: n
+ type(c_ptr) :: x
+ type(c_ptr), value :: y
+ type(c_ptr), optional :: z
+ !$omp target is_device_ptr(x,y,z)
+ block
+ integer, pointer :: ix, iy, iz
+ call c_f_pointer(x, ix)
+ call c_f_pointer(y, iy)
+ call c_f_pointer(z, iz)
+ if (ix /= 52) stop n*10 + 1
+ if (iy /= 85) stop n*10 + 2
+ if (iz /= 52) stop n*10 + 5
+ end block
+ end
+ subroutine base_ptr_f(n, x, y, z)
+ !$omp declare variant(var_ptr_f) match(construct={dispatch}) adjust_args(need_device_ptr : x, y, z)
+ integer, value :: n
+ type(c_ptr) :: x
+ type(c_ptr), value :: y
+ type(c_ptr), optional :: z
+ error stop n
+ end
+
+ subroutine var_caddr_f(x, y)
+ type(c_ptr) :: x
+ type(c_ptr), optional :: y
+ !$omp target has_device_addr(x, y)
+ block
+ integer, pointer :: ix, iy
+ call c_f_pointer(x, ix)
+ call c_f_pointer(x, iy)
+ if (ix /= 52) stop 3
+ if (iy /= 85) stop 6
+ end block
+ end
+! FIXME: optional args give a "sorry".
+! subroutine base_caddr_f(x, y)
+! !$omp declare variant(var_caddr_f) match(construct={dispatch}) adjust_args(need_device_addr : x, y)
+! type(c_ptr) :: x
+! type(c_ptr), optional :: y
+! error stop
+! end
+
+ subroutine var_iaddr_f(x,y)
+ integer :: x
+ integer, optional :: y
+ !$omp target has_device_addr(x, y)
+ block
+ if (x /= 52) stop 4
+ if (y /= 85) stop 4
+ end block
+ end
+
+! FIXME: optional args give a "sorry".
+! subroutine base_iaddr_f(x,y)
+! !$omp declare variant(var_iaddr_f) match(construct={dispatch}) adjust_args(need_device_addr : x, y)
+! integer :: x
+! integer, optional :: y
+! error stop
+! end
+
+ subroutine test_f(carg1, carg2, carg1v, carg2v, iarg1, iarg2)
+ type(c_ptr) :: carg1, carg2
+ type(c_ptr), value :: carg1v, carg2v
+ integer, target :: iarg1, iarg2
+ type(c_ptr) :: cptr1, cptr2
+ integer, target :: ivar1, ivar2
+
+
+ ivar1 = 52
+ ivar2 = 85
+
+ !$omp target enter data map(to: ivar1, ivar2)
+
+ cptr1 = c_loc(ivar1)
+ cptr2 = c_loc(ivar2)
+
+ !$omp dispatch
+ call base_ptr_f (1, carg1, carg2, carg1)
+ !$omp dispatch
+ call base_ptr_f (2, carg1v, carg2v, carg1v)
+ !$omp dispatch
+ call base_ptr_f (3, cptr1, cptr2, cptr1)
+ !$omp dispatch
+ call base_ptr_f (4, c_loc(iarg1), c_loc(iarg2), c_loc(iarg1))
+ !$omp dispatch
+ call base_ptr_f (6, c_loc(ivar1), c_loc(ivar2), c_loc(ivar1))
+
+! FIXME: optional argument functions not supported yet.
+! !$omp dispatch
+! call base_caddr_f (carg1, carg2)
+! !$omp dispatch
+! call base_caddr_f (carg1v, carg2v)
+! !$omp dispatch
+! call base_caddr_f (cptr1, cptr2)
+! !$omp dispatch
+! call base_caddr_f (c_loc(iarg1), c_loc(iarg2))
+! !$omp dispatch
+! call base_caddr_f (c_loc(ivar1), c_loc(ivar2))
+! !$omp dispatch
+! call base_iaddr_f (iarg1, iarg2)
+! !$omp dispatch
+! call base_iaddr_f (ivar1, iarg2)
+
+ !$omp target exit data map(release: ivar1, ivar2)
+ end
+end module m
+
+use m
+implicit none
+integer, target :: mx, my
+type(c_ptr) :: cptr1, cptr2
+mx = 52
+my = 85
+
+cptr1 = c_loc(mx)
+cptr2 = c_loc(my)
+
+!$omp target data map(to: mx, my)
+ call test_f (cptr1, cptr2, cptr1, cptr2, mx, my)
+!$omp end target data
+end
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-1.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-1.f90
new file mode 100644
index 0000000..6ee87e8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-1.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+implicit none
+integer, allocatable, target :: arr(:), arr2(:,:)
+integer, pointer :: ap(:), ap2(:,:)
+integer :: i, j
+
+allocate(arr(1:20))
+
+arr = 0
+
+!$omp target enter data map(to: arr)
+
+ap => arr(1:20:2)
+ap = 5
+
+!$omp target update to(ap)
+
+!$omp target exit data map(from: arr)
+
+do i=1,20
+ if (mod(i,2).eq.1.and.arr(i).ne.5) stop 1
+ if (mod(i,2).eq.0.and.arr(i).ne.0) stop 2
+end do
+
+allocate(arr2(1:20,1:20))
+
+ap2 => arr2(2:10:2,3:12:3)
+
+arr2 = 1
+
+!$omp target enter data map(to: arr2)
+
+!$omp target
+ap2 = 5
+!$omp end target
+
+!$omp target update from(ap2)
+
+do i=1,20
+ do j=1,20
+ if (i.ge.2.and.i.le.10.and.mod(i-2,2).eq.0.and.&
+ &j.ge.3.and.j.le.12.and.mod(j-3,3).eq.0) then
+ if (arr2(i,j).ne.5) stop 3
+ else
+ if (arr2(i,j).ne.1) stop 4
+ end if
+ end do
+end do
+
+!$omp target exit data map(delete: arr2)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-10.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-10.f90
new file mode 100644
index 0000000..c47ce38
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-10.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+character(len=8), allocatable, dimension(:) :: lines
+integer :: i
+
+allocate(lines(10))
+
+lines = "OMPHELLO"
+
+!$omp target enter data map(to: lines)
+
+!$omp target
+lines = "NEWVALUE"
+!$omp end target
+
+!$omp target update from(lines(5:7:2))
+
+do i=1,10
+ if (i.eq.5.or.i.eq.7) then
+ if (lines(i).ne."NEWVALUE") stop 1
+ else
+ if (lines(i).ne."OMPHELLO") stop 2
+ end if
+end do
+
+!$omp target exit data map(delete: lines)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-11.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-11.f90
new file mode 100644
index 0000000..a93acf2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-11.f90
@@ -0,0 +1,51 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+program p
+implicit none
+real(kind=4) :: arr(10,10,10,10)
+
+call s(arr,9,9,9,9)
+
+contains
+
+subroutine s(arr,m,n,o,p)
+implicit none
+integer :: i,m,n,o,p
+integer :: a,b,c,d
+real(kind=4) :: arr(0:m,0:n,0:o,0:p)
+
+arr = 0
+
+!$omp target enter data map(to: arr)
+
+!$omp target
+do i=0,9
+ arr(i,i,i,i) = i
+end do
+!$omp end target
+
+!$omp target update from(arr(0:2,0:2,0:2,0:2))
+
+do a=0,9
+ do b=0,9
+ do c=0,9
+ do d=0,9
+ if (a.le.2.and.b.le.2.and.c.le.2.and.d.le.2) then
+ if (a.eq.b.and.b.eq.c.and.c.eq.d) then
+ if (arr(a,b,c,d).ne.a) stop 1
+ else
+ if (arr(a,b,c,d).ne.0) stop 2
+ end if
+ else
+ if (arr(a,b,c,d).ne.0) stop 3
+ end if
+ end do
+ end do
+ end do
+end do
+
+!$omp target exit data map(delete: arr)
+
+end subroutine s
+end program p
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-12.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-12.f90
new file mode 100644
index 0000000..c47fbdb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-12.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+! Test plain, fixed-size arrays, and also pointers to same.
+
+implicit none
+integer(kind=8) :: arr(10,30)
+integer, target :: arr2(9,11,13)
+integer, pointer :: parr(:,:,:)
+integer :: i, j, k
+
+arr = 0
+!$omp target enter data map(to: arr)
+
+!$omp target
+arr = 99
+!$omp end target
+
+!$omp target update from(arr(1:10:3,5:30:7))
+
+do i=1,10
+ do j=1,30
+ if (mod(i-1,3).eq.0.and.mod(j-5,7).eq.0) then
+ if (arr(i,j).ne.99) stop 1
+ else
+ if (arr(i,j).ne.0) stop 2
+ endif
+ end do
+end do
+
+!$omp target exit data map(delete: arr)
+
+arr2 = 0
+parr => arr2
+!$omp target enter data map(to: parr)
+
+!$omp target
+parr = 99
+!$omp end target
+
+!$omp target update from(parr(7:9:2,5:7:2,3:6:3))
+
+do i=1,9
+ do j=1,11
+ do k=1,13
+ if (i.ge.7.and.j.ge.5.and.k.ge.3.and.&
+ &i.le.9.and.j.le.7.and.k.le.6.and.&
+ &mod(i-7,2).eq.0.and.mod(j-5,2).eq.0.and.mod(k-3,3).eq.0) then
+ if (parr(i,j,k).ne.99) stop 3
+ else
+ if (parr(i,j,k).ne.0) stop 4
+ end if
+ end do
+ end do
+end do
+
+!$omp target exit data map(delete: parr)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-13.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-13.f90
new file mode 100644
index 0000000..42f867e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-13.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+implicit none
+integer, allocatable :: arr(:,:,:,:,:)
+integer :: i, j, k, l, m
+
+allocate (arr(18,19,20,21,22))
+
+arr = 0
+
+!$omp target enter data map(to: arr)
+
+arr = 10
+
+!$omp target update to(arr(1:3:2,1:4:3,1:5:4,1:6:5,1:7:6))
+
+!$omp target
+do i=1,18
+ do j=1,19
+ do k=1,20
+ do l=1,21
+ do m=1,22
+ if ((i.eq.1.or.i.eq.3).and.&
+ &(j.eq.1.or.j.eq.4).and.&
+ &(k.eq.1.or.k.eq.5).and.&
+ &(l.eq.1.or.l.eq.6).and.&
+ &(m.eq.1.or.m.eq.7)) then
+ if (arr(i,j,k,l,m).ne.10) stop 1
+ else
+ if (arr(i,j,k,l,m).ne.0) stop 2
+ end if
+ end do
+ end do
+ end do
+ end do
+end do
+!$omp end target
+
+!$omp target exit data map(delete: arr)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-2.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-2.f90
new file mode 100644
index 0000000..2d3efb8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-2.f90
@@ -0,0 +1,101 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+program p
+implicit none
+integer, allocatable, target :: arr3(:,:,:)
+integer, pointer :: ap3(:,:,:)
+integer :: i, j, k
+
+allocate(arr3(1:10,1:10,1:10))
+
+! CHECK 1
+
+arr3 = 0
+ap3 => arr3(1:10,1:10,1:10:2)
+
+!$omp target enter data map(to: arr3)
+
+!$omp target
+ap3 = 5
+!$omp end target
+
+!$omp target update from(ap3)
+
+call check(arr3, 0, 1, 1, 2)
+
+!$omp target exit data map(delete: arr3)
+
+! CHECK 2
+
+arr3 = 0
+ap3 => arr3(1:10,1:10:2,1:10)
+
+!$omp target enter data map(to: arr3)
+
+!$omp target
+ap3 = 5
+!$omp end target
+
+!$omp target update from(ap3)
+
+call check(arr3, 2, 1, 2, 1)
+
+!$omp target exit data map(delete: arr3)
+
+! CHECK 3
+
+arr3 = 0
+ap3 => arr3(1:10:2,1:10,1:10)
+
+!$omp target enter data map(to: arr3)
+
+!$omp target
+ap3 = 5
+!$omp end target
+
+!$omp target update from(ap3)
+
+call check(arr3, 4, 2, 1, 1)
+
+!$omp target exit data map(delete: arr3)
+
+! CHECK 4
+
+arr3 = 0
+ap3 => arr3(1:10:2,1:10:2,1:10:2)
+
+!$omp target enter data map(to: arr3)
+
+!$omp target
+ap3 = 5
+!$omp end target
+
+!$omp target update from(ap3)
+
+call check(arr3, 6, 2, 2, 2)
+
+!$omp target exit data map(delete: arr3)
+
+contains
+
+subroutine check(arr,cb,s1,s2,s3)
+implicit none
+integer :: arr(:,:,:)
+integer :: cb, s1, s2, s3
+
+do i=1,10
+ do j=1,10
+ do k=1,10
+ if (mod(k-1,s1).eq.0.and.mod(j-1,s2).eq.0.and.mod(i-1,s3).eq.0) then
+ if (arr(k,j,i).ne.5) stop cb+1
+ else
+ if (arr(k,j,i).ne.0) stop cb+2
+ end if
+ end do
+ end do
+end do
+
+end subroutine check
+
+end program p
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-3.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-3.f90
new file mode 100644
index 0000000..14f1288
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-3.f90
@@ -0,0 +1,47 @@
+program p
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+integer :: A(200)
+A = [(i, i=1,200)]
+!$omp target enter data map(to: A(40:200))
+call foo(A(101:))
+
+contains
+
+subroutine foo(x)
+integer, target :: x(100)
+integer, pointer :: p(:,:)
+integer :: i, j
+
+p(0:5,-5:-1) => x(::2)
+
+!$omp target
+x = x * 2
+!$omp end target
+
+!$omp target update from(x(1:20:2))
+
+do i=1,20
+if (mod(i,2).eq.1 .and. x(i).ne.(100+i)*2) stop 1
+if (mod(i,2).eq.0 .and. x(i).ne.100+i) stop 2
+end do
+
+!$omp target
+p = 0
+!$omp end target
+
+!$omp target update from(p(::3,::2))
+
+do i=0,5
+ do j=-5,-1
+ if (mod(i,3).eq.0 .and. mod(j+5,2).eq.0) then
+ if (p(i,j).ne.0) stop 3
+ else
+ if (p(i,j).eq.0) stop 4
+ end if
+ end do
+end do
+
+end subroutine foo
+end program p
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-4.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-4.f90
new file mode 100644
index 0000000..46e8c23
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-4.f90
@@ -0,0 +1,78 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+type t
+ complex(kind=8) :: c
+ integer :: i
+end type t
+
+type u
+ integer :: i, j
+ complex(kind=8) :: c
+ integer :: k
+end type u
+
+type(t), target :: var(10)
+type(u), target :: var2(10)
+complex(kind=8), pointer :: ptr(:)
+integer :: i
+
+do i=1,10
+ var(i)%c = dcmplx(i,0)
+ var(i)%i = i
+end do
+
+ptr => var(:)%c
+
+!$omp target enter data map(to: var)
+
+!$omp target
+var(:)%c = dcmplx(0,0)
+var(:)%i = 0
+!$omp end target
+
+!$omp target update from(ptr)
+
+do i=1,10
+ if (var(i)%c.ne.dcmplx(0,0)) stop 1
+ if (var(i)%i.ne.i) stop 2
+end do
+
+!$omp target exit data map(delete: var)
+
+! Now do it again with a differently-ordered derived type.
+
+do i=1,10
+ var2(i)%c = dcmplx(0,i)
+ var2(i)%i = i
+ var2(i)%j = i * 2
+ var2(i)%k = i * 3
+end do
+
+ptr => var2(::2)%c
+
+!$omp target enter data map(to: var2)
+
+!$omp target
+var2(:)%c = dcmplx(0,0)
+var2(:)%i = 0
+var2(:)%j = 0
+var2(:)%k = 0
+!$omp end target
+
+!$omp target update from(ptr)
+
+do i=1,10
+ if (mod(i,2).eq.1) then
+ if (var2(i)%c.ne.dcmplx(0,0)) stop 3
+ else
+ if (var2(i)%c.ne.dcmplx(0,i)) stop 4
+ end if
+ if (var2(i)%i.ne.i) stop 5
+ if (var2(i)%j.ne.i * 2) stop 6
+ if (var2(i)%k.ne.i * 3) stop 7
+end do
+
+!$omp target exit data map(delete: var2)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-5.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-5.f90
new file mode 100644
index 0000000..9cc20fa3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-5.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+! Only some of an array mapped on the target
+
+integer, target :: arr(100)
+integer, pointer :: ptr(:)
+
+arr = [(i * 2, i=1,100)]
+
+!$omp target enter data map(to: arr(51:100))
+
+!$omp target
+arr(51:100) = arr(51:100) + 1
+!$omp end target
+
+!$omp target update from(arr(51:100:2))
+
+do i=1,100
+ if (i.le.50) then
+ if (arr(i).ne.i*2) stop 1
+ else
+ if (mod(i,2).eq.1 .and. arr(i).ne.i*2+1) stop 2
+ if (mod(i,2).eq.0 .and. arr(i).ne.i*2) stop 3
+ end if
+end do
+
+!$omp target exit data map(delete: arr)
+
+arr = [(i * 2, i=1,100)]
+
+! Similar, but update via pointer.
+
+ptr => arr(51:100)
+
+!$omp target enter data map(to: ptr(1:50))
+
+!$omp target
+ptr = ptr + 1
+!$omp end target
+
+!$omp target update from(ptr(::2))
+
+do i=1,100
+ if (i.le.50) then
+ if (arr(i).ne.i*2) stop 1
+ else
+ if (mod(i,2).eq.1 .and. arr(i).ne.i*2+1) stop 2
+ if (mod(i,2).eq.0 .and. arr(i).ne.i*2) stop 3
+ end if
+end do
+
+!$omp target exit data map(delete: ptr)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-6.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-6.f90
new file mode 100644
index 0000000..5c42b90
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-6.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+program p
+implicit none
+integer, dimension(100) :: parr
+integer :: i
+
+parr = [(i, i=1,100)]
+
+!$omp target enter data map(to: parr)
+
+call s(parr)
+
+do i=1,100
+ if (mod(i,3).eq.1 .and. parr(i).ne.999) stop 1
+ if (mod(i,3).ne.1 .and. parr(i).ne.i) stop 2
+end do
+
+!$omp target exit data map(delete: parr)
+
+contains
+subroutine s(arr)
+implicit none
+integer, intent(inout) :: arr(*)
+
+!$omp target map(alloc: arr(1:100))
+arr(1:100) = 999
+!$omp end target
+
+!$omp target update from(arr(1:100:3))
+
+end subroutine s
+end program p
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-7.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-7.f90
new file mode 100644
index 0000000..120fd9c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-7.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+! Assumed-shape arrays
+
+program p
+implicit none
+integer, dimension(100) :: parr
+integer :: i
+
+parr = [(i, i=1,100)]
+
+!$omp target enter data map(to: parr)
+
+call s(parr)
+
+do i=1,100
+ if (mod(i,3).eq.1 .and. parr(i).ne.999) stop 1
+ if (mod(i,3).ne.1 .and. parr(i).ne.i) stop 2
+end do
+
+!$omp target exit data map(delete: parr)
+
+contains
+subroutine s(arr)
+implicit none
+integer, intent(inout) :: arr(:)
+
+!$omp target
+arr = 999
+!$omp end target
+
+!$omp target update from(arr(1:100:3))
+
+end subroutine s
+end program p
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-8.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-8.f90
new file mode 100644
index 0000000..d9b3c9c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-8.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+! Test biasing for target-region lookup.
+
+implicit none
+integer, allocatable, target :: var(:,:,:)
+integer, pointer :: p(:,:,:)
+integer :: i, j, k
+
+allocate(var(1:20,5:25,10:30))
+
+var = 0
+
+!$omp target enter data map(to: var)
+
+!$omp target
+var = 99
+!$omp end target
+
+p => var(1:3:2,5:5,10:10)
+
+!$omp target update from(p)
+
+do i=1,20
+ do j=5,25
+ do k=10,30
+ if ((i.eq.1.or.i.eq.3).and.j.eq.5.and.k.eq.10) then
+ if (var(i,j,k).ne.99) stop 1
+ else
+ if (var(i,j,k).ne.0) stop 2
+ end if
+ end do
+ end do
+end do
+
+!$omp target exit data map(delete: var)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/noncontig-updates-9.f90 b/libgomp/testsuite/libgomp.fortran/noncontig-updates-9.f90
new file mode 100644
index 0000000..689a46a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/noncontig-updates-9.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+! This test case hits the problem described in:
+! https://gcc.gnu.org/pipermail/gcc-patches/2023-February/612219.html
+
+! { dg-xfail-run-if "'enter data' bug" { offload_device_nonshared_as } }
+
+character(len=:), allocatable, dimension(:) :: lines
+integer :: i
+
+allocate(character(len=8) :: lines(10))
+
+lines = "OMPHELLO"
+
+!$omp target enter data map(to: lines)
+
+!$omp target
+lines = "NEWVALUE"
+!$omp end target
+
+!$omp target update from(lines(5:7:2))
+
+do i=1,10
+ if (i.eq.5.or.i.eq.7) then
+ if (lines(i).ne."NEWVALUE") stop 1
+ else
+ if (lines(i).ne."OMPHELLO") stop 2
+ end if
+end do
+
+!$omp target exit data map(delete: lines)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/target-13.f90 b/libgomp/testsuite/libgomp.fortran/target-13.f90
index 6aacc77..e6334a5 100644
--- a/libgomp/testsuite/libgomp.fortran/target-13.f90
+++ b/libgomp/testsuite/libgomp.fortran/target-13.f90
@@ -76,7 +76,7 @@ var3a = var3
! ---------------
-!$omp target update from(var1%at(2:3))
+!$omp target update from(var1%at(::2))
if (var1a /= var1) error stop
if (any (var2a /= var2)) error stop
@@ -134,17 +134,20 @@ var1a%at(2)%a = var1a%at(2)%a * 7
var1a%at(3)%s = var1a%at(3)%s * (-3)
block
- integer, volatile :: i1,i2,i3,i4
+ integer, volatile :: i1,i2,i3,i4,i5,i6
i1 = 1
i2 = 2
i3 = 1
- i4 = 2
- !$omp target update from(var3(i1:i2)) from(var1%at(i3:i4))
+ i4 = 1
+ i5 = 2
+ i6 = 1
+ !$omp target update from(var3(i1:i2:i3)) from(var1%at(i4:i5:i6))
i1 = 3
i2 = 3
i3 = 1
i4 = 5
- !$omp target update from(var1%at(i1)%s) from(var1%at(i2)%a(i3:i4))
+ i5 = 1
+ !$omp target update from(var1%at(i1)%s) from(var1%at(i1)%a(i3:i4:i5))
end block
if (var1 /= var1) error stop
diff --git a/libgomp/testsuite/libgomp.fortran/target-enter-data-3a.f90 b/libgomp/testsuite/libgomp.fortran/target-enter-data-3a.f90
new file mode 100644
index 0000000..1fe3f03
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-enter-data-3a.f90
@@ -0,0 +1,567 @@
+! { dg-additional-options "-cpp" }
+
+! FIXME: Some tests do not work yet. Those are for now in '#if 0'
+
+! Check that 'map(alloc:' properly works with
+! - deferred-length character strings
+! - arrays with array descriptors
+! For those, the array descriptor / string length must be mapped with 'to:'
+
+program main
+implicit none
+
+type t
+ integer :: ic(2:5), ic2
+ character(len=11) :: ccstr(3:4), ccstr2
+ character(len=11,kind=4) :: cc4str(3:7), cc4str2
+ integer, pointer :: pc(:), pc2
+ character(len=:), pointer :: pcstr(:), pcstr2
+ character(len=:,kind=4), pointer :: pc4str(:), pc4str2
+end type t
+
+type(t) :: dt
+
+integer :: ii(5), ii2
+character(len=11) :: clstr(-1:1), clstr2
+character(len=11,kind=4) :: cl4str(0:3), cl4str2
+integer, pointer :: ip(:), ip2
+integer, allocatable :: ia(:), ia2
+character(len=:), pointer :: pstr(:), pstr2
+character(len=:), allocatable :: astr(:), astr2
+character(len=:,kind=4), pointer :: p4str(:), p4str2
+character(len=:,kind=4), allocatable :: a4str(:), a4str2
+
+
+allocate(dt%pc(5), dt%pc2)
+allocate(character(len=2) :: dt%pcstr(2))
+allocate(character(len=4) :: dt%pcstr2)
+
+allocate(character(len=3,kind=4) :: dt%pc4str(2:3))
+allocate(character(len=5,kind=4) :: dt%pc4str2)
+
+allocate(ip(5), ip2, ia(8), ia2)
+allocate(character(len=2) :: pstr(-2:0))
+allocate(character(len=4) :: pstr2)
+allocate(character(len=6) :: astr(3:5))
+allocate(character(len=8) :: astr2)
+
+allocate(character(len=3,kind=4) :: p4str(2:4))
+allocate(character(len=5,kind=4) :: p4str2)
+allocate(character(len=7,kind=4) :: a4str(-2:3))
+allocate(character(len=9,kind=4) :: a4str2)
+
+
+! integer :: ic(2:5), ic2
+
+!$omp target enter data map(alloc: dt%ic)
+!$omp target map(alloc: dt%ic)
+ if (size(dt%ic) /= 4) error stop
+ if (lbound(dt%ic, 1) /= 2) error stop
+ if (ubound(dt%ic, 1) /= 5) error stop
+ dt%ic = [22, 33, 44, 55]
+!$omp end target
+!$omp target exit data map(from: dt%ic)
+if (size(dt%ic) /= 4) error stop
+if (lbound(dt%ic, 1) /= 2) error stop
+if (ubound(dt%ic, 1) /= 5) error stop
+if (any (dt%ic /= [22, 33, 44, 55])) error stop
+
+!$omp target enter data map(alloc: dt%ic2)
+!$omp target map(alloc: dt%ic2)
+ dt%ic2 = 42
+!$omp end target
+!$omp target exit data map(from: dt%ic2)
+if (dt%ic2 /= 42) error stop
+
+
+! character(len=11) :: ccstr(3:4), ccstr2
+
+!$omp target enter data map(alloc: dt%ccstr)
+!$omp target map(alloc: dt%ccstr)
+ if (len(dt%ccstr) /= 11) error stop
+ if (size(dt%ccstr) /= 2) error stop
+ if (lbound(dt%ccstr, 1) /= 3) error stop
+ if (ubound(dt%ccstr, 1) /= 4) error stop
+ dt%ccstr = ["12345678901", "abcdefghijk"]
+!$omp end target
+!$omp target exit data map(from: dt%ccstr)
+if (len(dt%ccstr) /= 11) error stop
+if (size(dt%ccstr) /= 2) error stop
+if (lbound(dt%ccstr, 1) /= 3) error stop
+if (ubound(dt%ccstr, 1) /= 4) error stop
+if (any (dt%ccstr /= ["12345678901", "abcdefghijk"])) error stop
+
+!$omp target enter data map(alloc: dt%ccstr2)
+!$omp target map(alloc: dt%ccstr2)
+ if (len(dt%ccstr2) /= 11) error stop
+ dt%ccstr2 = "ABCDEFGHIJK"
+!$omp end target
+!$omp target exit data map(from: dt%ccstr2)
+if (len(dt%ccstr2) /= 11) error stop
+if (dt%ccstr2 /= "ABCDEFGHIJK") error stop
+
+
+! character(len=11,kind=4) :: cc4str(3:7), cc4str2
+
+#if 0
+! Value check fails
+!$omp target map(alloc: dt%cc4str)
+ if (len(dt%cc4str) /= 11) error stop
+ if (size(dt%cc4str) /= 5) error stop
+ if (lbound(dt%cc4str, 1) /= 3) error stop
+ if (ubound(dt%cc4str, 1) /= 7) error stop
+ dt%cc4str = [4_"12345678901", 4_"abcdefghijk", &
+ 4_"qerftcea6ds", 4_"a1f9g37ga4.", &
+ 4_"45ngwj56sj2"]
+!$omp end target
+!$omp target exit data map(from: dt%cc4str)
+if (len(dt%cc4str) /= 11) error stop
+if (size(dt%cc4str) /= 5) error stop
+if (lbound(dt%cc4str, 1) /= 3) error stop
+if (ubound(dt%cc4str, 1) /= 7) error stop
+if (dt%cc4str(3) /= 4_"12345678901") error stop
+if (dt%cc4str(4) /= 4_"abcdefghijk") error stop
+if (dt%cc4str(5) /= 4_"qerftcea6ds") error stop
+if (dt%cc4str(6) /= 4_"a1f9g37ga4.") error stop
+if (dt%cc4str(7) /= 4_"45ngwj56sj2") error stop
+#endif
+
+!$omp target enter data map(alloc: dt%cc4str2)
+!$omp target map(alloc: dt%cc4str2)
+ if (len(dt%cc4str2) /= 11) error stop
+ dt%cc4str2 = 4_"ABCDEFGHIJK"
+!$omp end target
+!$omp target exit data map(from: dt%cc4str2)
+if (len(dt%cc4str2) /= 11) error stop
+if (dt%cc4str2 /= 4_"ABCDEFGHIJK") error stop
+
+
+! integer, pointer :: pc(:), pc2
+! allocate(dt%pc(5), dt%pc2)
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
+
+!$omp target enter data map(alloc: dt%pc)
+!$omp target map(alloc: dt%pc)
+ if (.not. associated(dt%pc)) error stop
+ if (size(dt%pc) /= 5) error stop
+ if (lbound(dt%pc, 1) /= 1) error stop
+ if (ubound(dt%pc, 1) /= 5) error stop
+ dt%pc = [11, 22, 33, 44, 55]
+!$omp end target
+!$omp target exit data map(from: dt%pc)
+if (.not. associated(dt%pc)) error stop
+if (size(dt%pc) /= 5) error stop
+if (lbound(dt%pc, 1) /= 1) error stop
+if (ubound(dt%pc, 1) /= 5) error stop
+if (any (dt%pc /= [11, 22, 33, 44, 55])) error stop
+#endif
+
+!$omp target enter data map(alloc: dt%pc2)
+!$omp target map(alloc: dt%pc2)
+ if (.not. associated(dt%pc2)) error stop
+ dt%pc2 = 99
+!$omp end target
+!$omp target exit data map(from: dt%pc2)
+if (dt%pc2 /= 99) error stop
+if (.not. associated(dt%pc2)) error stop
+
+
+! character(len=:), pointer :: pcstr(:), pcstr2
+! allocate(character(len=2) :: dt%pcstr(2))
+! allocate(character(len=4) :: dt%pcstr2)
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
+
+!$omp target enter data map(alloc: dt%pcstr)
+!$omp target map(alloc: dt%pcstr)
+ if (.not. associated(dt%pcstr)) error stop
+ if (len(dt%pcstr) /= 2) error stop
+ if (size(dt%pcstr) /= 2) error stop
+ if (lbound(dt%pcstr, 1) /= 1) error stop
+ if (ubound(dt%pcstr, 1) /= 2) error stop
+ dt%pcstr = ["01", "jk"]
+!$omp end target
+!$omp target exit data map(from: dt%pcstr)
+if (.not. associated(dt%pcstr)) error stop
+if (len(dt%pcstr) /= 2) error stop
+if (size(dt%pcstr) /= 2) error stop
+if (lbound(dt%pcstr, 1) /= 1) error stop
+if (ubound(dt%pcstr, 1) /= 2) error stop
+if (any (dt%pcstr /= ["01", "jk"])) error stop
+#endif
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x01
+
+!$omp target enter data map(alloc: dt%pcstr2)
+!$omp target map(alloc: dt%pcstr2)
+ if (.not. associated(dt%pcstr2)) error stop
+ if (len(dt%pcstr2) /= 4) error stop
+ dt%pcstr2 = "HIJK"
+!$omp end target
+!$omp target exit data map(from: dt%pcstr2)
+if (.not. associated(dt%pcstr2)) error stop
+if (len(dt%pcstr2) /= 4) error stop
+if (dt%pcstr2 /= "HIJK") error stop
+#endif
+
+
+! character(len=:,kind=4), pointer :: pc4str(:), pc4str2
+! allocate(character(len=3,kind=4) :: dt%pc4str(2:3))
+! allocate(character(len=5,kind=4) :: dt%pc4str2)
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
+
+!$omp target enter data map(alloc: dt%pc4str)
+!$omp target map(alloc: dt%pc4str)
+ if (.not. associated(dt%pc4str)) error stop
+ if (len(dt%pc4str) /= 3) error stop
+ if (size(dt%pc4str) /= 2) error stop
+ if (lbound(dt%pc4str, 1) /= 2) error stop
+ if (ubound(dt%pc4str, 1) /= 3) error stop
+ dt%pc4str = [4_"456", 4_"tzu"]
+!$omp end target
+!$omp target exit data map(from: dt%pc4str)
+if (.not. associated(dt%pc4str)) error stop
+if (len(dt%pc4str) /= 3) error stop
+if (size(dt%pc4str) /= 2) error stop
+if (lbound(dt%pc4str, 1) /= 2) error stop
+if (ubound(dt%pc4str, 1) /= 3) error stop
+if (dt%pc4str(2) /= 4_"456") error stop
+if (dt%pc4str(3) /= 4_"tzu") error stop
+#endif
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x01
+
+!$omp target enter data map(alloc: dt%pc4str2)
+!$omp target map(alloc: dt%pc4str2)
+ if (.not. associated(dt%pc4str2)) error stop
+ if (len(dt%pc4str2) /= 5) error stop
+ dt%pc4str2 = 4_"98765"
+!$omp end target
+!$omp target exit data map(from: dt%pc4str2)
+if (.not. associated(dt%pc4str2)) error stop
+if (len(dt%pc4str2) /= 5) error stop
+if (dt%pc4str2 /= 4_"98765") error stop
+#endif
+
+
+! integer :: ii(5), ii2
+
+!$omp target enter data map(alloc: ii)
+!$omp target map(alloc: ii)
+ if (size(ii) /= 5) error stop
+ if (lbound(ii, 1) /= 1) error stop
+ if (ubound(ii, 1) /= 5) error stop
+ ii = [-1, -2, -3, -4, -5]
+!$omp end target
+!$omp target exit data map(from: ii)
+if (size(ii) /= 5) error stop
+if (lbound(ii, 1) /= 1) error stop
+if (ubound(ii, 1) /= 5) error stop
+if (any (ii /= [-1, -2, -3, -4, -5])) error stop
+
+!$omp target enter data map(alloc: ii2)
+!$omp target map(alloc: ii2)
+ ii2 = -410
+!$omp end target
+!$omp target exit data map(from: ii2)
+if (ii2 /= -410) error stop
+
+
+! character(len=11) :: clstr(-1:1), clstr2
+
+!$omp target enter data map(alloc: clstr)
+!$omp target map(alloc: clstr)
+ if (len(clstr) /= 11) error stop
+ if (size(clstr) /= 3) error stop
+ if (lbound(clstr, 1) /= -1) error stop
+ if (ubound(clstr, 1) /= 1) error stop
+ clstr = ["12345678901", "abcdefghijk", "ABCDEFGHIJK"]
+!$omp end target
+!$omp target exit data map(from: clstr)
+if (len(clstr) /= 11) error stop
+if (size(clstr) /= 3) error stop
+if (lbound(clstr, 1) /= -1) error stop
+if (ubound(clstr, 1) /= 1) error stop
+if (any (clstr /= ["12345678901", "abcdefghijk", "ABCDEFGHIJK"])) error stop
+
+!$omp target enter data map(alloc: clstr2)
+!$omp target map(alloc: clstr2)
+ if (len(clstr2) /= 11) error stop
+ clstr2 = "ABCDEFghijk"
+!$omp end target
+!$omp target exit data map(from: clstr2)
+if (len(clstr2) /= 11) error stop
+if (clstr2 /= "ABCDEFghijk") error stop
+
+
+! character(len=11,kind=4) :: cl4str(0:3), cl4str2
+
+!$omp target enter data map(alloc: cl4str)
+!$omp target map(alloc: cl4str)
+ if (len(cl4str) /= 11) error stop
+ if (size(cl4str) /= 4) error stop
+ if (lbound(cl4str, 1) /= 0) error stop
+ if (ubound(cl4str, 1) /= 3) error stop
+ cl4str = [4_"12345678901", 4_"abcdefghijk", &
+ 4_"qerftcea6ds", 4_"a1f9g37ga4."]
+!$omp end target
+!$omp target exit data map(from: cl4str)
+if (len(cl4str) /= 11) error stop
+if (size(cl4str) /= 4) error stop
+if (lbound(cl4str, 1) /= 0) error stop
+if (ubound(cl4str, 1) /= 3) error stop
+if (cl4str(0) /= 4_"12345678901") error stop
+if (cl4str(1) /= 4_"abcdefghijk") error stop
+if (cl4str(2) /= 4_"qerftcea6ds") error stop
+if (cl4str(3) /= 4_"a1f9g37ga4.") error stop
+
+!$omp target enter data map(alloc: cl4str2)
+!$omp target map(alloc: cl4str2)
+ if (len(cl4str2) /= 11) error stop
+ cl4str2 = 4_"ABCDEFGHIJK"
+!$omp end target
+!$omp target exit data map(from: cl4str2)
+if (len(cl4str2) /= 11) error stop
+if (cl4str2 /= 4_"ABCDEFGHIJK") error stop
+
+
+! allocate(ip(5), ip2, ia(8), ia2)
+
+!$omp target enter data map(alloc: ip)
+!$omp target map(alloc: ip)
+ if (.not. associated(ip)) error stop
+ if (size(ip) /= 5) error stop
+ if (lbound(ip, 1) /= 1) error stop
+ if (ubound(ip, 1) /= 5) error stop
+ ip = [11, 22, 33, 44, 55]
+!$omp end target
+!$omp target exit data map(from: ip)
+if (.not. associated(ip)) error stop
+if (size(ip) /= 5) error stop
+if (lbound(ip, 1) /= 1) error stop
+if (ubound(ip, 1) /= 5) error stop
+if (any (ip /= [11, 22, 33, 44, 55])) error stop
+
+!$omp target enter data map(alloc: ip2)
+!$omp target map(alloc: ip2)
+ if (.not. associated(ip2)) error stop
+ ip2 = 99
+!$omp end target
+!$omp target exit data map(from: ip2)
+if (ip2 /= 99) error stop
+if (.not. associated(ip2)) error stop
+
+
+! allocate(ip(5), ip2, ia(8), ia2)
+
+!$omp target enter data map(alloc: ia)
+!$omp target map(alloc: ia)
+ if (.not. allocated(ia)) error stop
+ if (size(ia) /= 8) error stop
+ if (lbound(ia, 1) /= 1) error stop
+ if (ubound(ia, 1) /= 8) error stop
+ ia = [1,2,3,4,5,6,7,8]
+!$omp end target
+!$omp target exit data map(from: ia)
+if (.not. allocated(ia)) error stop
+if (size(ia) /= 8) error stop
+if (lbound(ia, 1) /= 1) error stop
+if (ubound(ia, 1) /= 8) error stop
+if (any (ia /= [1,2,3,4,5,6,7,8])) error stop
+
+!$omp target enter data map(alloc: ia2)
+!$omp target map(alloc: ia2)
+ if (.not. allocated(ia2)) error stop
+ ia2 = 102
+!$omp end target
+!$omp target exit data map(from: ia2)
+if (ia2 /= 102) error stop
+if (.not. allocated(ia2)) error stop
+
+
+! character(len=:), pointer :: pstr(:), pstr2
+! allocate(character(len=2) :: pstr(-2:0))
+! allocate(character(len=4) :: pstr2)
+
+#if 0
+! libgomp: nvptx_alloc error: out of memory
+
+!$omp target enter data map(alloc: pstr)
+!$omp target map(alloc: pstr)
+ if (.not. associated(pstr)) error stop
+ if (len(pstr) /= 2) error stop
+ if (size(pstr) /= 3) error stop
+ if (lbound(pstr, 1) /= -2) error stop
+ if (ubound(pstr, 1) /= 0) error stop
+ pstr = ["01", "jk", "aq"]
+!$omp end target
+!$omp target exit data map(from: pstr)
+if (.not. associated(pstr)) error stop
+if (len(pstr) /= 2) error stop
+if (size(pstr) /= 3) error stop
+if (lbound(pstr, 1) /= -2) error stop
+if (ubound(pstr, 1) /= 0) error stop
+if (any (pstr /= ["01", "jk", "aq"])) error stop
+#endif
+
+!$omp target enter data map(alloc: pstr2)
+!$omp target map(alloc: pstr2)
+ if (.not. associated(pstr2)) error stop
+ if (len(pstr2) /= 4) error stop
+ pstr2 = "HIJK"
+!$omp end target
+!$omp target exit data map(from: pstr2)
+if (.not. associated(pstr2)) error stop
+if (len(pstr2) /= 4) error stop
+if (pstr2 /= "HIJK") error stop
+
+
+! character(len=:), allocatable :: astr(:), astr2
+! allocate(character(len=6) :: astr(3:5))
+! allocate(character(len=8) :: astr2)
+
+#if 0
+! libgomp: nvptx_alloc error: out of memory
+
+!$omp target enter data map(alloc: astr)
+!$omp target map(alloc: astr)
+ if (.not. allocated(astr)) error stop
+ if (len(astr) /= 6) error stop
+ if (size(astr) /= 3) error stop
+ if (lbound(astr, 1) /= 3) error stop
+ if (ubound(astr, 1) /= 5) error stop
+ astr = ["01db45", "jk$D%S", "zutg47"]
+!$omp end target
+!$omp target exit data map(from: astr)
+if (.not. allocated(astr)) error stop
+if (len(astr) /= 6) error stop
+if (size(astr) /= 3) error stop
+if (lbound(astr, 1) /= 3) error stop
+if (ubound(astr, 1) /= 5) error stop
+if (any (astr /= ["01db45", "jk$D%S", "zutg47"])) error stop
+#endif
+
+#if 0
+! libgomp: nvptx_alloc error: out of memory
+
+!$omp target enter data map(alloc: astr2)
+!$omp target map(alloc: astr2)
+ if (.not. allocated(astr2)) error stop
+ if (len(astr2) /= 8) error stop
+ astr2 = "HIJKhijk"
+!$omp end target
+!$omp target exit data map(from: astr2)
+if (.not. allocated(astr2)) error stop
+if (len(astr2) /= 8) error stop
+if (astr2 /= "HIJKhijk") error stop
+#endif
+
+
+! character(len=:,kind=4), pointer :: p4str(:), p4str2
+! allocate(character(len=3,kind=4) :: p4str(2:4))
+! allocate(character(len=5,kind=4) :: p4str2)
+
+#if 0
+! FAILS with value check
+
+!$omp target enter data map(alloc: p4str)
+!$omp target map(alloc: p4str)
+ if (.not. associated(p4str)) error stop
+ if (len(p4str) /= 3) error stop
+ if (size(p4str) /= 3) error stop
+ if (lbound(p4str, 1) /= 2) error stop
+ if (ubound(p4str, 1) /= 4) error stop
+ p4str(:) = [4_"f85", 4_"8af", 4_"A%F"]
+!$omp end target
+!$omp target exit data map(from: p4str)
+if (.not. associated(p4str)) error stop
+if (len(p4str) /= 3) error stop
+if (size(p4str) /= 3) error stop
+if (lbound(p4str, 1) /= 2) error stop
+if (ubound(p4str, 1) /= 4) error stop
+if (p4str(2) /= 4_"f85") error stop
+if (p4str(3) /= 4_"8af") error stop
+if (p4str(4) /= 4_"A%F") error stop
+#endif
+
+!$omp target enter data map(alloc: p4str2)
+!$omp target map(alloc: p4str2)
+ if (.not. associated(p4str2)) error stop
+ if (len(p4str2) /= 5) error stop
+ p4str2 = 4_"9875a"
+!$omp end target
+!$omp target exit data map(from: p4str2)
+if (.not. associated(p4str2)) error stop
+if (len(p4str2) /= 5) error stop
+if (p4str2 /= 4_"9875a") error stop
+
+
+! character(len=:,kind=4), allocatable :: a4str(:), a4str2
+! allocate(character(len=7,kind=4) :: a4str(-2:3))
+! allocate(character(len=9,kind=4) :: a4str2)
+
+#if 0
+! libgomp: Trying to map into device [0x1027ba0..0x251050bb9c9ebba0) object when [0x7ffd026e6708..0x7ffd026e6710) is already mapped
+
+!$omp target enter data map(alloc: a4str)
+!$omp target map(alloc: a4str)
+ if (.not. allocated(a4str)) error stop
+ if (len(a4str) /= 7) error stop
+ if (size(a4str) /= 6) error stop
+ if (lbound(a4str, 1) /= -2) error stop
+ if (ubound(a4str, 1) /= 3) error stop
+ ! See PR fortran/107508 why '(:)' is required
+ a4str(:) = [4_"sf456aq", 4_"3dtzu24", 4_"_4fh7sm", 4_"=ff85s7", 4_"j=8af4d", 4_".,A%Fsz"]
+!$omp end target
+!$omp target exit data map(from: a4str)
+if (.not. allocated(a4str)) error stop
+if (len(a4str) /= 7) error stop
+if (size(a4str) /= 6) error stop
+if (lbound(a4str, 1) /= -2) error stop
+if (ubound(a4str, 1) /= 3) error stop
+if (a4str(-2) /= 4_"sf456aq") error stop
+if (a4str(-1) /= 4_"3dtzu24") error stop
+if (a4str(0) /= 4_"_4fh7sm") error stop
+if (a4str(1) /= 4_"=ff85s7") error stop
+if (a4str(2) /= 4_"j=8af4d") error stop
+if (a4str(3) /= 4_".,A%Fsz") error stop
+#endif
+
+!$omp target enter data map(alloc: a4str2)
+!$omp target map(alloc: a4str2)
+ if (.not. allocated(a4str2)) error stop
+ if (len(a4str2) /= 9) error stop
+ a4str2 = 4_"98765a23d"
+!$omp end target
+!$omp target exit data map(from: a4str2)
+if (.not. allocated(a4str2)) error stop
+if (len(a4str2) /= 9) error stop
+if (a4str2 /= 4_"98765a23d") error stop
+
+
+deallocate(dt%pc, dt%pc2)
+deallocate(dt%pcstr)
+deallocate(dt%pcstr2)
+
+deallocate(dt%pc4str)
+deallocate(dt%pc4str2)
+
+deallocate(ip, ip2, ia, ia2)
+deallocate(pstr)
+deallocate(pstr2)
+deallocate(astr)
+deallocate(astr2)
+
+deallocate(p4str)
+deallocate(p4str2)
+deallocate(a4str)
+deallocate(a4str2)
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90
new file mode 100644
index 0000000..80e077e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-1.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays to target using map
+! iterators.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: expected, sum, i, j
+
+ expected = mkarray ()
+
+ !$omp target map(iterator(i=1:DIM1), to: x(i)%arr(:)) map(from: sum)
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ if (sum .ne. expected) stop 1
+contains
+ integer function mkarray ()
+ integer :: exp = 0
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ exp = exp + x(i)%arr(j)
+ end do
+ end do
+
+ mkarray = exp
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90
new file mode 100644
index 0000000..cf0e7fb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-2.f90
@@ -0,0 +1,45 @@
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays from target using map
+! iterators.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: expected, sum, i, j
+
+ call mkarray
+
+ !$omp target map(iterator(i=1:DIM1), from: x(i)%arr(:)) map(from: expected)
+ expected = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ x(i)%arr(j) = (i+1) * (j+1)
+ expected = expected + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+
+ if (sum .ne. expected) stop 1
+contains
+ subroutine mkarray
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ end do
+ end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90
new file mode 100644
index 0000000..d62fc1d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-3.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays to target using map
+! iterators, with multiple iterators and function calls in the iterator
+! expression.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 16
+ integer, parameter :: DIM2 = 4
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1), y(DIM1)
+ integer :: expected, sum, i, j, k
+
+ expected = mkarrays ()
+
+ !$omp target map(iterator(i=0:DIM1/4-1, j=0:3), to: x(f (i, j))%arr(:)) &
+ !$omp map(iterator(k=1:DIM1), to: y(k)%arr(:)) &
+ !$omp map(from: sum)
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j) * y(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ if (sum .ne. expected) stop 1
+contains
+ integer function mkarrays ()
+ integer :: exp = 0
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ allocate (y(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ y(i)%arr(j) = i + j
+ exp = exp + x(i)%arr(j) * y(i)%arr(j)
+ end do
+ end do
+
+ mkarrays = exp
+ end function
+
+ integer function f (i, j)
+ integer, intent(in) :: i, j
+
+ f = i * 4 + j + 1
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-4.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-4.f90
new file mode 100644
index 0000000..85f6287
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-4.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays to target using map
+! iterators with variable bounds.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: expected, sum, i, j
+ integer :: i_ubound
+
+ expected = mkarray (i_ubound)
+
+ !$omp target map(iterator(i=1:i_ubound), to: x(i)%arr(:)) map(from: sum)
+ sum = 0
+ do i = 1, i_ubound
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ if (sum .ne. expected) stop 1
+contains
+ integer function mkarray (ubound)
+ integer, intent(out) :: ubound
+ integer :: exp = 0
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ exp = exp + x(i)%arr(j)
+ end do
+ end do
+
+ ubound = DIM1
+ mkarray = exp
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-map-iterators-5.f90 b/libgomp/testsuite/libgomp.fortran/target-map-iterators-5.f90
new file mode 100644
index 0000000..4c47ee5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-map-iterators-5.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays to target using map
+! iterators, with multiple iterators, function calls and non-constant
+! bounds in the iterator expression.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 16
+ integer, parameter :: DIM2 = 4
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1), y(DIM1)
+ integer :: expected, sum, i, j, k
+ integer :: i_ubound
+ integer :: k_ubound
+
+ expected = mkarrays (k_ubound)
+ i_ubound = k_ubound / 4 - 1
+
+ !$omp target map(iterator(i=0:i_ubound, j=0:3), to: x(f (i, j))%arr(:)) &
+ !$omp map(iterator(k=1:k_ubound), to: y(k)%arr(:)) &
+ !$omp map(from: sum)
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j) * y(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ if (sum .ne. expected) stop 1
+contains
+ integer function mkarrays (ubound)
+ integer, intent(out) :: ubound
+ integer :: exp = 0
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ allocate (y(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ y(i)%arr(j) = i + j
+ exp = exp + x(i)%arr(j) * y(i)%arr(j)
+ end do
+ end do
+
+ ubound = DIM1
+ mkarrays = exp
+ end function
+
+ integer function f (i, j)
+ integer, intent(in) :: i, j
+
+ f = i * 4 + j + 1
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-update-iterators-1.f90 b/libgomp/testsuite/libgomp.fortran/target-update-iterators-1.f90
new file mode 100644
index 0000000..e9a13a3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-update-iterators-1.f90
@@ -0,0 +1,68 @@
+! { dg-do run }
+
+! Test target enter data and target update to the target using map
+! iterators.
+
+program test
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: expected, sum, i, j
+
+ expected = mkarray (x)
+
+ !$omp target enter data map(to: x)
+ !$omp target enter data map(iterator(i=1:DIM1), to: x(i)%arr(:))
+ !$omp target map(from: sum)
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ print *, sum, expected
+ if (sum .ne. expected) stop 1
+
+ expected = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ x(i)%arr(j) = x(i)%arr(j) * i * j
+ expected = expected + x(i)%arr(j)
+ end do
+ end do
+
+ !$omp target update to(iterator(i=1:DIM1): x(i)%arr(:))
+
+ !$omp target map(from: sum)
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ if (sum .ne. expected) stop 2
+contains
+ integer function mkarray (x)
+ type (array_ptr), intent(inout) :: x(DIM1)
+ integer :: exp = 0
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ exp = exp + x(i)%arr(j)
+ end do
+ end do
+
+ mkarray = exp
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-update-iterators-2.f90 b/libgomp/testsuite/libgomp.fortran/target-update-iterators-2.f90
new file mode 100644
index 0000000..2e982bc
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-update-iterators-2.f90
@@ -0,0 +1,63 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+! Test target enter data and target update from the target using map
+! iterators.
+
+program test
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: sum, expected
+
+ call mkarray (x)
+
+ !$omp target enter data map(to: x(:DIM1))
+ !$omp target enter data map(iterator(i=1:DIM1), to: x(i)%arr(:))
+ !$omp target map(from: expected)
+ expected = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ x(i)%arr(j) = (i + 1) * (j + 2)
+ expected = expected + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ ! Host copy of x should remain unchanged.
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ if (sum .ne. 0) stop 1
+
+ !$omp target update from(iterator(i=1:DIM1): x(i)%arr(:))
+
+ ! Host copy should now be updated.
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+
+ if (sum .ne. expected) stop 2
+contains
+ subroutine mkarray (x)
+ type (array_ptr), intent(inout) :: x(DIM1)
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = 0
+ end do
+ end do
+ end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-update-iterators-3.f90 b/libgomp/testsuite/libgomp.fortran/target-update-iterators-3.f90
new file mode 100644
index 0000000..54b2a6c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-update-iterators-3.f90
@@ -0,0 +1,78 @@
+! { dg-do run }
+! { dg-require-effective-target offload_device_nonshared_as }
+
+! Test target enter data and target update to the target using map
+! iterators with a function.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: x_new(DIM1, DIM2)
+ integer :: expected, sum, i, j
+
+ call mkarray (x)
+
+ !$omp target enter data map(to: x(:DIM1))
+ !$omp target enter data map(iterator(i=1:DIM1), to: x(i)%arr(:))
+
+ ! Update x on host.
+ do i = 1, DIM1
+ do j = 1, DIM2
+ x_new(i, j) = x(i)%arr(j)
+ x(i)%arr(j) = (i + 1) * (j + 2);
+ end do
+ end do
+
+ ! Update a subset of x on target.
+ !$omp target update to(iterator(i=1:DIM1/2): x(f (i))%arr(:))
+
+ !$omp target map(from: sum)
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ ! Calculate expected value on host.
+ do i = 1, DIM1/2
+ do j = 1, DIM2
+ x_new(f (i), j) = x(f (i))%arr(j)
+ end do
+ end do
+
+ expected = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ expected = expected + x_new(i, j)
+ end do
+ end do
+
+ if (sum .ne. expected) stop 1
+contains
+ subroutine mkarray (x)
+ type (array_ptr), intent(inout) :: x(DIM1)
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ end do
+ end do
+ end subroutine
+
+ integer function f (i)
+ integer, intent(in) :: i
+
+ f = i * 2
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-update-iterators-4.f90 b/libgomp/testsuite/libgomp.fortran/target-update-iterators-4.f90
new file mode 100644
index 0000000..9f138aa
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-update-iterators-4.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+
+! Test target enter data and target update to the target using map
+! iterators with non-constant bounds.
+
+program test
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: expected, sum, i, j, ubound
+
+ expected = mkarray (x, ubound)
+
+ !$omp target enter data map(to: x)
+ !$omp target enter data map(iterator(i=1:ubound), to: x(i)%arr(:))
+ !$omp target map(from: sum)
+ sum = 0
+ do i = 1, ubound
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ print *, sum, expected
+ if (sum .ne. expected) stop 1
+
+ expected = 0
+ do i = 1, ubound
+ do j = 1, DIM2
+ x(i)%arr(j) = x(i)%arr(j) * i * j
+ expected = expected + x(i)%arr(j)
+ end do
+ end do
+
+ !$omp target update to(iterator(i=1:ubound): x(i)%arr(:))
+
+ !$omp target map(from: sum)
+ sum = 0
+ do i = 1, ubound
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ if (sum .ne. expected) stop 2
+contains
+ integer function mkarray (x, bound)
+ type (array_ptr), intent(inout) :: x(DIM1)
+ integer, intent(out) :: bound
+ integer :: exp = 0
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ exp = exp + x(i)%arr(j)
+ end do
+ end do
+
+ bound = DIM1
+ mkarray = exp
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90
index 0732796..bb98403 100644
--- a/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90
@@ -3,8 +3,6 @@
! Minimal test for valid code:
! - predefined allocators do not need any special treatment in uses_allocators
! (as 'requires dynamic_allocators' is the default).
-!
-! - Non-predefined allocators are currently rejected ('sorry)'
subroutine test
use omp_lib
@@ -35,22 +33,22 @@ subroutine non_predef
integer(kind=omp_allocator_handle_kind) :: a1, a2, a3
- !$omp target uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2)) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp target uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))
block; end block
- !$omp target parallel uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2)) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp target parallel uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))
block; end block
!$omp target uses_allocators(traits(trait):a1) &
- !$omp& uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp& uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)
block; end block
!$omp target parallel uses_allocators(traits(trait):a1) &
- !$omp& uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp& uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)
block; end block
- !$omp target uses_allocators ( traits(trait2) , memspace ( omp_low_lat_mem_space ) : a2 , a3) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp target uses_allocators ( traits(trait2) , memspace ( omp_low_lat_mem_space ) : a2 , a3)
block; end block
end subroutine
@@ -62,7 +60,7 @@ subroutine trait_present
integer(kind=omp_allocator_handle_kind) :: a1
! Invalid in OpenMP 5.0 / 5.1, but valid since 5.2 the same as omp_default_mem_space + emptry traits array
- !$omp target uses_allocators ( a1 ) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp target uses_allocators ( a1 )
block; end block
end
@@ -76,13 +74,13 @@ subroutine odd_names
integer(kind=omp_allocator_handle_kind) :: traits
integer(kind=omp_allocator_handle_kind) :: memspace
- !$omp target uses_allocators ( traits(trait1), memspace(trait1) ) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp target uses_allocators ( traits(trait1), memspace(trait1) )
block; end block
- !$omp target uses_allocators ( traits(trait1), memspace(omp_low_lat_mem_space) : traits) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp target uses_allocators ( traits(trait1), memspace(omp_low_lat_mem_space) : traits)
block; end block
- !$omp target uses_allocators ( memspace(omp_low_lat_mem_space), traits(trait1) : memspace) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp target uses_allocators ( memspace(omp_low_lat_mem_space), traits(trait1) : memspace)
block; end block
end
@@ -94,6 +92,6 @@ subroutine more_checks
integer(kind=omp_allocator_handle_kind) :: a1, a2(4)
integer(kind=1) :: a3
- !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a1 ) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
+ !$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a1 )
block; end block
end
diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_3.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_3.f90
new file mode 100644
index 0000000..8acdd42
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_3.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" }
+
+program main
+ use omp_lib
+ implicit none
+ integer, allocatable :: arr(:)
+ integer (omp_allocator_handle_kind) :: bar, foo
+
+ type (omp_alloctrait), parameter :: traits_array(*) = &
+ [omp_alloctrait(omp_atk_pinned,omp_atv_true),&
+ omp_alloctrait(omp_atk_partition,omp_atv_nearest)]
+
+ !$omp target allocate(bar : arr) uses_allocators(bar)
+ block
+ allocate(arr(100))
+ end block
+
+ !$omp target uses_allocators(omp_default_mem_alloc)
+ block
+ end block
+
+ !$omp target uses_allocators(bar(traits_array), foo (traits_array))
+ block
+ if (foo == 0) stop 1
+ end block
+
+ !$omp target uses_allocators(traits(traits_array) : bar)
+ block
+ end block
+
+ !$omp target parallel uses_allocators(memspace (omp_low_lat_mem_space) : bar)
+ block
+ end block
+
+ !$omp target parallel uses_allocators(memspace (omp_high_bw_mem_space), traits(traits_array) : bar)
+ block
+ use iso_c_binding
+ type(c_ptr) :: ptr
+ integer(c_size_t) :: sz = 32
+ ptr = omp_alloc (sz, bar)
+ call omp_free (ptr, bar)
+ end block
+
+end program main
+
+! { dg-final { scan-tree-dump "pragma omp target allocate\\(allocator\\(bar\\):arr\\) uses_allocators\\(bar: memspace\\(\\), traits\\(\\)\\)" "original" } }
+! { dg-final { scan-tree-dump "pragma omp target" "original" } }
+! { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(\\), traits\\(traits_array\\)\\) uses_allocators\\(foo: memspace\\(\\), traits\\(traits_array\\)\\)" "original" } }
+! { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(\\), traits\\(traits_array\\)\\)" "original" } }
+! { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(omp_low_lat_mem_space\\), traits\\(\\)\\)" "original" } }
+! { dg-final { scan-tree-dump "pragma omp target uses_allocators\\(bar: memspace\\(omp_high_bw_mem_space\\), traits\\(traits_array\\)\\)" "original" } }
+
+! { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) allocate\\(allocator\\(bar\\):arr\\) uses_allocators\\(bar: memspace\\(\\), traits\\(\\)\\) private\\(bar\\)" "gimple" } }
+! { dg-final { scan-tree-dump "pragma omp target" "gimple" } }
+! { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(\\), traits\\(traits_array\\)\\) uses_allocators\\(foo: memspace\\(\\), traits\\(traits_array\\)\\) private\\(foo\\) private\\(bar\\)" "gimple" } }
+! { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(\\), traits\\(traits_array\\)\\) private\\(bar\\)" "gimple" } }
+! { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(omp_low_lat_mem_space\\), traits\\(\\)\\) firstprivate\\(omp_low_lat_mem_space\\) private\\(bar\\)" "gimple" } }
+! { dg-final { scan-tree-dump "pragma omp target num_teams\\(-2\\) thread_limit\\(0\\) uses_allocators\\(bar: memspace\\(omp_high_bw_mem_space\\), traits\\(traits_array\\)\\) firstprivate\\(omp_high_bw_mem_space\\) private\\(bar\\)" "gimple" } }
+
+! { dg-final { scan-tree-dump-times "__builtin_omp_init_allocator" 6 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_omp_destroy_allocator" 6 "gimple" } }
diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_4.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_4.f90
new file mode 100644
index 0000000..00f1dcb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_4.f90
@@ -0,0 +1,54 @@
+! { dg-do compile }
+
+program main
+ use omp_lib
+ implicit none
+ integer (omp_allocator_handle_kind) :: bar, foo
+
+ type (omp_alloctrait), parameter :: traits_array(*) = &
+ [omp_alloctrait(omp_atk_pinned,omp_atv_true),&
+ omp_alloctrait(omp_atk_partition,omp_atv_nearest)]
+
+ !$omp target uses_allocators(omp_non_existant_alloc) ! { dg-error "Allocator 'omp_non_existant_alloc' at .1. in USES_ALLOCATORS must be a scalar integer of kind 'omp_allocator_handle_kind'" }
+ block ! { dg-error "Symbol 'omp_non_existant_alloc' at .1. has no IMPLICIT type; did you mean 'omp_const_mem_alloc'\?" "" { target *-*-* } .-1 }
+ end block
+
+ !$omp target uses_allocators(bar(traits_array), foo (traits_array), ) ! { dg-error "Invalid character in name" }
+ block
+ end block
+
+ !$omp target uses_allocators(traits(xyz) : bar) ! { dg-error "Symbol 'xyz' at .1. has no IMPLICIT type" }
+ block ! { dg-error "Traits array 'xyz' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" "" { target *-*-* } .-1 }
+ end block
+
+ !$omp target uses_allocators(memspace(omp_non_existant_mem_space) : foo) ! { dg-error "Symbol 'omp_non_existant_mem_space' at .1. has no IMPLICIT type; did you mean 'omp_const_mem_space'\?" }
+ ! { dg-error "Memspace 'omp_non_existant_mem_space' at .1. in USES_ALLOCATORS must be a predefined memory space" "" { target *-*-* } .-1 }
+
+ block
+ end block
+
+ !$omp target uses_allocators(traits(traits_array), traits(traits_array) : bar) ! { dg-error "Duplicate TRAITS modifier at .1. in USES_ALLOCATORS clause" }
+ block
+ end block
+
+ !$omp target uses_allocators(memspace(omp_default_mem_space), memspace(omp_default_mem_space) : foo) ! { dg-error "Duplicate MEMSPACE modifier at .1. in USES_ALLOCATORS clause" }
+ block
+ end block
+
+ !$omp target uses_allocators(memspace(omp_default_mem_space), traits(traits_array), traits(traits_array) : foo) ! { dg-error "Duplicate TRAITS modifier at .1. in USES_ALLOCATORS clause" }
+ block
+ end block
+
+ !$omp target uses_allocators (omp_null_allocator) ! { dg-error "Allocator 'omp_null_allocator' at .1. in USES_ALLOCATORS must either a variable or a predefined allocator" }
+ block
+ end block
+
+ !$omp target uses_allocators (memspace(omp_high_bw_mem_space) : foo, bar)
+ block
+ end block
+
+ !$omp target uses_allocators (memspace(omp_high_bw_mem_space) : foo(foo_traits)) ! { dg-error "70:Unexpected '\\(' at .1." }
+ block
+ end block
+
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_5.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_5.f90
new file mode 100644
index 0000000..00f8710
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_5.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+program main
+ use omp_lib
+ implicit none
+ integer, allocatable :: arr(:)
+ integer (omp_allocator_handle_kind) :: bar
+
+ !$omp target allocate(bar : arr) ! { dg-error "allocator 'bar' requires 'uses_allocators.bar.' clause in target region" }
+ block
+ allocate(arr(100))
+ end block
+
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/uses_allocators_6.f90 b/libgomp/testsuite/libgomp.fortran/uses_allocators_6.f90
new file mode 100644
index 0000000..993435fd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/uses_allocators_6.f90
@@ -0,0 +1,50 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+
+program main
+ use iso_c_binding
+ use omp_lib
+ implicit none (type, external)
+ integer :: x, xbuf(10)
+ integer(c_intptr_t) :: iptr
+ integer(omp_allocator_handle_kind) :: my_alloc
+ type(omp_alloctrait), parameter :: trait(*) = [omp_alloctrait(omp_atk_alignment, 128)]
+
+ !$omp target uses_allocators(omp_low_lat_mem_alloc) map(tofrom: x, xbuf) defaultmap(none)
+ !$omp parallel allocate(allocator(omp_low_lat_mem_alloc), align(128): x, xbuf) if(.false.) firstprivate(x, xbuf)
+ if (mod (TRANSFER (loc(x), iptr), 128) /= 0) &
+ stop 1
+ if (mod (TRANSFER (loc(xbuf), iptr), 128) /= 0) &
+ stop 2
+ !$omp end parallel
+ !$omp end target
+
+ my_alloc = transfer(int(z'ABCD', omp_allocator_handle_kind), my_alloc)
+
+ !$omp target uses_allocators(traits(trait): my_alloc) defaultmap(none) map(tofrom: x, xbuf)
+ !$omp parallel allocate(allocator(my_alloc): x, xbuf) if(.false.) firstprivate(x, xbuf)
+ if (mod (TRANSFER (loc(x), iptr), 128) /= 0) &
+ stop 3
+ if (mod (TRANSFER (loc(xbuf), iptr), 128) /= 0) &
+ stop 4
+ !$omp end parallel
+ !$omp end target
+
+ if (transfer(my_alloc, 0_omp_allocator_handle_kind) /= int(z'ABCD', omp_allocator_handle_kind)) &
+ stop 5
+
+ ! The following creates an allocator with empty traits + default mem space.
+ !$omp target uses_allocators(my_alloc) map(tofrom: x, xbuf) defaultmap(none)
+ !$omp parallel allocate(allocator(my_alloc), align(128): x, xbuf) if(.false.) firstprivate(x, xbuf)
+ if (mod (TRANSFER (loc(x), iptr), 128) /= 0) &
+ stop 6
+ if (mod (TRANSFER (loc(xbuf), iptr), 128) /= 0) &
+ stop 7
+ !$omp end parallel
+ !$omp end target
+
+ if (transfer(my_alloc, 0_omp_allocator_handle_kind) /= int(z'ABCD', omp_allocator_handle_kind)) &
+ stop 8
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp target .*private\\(my_alloc\\).*uses_allocators\\(my_alloc: memspace\\(\\), traits\\(trait\\)\\)" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target .*private\\(my_alloc\\).*uses_allocators\\(my_alloc: memspace\\(\\), traits\\(\\)\\)" 1 "gimple" } }
diff --git a/libgomp/testsuite/libgomp.oacc-c++/exceptions-bad_cast-3.C b/libgomp/testsuite/libgomp.oacc-c++/exceptions-bad_cast-3.C
index 4fa419f..e9372fa 100644
--- a/libgomp/testsuite/libgomp.oacc-c++/exceptions-bad_cast-3.C
+++ b/libgomp/testsuite/libgomp.oacc-c++/exceptions-bad_cast-3.C
@@ -44,6 +44,6 @@ int main()
}
}
-/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial map\(tofrom:_ZTI2C2 \[len: [0-9]+\]\) map\(tofrom:_ZTI2C1 \[len: [0-9]+\]\) map\(tofrom:_ZTV2C1 \[len: [0-9]+\]\)$} gimple { xfail *-*-* } } } */
+/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial map\(tofrom:_ZTI2C2 \[len: [0-9]+\] \[runtime_implicit\]\) map\(tofrom:_ZTI2C1 \[len: [0-9]+\] \[runtime_implicit\]\) map\(tofrom:_ZTV2C1 \[len: [0-9]+\] \[runtime_implicit\]\)$} gimple { xfail *-*-* } } } */
/* { dg-final { scan-tree-dump-times {gimple_call <__cxa_bad_cast, } 1 optimized } } */
diff --git a/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-1.C b/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-1.C
index f2ef751..08c5766 100644
--- a/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-1.C
+++ b/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-1.C
@@ -4,9 +4,6 @@
{ dg-additional-options -fexceptions } */
/* { dg-additional-options -fdump-tree-optimized-raw }
{ dg-additional-options -foffload-options=-fdump-tree-optimized-raw } */
-/* { dg-bogus {Size expression must be absolute\.} PR119737 { target { openacc_radeon_accel_selected && __OPTIMIZE__ } xfail *-*-* } 0 }
- { dg-ice PR119737 { openacc_radeon_accel_selected && __OPTIMIZE__ } }
- { dg-excess-errors {'mkoffload' failure etc.} { xfail { openacc_radeon_accel_selected && __OPTIMIZE__ } } } */
/* See also '../libgomp.c++/target-exceptions-throw-1.C'. */
diff --git a/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-2.C b/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-2.C
index f6dc970..a7408cd 100644
--- a/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-2.C
+++ b/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-2.C
@@ -6,9 +6,6 @@
{ dg-additional-options -foffload-options=-fdump-tree-optimized-raw } */
/* { dg-bogus {undefined symbol: typeinfo name for MyException} PR119806 { target { openacc_radeon_accel_selected && { ! __OPTIMIZE__ } } xfail *-*-* } 0 }
{ dg-excess-errors {'mkoffload' failure etc.} { xfail { openacc_radeon_accel_selected && { ! __OPTIMIZE__ } } } } */
-/* { dg-bogus {Size expression must be absolute\.} PR119737 { target { openacc_radeon_accel_selected && __OPTIMIZE__ } xfail *-*-* } 0 }
- { dg-ice PR119737 { openacc_radeon_accel_selected && __OPTIMIZE__ } }
- { dg-excess-errors {'mkoffload' failures etc.} { xfail { openacc_radeon_accel_selected && __OPTIMIZE__ } } } */
/* { dg-bogus {Initial value type mismatch} PR119806 { target { openacc_nvidia_accel_selected && { ! __OPTIMIZE__ } } xfail *-*-* } 0 }
{ dg-excess-errors {'mkoffload' failure etc.} { xfail { openacc_nvidia_accel_selected && { ! __OPTIMIZE__ } } } } */
diff --git a/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-3.C b/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-3.C
index 74a62b3..6664f80 100644
--- a/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-3.C
+++ b/libgomp/testsuite/libgomp.oacc-c++/exceptions-throw-3.C
@@ -37,7 +37,7 @@ int main()
}
}
-/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial map\(tofrom:_ZTI11MyException \[len: [0-9]+\]\)$} gimple { xfail *-*-* } } } */
+/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial map\(tofrom:_ZTI11MyException \[len: [0-9]+\] \[runtime_implicit\]\)$} gimple { xfail *-*-* } } } */
/* { dg-final { scan-tree-dump-times {gimple_call <__cxa_allocate_exception, } 1 optimized } }
{ dg-final { scan-tree-dump-times {gimple_call <__cxa_throw, } 1 optimized } } */
diff --git a/libgomp/testsuite/libgomp.oacc-c++/firstprivate-int.C b/libgomp/testsuite/libgomp.oacc-c++/firstprivate-int.C
new file mode 100644
index 0000000..86b8722
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c++/firstprivate-int.C
@@ -0,0 +1,83 @@
+/* Verify the GOMP_MAP_FIRSTPRIVATE_INT optimization on various types.
+ This test is similer to the test in libgomp.oacc-c-c++-common, but
+ it focuses on reference types. */
+
+#include <assert.h>
+#include <stdint.h>
+#include <complex.h>
+
+void test_ref (int8_t &i8i, int8_t &i8o, int16_t &i16i, int16_t &i16o,
+ int32_t &i32i, int32_t &i32o, int64_t &i64i, int64_t &i64o,
+ uint8_t &u8i, uint8_t &u8o, uint16_t &u16i, uint16_t &u16o,
+ uint32_t &u32i, uint32_t &u32o, uint64_t &u64i, uint64_t &u64o,
+ float &r32i, float &r32o, double &r64i, double &r64o,
+ int _Complex &cii, int _Complex &cio,
+ float _Complex &cfi, float _Complex &cfo,
+ double _Complex &cdi, double _Complex &cdo)
+{
+#pragma acc parallel firstprivate (i8i,i16i,i32i,i64i,u8i,u16i,u32i,u64i) \
+ firstprivate(r32i,r64i,cii,cfi,cdi) copyout(i8o,i16o,i32o,i64o) \
+ copyout(u8o,u16o,u32o,u64o,r32o,r64o,cio,cfo,cdo) num_gangs(1)
+ {
+ i8o = i8i;
+ i16o = i16i;
+ i32o = i32i;
+ i64o = i64i;
+
+ u8o = u8i;
+ u16o = u16i;
+ u32o = u32i;
+ u64o = u64i;
+
+ r32o = r32i;
+ r64o = r64i;
+
+ cio = cii;
+ cfo = cfi;
+ cdo = cdi;
+ }
+}
+
+int
+main ()
+{
+ int8_t i8i = -1, i8o;
+ int16_t i16i = -2, i16o;
+ int32_t i32i = -3, i32o;
+ int64_t i64i = -4, i64o;
+
+ uint8_t u8i = 1, u8o;
+ uint16_t u16i = 2, u16o;
+ uint32_t u32i = 3, u32o;
+ uint64_t u64i = 4, u64o;
+
+ float r32i = .5, r32o;
+ double r64i = .25, r64o;
+
+ int _Complex cii = 2, cio;
+ float _Complex cfi = 4, cfo;
+ double _Complex cdi = 8, cdo;
+
+ test_ref (i8i, i8o, i16i, i16o, i32i, i32o, i64i, i64o, u8i, u8o, u16i,
+ u16o, u32i, u32o, u64i, u64o, r32i, r32o, r64i, r64o, cii, cio,
+ cfi, cfo, cdi, cdo);
+
+ assert (i8o == i8i);
+ assert (i16o == i16i);
+ assert (i32o == i32i);
+ assert (i64o == i64i);
+
+ assert (u8o == u8i);
+ assert (u16o == u16i);
+ assert (u32o == u32i);
+ assert (u64o == u64i);
+
+ assert (r32o == r32i);
+ assert (r64o == r64i);
+
+ assert (cio == cii);
+ assert (cfo == cfi);
+ assert (cdo == cdi);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-1.C b/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-1.C
index 5c3e037..4a876f7 100644
--- a/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-1.C
+++ b/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-1.C
@@ -39,4 +39,4 @@ int main()
}
}
-/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial map\(tofrom:_ZTI2C2 \[len: [0-9]+\]\) map\(tofrom:_ZTI2C1 \[len: [0-9]+\]\) map\(tofrom:_ZTV2C1 \[len: [0-9]+\]\)$} gimple { xfail *-*-* } } } */
+/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial map\(tofrom:_ZTI2C2 \[len: [0-9]+\] \[runtime_implicit\]\) map\(tofrom:_ZTI2C1 \[len: [0-9]+\] \[runtime_implicit\]\) map\(tofrom:_ZTV2C1 \[len: [0-9]+\] \[runtime_implicit\]\)$} gimple { xfail *-*-* } } } */
diff --git a/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-2.C b/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-2.C
index 207b183..052e423 100644
--- a/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-2.C
+++ b/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-2.C
@@ -9,4 +9,4 @@
/* { dg-bogus {using 'vector_length \(32\)', ignoring 1} {} { target openacc_nvidia_accel_selected xfail *-*-* } 0 } */
-/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial default\(none\) map\(tofrom:_ZTI2C2 \[len: [0-9]+\]\) map\(tofrom:_ZTI2C1 \[len: [0-9]+\]\) map\(tofrom:_ZTV2C1 \[len: [0-9]+\]\)$} gimple { xfail *-*-* } } } */
+/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial default\(none\) map\(tofrom:_ZTI2C2 \[len: [0-9]+\] \[runtime_implicit\]\) map\(tofrom:_ZTI2C1 \[len: [0-9]+\] \[runtime_implicit\]\) map\(tofrom:_ZTV2C1 \[len: [0-9]+\] \[runtime_implicit\]\)$} gimple { xfail *-*-* } } } */
diff --git a/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-3.C b/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-3.C
index e9b44de..fd1844b 100644
--- a/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-3.C
+++ b/libgomp/testsuite/libgomp.oacc-c++/pr119692-1-3.C
@@ -9,4 +9,4 @@
/* { dg-bogus {using 'vector_length \(32\)', ignoring 1} {} { target openacc_nvidia_accel_selected xfail *-*-* } 0 } */
-/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial default\(present\) map\(force_present:_ZTI2C2 \[len: [0-9]+\]\) map\(force_present:_ZTI2C1 \[len: [0-9]+\]\) map\(force_present:_ZTV2C1 \[len: [0-9]+\]\)$} gimple { xfail *-*-* } } } */
+/* { dg-final { scan-tree-dump-not {(?n)#pragma omp target oacc_serial default\(present\) map\(force_present:_ZTI2C2 \[len: [0-9]+\] \[runtime_implicit\]\) map\(force_present:_ZTI2C1 \[len: [0-9]+\] \[runtime_implicit\]\) map\(force_present:_ZTV2C1 \[len: [0-9]+\] \[runtime_implicit\]\)$} gimple { xfail *-*-* } } } */
diff --git a/libgomp/testsuite/libgomp.oacc-c++/privatized-ref-3.C b/libgomp/testsuite/libgomp.oacc-c++/privatized-ref-3.C
index 11e1cef..5c70260 100644
--- a/libgomp/testsuite/libgomp.oacc-c++/privatized-ref-3.C
+++ b/libgomp/testsuite/libgomp.oacc-c++/privatized-ref-3.C
@@ -47,7 +47,7 @@ void gangs (void)
int tmpvar;
int &tmpref = tmpvar;
#pragma acc loop collapse(2) gang private(tmpref) /* { dg-line l_loop[incr c_loop] } */
- /* { dg-note {variable 'tmpref' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
+ /* { dg-note {variable 'tmpref' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } l_loop$c_loop } */
/* { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
/* { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
for (i = 0; i < 256; i++)
@@ -96,7 +96,7 @@ void workers (void)
for (i = 0; i < 256; i++)
{
#pragma acc loop worker private(tmpref) /* { dg-line l_loop[incr c_loop] } */
- /* { dg-note {variable 'tmpref' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
+ /* { dg-note {variable 'tmpref' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } l_loop$c_loop } */
/* { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
for (j = 0; j < 256; j++)
{
@@ -142,7 +142,7 @@ void vectors (void)
for (i = 0; i < 256; i++)
{
#pragma acc loop vector private(tmpref) /* { dg-line l_loop[incr c_loop] } */
- /* { dg-note {variable 'tmpref' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
+ /* { dg-note {variable 'tmpref' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } l_loop$c_loop } */
/* { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
for (j = 0; j < 256; j++)
{
@@ -184,7 +184,7 @@ void gangs_workers_vectors (void)
int tmpvar;
int &tmpref = tmpvar;
#pragma acc loop collapse(2) gang worker vector private(tmpref) /* { dg-line l_loop[incr c_loop] } */
- /* { dg-note {variable 'tmpref' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
+ /* { dg-note {variable 'tmpref' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } l_loop$c_loop } */
/* { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
/* { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop } */
for (i = 0; i < 256; i++)
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-dispatch-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-dispatch-1.c
index d929bfd..a9a8c74 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-dispatch-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-dispatch-1.c
@@ -114,8 +114,6 @@ void acc_register_library (acc_prof_reg reg_, acc_prof_reg unreg_, acc_prof_look
int main()
{
- acc_register_library (acc_prof_register, acc_prof_unregister, acc_prof_lookup);
-
STATE_OP (state, = 0);
reg (acc_ev_compute_construct_start, cb_compute_construct_start_1, acc_reg);
reg (acc_ev_compute_construct_start, cb_compute_construct_start_1, acc_reg);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-init-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-init-1.c
index b5e7715..91b3732 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-init-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-init-1.c
@@ -270,8 +270,6 @@ static void cb_compute_construct_end (acc_prof_info *prof_info, acc_event_info *
int main()
{
- acc_register_library (acc_prof_register, acc_prof_unregister, acc_prof_lookup);
-
STATE_OP (state, = 0);
reg (acc_ev_device_init_start, cb_device_init_start, acc_reg);
reg (acc_ev_device_init_end, cb_device_init_end, acc_reg);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-kernels-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-kernels-1.c
index 2c85397..2cd2c98 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-kernels-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-kernels-1.c
@@ -59,6 +59,7 @@ static int state = -1;
static acc_device_t acc_device_type;
static int acc_device_num;
static int num_gangs, num_workers, vector_length;
+static int async;
static void cb_enqueue_launch_start (acc_prof_info *prof_info, acc_event_info *event_info, acc_api_info *api_info)
@@ -76,7 +77,7 @@ static void cb_enqueue_launch_start (acc_prof_info *prof_info, acc_event_info *e
assert (prof_info->device_type == acc_device_type);
assert (prof_info->device_number == acc_device_num);
assert (prof_info->thread_id == -1);
- assert (prof_info->async == acc_async_noval);
+ assert (prof_info->async == async);
assert (prof_info->async_queue == prof_info->async);
assert (prof_info->src_file == NULL);
assert (prof_info->func_name == NULL);
@@ -166,8 +167,6 @@ void acc_register_library (acc_prof_reg reg_, acc_prof_reg unreg_, acc_prof_look
int main()
{
- acc_register_library (acc_prof_register, acc_prof_unregister, acc_prof_lookup);
-
STATE_OP (state, = 0);
reg (acc_ev_enqueue_launch_start, cb_enqueue_launch_start, acc_reg);
assert (state == 0);
@@ -176,8 +175,10 @@ int main()
acc_device_num = acc_get_device_num (acc_device_type);
assert (state == 0);
- /* Parallelism dimensions: compiler/runtime decides. */
STATE_OP (state, = 0);
+ /* Implicit async. */
+ async = acc_async_noval;
+ /* Parallelism dimensions: compiler/runtime decides. */
num_gangs = num_workers = vector_length = 0;
{
#define N 100
@@ -203,8 +204,10 @@ int main()
#undef N
}
- /* Parallelism dimensions: literal. */
STATE_OP (state, = 0);
+ /* Explicit async: without argument. */
+ async = acc_async_noval;
+ /* Parallelism dimensions: literal. */
num_gangs = 30;
num_workers = 3;
vector_length = 5;
@@ -212,6 +215,7 @@ int main()
#define N 100
int x[N];
#pragma acc kernels /* { dg-line l_compute[incr c_compute] } */ \
+ async \
num_gangs (30) num_workers (3) vector_length (5)
/* { dg-note {OpenACC 'kernels' decomposition: variable 'i' declared in block requested to be made addressable} {} { target *-*-* } l_compute$c_compute }
{ dg-note {variable 'i' made addressable} {} { target *-*-* } l_compute$c_compute } */
@@ -234,8 +238,10 @@ int main()
#undef N
}
- /* Parallelism dimensions: variable. */
STATE_OP (state, = 0);
+ /* Explicit async: variable. */
+ async = 123;
+ /* Parallelism dimensions: variable. */
num_gangs = 22;
num_workers = 5;
vector_length = 7;
@@ -243,6 +249,7 @@ int main()
#define N 100
int x[N];
#pragma acc kernels /* { dg-line l_compute[incr c_compute] } */ \
+ async (async) \
num_gangs (num_gangs) num_workers (num_workers) vector_length (vector_length)
/* { dg-note {OpenACC 'kernels' decomposition: variable 'i' declared in block requested to be made addressable} {} { target *-*-* } l_compute$c_compute }
{ dg-note {variable 'i' made addressable} {} { target *-*-* } l_compute$c_compute } */
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-parallel-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-parallel-1.c
index 9b4493d..27f86d3 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-parallel-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-parallel-1.c
@@ -830,8 +830,6 @@ static void cb_enqueue_launch_end (acc_prof_info *prof_info, acc_event_info *eve
int main()
{
- acc_register_library (acc_prof_register, acc_prof_unregister, acc_prof_lookup);
-
STATE_OP (state, = 0);
reg (acc_ev_device_init_start, cb_device_init_start, acc_reg);
reg (acc_ev_device_init_end, cb_device_init_end, acc_reg);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-valid_bytes-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-valid_bytes-1.c
index 5b58c51..a723ad9 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-valid_bytes-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-valid_bytes-1.c
@@ -143,8 +143,6 @@ typedef struct E
int main()
{
- acc_register_library (acc_prof_register, acc_prof_unregister, acc_prof_lookup);
-
A A1;
DEBUG_printf ("s=%zd, vb=%zd\n", sizeof A1, VALID_BYTES_A);
assert (VALID_BYTES_A <= sizeof A1);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-version-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-version-1.c
index f537868..5c05ee3 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-version-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/acc_prof-version-1.c
@@ -16,7 +16,7 @@ static void cb_any_event (acc_prof_info *prof_info, acc_event_info *event_info,
{
DEBUG_printf ("%s %d\n", __FUNCTION__, prof_info->event_type);
- assert (prof_info->version == 201711);
+ assert (prof_info->version == 201811);
++ev_count;
}
@@ -56,8 +56,6 @@ void acc_register_library (acc_prof_reg reg_, acc_prof_reg unreg_, acc_prof_look
int main()
{
- acc_register_library (acc_prof_register, acc_prof_unregister, acc_prof_lookup);
-
ev_count = 0;
/* Trigger tests done in 'cb_*' functions. */
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/data-firstprivate-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/data-firstprivate-1.c
index 8900a4e..4b88c53 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/data-firstprivate-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/data-firstprivate-1.c
@@ -1,6 +1,12 @@
/* Test behavior of 'firstprivate' lexically vs. dynamically nested inside a
'data' region. */
+/* The firstprivate_int optimization changes the semantics of firstprivate
+ in dynamically_nested_compute_2 to copy-by-value when not using shared
+ memory, leading to the behaviour suggested in PR92036 for this case. */
+
+/* { dg-xfail-run-if "firstprivate_int" { *-*-* } { "-DACC_MEM_SHARED=0" } } */
+
#include <stdlib.h>
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/firstprivate-int.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/firstprivate-int.c
new file mode 100644
index 0000000..6d14599
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/firstprivate-int.c
@@ -0,0 +1,67 @@
+/* Verify the GOMP_MAP_FIRSTPRIVATE_INT optimization on various types. */
+
+#include <assert.h>
+#include <stdint.h>
+#include <complex.h>
+
+int
+main ()
+{
+ int8_t i8i = -1, i8o;
+ int16_t i16i = -2, i16o;
+ int32_t i32i = -3, i32o;
+ int64_t i64i = -4, i64o;
+
+ uint8_t u8i = 1, u8o;
+ uint16_t u16i = 2, u16o;
+ uint32_t u32i = 3, u32o;
+ uint64_t u64i = 4, u64o;
+
+ float r32i = .5, r32o;
+ double r64i = .25, r64o;
+
+ int _Complex cii = 2, cio;
+ float _Complex cfi = 4, cfo;
+ double _Complex cdi = 8, cdo;
+
+#pragma acc parallel firstprivate (i8i,i16i,i32i,i64i,u8i,u16i,u32i,u64i) \
+ firstprivate(r32i,r64i,cii,cfi,cdi) copyout(i8o,i16o,i32o,i64o) \
+ copyout(u8o,u16o,u32o,u64o,r32o,r64o,cio,cfo,cdo) num_gangs(1)
+ {
+ i8o = i8i;
+ i16o = i16i;
+ i32o = i32i;
+ i64o = i64i;
+
+ u8o = u8i;
+ u16o = u16i;
+ u32o = u32i;
+ u64o = u64i;
+
+ r32o = r32i;
+ r64o = r64i;
+
+ cio = cii;
+ cfo = cfi;
+ cdo = cdi;
+ }
+
+ assert (i8o == i8i);
+ assert (i16o == i16i);
+ assert (i32o == i32i);
+ assert (i64o == i64i);
+
+ assert (u8o == u8i);
+ assert (u16o == u16i);
+ assert (u32o == u32i);
+ assert (u64o == u64i);
+
+ assert (r32o == r32i);
+ assert (r64o == r64i);
+
+ assert (cio == cii);
+ assert (cfo == cfi);
+ assert (cdo == cdi);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/implicit-mapping-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/implicit-mapping-1.c
new file mode 100644
index 0000000..ed0ab94
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/implicit-mapping-1.c
@@ -0,0 +1,25 @@
+/* { dg-do run } */
+
+#include <string.h>
+#include <assert.h>
+
+int main(void)
+{
+ int arr[100];
+
+ memset (arr, 0, sizeof (int) * 100);
+
+#pragma acc enter data copyin(arr[30:10])
+
+#pragma acc serial
+/* { dg-warning {using .vector_length \(32\)., ignoring 1} "" { target openacc_nvidia_accel_selected } .-1 } */
+ {
+ arr[33] = 66;
+ }
+
+#pragma acc exit data copyout(arr[30:10])
+
+ assert (arr[33] == 66);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-69.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-69.c
index 00e0ca8..0c46f95 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-69.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-69.c
@@ -10,46 +10,14 @@
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
CUstream stream;
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float dtime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
- abort ();
- }
-
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
- r = cuModuleLoad (&module, "subr.ptx");
+ r = cuModuleLoad (&module, "./subr.ptx");
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuModuleLoad failed: %d\n", r);
@@ -63,20 +31,6 @@ main (int argc, char **argv)
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
-
- acc_map_data (a, d_a, nbytes);
-
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
-
stream = (CUstream) acc_get_cuda_stream (0);
if (stream != NULL)
abort ();
@@ -91,7 +45,7 @@ main (int argc, char **argv)
if (!acc_set_cuda_stream (0, stream))
abort ();
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -119,11 +73,6 @@ main (int argc, char **argv)
abort ();
}
- acc_unmap_data (a);
-
- free (a);
- acc_free (d_a);
-
acc_shutdown (acc_device_nvidia);
exit (0);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-70.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-70.c
index a2918c0..b28d115 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-70.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-70.c
@@ -2,6 +2,7 @@
/* { dg-additional-options "-lcuda" } */
/* { dg-require-effective-target openacc_cuda } */
+#include <sys/time.h>
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
@@ -11,47 +12,17 @@
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
- const int N = 10;
+ const int N = 3;
int i;
CUstream streams[N];
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float dtime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
+ struct timeval tv1, tv2;
+ time_t diff;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
- abort ();
- }
-
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
@@ -66,20 +37,6 @@ main (int argc, char **argv)
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
-
- acc_map_data (a, d_a, nbytes);
-
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
-
for (i = 0; i < N; i++)
{
streams[i] = (CUstream) acc_get_cuda_stream (i);
@@ -97,9 +54,29 @@ main (int argc, char **argv)
abort ();
}
+ gettimeofday (&tv1, NULL);
+
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[0], NULL, 0);
+ if (r != CUDA_SUCCESS)
+ {
+ fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
+ abort ();
+ }
+
+ r = cuCtxSynchronize ();
+ if (r != CUDA_SUCCESS)
+ {
+ fprintf (stderr, "cuCtxLaunch failed: %d\n", r);
+ abort ();
+ }
+
+ gettimeofday (&tv2, NULL);
+
+ diff = tv2.tv_sec - tv1.tv_sec;
+
for (i = 0; i < N; i++)
{
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[i], kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[i], NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -113,7 +90,7 @@ main (int argc, char **argv)
}
}
- sleep ((int) (dtime / 1000.0f) + 1);
+ sleep ((diff + 1) * N);
for (i = 0; i < N; i++)
{
@@ -124,10 +101,6 @@ main (int argc, char **argv)
}
}
- acc_unmap_data (a);
-
- free (a);
- acc_free (d_a);
acc_shutdown (acc_device_nvidia);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-72.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-72.c
index 99b62f1..025cd8a 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-72.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-72.c
@@ -11,45 +11,13 @@
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
CUstream stream;
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float dtime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
- abort ();
- }
-
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
@@ -64,20 +32,6 @@ main (int argc, char **argv)
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
-
- acc_map_data (a, d_a, nbytes);
-
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
-
r = cuStreamCreate (&stream, CU_STREAM_DEFAULT);
if (r != CUDA_SUCCESS)
{
@@ -88,7 +42,7 @@ main (int argc, char **argv)
if (!acc_set_cuda_stream (0, stream))
abort ();
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -101,7 +55,12 @@ main (int argc, char **argv)
abort ();
}
- sleep ((int) (dtime / 1000.f) + 1);
+ r = cuCtxSynchronize ();
+ if (r != CUDA_SUCCESS)
+ {
+ fprintf (stderr, "cuCtxSynchronize () failed: %d\n", r);
+ abort ();
+ }
if (acc_async_test_all () != 1)
{
@@ -109,11 +68,6 @@ main (int argc, char **argv)
abort ();
}
- acc_unmap_data (a);
-
- free (a);
- acc_free (d_a);
-
acc_shutdown (acc_device_nvidia);
exit (0);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-73.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-73.c
index 5b4b3fd..21e0f8c 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-73.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-73.c
@@ -2,6 +2,7 @@
/* { dg-additional-options "-lcuda" } */
/* { dg-require-effective-target openacc_cuda } */
+#include <sys/time.h>
#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>
@@ -11,47 +12,15 @@
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
- const int N = 10;
+ const int N = 6;
int i;
CUstream streams[N];
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float dtime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
- abort ();
- }
-
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
@@ -66,20 +35,6 @@ main (int argc, char **argv)
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
-
- acc_map_data (a, d_a, nbytes);
-
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
-
for (i = 0; i < N; i++)
{
streams[i] = (CUstream) acc_get_cuda_stream (i);
@@ -99,13 +54,12 @@ main (int argc, char **argv)
for (i = 0; i < N; i++)
{
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[i], kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[i], NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
abort ();
}
-
}
if (acc_async_test_all () != 0)
@@ -114,7 +68,12 @@ main (int argc, char **argv)
abort ();
}
- sleep ((int) (dtime / 1000.0f) + 1);
+ r = cuCtxSynchronize ();
+ if (r != CUDA_SUCCESS)
+ {
+ fprintf (stderr, "cuCtxSynchronize failed: %d\n", r);
+ abort ();
+ }
if (acc_async_test_all () != 1)
{
@@ -122,11 +81,6 @@ main (int argc, char **argv)
abort ();
}
- acc_unmap_data (a);
-
- free (a);
- acc_free (d_a);
-
acc_shutdown (acc_device_nvidia);
exit (0);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-74.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-74.c
index 939f255..13953df 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-74.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-74.c
@@ -6,77 +6,53 @@
#include <stdlib.h>
#include <openacc.h>
#include <cuda.h>
-#include "timer.h"
+#include <sys/time.h>
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
CUstream stream;
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float atime, dtime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
+ struct timeval tv1, tv2;
+ time_t t1, t2;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
+ r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
+ fprintf (stderr, "cuModuleLoad failed: %d\n", r);
abort ();
}
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
+ r = cuModuleGetFunction (&delay, module, "delay");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
+ fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
abort ();
}
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
+ gettimeofday (&tv1, NULL);
- r = cuModuleLoad (&module, "subr.ptx");
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, NULL, NULL, 0);
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleLoad failed: %d\n", r);
+ fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
abort ();
}
- r = cuModuleGetFunction (&delay, module, "delay");
+ r = cuCtxSynchronize ();
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
+ fprintf (stderr, "cuCtxSynchronize failed: %d\n", r);
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
-
- acc_map_data (a, d_a, nbytes);
+ gettimeofday (&tv2, NULL);
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
+ t1 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
stream = (CUstream) acc_get_cuda_stream (0);
if (stream != NULL)
@@ -92,11 +68,9 @@ main (int argc, char **argv)
if (!acc_set_cuda_stream (0, stream))
abort ();
- init_timers (1);
+ gettimeofday (&tv1, NULL);
- start_timer (0);
-
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -104,38 +78,31 @@ main (int argc, char **argv)
}
acc_wait (0);
- /* Test unseen async-argument. */
- acc_wait (1);
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
+
+ t2 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
- if (atime < dtime)
+ if (((abs (t2 - t1) / t1) * 100.0) > 1.0)
{
- fprintf (stderr, "actual time < delay time\n");
+ fprintf (stderr, "too long 1\n");
abort ();
}
- start_timer (0);
+ gettimeofday (&tv1, NULL);
acc_wait (0);
- /* Test unseen async-argument. */
- acc_wait (1);
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
+
+ t2 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
- if (0.010 < atime)
+ if (t2 > 1000)
{
- fprintf (stderr, "actual time too long\n");
+ fprintf (stderr, "too long 2\n");
abort ();
}
- acc_unmap_data (a);
-
- fini_timers ();
-
- free (a);
- acc_free (d_a);
-
acc_shutdown (acc_device_nvidia);
exit (0);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-75.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-75.c
index 804ee39..96c3675 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-75.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-75.c
@@ -7,78 +7,55 @@
#include <stdlib.h>
#include <openacc.h>
#include <cuda.h>
-#include "timer.h"
+#include <sys/time.h>
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
- int N;
+ const int N = 2;
int i;
CUstream stream;
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float atime, dtime, hitime, lotime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
+ struct timeval tv1, tv2;
+ time_t t1, t2;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
+ r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
+ fprintf (stderr, "cuModuleLoad failed: %d\n", r);
abort ();
}
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
+ r = cuModuleGetFunction (&delay, module, "delay");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
+ fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
abort ();
}
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
+ gettimeofday (&tv1, NULL);
- r = cuModuleLoad (&module, "subr.ptx");
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, NULL, NULL, 0);
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleLoad failed: %d\n", r);
+ fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
abort ();
}
- r = cuModuleGetFunction (&delay, module, "delay");
+ r = cuCtxSynchronize ();
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
+ fprintf (stderr, "cuCtxSynchronize failed: %d\n", r);
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- N = nprocs;
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
+ gettimeofday (&tv2, NULL);
- acc_map_data (a, d_a, nbytes);
+ t1 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
stream = (CUstream) acc_get_cuda_stream (0);
if (stream != NULL)
@@ -94,16 +71,11 @@ main (int argc, char **argv)
if (!acc_set_cuda_stream (0, stream))
abort ();
- init_timers (1);
-
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
-
- start_timer (0);
+ gettimeofday (&tv1, NULL);
for (i = 0; i < N; i++)
{
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -113,27 +85,18 @@ main (int argc, char **argv)
acc_wait (0);
}
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
- hitime = dtime * N;
- hitime += hitime * 0.02;
+ t2 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
- lotime = dtime * N;
- lotime -= lotime * 0.02;
+ t1 *= N;
- if (atime > hitime || atime < lotime)
+ if (((abs (t2 - t1) / t1) * 100.0) > 1.0)
{
- fprintf (stderr, "actual time < delay time\n");
+ fprintf (stderr, "too long\n");
abort ();
}
- acc_unmap_data (a);
-
- fini_timers ();
-
- free (a);
- acc_free (d_a);
-
acc_shutdown (acc_device_nvidia);
exit (0);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-76.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-76.c
index f904526..0ec97dd 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-76.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-76.c
@@ -7,78 +7,55 @@
#include <unistd.h>
#include <openacc.h>
#include <cuda.h>
-#include "timer.h"
+#include <sys/time.h>
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
- int N;
+ const int N = 2;
int i;
CUstream *streams;
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float atime, dtime, hitime, lotime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
+ struct timeval tv1, tv2;
+ time_t t1, t2;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
+ r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
+ fprintf (stderr, "cuModuleLoad failed: %d\n", r);
abort ();
}
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
+ r = cuModuleGetFunction (&delay, module, "delay");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
+ fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
abort ();
}
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
+ gettimeofday (&tv1, NULL);
- r = cuModuleLoad (&module, "subr.ptx");
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, NULL, NULL, 0);
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleLoad failed: %d\n", r);
+ fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
abort ();
}
- r = cuModuleGetFunction (&delay, module, "delay");
+ r = cuCtxSynchronize ();
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
+ fprintf (stderr, "cuCtxSynchronize failed: %d\n", r);
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- N = nprocs;
+ gettimeofday (&tv2, NULL);
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
-
- acc_map_data (a, d_a, nbytes);
+ t1 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
streams = (CUstream *) malloc (N * sizeof (void *));
@@ -99,16 +76,11 @@ main (int argc, char **argv)
abort ();
}
- init_timers (1);
-
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
-
- start_timer (0);
+ gettimeofday (&tv1, NULL);
for (i = 0; i < N; i++)
{
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[i], kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[i], NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -118,27 +90,19 @@ main (int argc, char **argv)
acc_wait (i);
}
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
- hitime = dtime * N;
- hitime += hitime * 0.02;
+ t2 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
- lotime = dtime * N;
- lotime -= lotime * 0.02;
+ t1 *= N;
- if (atime > hitime || atime < lotime)
+ if (((abs (t2 - t1) / t1) * 100.0) > 1.0)
{
- fprintf (stderr, "actual time < delay time\n");
+ fprintf (stderr, "too long\n");
abort ();
}
- acc_unmap_data (a);
-
- fini_timers ();
-
free (streams);
- free (a);
- acc_free (d_a);
acc_shutdown (acc_device_nvidia);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-78.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-78.c
index d8cba4d..fb191c6 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-78.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-78.c
@@ -7,77 +7,53 @@
#include <unistd.h>
#include <openacc.h>
#include <cuda.h>
-#include "timer.h"
+#include <sys/time.h>
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
CUstream stream;
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float atime, dtime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
+ struct timeval tv1, tv2;
+ time_t t1, t2;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
+ r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
+ fprintf (stderr, "cuModuleLoad failed: %d\n", r);
abort ();
}
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
+ r = cuModuleGetFunction (&delay, module, "delay");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
+ fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
abort ();
}
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
+ gettimeofday (&tv1, NULL);
- r = cuModuleLoad (&module, "subr.ptx");
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, NULL, NULL, 0);
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleLoad failed: %d\n", r);
+ fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
abort ();
}
- r = cuModuleGetFunction (&delay, module, "delay");
+ r = cuCtxSynchronize ();
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
+ fprintf (stderr, "cuCtxSynchronize failed: %d\n", r);
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
-
- acc_map_data (a, d_a, nbytes);
+ gettimeofday (&tv2, NULL);
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
+ t1 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
stream = (CUstream) acc_get_cuda_stream (0);
if (stream != NULL)
@@ -93,11 +69,9 @@ main (int argc, char **argv)
if (!acc_set_cuda_stream (0, stream))
abort ();
- init_timers (1);
+ gettimeofday (&tv1, NULL);
- start_timer (0);
-
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -106,33 +80,30 @@ main (int argc, char **argv)
acc_wait_all ();
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
+
+ t2 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
- if (atime < dtime)
+ if (t2 > (t1 + (t1 * 0.10)))
{
- fprintf (stderr, "actual time < delay time\n");
+ fprintf (stderr, "too long 1\n");
abort ();
}
- start_timer (0);
+ gettimeofday (&tv1, NULL);
acc_wait_all ();
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
+
+ t2 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
- if (0.010 < atime)
+ if (t2 > 1000)
{
- fprintf (stderr, "actual time too long\n");
+ fprintf (stderr, "too long 2\n");
abort ();
}
- acc_unmap_data (a);
-
- fini_timers ();
-
- free (a);
- acc_free (d_a);
-
acc_shutdown (acc_device_nvidia);
exit (0);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-79.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-79.c
index b805d5f..af8aa11 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-79.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-79.c
@@ -7,80 +7,55 @@
#include <unistd.h>
#include <openacc.h>
#include <cuda.h>
-#include "timer.h"
+#include <sys/time.h>
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
- int N;
+ const int N = 2;
int i;
CUstream stream;
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float atime, dtime, hitime, lotime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
-
- devnum = 2;
+ struct timeval tv1, tv2;
+ time_t t1, t2;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
+ r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
+ fprintf (stderr, "cuModuleLoad failed: %d\n", r);
abort ();
}
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
+ r = cuModuleGetFunction (&delay, module, "delay");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
+ fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
abort ();
}
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
+ gettimeofday (&tv1, NULL);
- r = cuModuleLoad (&module, "subr.ptx");
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, NULL, NULL, 0);
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleLoad failed: %d\n", r);
+ fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
abort ();
}
- r = cuModuleGetFunction (&delay, module, "delay");
+ r = cuCtxSynchronize ();
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
+ fprintf (stderr, "cuCtxSynchronize failed: %d\n", r);
abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 200.0;
-
- dticks = (unsigned long) (dtime * clkrate);
-
- N = nprocs;
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
+ gettimeofday (&tv2, NULL);
- acc_map_data (a, d_a, nbytes);
+ t1 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
r = cuStreamCreate (&stream, CU_STREAM_DEFAULT);
if (r != CUDA_SUCCESS)
@@ -106,16 +81,11 @@ main (int argc, char **argv)
if (!acc_set_cuda_stream (0, stream))
abort ();
- init_timers (1);
-
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
-
- start_timer (0);
+ gettimeofday (&tv1, NULL);
for (i = 0; i < N; i++)
{
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, stream, NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -157,7 +127,7 @@ main (int argc, char **argv)
acc_wait (1);
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
if (acc_async_test (0) != 1)
abort ();
@@ -165,25 +135,16 @@ main (int argc, char **argv)
if (acc_async_test (1) != 1)
abort ();
- hitime = dtime * N;
- hitime += hitime * 0.02;
+ t2 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
- lotime = dtime * N;
- lotime -= lotime * 0.02;
+ t1 *= N;
- if (atime > hitime || atime < lotime)
+ if (((abs (t2 - t1) / t1) * 100.0) > 1.0)
{
- fprintf (stderr, "actual time < delay time\n");
+ fprintf (stderr, "too long\n");
abort ();
}
- acc_unmap_data (a);
-
- fini_timers ();
-
- free (a);
- acc_free (d_a);
-
acc_shutdown (acc_device_nvidia);
exit (0);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-81.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-81.c
index 958672c..902d257 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-81.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-81.c
@@ -7,78 +7,55 @@
#include <unistd.h>
#include <openacc.h>
#include <cuda.h>
-#include "timer.h"
+#include <sys/time.h>
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay;
CUmodule module;
CUresult r;
- int N;
+ const int N = 2;
int i;
CUstream *streams, stream;
- unsigned long *a, *d_a, dticks;
- int nbytes;
- float atime, dtime;
- void *kargs[2];
- int clkrate;
- int devnum, nprocs;
+ struct timeval tv1, tv2;
+ time_t t1, t2;
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
+ r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
+ fprintf (stderr, "cuModuleLoad failed: %d\n", r);
abort ();
}
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
+ r = cuModuleGetFunction (&delay, module, "delay");
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
+ fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
abort ();
}
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
+ gettimeofday (&tv1, NULL);
- r = cuModuleLoad (&module, "subr.ptx");
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, NULL, NULL, 0);
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleLoad failed: %d\n", r);
- abort ();
+ fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
+ abort ();
}
- r = cuModuleGetFunction (&delay, module, "delay");
+ r = cuCtxSynchronize ();
if (r != CUDA_SUCCESS)
{
- fprintf (stderr, "cuModuleGetFunction failed: %d\n", r);
- abort ();
+ fprintf (stderr, "cuCtxSynchronize failed: %d\n", r);
+ abort ();
}
- nbytes = nprocs * sizeof (unsigned long);
-
- dtime = 500.0;
-
- dticks = (unsigned long) (dtime * clkrate);
+ gettimeofday (&tv2, NULL);
- N = nprocs;
-
- a = (unsigned long *) malloc (nbytes);
- d_a = (unsigned long *) acc_malloc (nbytes);
-
- acc_map_data (a, d_a, nbytes);
+ t1 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
streams = (CUstream *) malloc (N * sizeof (void *));
@@ -99,11 +76,6 @@ main (int argc, char **argv)
abort ();
}
- init_timers (1);
-
- kargs[0] = (void *) &d_a;
- kargs[1] = (void *) &dticks;
-
stream = (CUstream) acc_get_cuda_stream (N);
if (stream != NULL)
abort ();
@@ -118,11 +90,11 @@ main (int argc, char **argv)
if (!acc_set_cuda_stream (N, stream))
abort ();
- start_timer (0);
+ gettimeofday (&tv1, NULL);
for (i = 0; i < N; i++)
{
- r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[i], kargs, 0);
+ r = cuLaunchKernel (delay, 1, 1, 1, 1, 1, 1, 0, streams[i], NULL, 0);
if (r != CUDA_SUCCESS)
{
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
@@ -130,6 +102,10 @@ main (int argc, char **argv)
}
}
+ gettimeofday (&tv2, NULL);
+
+ t2 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
+
acc_wait_all_async (N);
for (i = 0; i <= N; i++)
@@ -146,15 +122,13 @@ main (int argc, char **argv)
abort ();
}
- atime = stop_timer (0);
-
- if (atime < dtime)
+ if ((t1 * N) < t2)
{
- fprintf (stderr, "actual time < delay time\n");
+ fprintf (stderr, "too long 1\n");
abort ();
}
- start_timer (0);
+ gettimeofday (&tv1, NULL);
stream = (CUstream) acc_get_cuda_stream (N + 1);
if (stream != NULL)
@@ -174,35 +148,33 @@ main (int argc, char **argv)
acc_wait (N + 1);
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
+
+ t1 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
- if (0.10 < atime)
+ if (t1 > 1000)
{
- fprintf (stderr, "actual time too long\n");
+ fprintf (stderr, "too long 2\n");
abort ();
}
- start_timer (0);
+ gettimeofday (&tv1, NULL);
acc_wait_all_async (N);
acc_wait (N);
- atime = stop_timer (0);
+ gettimeofday (&tv2, NULL);
- if (0.10 < atime)
+ t1 = ((tv2.tv_sec - tv1.tv_sec) * 1000000) + (tv2.tv_usec - tv1.tv_usec);
+
+ if (t1 > 1000)
{
- fprintf (stderr, "actual time too long\n");
+ fprintf (stderr, "too long 3\n");
abort ();
}
- acc_unmap_data (a);
-
- fini_timers ();
-
free (streams);
- free (a);
- acc_free (d_a);
acc_shutdown (acc_device_nvidia);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-82.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-82.c
index a36f8e6..054ffbf 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-82.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-82.c
@@ -11,46 +11,18 @@
int
main (int argc, char **argv)
{
- CUdevice dev;
CUfunction delay2;
CUmodule module;
CUresult r;
- int N;
+ const int N = 32;
int i;
CUstream *streams;
- unsigned long **a, **d_a, *tid, ticks;
+ unsigned long **a, **d_a, *tid;
int nbytes;
- void *kargs[3];
- int clkrate;
- int devnum, nprocs;
+ void *kargs[2];
acc_init (acc_device_nvidia);
- devnum = acc_get_device_num (acc_device_nvidia);
-
- r = cuDeviceGet (&dev, devnum);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGet failed: %d\n", r);
- abort ();
- }
-
- r =
- cuDeviceGetAttribute (&nprocs, CU_DEVICE_ATTRIBUTE_MULTIPROCESSOR_COUNT,
- dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
- r = cuDeviceGetAttribute (&clkrate, CU_DEVICE_ATTRIBUTE_CLOCK_RATE, dev);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuDeviceGetAttribute failed: %d\n", r);
- abort ();
- }
-
r = cuModuleLoad (&module, "subr.ptx");
if (r != CUDA_SUCCESS)
{
@@ -67,10 +39,6 @@ main (int argc, char **argv)
nbytes = sizeof (int);
- ticks = (unsigned long) (200.0 * clkrate);
-
- N = nprocs;
-
streams = (CUstream *) malloc (N * sizeof (void *));
a = (unsigned long **) malloc (N * sizeof (unsigned long *));
@@ -104,8 +72,7 @@ main (int argc, char **argv)
for (i = 0; i < N; i++)
{
kargs[0] = (void *) &d_a[i];
- kargs[1] = (void *) &ticks;
- kargs[2] = (void *) &tid[i];
+ kargs[1] = (void *) &tid[i];
r = cuLaunchKernel (delay2, 1, 1, 1, 1, 1, 1, 0, streams[i], kargs, 0);
if (r != CUDA_SUCCESS)
@@ -113,8 +80,6 @@ main (int argc, char **argv)
fprintf (stderr, "cuLaunchKernel failed: %d\n", r);
abort ();
}
-
- ticks = (unsigned long) (50.0 * clkrate);
}
acc_wait_all_async (0);
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-93.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-93.c
new file mode 100644
index 0000000..b18155d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-93.c
@@ -0,0 +1,19 @@
+/* { dg-do run { target { ! openacc_nvidia_accel_present } } } */
+
+#include <stdio.h>
+#include <openacc.h>
+
+int
+main (void)
+{
+ fprintf (stderr, "CheCKpOInT\n");
+ acc_init (acc_device_nvidia);
+
+ acc_shutdown (acc_device_nvidia);
+
+ return 0;
+}
+
+/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */
+/* { dg-output "device type nvidia not supported" } */
+/* { dg-shouldfail "" } */
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-auto-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-auto-1.c
index c13cab7..4182755 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-auto-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-auto-1.c
@@ -107,7 +107,7 @@ int vector_1 (int *ary, int size)
{
#pragma acc loop gang
for (int jx = 0; jx < 1; jx++)
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int ix = 0; ix < size; ix++)
ary[ix] = place ();
}
@@ -123,7 +123,7 @@ int vector_2 (int *ary, int size)
{
#pragma acc loop worker
for (int jx = 0; jx < size / 64; jx++)
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int ix = 0; ix < 64; ix++)
ary[ix + jx * 64] = place ();
}
@@ -139,7 +139,7 @@ int worker_1 (int *ary, int size)
{
#pragma acc loop gang
for (int kx = 0; kx < 1; kx++)
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int jx = 0; jx < size / 64; jx++)
#pragma acc loop vector
for (int ix = 0; ix < 64; ix++)
@@ -156,7 +156,7 @@ int gang_1 (int *ary, int size)
#pragma acc parallel num_gangs (32) num_workers (32) vector_length(32) copy(ary[0:size]) firstprivate (size)
/* { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-1 } */
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int jx = 0; jx < size / 64; jx++)
#pragma acc loop worker
for (int ix = 0; ix < 64; ix++)
@@ -172,11 +172,11 @@ int gang_2 (int *ary, int size)
#pragma acc parallel num_gangs (32) num_workers (32) vector_length(32) copy(ary[0:size]) firstprivate (size)
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int kx = 0; kx < size / (32 * 32); kx++)
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int jx = 0; jx < 32; jx++)
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int ix = 0; ix < 32; ix++)
ary[ix + jx * 32 + kx * 32 * 32] = place ();
}
@@ -190,9 +190,9 @@ int gang_3 (int *ary, int size)
#pragma acc parallel num_workers (32) vector_length(32) copy(ary[0:size]) firstprivate (size)
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int jx = 0; jx < size / 64; jx++)
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int ix = 0; ix < 64; ix++)
ary[ix + jx * 64] = place ();
}
@@ -206,7 +206,7 @@ int gang_4 (int *ary, int size)
#pragma acc parallel vector_length(32) copy(ary[0:size]) firstprivate (size)
{
-#pragma acc loop auto
+#pragma acc loop auto independent
for (int jx = 0; jx < size; jx++)
ary[jx] = place ();
}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-default-compile.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-default-compile.c
new file mode 100644
index 0000000..6c479e4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-default-compile.c
@@ -0,0 +1,13 @@
+/* { dg-additional-options "-fopenacc-dim=16:16" } */
+/* This code uses nvptx inline assembly guarded with acc_on_device, which is
+ not optimized away at -O0, and then confuses the target assembler.
+ { dg-skip-if "" { *-*-* } { "-O0" } { "" } } */
+/* { dg-set-target-env-var "GOMP_OPENACC_DIM" "8:8" } */
+
+#include "loop-default.h"
+
+int main ()
+{
+ /* Environment should be ignored. */
+ return test_1 (16, 16, 32);
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-gwv-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-gwv-1.c
index d3f6ea2..18d56f6d 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-gwv-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-gwv-1.c
@@ -67,12 +67,23 @@ int main ()
int expected = ix;
if(ondev)
{
- int chunk_size = (N + gangsize * workersize * vectorsize - 1)
- / (gangsize * workersize * vectorsize);
+#if defined (ACC_DEVICE_TYPE_radeon) && defined (__OPTIMIZE__)
+ int use_vectorsize = 64;
+#else
+ int use_vectorsize = vectorsize;
+#endif
+ int chunk_size = (N + gangsize * workersize * use_vectorsize - 1)
+ / (gangsize * workersize * use_vectorsize);
+#ifdef ACC_DEVICE_TYPE_radeon
+ int g = ix / (chunk_size * workersize * use_vectorsize);
+ int w = (ix / (chunk_size * use_vectorsize)) % workersize;
+ int v = 0;
+#else
int g = ix / (chunk_size * workersize * vectorsize);
int w = (ix / vectorsize) % workersize;
int v = ix % vectorsize;
+#endif
expected = (g << 16) | (w << 8) | v;
}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-gwv-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-gwv-1.c
index 4099d60..e29e89d 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-gwv-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-gwv-1.c
@@ -64,12 +64,23 @@ int main ()
int val = ix;
if (ondev)
{
- int chunk_size = (N + gangsize * workersize * vectorsize - 1)
- / (gangsize * workersize * vectorsize);
-
+#if defined (ACC_DEVICE_TYPE_radeon) && defined (__OPTIMIZE__)
+ int use_vectorsize = 64;
+#else
+ int use_vectorsize = vectorsize;
+#endif
+ int chunk_size = (N + gangsize * workersize * use_vectorsize - 1)
+ / (gangsize * workersize * use_vectorsize);
+
+#ifdef ACC_DEVICE_TYPE_radeon
+ int g = ix / (chunk_size * workersize * use_vectorsize);
+ int w = (ix / (chunk_size * use_vectorsize)) % workersize;
+ int v = 0;
+#else
int g = ix / (chunk_size * vectorsize * workersize);
int w = ix / vectorsize % workersize;
int v = ix % vectorsize;
+#endif
val = (g << 16) | (w << 8) | v;
}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-wv-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-wv-1.c
index fadb262..616cf50 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-wv-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-red-wv-1.c
@@ -63,8 +63,24 @@ int main ()
if(ondev)
{
int g = 0;
+#ifdef ACC_DEVICE_TYPE_radeon
+# ifdef __OPTIMIZE__
+ int use_vecsize = 64;
+# else
+ int use_vecsize = vectorsize;
+# endif
+ /* For Radeon, the loop is split into contiguous blocks of
+ chunk_size * vector_size, with chunk_size selected to cover the
+ whole iteration space. Each block is then autovectorized where
+ possible. */
+ int chunk_size = (N + workersize * use_vecsize - 1)
+ / (workersize * use_vecsize);
+ int w = ix / (chunk_size * use_vecsize);
+ int v = 0;
+#else
int w = (ix / vectorsize) % workersize;
int v = ix % vectorsize;
+#endif
val = (g << 16) | (w << 8) | v;
}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-wv-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-wv-1.c
index 7732606..560b748 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-wv-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/loop-wv-1.c
@@ -65,8 +65,24 @@ int main ()
if(ondev)
{
int g = 0;
+#ifdef ACC_DEVICE_TYPE_radeon
+# ifdef __OPTIMIZE__
+ int use_vecsize = 64;
+# else
+ int use_vecsize = vectorsize;
+# endif
+ /* For Radeon, the loop is split into contiguous blocks of
+ chunk_size * vector_size, with chunk_size selected to cover the
+ whole iteration space. Each block is then autovectorized where
+ possible. */
+ int chunk_size = (N + workersize * use_vecsize - 1)
+ / (workersize * use_vecsize);
+ int w = ix / (chunk_size * use_vecsize);
+ int v = 0;
+#else
int w = (ix / vectorsize) % workersize;
int v = ix % vectorsize;
+#endif
expected = (g << 16) | (w << 8) | v;
}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-1.c
new file mode 100644
index 0000000..a70375c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-1.c
@@ -0,0 +1,103 @@
+/* { dg-do run } */
+
+#include <stdlib.h>
+#include <assert.h>
+
+#define n 100
+#define m 100
+
+int b[n][m];
+
+void
+test1 (void)
+{
+ int i, j, *a[100];
+
+ /* Array of pointers form test. */
+ for (i = 0; i < n; i++)
+ {
+ a[i] = (int *)malloc (sizeof (int) * m);
+ for (j = 0; j < m; j++)
+ b[i][j] = j - i;
+ }
+
+ #pragma acc parallel loop copyout(a[0:n][0:m]) copyin(b)
+ for (i = 0; i < n; i++)
+ #pragma acc loop
+ for (j = 0; j < m; j++)
+ a[i][j] = b[i][j];
+
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < m; j++)
+ assert (a[i][j] == b[i][j]);
+ /* Clean up. */
+ free (a[i]);
+ }
+}
+
+void
+test2 (void)
+{
+ int i, j, **a = (int **) malloc (sizeof (int *) * n);
+
+ /* Separately allocated blocks. */
+ for (i = 0; i < n; i++)
+ {
+ a[i] = (int *)malloc (sizeof (int) * m);
+ for (j = 0; j < m; j++)
+ b[i][j] = j - i;
+ }
+
+ #pragma acc parallel loop copyout(a[0:n][0:m]) copyin(b)
+ for (i = 0; i < n; i++)
+ #pragma acc loop
+ for (j = 0; j < m; j++)
+ a[i][j] = b[i][j];
+
+ for (i = 0; i < n; i++)
+ {
+ for (j = 0; j < m; j++)
+ assert (a[i][j] == b[i][j]);
+ /* Clean up. */
+ free (a[i]);
+ }
+ free (a);
+}
+
+void
+test3 (void)
+{
+ int i, j, **a = (int **) malloc (sizeof (int *) * n);
+ a[0] = (int *) malloc (sizeof (int) * n * m);
+
+ /* Rows allocated in one contiguous block. */
+ for (i = 0; i < n; i++)
+ {
+ a[i] = *a + i * m;
+ for (j = 0; j < m; j++)
+ b[i][j] = j - i;
+ }
+
+ #pragma acc parallel loop copyout(a[0:n][0:m]) copyin(b)
+ for (i = 0; i < n; i++)
+ #pragma acc loop
+ for (j = 0; j < m; j++)
+ a[i][j] = b[i][j];
+
+ for (i = 0; i < n; i++)
+ for (j = 0; j < m; j++)
+ assert (a[i][j] == b[i][j]);
+
+ free (a[0]);
+ free (a);
+}
+
+int
+main (void)
+{
+ test1 ();
+ test2 ();
+ test3 ();
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-2.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-2.c
new file mode 100644
index 0000000..b85c637
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-2.c
@@ -0,0 +1,37 @@
+/* { dg-do run } */
+
+#include <assert.h>
+#include "noncontig_array-utils.h"
+
+int
+main (void)
+{
+ int n = 10;
+ int ***a = (int ***) create_ncarray (sizeof (int), n, 3);
+ int ***b = (int ***) create_ncarray (sizeof (int), n, 3);
+ int ***c = (int ***) create_ncarray (sizeof (int), n, 3);
+
+ for (int i = 0; i < n; i++)
+ for (int j = 0; j < n; j++)
+ for (int k = 0; k < n; k++)
+ {
+ a[i][j][k] = i + j * k + k;
+ b[i][j][k] = j + k * i + i * j;
+ c[i][j][k] = a[i][j][k];
+ }
+
+ #pragma acc parallel copy (a[0:n][0:n][0:n]) copyin (b[0:n][0:n][0:n])
+ {
+ for (int i = 0; i < n; i++)
+ for (int j = 0; j < n; j++)
+ for (int k = 0; k < n; k++)
+ a[i][j][k] += b[k][j][i] + i + j + k;
+ }
+
+ for (int i = 0; i < n; i++)
+ for (int j = 0; j < n; j++)
+ for (int k = 0; k < n; k++)
+ assert (a[i][j][k] == c[i][j][k] + b[k][j][i] + i + j + k);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-3.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-3.c
new file mode 100644
index 0000000..99db207
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-3.c
@@ -0,0 +1,45 @@
+/* { dg-do run } */
+
+#include <assert.h>
+#include "noncontig_array-utils.h"
+
+int main (void)
+{
+ int n = 20, x = 5, y = 12;
+ int *****a = (int *****) create_ncarray (sizeof (int), n, 5);
+
+ int sum1 = 0, sum2 = 0, sum3 = 0;
+
+ for (int i = 0; i < n; i++)
+ for (int j = 0; j < n; j++)
+ for (int k = 0; k < n; k++)
+ for (int l = 0; l < n; l++)
+ for (int m = 0; m < n; m++)
+ {
+ a[i][j][k][l][m] = 1;
+ sum1++;
+ }
+
+ #pragma acc parallel copy (a[x:y][x:y][x:y][x:y][x:y]) copy(sum2)
+ {
+ for (int i = x; i < x + y; i++)
+ for (int j = x; j < x + y; j++)
+ for (int k = x; k < x + y; k++)
+ for (int l = x; l < x + y; l++)
+ for (int m = x; m < x + y; m++)
+ {
+ a[i][j][k][l][m] = 0;
+ sum2++;
+ }
+ }
+
+ for (int i = 0; i < n; i++)
+ for (int j = 0; j < n; j++)
+ for (int k = 0; k < n; k++)
+ for (int l = 0; l < n; l++)
+ for (int m = 0; m < n; m++)
+ sum3 += a[i][j][k][l][m];
+
+ assert (sum1 == sum2 + sum3);
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-4.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-4.c
new file mode 100644
index 0000000..6cfaf98
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-4.c
@@ -0,0 +1,36 @@
+/* { dg-do run } */
+
+#include <assert.h>
+#include "noncontig_array-utils.h"
+
+int main (void)
+{
+ int n = 128;
+ double ***a = (double ***) create_ncarray (sizeof (double), n, 3);
+ double ***b = (double ***) create_ncarray (sizeof (double), n, 3);
+
+ for (int i = 0; i < n; i++)
+ for (int j = 0; j < n; j++)
+ for (int k = 0; k < n; k++)
+ a[i][j][k] = i + j + k + i * j * k;
+
+ /* This test exercises async copyout of non-contiguous array rows. */
+ #pragma acc parallel copyin(a[0:n][0:n][0:n]) copyout(b[0:n][0:n][0:n]) async(5)
+ {
+ #pragma acc loop gang
+ for (int i = 0; i < n; i++)
+ #pragma acc loop vector
+ for (int j = 0; j < n; j++)
+ for (int k = 0; k < n; k++)
+ b[i][j][k] = a[i][j][k] * 2.0;
+ }
+
+ #pragma acc wait (5)
+
+ for (int i = 0; i < n; i++)
+ for (int j = 0; j < n; j++)
+ for (int k = 0; k < n; k++)
+ assert (b[i][j][k] == a[i][j][k] * 2.0);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-utils.h b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-utils.h
new file mode 100644
index 0000000..6900d1f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/noncontig_array-utils.h
@@ -0,0 +1,44 @@
+#include <stdlib.h>
+#include <string.h>
+#include <assert.h>
+#include <stdint.h>
+
+/* Allocate and create a pointer based NDIMS-dimensional array,
+ each dimension DIMLEN long, with ELSIZE sized data elements. */
+void *
+create_ncarray (size_t elsize, int dimlen, int ndims)
+{
+ size_t blk_size = 0;
+ size_t n = 1;
+
+ for (int i = 0; i < ndims - 1; i++)
+ {
+ n *= dimlen;
+ blk_size += sizeof (void *) * n;
+ }
+ size_t data_rows_num = n;
+ size_t data_rows_offset = blk_size;
+ blk_size += elsize * n * dimlen;
+
+ void *blk = (void *) malloc (blk_size);
+ memset (blk, 0, blk_size);
+ void **curr_dim = (void **) blk;
+ n = 1;
+
+ for (int d = 0; d < ndims - 1; d++)
+ {
+ uintptr_t next_dim = (uintptr_t) (curr_dim + n * dimlen);
+ size_t next_dimlen = dimlen * (d < ndims - 2 ? sizeof (void *) : elsize);
+
+ for (int b = 0; b < n; b++)
+ for (int i = 0; i < dimlen; i++)
+ if (d < ndims - 1)
+ curr_dim[b * dimlen + i]
+ = (void*) (next_dim + b * dimlen * next_dimlen + i * next_dimlen);
+
+ n *= dimlen;
+ curr_dim = (void**) next_dim;
+ }
+ assert (n == data_rows_num);
+ return blk;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/par-reduction-3.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/par-reduction-3.c
new file mode 100644
index 0000000..856ef0e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/par-reduction-3.c
@@ -0,0 +1,29 @@
+/* Check a parallel reduction which is are explicitly initialized by
+ the user. */
+
+#include <assert.h>
+
+int
+main ()
+{
+ int n = 10;
+ float accel = 1.0, host = 1.0;
+ int i;
+
+#pragma acc parallel copyin(n) reduction(*:accel)
+ {
+ accel = 1.0;
+#pragma acc loop gang reduction(*:accel)
+ for( i = 1; i <= n; i++)
+ {
+ accel *= 2.0;
+ }
+ }
+
+ for (i = 1; i <= n; i++)
+ host *= 2.0;
+
+ assert (accel == host);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr70828-2.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr70828-2.c
new file mode 100644
index 0000000..357114c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr70828-2.c
@@ -0,0 +1,34 @@
+/* Subarray declared on data construct, accessed through pointer. */
+
+#include <assert.h>
+
+void
+s1 (int *arr, int c)
+{
+#pragma acc data copy(arr[5:c-10])
+ {
+#pragma acc parallel loop
+ for (int i = 5; i < c - 5; i++)
+ arr[i] = i;
+ }
+}
+
+int
+main (int argc, char* argv[])
+{
+ const int c = 100;
+ int arr[c];
+
+ for (int i = 0; i < c; i++)
+ arr[i] = 0;
+
+ s1 (arr, c);
+
+ for (int i = 0; i < c; i++)
+ if (i >= 5 && i < c - 5)
+ assert (arr[i] == i);
+ else
+ assert (arr[i] == 0);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/pr70828.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr70828.c
new file mode 100644
index 0000000..4b6dbd7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/pr70828.c
@@ -0,0 +1,27 @@
+/* Subarray declared on enclosing data construct. */
+
+#include <assert.h>
+
+int
+main ()
+{
+ int a[100], i;
+
+ for (i = 0; i < 100; i++)
+ a[i] = 0;
+
+#pragma acc data copy(a[10:80])
+ {
+ #pragma acc parallel loop
+ for (i = 10; i < 90; i++)
+ a[i] = i;
+ }
+
+ for (i = 0; i < 100; i++)
+ if (i >= 10 && i < 90)
+ assert (a[i] == i);
+ else
+ assert (a[i] == 0);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/privatize-reduction-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/privatize-reduction-1.c
new file mode 100644
index 0000000..206e66f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/privatize-reduction-1.c
@@ -0,0 +1,41 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+int
+main (int argc, char *argv[])
+{
+#define N 100
+ int n = N;
+ int i, j, tmp;
+ int input[N*N], output[N], houtput[N];
+
+ for (i = 0; i < n * n; i++)
+ input[i] = i;
+
+ for (i = 0; i < n; i++)
+ {
+ tmp = 0;
+ for (j = 0; j < n; j++)
+ tmp += input[i * n + j];
+ houtput[i] = tmp;
+ }
+
+ #pragma acc parallel loop gang
+ for (i = 0; i < n; i++)
+ {
+ tmp = 0;
+
+ #pragma acc loop worker reduction(+:tmp)
+ for (j = 0; j < n; j++)
+ tmp += input[i * n + j];
+
+ output[i] = tmp;
+ }
+
+ /* Test if every worker-level reduction had correct private result. */
+ for (i = 0; i < n; i++)
+ if (houtput[i] != output[i])
+ abort ();
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/privatize-reduction-2.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/privatize-reduction-2.c
new file mode 100644
index 0000000..0c317dc
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/privatize-reduction-2.c
@@ -0,0 +1,23 @@
+#include <assert.h>
+
+int
+main ()
+{
+ const int n = 1000;
+ int i, j, temp, a[n];
+
+#pragma acc parallel loop
+ for (i = 0; i < n; i++)
+ {
+ temp = i;
+#pragma acc loop reduction (+:temp)
+ for (j = 0; j < n; j++)
+ temp ++;
+ a[i] = temp;
+ }
+
+ for (i = 0; i < n; i++)
+ assert (a[i] == i+n);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-1.c
new file mode 100644
index 0000000..6f1b86a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-1.c
@@ -0,0 +1,69 @@
+/* { dg-do run } */
+
+/* Array reductions. */
+
+#include <stdlib.h>
+#include "reduction.h"
+
+#define ng 8
+#define nw 4
+#define vl 32
+
+#define N 10
+
+#define check_reduction_array_op_all(type, opr, init, b) \
+ check_reduction_xxx_xx_all(array, op, type, opr, init, b)
+#define check_reduction_arraysec_op_all(type, opr, init, b) \
+ check_reduction_xxx_xx_all(arraysec, op, type, opr, init, b)
+#define check_reduction_array_macro_all(type, opr, init, b) \
+ check_reduction_xxx_xx_all(array, macro, type, opr, init, b)
+#define check_reduction_arraysec_macro_all(type, opr, init, b) \
+ check_reduction_xxx_xx_all(arraysec, macro, type, opr, init, b)
+
+int
+main (void)
+{
+ const int n = 100;
+ int ints[n];
+ float flts[n];
+ double dbls[n];
+ int cmp_val = 5;
+
+ for (int i = 0; i < n; i++)
+ {
+ ints[i] = i + 1;
+ flts[i] = i + 1;
+ dbls[i] = i + 1;
+ }
+
+ check_reduction_array_op_all (int, +, 0, ints[i]);
+ check_reduction_array_op_all (int, *, 1, ints[i]);
+ check_reduction_array_op_all (int, &, -1, ints[i]);
+ check_reduction_array_op_all (int, |, 0, ints[i]);
+ check_reduction_array_op_all (int, ^, 0, ints[i]);
+ check_reduction_array_op_all (int, &&, 1, (cmp_val > ints[i]));
+ check_reduction_array_op_all (int, ||, 0, (cmp_val > ints[i]));
+ check_reduction_array_macro_all (int, min, n + 1, ints[i]);
+ check_reduction_array_macro_all (int, max, -1, ints[i]);
+
+ check_reduction_array_op_all (float, +, 0, flts[i]);
+ check_reduction_array_op_all (float, *, 1, flts[i]);
+ check_reduction_array_macro_all (float, min, n + 1, flts[i]);
+ check_reduction_array_macro_all (float, max, -1, flts[i]);
+
+ check_reduction_arraysec_op_all (int, +, 0, ints[i]);
+ check_reduction_arraysec_op_all (float, *, 1, flts[i]);
+ check_reduction_arraysec_macro_all (double, min, n + 1, dbls[i]);
+ check_reduction_arraysec_macro_all (double, max, -1, dbls[i]);
+
+ check_reduction_array_op_all (double, +, 0, dbls[i]);
+#if 0
+ /* Currently fails due to unclear issue, presumably unrelated to reduction
+ mechanics. Avoiding for now. */
+ check_reduction_array_op_all (double, *, 1.0, dbls[i]);
+#endif
+ check_reduction_array_macro_all (double, min, n + 1, dbls[i]);
+ check_reduction_array_macro_all (double, max, -1, dbls[i]);
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-2.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-2.c
new file mode 100644
index 0000000..db8b374
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-2.c
@@ -0,0 +1,115 @@
+/* { dg-do run } */
+
+/* More array reduction tests, different combinations of parallel/loop
+ construct, implied/explicit copy clauses, and subarrays. */
+
+#define ARRAY_BODY(ARRAY, MIN, LEN) \
+ for (int i = 0; i < 10; i++) \
+ for (int j = MIN; j < MIN + LEN; j++) \
+ ARRAY[j] += 1;
+
+int main (void)
+{
+ int o[6] = { 5, 1, 1, 5, 9, 9 };
+ int a[6];
+
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ a[i] = o[i];
+
+ #pragma acc parallel
+ #pragma acc loop reduction(+:a[1:2])
+ ARRAY_BODY (a, 1, 2)
+ ARRAY_BODY (o, 1, 2)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel
+ #pragma acc loop gang reduction(+:a[1:2])
+ ARRAY_BODY (a, 1, 2)
+ ARRAY_BODY (o, 1, 2)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a[3:2])
+ #pragma acc loop reduction(+:a[3:2])
+ ARRAY_BODY (a, 3, 2)
+ ARRAY_BODY (o, 3, 2)
+ for (int i = 0; i < 6; i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a[3:2])
+ #pragma acc loop worker reduction(+:a[3:2])
+ ARRAY_BODY (a, 3, 2)
+ ARRAY_BODY (o, 3, 2)
+ for (int i = 0; i < 6; i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop reduction(+:a[0:5])
+ ARRAY_BODY (a, 0, 5)
+ ARRAY_BODY (o, 0, 5)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop vector reduction(+:a[0:5])
+ ARRAY_BODY (a, 0, 5)
+ ARRAY_BODY (o, 0, 5)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel
+ #pragma acc loop reduction(+:a)
+ ARRAY_BODY (a, 4, 1)
+ ARRAY_BODY (o, 4, 1)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop reduction(+:a)
+ ARRAY_BODY (a, 3, 3)
+ ARRAY_BODY (o, 3, 3)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+#if !defined(ACC_DEVICE_TYPE_host)
+
+ #pragma acc parallel loop reduction(+:a)
+ ARRAY_BODY (a, 1, 3)
+ ARRAY_BODY (o, 1, 3)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel loop reduction(+:a[2:3])
+ ARRAY_BODY (a, 2, 3)
+ ARRAY_BODY (o, 2, 3)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel reduction(+:a)
+ ARRAY_BODY (a, 3, 2)
+ ARRAY_BODY (o, 3, 2)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel reduction(+:a[1:2])
+ ARRAY_BODY (a, 1, 2)
+ ARRAY_BODY (o, 1, 2)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+#endif
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-3.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-3.c
new file mode 100644
index 0000000..0f023b7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-3.c
@@ -0,0 +1,114 @@
+/* { dg-do run } */
+
+/* Same as reduction-arrays-2.c test, but with non-constant subarray
+ base indexes. */
+
+#define ARRAY_BODY(ARRAY, MIN, LEN) \
+ for (int i = 0; i < 10; i++) \
+ for (int j = MIN; j < MIN + LEN; j++) \
+ ARRAY[j] += 1;
+
+int zero = 0;
+int one = 1;
+int two = 2;
+int three = 3;
+int four = 4;
+
+int main (void)
+{
+ int o[6] = { 5, 1, 1, 5, 9, 9 };
+ int a[6];
+
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ a[i] = o[i];
+
+ #pragma acc parallel
+ #pragma acc loop reduction(+:a[one:2])
+ ARRAY_BODY (a, one, 2)
+ ARRAY_BODY (o, one, 2)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel
+ #pragma acc loop gang reduction(+:a[one:2])
+ ARRAY_BODY (a, one, 2)
+ ARRAY_BODY (o, one, 2)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a[three:2])
+ #pragma acc loop reduction(+:a[three:2])
+ ARRAY_BODY (a, three, 2)
+ ARRAY_BODY (o, three, 2)
+ for (int i = 0; i < 6; i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a[three:2])
+ #pragma acc loop worker reduction(+:a[three:2])
+ ARRAY_BODY (a, three, 2)
+ ARRAY_BODY (o, three, 2)
+ for (int i = 0; i < 6; i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop reduction(+:a[zero:5])
+ ARRAY_BODY (a, zero, 5)
+ ARRAY_BODY (o, zero, 5)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop vector reduction(+:a[zero:5])
+ ARRAY_BODY (a, zero, 5)
+ ARRAY_BODY (o, zero, 5)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel
+ #pragma acc loop reduction(+:a)
+ ARRAY_BODY (a, four, 1)
+ ARRAY_BODY (o, four, 1)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop reduction(+:a)
+ ARRAY_BODY (a, three, 3)
+ ARRAY_BODY (o, three, 3)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+#if !defined(ACC_DEVICE_TYPE_host)
+
+ #pragma acc parallel loop reduction(+:a)
+ ARRAY_BODY (a, one, 3)
+ ARRAY_BODY (o, one, 3)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel loop reduction(+:a[two:3])
+ ARRAY_BODY (a, two, 3)
+ ARRAY_BODY (o, two, 3)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel reduction(+:a[one:2])
+ ARRAY_BODY (a, one, 2)
+ ARRAY_BODY (o, one, 2)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+#endif
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-4.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-4.c
new file mode 100644
index 0000000..94dd4c4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-4.c
@@ -0,0 +1,115 @@
+/* { dg-do run } */
+
+/* Same as reduction-arrays-3.c test, but additionally with
+ non-constant subarray lengths. */
+
+#define ARRAY_BODY(ARRAY, MIN, LEN) \
+ for (int i = 0; i < 10; i++) \
+ for (int j = MIN; j < MIN + LEN; j++) \
+ ARRAY[j] += 1;
+
+int zero = 0;
+int one = 1;
+int two = 2;
+int three = 3;
+int four = 4;
+int five = 5;
+
+int main (void)
+{
+ int o[6] = { 5, 1, 1, 5, 9, 9 };
+ int a[6];
+
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ a[i] = o[i];
+
+ #pragma acc parallel
+ #pragma acc loop reduction(+:a[one:two])
+ ARRAY_BODY (a, one, two)
+ ARRAY_BODY (o, one, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel
+ #pragma acc loop gang reduction(+:a[one:two])
+ ARRAY_BODY (a, one, two)
+ ARRAY_BODY (o, one, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a[three:two])
+ #pragma acc loop reduction(+:a[three:two])
+ ARRAY_BODY (a, three, two)
+ ARRAY_BODY (o, three, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a[three:two])
+ #pragma acc loop worker reduction(+:a[three:two])
+ ARRAY_BODY (a, three, two)
+ ARRAY_BODY (o, three, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop reduction(+:a[zero:five])
+ ARRAY_BODY (a, zero, five)
+ ARRAY_BODY (o, zero, five)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop vector reduction(+:a[zero:five])
+ ARRAY_BODY (a, zero, five)
+ ARRAY_BODY (o, zero, five)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel
+ #pragma acc loop reduction(+:a)
+ ARRAY_BODY (a, four, one)
+ ARRAY_BODY (o, four, one)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop reduction(+:a)
+ ARRAY_BODY (a, three, three)
+ ARRAY_BODY (o, three, three)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+#if !defined(ACC_DEVICE_TYPE_host)
+
+ #pragma acc parallel loop reduction(+:a)
+ ARRAY_BODY (a, one, three)
+ ARRAY_BODY (o, one, three)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel loop reduction(+:a[two:three])
+ ARRAY_BODY (a, two, three)
+ ARRAY_BODY (o, two, three)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel reduction(+:a[one:two])
+ ARRAY_BODY (a, one, two)
+ ARRAY_BODY (o, one, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+#endif
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-5.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-5.c
new file mode 100644
index 0000000..56ae020
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-arrays-5.c
@@ -0,0 +1,113 @@
+/* { dg-do run } */
+
+/* Same as reduction-arrays-4.c test, but reduced arrays are VLAs. */
+
+#define ARRAY_BODY(ARRAY, MIN, LEN) \
+ for (int i = 0; i < 10; i++) \
+ for (int j = MIN; j < MIN + LEN; j++) \
+ ARRAY[j] += 1;
+
+int zero = 0;
+int one = 1;
+int two = 2;
+int three = 3;
+int four = 4;
+int five = 5;
+int six = 6;
+
+int main (void)
+{
+ int init[6] = { 5, 1, 1, 5, 9, 9 };
+ int o[six];
+ int a[six];
+
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ a[i] = o[i] = init[i];
+
+ #pragma acc parallel
+ #pragma acc loop reduction(+:a[one:two])
+ ARRAY_BODY (a, one, two)
+ ARRAY_BODY (o, one, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel
+ #pragma acc loop gang reduction(+:a[one:two])
+ ARRAY_BODY (a, one, two)
+ ARRAY_BODY (o, one, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a[three:two])
+ #pragma acc loop reduction(+:a[three:two])
+ ARRAY_BODY (a, three, two)
+ ARRAY_BODY (o, three, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a[three:two])
+ #pragma acc loop worker reduction(+:a[three:two])
+ ARRAY_BODY (a, three, two)
+ ARRAY_BODY (o, three, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop reduction(+:a[zero:five])
+ ARRAY_BODY (a, zero, five)
+ ARRAY_BODY (o, zero, five)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop vector reduction(+:a[zero:five])
+ ARRAY_BODY (a, zero, five)
+ ARRAY_BODY (o, zero, five)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel
+ #pragma acc loop reduction(+:a)
+ ARRAY_BODY (a, four, one)
+ ARRAY_BODY (o, four, one)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel copy(a)
+ #pragma acc loop reduction(+:a)
+ ARRAY_BODY (a, three, three)
+ ARRAY_BODY (o, three, three)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel loop reduction(+:a)
+ ARRAY_BODY (a, one, three)
+ ARRAY_BODY (o, one, three)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel loop reduction(+:a[two:three])
+ ARRAY_BODY (a, two, three)
+ ARRAY_BODY (o, two, three)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ #pragma acc parallel reduction(+:a[one:two])
+ ARRAY_BODY (a, one, two)
+ ARRAY_BODY (o, one, two)
+ for (int i = 0; i < sizeof (a) / sizeof (int); i++)
+ if (a[i] != o[i])
+ __builtin_abort ();
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-cplx-flt-2.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-cplx-flt-2.c
new file mode 100644
index 0000000..350174a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-cplx-flt-2.c
@@ -0,0 +1,32 @@
+#include <complex.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+typedef float _Complex Type;
+
+#define N 32
+
+int
+main (void)
+{
+ Type ary[N];
+
+ for (int ix = 0; ix < N; ix++)
+ ary[ix] = 1.0 + 1.0j;
+
+ Type tprod = 1.0;
+
+#pragma acc parallel vector_length(32)
+ {
+#pragma acc loop vector reduction (*:tprod)
+ for (int ix = 0; ix < N; ix++)
+ tprod *= ary[ix];
+ }
+
+ Type expected = 65536.0;
+
+ if (tprod != expected)
+ abort ();
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-structs-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-structs-1.c
new file mode 100644
index 0000000..22216ff
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction-structs-1.c
@@ -0,0 +1,121 @@
+/* { dg-do run } */
+
+/* Struct reductions. */
+
+#include <stdlib.h>
+#include "reduction.h"
+
+#define ng 8
+#define nw 4
+#define vl 32
+
+#define N 10
+
+typedef struct { int x, y; } int_pair;
+typedef struct { float m, n; } flt_pair;
+typedef struct
+{
+ int i;
+ double d;
+ float f;
+ int a[N];
+ int_pair ip;
+ flt_pair fp;
+} rectype;
+
+static void
+init_struct (rectype *rec, int val)
+{
+ rec->i = val;
+ rec->d = (double) val;
+ rec->f = (float) val;
+ for (int i = 0; i < N; i++)
+ rec->a[i] = val;
+ rec->ip.x = val;
+ rec->ip.y = val;
+ rec->fp.m = (float) val;
+ rec->fp.n = (float) val;
+}
+
+static int
+struct_eq (rectype *a, rectype *b)
+{
+ if (a->i != b->i || a->d != b->d
+ || a->f != b->f
+ || a->ip.x != b->ip.x
+ || a->ip.y != b->ip.y
+ || a->fp.m != b->fp.m
+ || a->fp.n != b->fp.n)
+ return 0;
+
+ for (int i = 0; i < N; i++)
+ if (a->a[i] != b->a[i])
+ return 0;
+ return 1;
+}
+
+#define check_reduction_struct_xx(type, op, init, b, gwv_par, gwv_loop, apply) \
+ { \
+ type res, vres; \
+ init_struct (&res, init); \
+ DO_PRAGMA (acc parallel gwv_par copy(res)) \
+ DO_PRAGMA (acc loop gwv_loop reduction (op:res)) \
+ for (int i = 0; i < n; i++) \
+ { \
+ res.i = apply (op, res.i, b); \
+ res.d = apply (op, res.d, b); \
+ res.f = apply (op, res.f, b); \
+ for (int j = 0; j < N; j++) \
+ res.a[j] = apply (op, res.a[j], b); \
+ res.ip.x = apply (op, res.ip.x, b); \
+ res.ip.y = apply (op, res.ip.y, b); \
+ res.fp.m = apply (op, res.fp.m, b); \
+ res.fp.n = apply (op, res.fp.n, b); \
+ } \
+ \
+ init_struct (&vres, init); \
+ for (int i = 0; i < n; i++) \
+ { \
+ vres.i = apply (op, vres.i, b); \
+ vres.d = apply (op, vres.d, b); \
+ vres.f = apply (op, vres.f, b); \
+ for (int j = 0; j < N; j++) \
+ vres.a[j] = apply (op, vres.a[j], b); \
+ vres.ip.x = apply (op, vres.ip.x, b); \
+ vres.ip.y = apply (op, vres.ip.y, b); \
+ vres.fp.m = apply (op, vres.fp.m, b); \
+ vres.fp.n = apply (op, vres.fp.n, b); \
+ } \
+ \
+ if (!struct_eq (&res, &vres)) \
+ __builtin_abort (); \
+ }
+
+#define operator_apply(op, a, b) (a op b)
+#define check_reduction_struct_op(type, op, init, b, gwv_par, gwv_loop) \
+ check_reduction_struct_xx(type, op, init, b, gwv_par, gwv_loop, operator_apply)
+
+#define function_apply(op, a, b) (op (a, b))
+#define check_reduction_struct_macro(type, op, init, b, gwv_par, gwv_loop) \
+ check_reduction_struct_xx(type, op, init, b, gwv_par, gwv_loop, function_apply)
+
+#define check_reduction_struct_op_all(type, opr, init, b) \
+ check_reduction_xxx_xx_all (struct, op, type, opr, init, b)
+#define check_reduction_struct_macro_all(type, opr, init, b) \
+ check_reduction_xxx_xx_all (struct, macro, type, opr, init, b)
+
+int
+main (void)
+{
+ const int n = 10;
+ int ints[n];
+
+ for (int i = 0; i < n; i++)
+ ints[i] = i + 1;
+
+ check_reduction_struct_op_all (rectype, +, 0, ints[i]);
+ check_reduction_struct_op_all (rectype, *, 1, ints[i]);
+ check_reduction_struct_macro_all (rectype, min, n + 1, ints[i]);
+ check_reduction_struct_macro_all (rectype, max, -1, ints[i]);
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction.h b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction.h
index 1b3f8d4..c928578 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction.h
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/reduction.h
@@ -37,6 +37,58 @@ DO_PRAGMA (acc loop gwv_loop reduction (op:res)) \
abort (); \
}
+#define check_reduction_array_xx(type, var, var_in_clause, op, init, b, \
+ gwv_par, gwv_loop, apply) \
+ { \
+ type var[N], var ## _check[N]; \
+ for (int i = 0; i < N; i++) \
+ var[i] = var ## _check[i] = (init); \
+ DO_PRAGMA (acc parallel gwv_par copy (var_in_clause)) \
+ DO_PRAGMA (acc loop gwv_loop reduction (op: var_in_clause)) \
+ for (int i = 0; i < n; i++) \
+ for (int j = 0; j < N; j++) \
+ var[j] = apply (op, var[j], (b)); \
+ \
+ for (int i = 0; i < n; i++) \
+ for (int j = 0; j < N; j++) \
+ var ## _check[j] = apply (op, var ## _check[j], (b)); \
+ \
+ for (int j = 0; j < N; j++) \
+ if (var[j] != var ## _check[j]) \
+ abort (); \
+ }
+
+#define operator_apply(op, a, b) (a op b)
+#define check_reduction_array_op(type, op, init, b, gwv_par, gwv_loop) \
+ check_reduction_array_xx (type, v, v, op, init, b, gwv_par, gwv_loop, \
+ operator_apply)
+#define check_reduction_arraysec_op(type, op, init, b, gwv_par, gwv_loop) \
+ check_reduction_array_xx (type, v, v[:N], op, init, b, gwv_par, gwv_loop, \
+ operator_apply)
+
+
+#define function_apply(op, a, b) (op (a, b))
+#define check_reduction_array_macro(type, op, init, b, gwv_par, gwv_loop)\
+ check_reduction_array_xx (type, v, v, op, init, b, gwv_par, gwv_loop, \
+ function_apply)
+#define check_reduction_arraysec_macro(type, op, init, b, gwv_par, gwv_loop)\
+ check_reduction_array_xx (type, v, v[:N], op, init, b, gwv_par, gwv_loop, \
+ function_apply)
+
+#define check_reduction_xxx_xx_all(tclass, form, type, op, init, b) \
+ check_reduction_ ## tclass ## _ ## form (type, op, init, b, num_gangs (ng), gang); \
+ check_reduction_ ## tclass ## _ ## form (type, op, init, b, num_workers (nw), worker); \
+ check_reduction_ ## tclass ## _ ## form (type, op, init, b, vector_length (vl), vector); \
+ check_reduction_ ## tclass ## _ ## form (type, op, init, b, \
+ num_gangs (ng) num_workers (nw), gang worker); \
+ check_reduction_ ## tclass ## _ ## form (type, op, init, b, \
+ num_gangs (ng) vector_length (vl), gang vector); \
+ check_reduction_ ## tclass ## _ ## form (type, op, init, b, \
+ num_workers (nw) vector_length (vl), worker vector); \
+ check_reduction_ ## tclass ## _ ## form (type, op, init, b, \
+ num_gangs (ng) num_workers (nw) vector_length (vl), \
+ gang worker vector);
+
#define max(a, b) (((a) > (b)) ? (a) : (b))
#define min(a, b) (((a) < (b)) ? (a) : (b))
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-gwv-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-gwv-1.c
index 81e0811..59249a0 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-gwv-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-gwv-1.c
@@ -62,12 +62,23 @@ int main ()
int expected = ix;
if(ondev)
{
- int chunk_size = (N + gangsize * workersize * vectorsize - 1)
- / (gangsize * workersize * vectorsize);
+#if defined (ACC_DEVICE_TYPE_radeon) && defined (__OPTIMIZE__)
+ int use_vectorsize = 64;
+#else
+ int use_vectorsize = vectorsize;
+#endif
+ int chunk_size = (N + gangsize * workersize * use_vectorsize - 1)
+ / (gangsize * workersize * use_vectorsize);
- int g = ix / (chunk_size * vectorsize * workersize);
+#ifdef ACC_DEVICE_TYPE_radeon
+ int g = ix / (chunk_size * workersize * use_vectorsize);
+ int w = (ix / (chunk_size * use_vectorsize)) % workersize;
+ int v = 0;
+#else
+ int g = ix / (chunk_size * workersize * vectorsize);
int w = (ix / vectorsize) % workersize;
int v = ix % vectorsize;
+#endif
expected = (g << 16) | (w << 8) | v;
}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-wv-1.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-wv-1.c
index 647d075..8eada23 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-wv-1.c
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-wv-1.c
@@ -61,8 +61,24 @@ int main ()
if(ondev)
{
int g = 0;
+#ifdef ACC_DEVICE_TYPE_radeon
+# ifdef __OPTIMIZE__
+ int use_vecsize = 64;
+# else
+ int use_vecsize = vectorsize;
+# endif
+ /* For Radeon, the loop is split into contiguous blocks of
+ chunk_size * vector_size, with chunk_size selected to cover the
+ whole iteration space. Each block is then autovectorized where
+ possible. */
+ int chunk_size = (N + workersize * use_vecsize - 1)
+ / (workersize * use_vecsize);
+ int w = ix / (chunk_size * use_vecsize);
+ int v = 0;
+#else
int w = (ix / vectorsize) % workersize;
int v = ix % vectorsize;
+#endif
expected = (g << 16) | (w << 8) | v;
}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/subr.h b/libgomp/testsuite/libgomp.oacc-c-c++-common/subr.h
index 9db236c..a99c08d 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/subr.h
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/subr.h
@@ -1,46 +1,23 @@
-
-#if ACC_DEVICE_TYPE_nvidia
-
#pragma acc routine nohost
-static int clock (void)
-{
- int thetime;
-
- asm __volatile__ ("mov.u32 %0, %%clock;" : "=r"(thetime));
-
- return thetime;
-}
-
-#endif
-
void
-delay (unsigned long *d_o, unsigned long delay)
+delay ()
{
- int start, ticks;
+ int i, sum;
+ const int N = 500000;
- start = clock ();
-
- ticks = 0;
-
- while (ticks < delay)
- ticks = clock () - start;
-
- return;
+ for (i = 0; i < N; i++)
+ sum = sum + 1;
}
+#pragma acc routine nohost
void
-delay2 (unsigned long *d_o, unsigned long delay, unsigned long tid)
+delay2 (unsigned long *d_o, unsigned long tid)
{
- int start, ticks;
+ int i, sum;
+ const int N = 500000;
- start = clock ();
-
- ticks = 0;
-
- while (ticks < delay)
- ticks = clock () - start;
+ for (i = 0; i < N; i++)
+ sum = sum + 1;
d_o[0] = tid;
-
- return;
}
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/subr.ptx b/libgomp/testsuite/libgomp.oacc-c-c++-common/subr.ptx
index 6f748fc..88b63bf 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/subr.ptx
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/subr.ptx
@@ -1,148 +1,90 @@
-// BEGIN PREAMBLE
- .version 3.1
- .target sm_30
+ .version 3.1
+ .target sm_30
.address_size 64
-// END PREAMBLE
-// BEGIN FUNCTION DEF: clock
-.func (.param.u32 %out_retval)clock
-{
-.reg.u32 %retval;
- .reg.u64 %hr10;
- .reg.u32 %r22;
- .reg.u32 %r23;
- .reg.u32 %r24;
- .local.align 8 .b8 %frame[8];
- // #APP
-// 7 "subr.c" 1
- mov.u32 %r24, %clock;
-// 0 "" 2
- // #NO_APP
- st.local.u32 [%frame], %r24;
- ld.local.u32 %r22, [%frame];
- mov.u32 %r23, %r22;
- mov.u32 %retval, %r23;
- st.param.u32 [%out_retval], %retval;
- ret;
- }
-// END FUNCTION DEF
-// BEGIN GLOBAL FUNCTION DEF: delay
-.visible .entry delay(.param.u64 %in_ar1, .param.u64 %in_ar2)
-{
- .reg.u64 %ar1;
- .reg.u64 %ar2;
- .reg.u64 %hr10;
- .reg.u64 %r22;
- .reg.u32 %r23;
- .reg.u64 %r24;
- .reg.u64 %r25;
- .reg.u32 %r26;
- .reg.u32 %r27;
- .reg.u32 %r28;
- .reg.u32 %r29;
- .reg.u32 %r30;
- .reg.u64 %r31;
- .reg.pred %r32;
- .local.align 8 .b8 %frame[24];
- ld.param.u64 %ar1, [%in_ar1];
- ld.param.u64 %ar2, [%in_ar2];
- mov.u64 %r24, %ar1;
- st.u64 [%frame+8], %r24;
- mov.u64 %r25, %ar2;
- st.local.u64 [%frame+16], %r25;
+ .visible .entry delay
{
- .param.u32 %retval_in;
- {
- call (%retval_in), clock;
- }
- ld.param.u32 %r26, [%retval_in];
-}
- st.local.u32 [%frame+4], %r26;
- mov.u32 %r27, 0;
- st.local.u32 [%frame], %r27;
- bra $L4;
-$L5:
- {
- .param.u32 %retval_in;
- {
- call (%retval_in), clock;
- }
- ld.param.u32 %r28, [%retval_in];
-}
- mov.u32 %r23, %r28;
- ld.local.u32 %r30, [%frame+4];
- sub.u32 %r29, %r23, %r30;
- st.local.u32 [%frame], %r29;
-$L4:
- ld.local.s32 %r22, [%frame];
- ld.local.u64 %r31, [%frame+16];
- setp.lo.u64 %r32,%r22,%r31;
- @%r32 bra $L5;
+ .reg .u64 %hr10;
+ .reg .u32 %r22;
+ .reg .u32 %r23;
+ .reg .u32 %r24;
+ .reg .u32 %r25;
+ .reg .u32 %r26;
+ .reg .u32 %r27;
+ .reg .u32 %r28;
+ .reg .u32 %r29;
+ .reg .pred %r30;
+ .reg .u64 %frame;
+ .local .align 8 .b8 %farray[16];
+ cvta.local.u64 %frame,%farray;
+ mov.u32 %r22,500000;
+ st.u32 [%frame+8],%r22;
+ mov.u32 %r23,0;
+ st.u32 [%frame],%r23;
+ bra $L2;
+ $L3:
+ ld.u32 %r25,[%frame+4];
+ add.u32 %r24,%r25,1;
+ st.u32 [%frame+4],%r24;
+ ld.u32 %r27,[%frame];
+ add.u32 %r26,%r27,1;
+ st.u32 [%frame],%r26;
+ $L2:
+ ld.u32 %r28,[%frame];
+ ld.u32 %r29,[%frame+8];
+ setp.lt.s32 %r30,%r28,%r29;
+ @%r30
+ bra $L3;
ret;
}
-// END FUNCTION DEF
-// BEGIN GLOBAL FUNCTION DEF: delay2
-.visible .entry delay2(.param.u64 %in_ar1, .param.u64 %in_ar2, .param.u64 %in_ar3)
-{
- .reg.u64 %ar1;
- .reg.u64 %ar2;
- .reg.u64 %ar3;
- .reg.u64 %hr10;
- .reg.u64 %r22;
- .reg.u32 %r23;
- .reg.u64 %r24;
- .reg.u64 %r25;
- .reg.u64 %r26;
- .reg.u32 %r27;
- .reg.u32 %r28;
- .reg.u32 %r29;
- .reg.u32 %r30;
- .reg.u32 %r31;
- .reg.u64 %r32;
- .reg.pred %r33;
- .reg.u64 %r34;
- .reg.u64 %r35;
- .local.align 8 .b8 %frame[32];
- ld.param.u64 %ar1, [%in_ar1];
- ld.param.u64 %ar2, [%in_ar2];
- ld.param.u64 %ar3, [%in_ar3];
- mov.u64 %r24, %ar1;
- st.local.u64 [%frame+8], %r24;
- mov.u64 %r25, %ar2;
- st.local.u64 [%frame+16], %r25;
- mov.u64 %r26, %ar3;
- st.local.u64 [%frame+24], %r26;
- {
- .param.u32 %retval_in;
- {
- call (%retval_in), clock;
- }
- ld.param.u32 %r27, [%retval_in];
-}
- st.local.u32 [%frame+4], %r27;
- mov.u32 %r28, 0;
- st.local.u32 [%frame], %r28;
- bra $L8;
-$L9:
- {
- .param.u32 %retval_in;
+
+ .visible .entry delay2 (.param .u64 %in_ar1, .param .u64 %in_ar2)
{
- call (%retval_in), clock;
- }
- ld.param.u32 %r29, [%retval_in];
-}
- mov.u32 %r23, %r29;
- ld.local.u32 %r31, [%frame+4];
- sub.u32 %r30, %r23, %r31;
- st.local.u32 [%frame], %r30;
-$L8:
- ld.local.s32 %r22, [%frame];
- ld.local.u64 %r32, [%frame+16];
- setp.lo.u64 %r33,%r22,%r32;
- @%r33 bra $L9;
- ld.local.u64 %r34, [%frame+8];
- ld.local.u64 %r35, [%frame+24];
- st.u64 [%r34], %r35;
+ .reg .u64 %ar1;
+ .reg .u64 %ar2;
+ .reg .u64 %hr10;
+ .reg .u64 %r22;
+ .reg .u64 %r23;
+ .reg .u32 %r24;
+ .reg .u32 %r25;
+ .reg .u32 %r26;
+ .reg .u32 %r27;
+ .reg .u32 %r28;
+ .reg .u32 %r29;
+ .reg .u32 %r30;
+ .reg .u32 %r31;
+ .reg .pred %r32;
+ .reg .u64 %r33;
+ .reg .u64 %r34;
+ .reg .u64 %frame;
+ .local .align 8 .b8 %farray[32];
+ cvta.local.u64 %frame,%farray;
+ ld.param.u64 %ar1,[%in_ar1];
+ ld.param.u64 %ar2,[%in_ar2];
+ mov.u64 %r22,%ar1;
+ st.u64 [%frame+16],%r22;
+ mov.u64 %r23,%ar2;
+ st.u64 [%frame+24],%r23;
+ mov.u32 %r24,500000;
+ st.u32 [%frame+8],%r24;
+ mov.u32 %r25,0;
+ st.u32 [%frame],%r25;
+ bra $L5;
+ $L6:
+ ld.u32 %r27,[%frame+4];
+ add.u32 %r26,%r27,1;
+ st.u32 [%frame+4],%r26;
+ ld.u32 %r29,[%frame];
+ add.u32 %r28,%r29,1;
+ st.u32 [%frame],%r28;
+ $L5:
+ ld.u32 %r30,[%frame];
+ ld.u32 %r31,[%frame+8];
+ setp.lt.s32 %r32,%r30,%r31;
+ @%r32
+ bra $L6;
+ ld.u64 %r33,[%frame+16];
+ ld.u64 %r34,[%frame+24];
+ st.u64 [%r33],%r34;
ret;
}
-// END FUNCTION DEF
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/timer.h b/libgomp/testsuite/libgomp.oacc-c-c++-common/timer.h
index 53749da..e69de29 100644
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/timer.h
+++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/timer.h
@@ -1,103 +0,0 @@
-
-#include <stdio.h>
-#include <cuda.h>
-
-static int _Tnum_timers;
-static CUevent *_Tstart_events, *_Tstop_events;
-static CUstream _Tstream;
-
-void
-init_timers (int ntimers)
-{
- int i;
- CUresult r;
-
- _Tnum_timers = ntimers;
-
- _Tstart_events = (CUevent *) malloc (_Tnum_timers * sizeof (CUevent));
- _Tstop_events = (CUevent *) malloc (_Tnum_timers * sizeof (CUevent));
-
- r = cuStreamCreate (&_Tstream, CU_STREAM_DEFAULT);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuStreamCreate failed: %d\n", r);
- abort ();
- }
-
- for (i = 0; i < _Tnum_timers; i++)
- {
- r = cuEventCreate (&_Tstart_events[i], CU_EVENT_DEFAULT);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuEventCreate failed: %d\n", r);
- abort ();
- }
-
- r = cuEventCreate (&_Tstop_events[i], CU_EVENT_DEFAULT);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuEventCreate failed: %d\n", r);
- abort ();
- }
- }
-}
-
-void
-fini_timers (void)
-{
- int i;
-
- for (i = 0; i < _Tnum_timers; i++)
- {
- cuEventDestroy (_Tstart_events[i]);
- cuEventDestroy (_Tstop_events[i]);
- }
-
- cuStreamDestroy (_Tstream);
-
- free (_Tstart_events);
- free (_Tstop_events);
-}
-
-void
-start_timer (int timer)
-{
- CUresult r;
-
- r = cuEventRecord (_Tstart_events[timer], _Tstream);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuEventRecord failed: %d\n", r);
- abort ();
- }
-}
-
-float
-stop_timer (int timer)
-{
- CUresult r;
- float etime;
-
- r = cuEventRecord (_Tstop_events[timer], _Tstream);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuEventRecord failed: %d\n", r);
- abort ();
- }
-
- r = cuEventSynchronize (_Tstop_events[timer]);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuEventSynchronize failed: %d\n", r);
- abort ();
- }
-
- r = cuEventElapsedTime (&etime, _Tstart_events[timer], _Tstop_events[timer]);
- if (r != CUDA_SUCCESS)
- {
- fprintf (stderr, "cuEventElapsedTime failed: %d\n", r);
- abort ();
- }
-
- return etime;
-}
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/allocatable-scalar.f90 b/libgomp/testsuite/libgomp.oacc-fortran/allocatable-scalar.f90
new file mode 100644
index 0000000..42b3408
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/allocatable-scalar.f90
@@ -0,0 +1,33 @@
+! Test non-declared allocatable scalars in OpenACC data clauses.
+
+! { dg-do run }
+
+program main
+ implicit none
+ integer, parameter :: n = 100
+ integer, allocatable :: a, c
+ integer :: i, b(n)
+
+ allocate (a)
+
+ a = 50
+
+ !$acc parallel loop
+ do i = 1, n;
+ b(i) = a
+ end do
+
+ do i = 1, n
+ if (b(i) /= a) stop 1
+ end do
+
+ allocate (c)
+
+ !$acc parallel copyout(c) num_gangs(1)
+ c = a
+ !$acc end parallel
+
+ if (c /= a) stop 2
+
+ deallocate (a, c)
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/data-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/data-3.f90
index 19eb4bd..b5586be 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/data-3.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/data-3.f90
@@ -55,7 +55,8 @@ program asyncwait
c(:) = 0.0
d(:) = 0.0
- !$acc enter data copyin (a(1:N)) create (b(1:N)) create (c(1:N)) create (d(1:N))
+ !$acc enter data copyin (a(1:N)) create (b(1:N)) create (c(1:N)) &
+ !$acc& create (d(1:N))
!$acc parallel async (1)
do i = 1, N
@@ -76,7 +77,8 @@ program asyncwait
!$acc end parallel
!$acc wait (1)
- !$acc exit data copyout (a(1:N)) copyout (b(1:N)) copyout (c(1:N)) copyout (d(1:N))
+ !$acc exit data copyout (a(1:N)) copyout (b(1:N)) copyout (c(1:N)) &
+ !$acc& copyout (d(1:N))
do i = 1, N
if (a(i) .ne. 3.0) STOP 5
@@ -91,7 +93,8 @@ program asyncwait
d(:) = 0.0
e(:) = 0.0
- !$acc enter data copyin (a(1:N)) create (b(1:N)) create (c(1:N)) create (d(1:N)) copyin (e(1:N))
+ !$acc enter data copyin (a(1:N)) create (b(1:N)) create (c(1:N)) &
+ !$acc& create (d(1:N)) copyin (e(1:N))
!$acc parallel async (1)
do i = 1, N
@@ -118,7 +121,8 @@ program asyncwait
!$acc end parallel
!$acc wait (1)
- !$acc exit data copyout (a(1:N)) copyout (b(1:N)) copyout (c(1:N)) copyout (d(1:N)) copyout (e(1:N))
+ !$acc exit data copyout (a(1:N)) copyout (b(1:N)) copyout (c(1:N)) &
+ !$acc& copyout (d(1:N)) copyout (e(1:N))
!$acc exit data delete (N)
do i = 1, N
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90
index 759873b..6e53dc5 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90
@@ -2,11 +2,10 @@
! { dg-do run }
-!TODO-OpenACC-declare-allocate
-! Missing support for OpenACC "Changes from Version 2.0 to 2.5":
+! We've got support for OpenACC "Changes from Version 2.0 to 2.5":
! "The 'declare create' directive with a Fortran 'allocatable' has new behavior".
-! Thus, after 'allocate'/before 'deallocate', do
-! '!$acc enter data create'/'!$acc exit data delete' manually.
+! Yet, after 'allocate'/before 'deallocate', do
+! '!$acc enter data create'/'!$acc exit data delete' manually, too.
!TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'.
@@ -213,9 +212,9 @@ program test
!$acc exit data delete (b)
deallocate (b)
end program test ! { dg-line l[incr c] }
-! { dg-bogus {note: variable 'overflow\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c }
-! { dg-bogus {note: variable 'not_prev_allocated\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c }
-! { dg-bogus {note: variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} {TODO n/a} { xfail *-*-* } l$c }
+! { dg-bogus {note: variable 'overflow\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
+! { dg-bogus {note: variable 'not_prev_allocated\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
+! { dg-bogus {note: variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} {} { target *-*-* } l$c }
! Set each element in array 'b' at index i to i*2.
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-runtime.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-runtime.f90
index e4cb9c3..0072827 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-runtime.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-runtime.f90
@@ -2,11 +2,10 @@
! { dg-do run }
-!TODO-OpenACC-declare-allocate
-! Missing support for OpenACC "Changes from Version 2.0 to 2.5":
+! We've got support for OpenACC "Changes from Version 2.0 to 2.5":
! "The 'declare create' directive with a Fortran 'allocatable' has new behavior".
-! Thus, after 'allocate'/before 'deallocate', call 'acc_create'/'acc_delete'
-! manually.
+! Yet, after 'allocate'/before 'deallocate', call 'acc_create'/'acc_delete'
+! manually, too.
!TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'.
@@ -213,9 +212,9 @@ program test
call acc_delete (b)
deallocate (b)
end program test ! { dg-line l[incr c] }
-! { dg-bogus {note: variable 'overflow\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c }
-! { dg-bogus {note: variable 'not_prev_allocated\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c }
-! { dg-bogus {note: variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} {TODO n/a} { xfail *-*-* } l$c }
+! { dg-bogus {note: variable 'overflow\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
+! { dg-bogus {note: variable 'not_prev_allocated\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
+! { dg-bogus {note: variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} {} { target *-*-* } l$c }
! Set each element in array 'b' at index i to i*2.
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90
index 1c8ccd9..ab6ff75 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90
@@ -1,12 +1,10 @@
! Test OpenACC 'declare create' with allocatable arrays.
! { dg-do run }
+! { dg-additional-options "-Wopenacc-parallelism" }
-!TODO-OpenACC-declare-allocate
-! Not currently implementing correct '-DACC_MEM_SHARED=0' behavior:
-! Missing support for OpenACC "Changes from Version 2.0 to 2.5":
+! We've got support for OpenACC "Changes from Version 2.0 to 2.5":
! "The 'declare create' directive with a Fortran 'allocatable' has new behavior".
-! { dg-xfail-run-if TODO { *-*-* } { -DACC_MEM_SHARED=0 } }
!TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'.
@@ -204,9 +202,9 @@ program test
deallocate (b)
end program test ! { dg-line l[incr c] }
-! { dg-bogus {note: variable 'overflow\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c }
-! { dg-bogus {note: variable 'not_prev_allocated\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c }
-! { dg-bogus {note: variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} {TODO n/a} { xfail *-*-* } l$c }
+! { dg-bogus {note: variable 'overflow\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
+! { dg-bogus {note: variable 'not_prev_allocated\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
+! { dg-bogus {note: variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} {} { target *-*-* } l$c }
! Set each element in array 'b' at index i to i*2.
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90
new file mode 100644
index 0000000..df5ab26
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90
@@ -0,0 +1,48 @@
+! Test declare create with allocatable scalars.
+
+! { dg-do run }
+
+program main
+ use openacc
+ implicit none
+ integer, parameter :: n = 100
+ integer, allocatable :: a, c
+ integer :: i, b(n)
+ !$acc declare create (c)
+
+ allocate (a)
+
+ a = 50
+
+ !$acc parallel loop firstprivate(a)
+ do i = 1, n;
+ b(i) = a
+ end do
+
+ do i = 1, n
+ if (b(i) /= a) stop 1
+ end do
+
+ allocate (c)
+ a = 100
+
+ if (.not.acc_is_present(c)) stop 2
+
+ !$acc parallel num_gangs(1) present(c)
+ c = a
+ !$acc end parallel
+
+ !$acc update host(c)
+ if (c /= a) stop 3
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = c
+ end do
+
+ do i = 1, n
+ if (b(i) /= a) stop 4
+ end do
+
+ deallocate (a, c)
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90
new file mode 100644
index 0000000..c64d4bb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90
@@ -0,0 +1,219 @@
+! Test declare create with allocatable arrays.
+
+! { dg-do run }
+! { dg-additional-options "-Wopenacc-parallelism" }
+
+module vars
+ implicit none
+ integer, parameter :: n = 100
+ real*8, allocatable :: a, b(:)
+ !$acc declare create (a, b)
+end module vars
+
+program test
+ use vars
+ use openacc
+ implicit none
+ integer :: i
+
+ interface
+ subroutine sub1
+ !$acc routine gang
+ end subroutine sub1
+
+ subroutine sub2
+ end subroutine sub2
+
+ real*8 function fun1 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun1
+
+ real*8 function fun2 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun2
+ end interface
+
+ if (allocated (a)) stop 1
+ if (allocated (b)) stop 2
+
+ ! Test local usage of an allocated declared array.
+
+ allocate (a)
+
+ if (.not.allocated (a)) stop 3
+ if (acc_is_present (a) .neqv. .true.) stop 4
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 5
+ if (acc_is_present (b) .neqv. .true.) stop 6
+
+ a = 2.0
+ !$acc update device(a)
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = i * a
+ end do
+
+ if (.not.acc_is_present (b)) stop 7
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= i*a) stop 8
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside an acc
+ ! routine subroutine.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 9
+ if (acc_is_present (b) .neqv. .true.) stop 10
+
+ !$acc parallel
+ call sub1
+ !$acc end parallel
+
+ if (.not.acc_is_present (b)) stop 11
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= a+i*2) stop 12
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside a host
+ ! subroutine.
+
+ call sub2
+
+ if (.not.acc_is_present (b)) stop 13
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= 1.0) stop 14
+ end do
+
+ deallocate (b)
+
+ if (allocated (b)) stop 15
+
+ ! Test the usage of an allocated declared array inside an acc
+ ! routine function.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 16
+ if (acc_is_present (b) .neqv. .true.) stop 17
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = fun1 (i)
+ end do
+
+ if (.not.acc_is_present (b)) stop 18
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= i) stop 19
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside a host
+ ! function.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 20
+ if (acc_is_present (b) .neqv. .true.) stop 21
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+
+ !$acc update host(b)
+
+ do i = 1, n
+ b(i) = fun2 (i)
+ end do
+
+ if (.not.acc_is_present (b)) stop 22
+
+ do i = 1, n
+ if (b(i) /= i*a) stop 23
+ end do
+
+ deallocate (a)
+ deallocate (b)
+end program test
+
+! Set each element in array 'b' at index i to a+i*2.
+
+subroutine sub1 ! { dg-warning "region is worker partitioned" }
+ use vars
+ implicit none
+ integer i
+ !$acc routine gang
+
+ !$acc loop
+ do i = 1, n
+ b(i) = a+i*2
+ end do
+end subroutine sub1
+
+! Allocate array 'b', and set it to all 1.0.
+
+subroutine sub2
+ use vars
+ use openacc
+ implicit none
+ integer i
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 24
+ if (acc_is_present (b) .neqv. .true.) stop 25
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+end subroutine sub2
+
+! Return b(i) * i;
+
+real*8 function fun1 (i)
+ use vars
+ implicit none
+ integer i
+ !$acc routine seq
+
+ fun1 = b(i) * i
+end function fun1
+
+! Return b(i) * i * a;
+
+real*8 function fun2 (i)
+ use vars
+ implicit none
+ integer i
+
+ fun2 = b(i) * i * a
+end function fun2
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90
new file mode 100644
index 0000000..afbe52f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90
@@ -0,0 +1,66 @@
+! Test declare create with allocatable arrays and scalars. The unused
+! declared array 'b' caused an ICE in the past.
+
+! { dg-do run }
+
+module vars
+ implicit none
+ integer, parameter :: n = 100
+ real*8, allocatable :: a, b(:)
+ !$acc declare create (a, b)
+end module vars
+
+program test
+ use vars
+ implicit none
+ integer :: i
+
+ interface
+ subroutine sub1
+ end subroutine sub1
+
+ subroutine sub2
+ end subroutine sub2
+
+ real*8 function fun1 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun1
+
+ real*8 function fun2 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun2
+ end interface
+
+ if (allocated (a)) stop 1
+ if (allocated (b)) stop 2
+
+ ! Test the usage of an allocated declared array inside an acc
+ ! routine subroutine.
+
+ allocate (a)
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 3
+
+ call sub1
+
+ !$acc update self(a)
+ if (a /= 50) stop 4
+
+ deallocate (a)
+ deallocate (b)
+
+end program test
+
+! Set 'a' to 50.
+
+subroutine sub1
+ use vars
+ implicit none
+ integer i
+
+ a = 50
+ !$acc update device(a)
+end subroutine sub1
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90
index 6604f72..0f4d21a 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-directive.f90
@@ -7,11 +7,10 @@
! host/device array descriptors.
! { dg-skip-if n/a { *-*-* } { -DACC_MEM_SHARED=1 } }
-!TODO-OpenACC-declare-allocate
-! Missing support for OpenACC "Changes from Version 2.0 to 2.5":
+! We've got support for OpenACC "Changes from Version 2.0 to 2.5":
! "The 'declare create' directive with a Fortran 'allocatable' has new behavior".
-! Thus, after 'allocate'/before 'deallocate', do
-! '!$acc enter data create'/'!$acc exit data delete' manually.
+! Yet, after 'allocate'/before 'deallocate', do
+! '!$acc enter data create'/'!$acc exit data delete' manually, too.
!TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'.
@@ -101,8 +100,6 @@ program test
allocate (b(n1_lb:n1_ub))
call verify_n1_allocated
- if (acc_is_present (b)) error stop
- !$acc enter data create (b)
! This is now OpenACC "present":
if (.not.acc_is_present (b)) error stop
! ..., and got the actual array descriptor installed:
@@ -110,15 +107,16 @@ program test
call verify_n1_allocated
!$acc end serial
+ !$acc enter data create (b)
+ if (.not.acc_is_present (b)) error stop
+ !$acc serial
+ call verify_n1_allocated
+ !$acc end serial
+
do i = n1_lb, n1_ub
b(i) = i - 1
end do
- ! In 'declare-allocatable-array_descriptor-1-runtime.f90', this does "verify
- ! that host-to-device copy doesn't touch the device-side (still initial)
- ! array descriptor (but it does copy the array data"). This is here not
- ! applicable anymore, as we've already gotten the actual array descriptor
- ! installed. Thus now verify that it does copy the array data.
call acc_update_device (b)
!$acc serial
call verify_n1_allocated
@@ -143,12 +141,6 @@ program test
!TODO 'GOMP_MAP_TO_PSET':
! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_parallel map\(tofrom:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(from:id1_2 \[len: [0-9]+\]\)$} 1 gimple } }
- ! In 'declare-allocatable-array_descriptor-1-runtime.f90', this does "verify
- ! that device-to-host copy doesn't touch the host-side array descriptor,
- ! doesn't copy out the device-side (still initial) array descriptor (but it
- ! does copy the array data)". This is here not applicable anymore, as we've
- ! already gotten the actual array descriptor installed. Thus now verify that
- ! it does copy the array data.
call acc_update_self (b)
call verify_n1_allocated
@@ -223,14 +215,13 @@ program test
!$acc exit data delete (b)
if (.not.allocated (b)) error stop
- if (acc_is_present (b)) error stop
- ! The device-side array descriptor doesn't get updated, so 'b' still appears
- ! as "allocated":
+ if (.not.acc_is_present (b)) error stop
!$acc serial
call verify_n1_allocated
!$acc end serial
deallocate (b)
+ !if (acc_is_present (b)) error stop
call verify_n1_deallocated (.false.)
! The device-side array descriptor doesn't get updated, so 'b' still appears
! as "allocated":
@@ -260,10 +251,13 @@ program test
allocate (b(n2_lb:n2_ub))
call verify_n2_allocated
- if (acc_is_present (b)) error stop
+ if (.not.acc_is_present (b)) error stop
+ !$acc serial
+ call verify_n2_allocated
+ !$acc end serial
+
!$acc enter data create (b)
if (.not.acc_is_present (b)) error stop
- ! ..., and got the actual array descriptor installed:
!$acc serial
call verify_n2_allocated
!$acc end serial
@@ -337,12 +331,13 @@ program test
!$acc exit data delete (b)
if (.not.allocated (b)) error stop
- if (acc_is_present (b)) error stop
+ if (.not.acc_is_present (b)) error stop
!$acc serial
call verify_n2_allocated
!$acc end serial
deallocate (b)
+ !if (acc_is_present (b)) error stop
call verify_n2_deallocated (.false.)
!$acc serial
call verify_n2_allocated
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90
index b27f312..0682256 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1-runtime.f90
@@ -7,11 +7,10 @@
! host/device array descriptors.
! { dg-skip-if n/a { *-*-* } { -DACC_MEM_SHARED=1 } }
-!TODO-OpenACC-declare-allocate
-! Missing support for OpenACC "Changes from Version 2.0 to 2.5":
+! We've got support for OpenACC "Changes from Version 2.0 to 2.5":
! "The 'declare create' directive with a Fortran 'allocatable' has new behavior".
-! Thus, after 'allocate'/before 'deallocate', call 'acc_create'/'acc_delete'
-! manually.
+! Yet, after 'allocate'/before 'deallocate', call 'acc_create'/'acc_delete'
+! manually, too.
!TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'.
@@ -101,31 +100,47 @@ program test
allocate (b(n1_lb:n1_ub))
call verify_n1_allocated
- if (acc_is_present (b)) error stop
- call acc_create (b)
! This is now OpenACC "present":
if (.not.acc_is_present (b)) error stop
- ! This still has the initial array descriptor:
+ ! ..., and got the actual array descriptor installed:
!$acc serial
- call verify_initial
+ call verify_n1_allocated
+ !$acc end serial
+
+ call acc_create (b)
+ if (.not.acc_is_present (b)) error stop
+ !$acc serial
+ call verify_n1_allocated
!$acc end serial
do i = n1_lb, n1_ub
b(i) = i - 1
end do
- ! Verify that host-to-device copy doesn't touch the device-side (still
- ! initial) array descriptor (but it does copy the array data).
call acc_update_device (b)
!$acc serial
- call verify_initial
+ call verify_n1_allocated
!$acc end serial
b = 40
- ! Verify that device-to-host copy doesn't touch the host-side array
- ! descriptor, doesn't copy out the device-side (still initial) array
- ! descriptor (but it does copy the array data).
+ !$acc parallel copyout (id1_1) ! No data clause for 'b' (explicit or implicit): no 'GOMP_MAP_TO_PSET'.
+ call verify_n1_values (-1)
+ id1_1 = 0
+ !$acc end parallel
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc parallel map\(from:id1_1\)$} 1 original } }
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_parallel map\(from:id1_1 \[len: [0-9]+\]\)$} 1 gimple } }
+
+ !$acc parallel copy (b) copyout (id1_2)
+ ! As already present, 'copy (b)' doesn't copy; addend is still '-1'.
+ call verify_n1_values (-1)
+ id1_2 = 0
+ !$acc end parallel
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc parallel map\(tofrom:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(from:id1_2\)$} 1 original } }
+ !TODO ..., but without an actual use of 'b', the gimplifier removes the
+ !TODO 'GOMP_MAP_TO_PSET':
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_parallel map\(tofrom:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(from:id1_2 \[len: [0-9]+\]\)$} 1 gimple } }
+
call acc_update_self (b)
call verify_n1_allocated
@@ -142,11 +157,19 @@ program test
! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_update map\(force_to:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(force_from:id1_1 \[len: [0-9]+\]\)$} 1 gimple } }
! ..., but it's silently skipped in 'GOACC_update'.
!$acc serial
- call verify_initial
+ call verify_n1_allocated
!$acc end serial
b = 41
+ !$acc parallel
+ call verify_n1_values (1)
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ call verify_n1_values (1)
+ !$acc end parallel
+
!$acc update self (b) self (id1_2)
! We do have 'GOMP_MAP_TO_PSET' here:
! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc update map\(force_from:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(force_from:id1_2\);$} 1 original } }
@@ -159,20 +182,9 @@ program test
b(i) = b(i) + 2
end do
- ! Now install the actual array descriptor, via a data clause for 'b'
- ! (explicit or implicit): must get a 'GOMP_MAP_TO_PSET', which then in
- ! 'gomp_map_vars_internal' is handled as 'declare target', and because of
- ! '*(void **) hostaddrs[i] != NULL', we've got 'has_always_ptrset == true',
- ! 'always_to_cnt == 1', and therefore 'gomp_map_vars_existing' does update
- ! the 'GOMP_MAP_TO_PSET'.
- !$acc serial present (b) copyin (id1_1)
- call verify_initial
- id1_1 = 0
- !$acc end serial
- ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc serial map\(force_present:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(to:id1_1\)$} 1 original } }
- !TODO ..., but without an actual use of 'b', the gimplifier removes the
- !TODO 'GOMP_MAP_TO_PSET':
- ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_serial map\(force_present:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(to:id1_1 \[len: [0-9]+\]\)$} 1 gimple } }
+ ! Now test that (potentially re-)installing the actual array descriptor is a
+ ! no-op, via a data clause for 'b' (explicit or implicit): must get a
+ ! 'GOMP_MAP_TO_PSET'.
!$acc serial present (b) copyin (id1_2)
call verify_n1_allocated
!TODO Use of 'b':
@@ -203,14 +215,13 @@ program test
call acc_delete (b)
if (.not.allocated (b)) error stop
- if (acc_is_present (b)) error stop
- ! The device-side array descriptor doesn't get updated, so 'b' still appears
- ! as "allocated":
+ if (.not.acc_is_present (b)) error stop
!$acc serial
call verify_n1_allocated
!$acc end serial
deallocate (b)
+ !if (acc_is_present (b)) error stop
call verify_n1_deallocated (.false.)
! The device-side array descriptor doesn't get updated, so 'b' still appears
! as "allocated":
@@ -240,12 +251,15 @@ program test
allocate (b(n2_lb:n2_ub))
call verify_n2_allocated
- if (acc_is_present (b)) error stop
+ if (.not.acc_is_present (b)) error stop
+ !$acc serial
+ call verify_n2_allocated
+ !$acc end serial
+
call acc_create (b)
if (.not.acc_is_present (b)) error stop
- ! This still has the previous (n1) array descriptor:
!$acc serial
- call verify_n1_deallocated (.true.)
+ call verify_n2_allocated
!$acc end serial
do i = n2_lb, n2_ub
@@ -254,11 +268,19 @@ program test
call acc_update_device (b)
!$acc serial
- call verify_n1_deallocated (.true.)
+ call verify_n2_allocated
!$acc end serial
b = -40
+ !$acc parallel
+ call verify_n2_values (20)
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ call verify_n2_values (20)
+ !$acc end parallel
+
call acc_update_self (b)
call verify_n2_allocated
@@ -269,11 +291,19 @@ program test
!$acc update device (b)
!$acc serial
- call verify_n1_deallocated (.true.)
+ call verify_n2_allocated
!$acc end serial
b = -41
+ !$acc parallel
+ call verify_n2_values (-20)
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ call verify_n2_values (-20)
+ !$acc end parallel
+
!$acc update self (b)
call verify_n2_allocated
@@ -301,12 +331,13 @@ program test
call acc_delete (b)
if (.not.allocated (b)) error stop
- if (acc_is_present (b)) error stop
+ if (.not.acc_is_present (b)) error stop
!$acc serial
call verify_n2_allocated
!$acc end serial
deallocate (b)
+ !if (acc_is_present (b)) error stop
call verify_n2_deallocated (.false.)
!$acc serial
call verify_n2_allocated
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1.f90
new file mode 100644
index 0000000..1105a57
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-array_descriptor-1.f90
@@ -0,0 +1,405 @@
+! Test OpenACC 'declare create' with allocatable arrays.
+
+! { dg-do run }
+
+! Note that we're not testing OpenACC semantics here, but rather documenting
+! current GCC behavior, specifically, behavior concerning updating of
+! host/device array descriptors.
+! { dg-skip-if n/a { *-*-* } { -DACC_MEM_SHARED=1 } }
+
+! We've got support for OpenACC "Changes from Version 2.0 to 2.5":
+! "The 'declare create' directive with a Fortran 'allocatable' has new behavior".
+
+
+!TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'.
+
+
+!TODO OpenACC 'serial' vs. GCC/nvptx:
+!TODO { dg-prune-output {using 'vector_length \(32\)', ignoring 1} }
+
+
+! { dg-additional-options -fdump-tree-original }
+! { dg-additional-options -fdump-tree-gimple }
+
+
+module vars
+ implicit none
+ integer, parameter :: n1_lb = -3
+ integer, parameter :: n1_ub = 6
+ integer, parameter :: n2_lb = -9999
+ integer, parameter :: n2_ub = 22222
+
+ integer, allocatable :: b(:)
+ !$acc declare create (b)
+
+end module vars
+
+program test
+ use vars
+ use openacc
+ implicit none
+ integer :: i
+
+ ! Identifiers for purposes of reliable '-fdump-tree-[...]' scanning.
+ integer :: id1_1, id1_2
+
+ interface
+
+ subroutine verify_initial
+ implicit none
+ !$acc routine seq
+ end subroutine verify_initial
+
+ subroutine verify_n1_allocated
+ implicit none
+ !$acc routine seq
+ end subroutine verify_n1_allocated
+
+ subroutine verify_n1_values (addend)
+ implicit none
+ !$acc routine gang
+ integer, value :: addend
+ end subroutine verify_n1_values
+
+ subroutine verify_n1_deallocated (expect_allocated)
+ implicit none
+ !$acc routine seq
+ logical, value :: expect_allocated
+ end subroutine verify_n1_deallocated
+
+ subroutine verify_n2_allocated
+ implicit none
+ !$acc routine seq
+ end subroutine verify_n2_allocated
+
+ subroutine verify_n2_values (addend)
+ implicit none
+ !$acc routine gang
+ integer, value :: addend
+ end subroutine verify_n2_values
+
+ subroutine verify_n2_deallocated (expect_allocated)
+ implicit none
+ !$acc routine seq
+ logical, value :: expect_allocated
+ end subroutine verify_n2_deallocated
+
+ end interface
+
+ call acc_create (id1_1)
+ call acc_create (id1_2)
+
+ call verify_initial
+ ! It is important here (and similarly, following) that there is no data
+ ! clause for 'b' (explicit or implicit): no 'GOMP_MAP_TO_PSET'.
+ !$acc serial
+ call verify_initial
+ !$acc end serial
+
+ allocate (b(n1_lb:n1_ub))
+ call verify_n1_allocated
+ ! This is now OpenACC "present":
+ if (.not.acc_is_present (b)) error stop
+ ! ..., and got the actual array descriptor installed:
+ !$acc serial
+ call verify_n1_allocated
+ !$acc end serial
+
+ do i = n1_lb, n1_ub
+ b(i) = i - 1
+ end do
+
+ call acc_update_device (b)
+ !$acc serial
+ call verify_n1_allocated
+ !$acc end serial
+
+ b = 40
+
+ !$acc parallel copyout (id1_1) ! No data clause for 'b' (explicit or implicit): no 'GOMP_MAP_TO_PSET'.
+ call verify_n1_values (-1)
+ id1_1 = 0
+ !$acc end parallel
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc parallel map\(from:id1_1\)$} 1 original } }
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_parallel map\(from:id1_1 \[len: [0-9]+\]\)$} 1 gimple } }
+
+ !$acc parallel copy (b) copyout (id1_2)
+ ! As already present, 'copy (b)' doesn't copy; addend is still '-1'.
+ call verify_n1_values (-1)
+ id1_2 = 0
+ !$acc end parallel
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc parallel map\(tofrom:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(from:id1_2\)$} 1 original } }
+ !TODO ..., but without an actual use of 'b', the gimplifier removes the
+ !TODO 'GOMP_MAP_TO_PSET':
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_parallel map\(tofrom:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(from:id1_2 \[len: [0-9]+\]\)$} 1 gimple } }
+
+ call acc_update_self (b)
+ call verify_n1_allocated
+
+ do i = n1_lb, n1_ub
+ if (b(i) /= i - 1) error stop
+ b(i) = b(i) + 2
+ end do
+
+ ! The same using the OpenACC 'update' directive.
+
+ !$acc update device (b) self (id1_1)
+ ! We do have 'GOMP_MAP_TO_PSET' here:
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc update map\(force_to:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(force_from:id1_1\);$} 1 original } }
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_update map\(force_to:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(force_from:id1_1 \[len: [0-9]+\]\)$} 1 gimple } }
+ ! ..., but it's silently skipped in 'GOACC_update'.
+ !$acc serial
+ call verify_n1_allocated
+ !$acc end serial
+
+ b = 41
+
+ !$acc parallel
+ call verify_n1_values (1)
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ call verify_n1_values (1)
+ !$acc end parallel
+
+ !$acc update self (b) self (id1_2)
+ ! We do have 'GOMP_MAP_TO_PSET' here:
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc update map\(force_from:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(force_from:id1_2\);$} 1 original } }
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_update map\(force_from:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(force_from:id1_2 \[len: [0-9]+\]\)$} 1 gimple } }
+ ! ..., but it's silently skipped in 'GOACC_update'.
+ call verify_n1_allocated
+
+ do i = n1_lb, n1_ub
+ if (b(i) /= i + 1) error stop
+ b(i) = b(i) + 2
+ end do
+
+ ! Now test that (potentially re-)installing the actual array descriptor is a
+ ! no-op, via a data clause for 'b' (explicit or implicit): must get a
+ ! 'GOMP_MAP_TO_PSET'.
+ !$acc serial present (b) copyin (id1_2)
+ call verify_n1_allocated
+ !TODO Use of 'b':
+ id1_2 = ubound (b, 1)
+ !$acc end serial
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc serial map\(force_present:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(to:id1_2\)$} 1 original } }
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_serial map\(force_present:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(to:id1_2 \[len: [0-9]+\]\)$} 1 gimple } }
+
+ !$acc parallel copyin (id1_1) ! No data clause for 'b' (explicit or implicit): no 'GOMP_MAP_TO_PSET'.
+ call verify_n1_values (1)
+ id1_1 = 0
+ !$acc end parallel
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc parallel map\(to:id1_1\)$} 1 original } }
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_parallel map\(to:id1_1 \[len: [0-9]+\]\)$} 1 gimple } }
+
+ !$acc parallel copy (b) copyin (id1_2)
+ ! As already present, 'copy (b)' doesn't copy; addend is still '1'.
+ call verify_n1_values (1)
+ id1_2 = 0
+ !$acc end parallel
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc parallel map\(tofrom:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(to:id1_2\)$} 1 original } }
+ !TODO ..., but without an actual use of 'b', the gimplifier removes the
+ !TODO 'GOMP_MAP_TO_PSET':
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_parallel map\(tofrom:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(to:id1_2 \[len: [0-9]+\]\)$} 1 gimple } }
+
+ call verify_n1_allocated
+ if (.not.acc_is_present (b)) error stop
+
+ deallocate (b)
+ !if (acc_is_present (b)) error stop
+ call verify_n1_deallocated (.false.)
+ ! The device-side array descriptor doesn't get updated, so 'b' still appears
+ ! as "allocated":
+ !$acc serial
+ call verify_n1_allocated
+ !$acc end serial
+
+ ! Now try to install the actual array descriptor, via a data clause for 'b'
+ ! (explicit or implicit): must get a 'GOMP_MAP_TO_PSET', which then in
+ ! 'gomp_map_vars_internal' is handled as 'declare target', but because of
+ ! '*(void **) hostaddrs[i] == NULL', we've got 'has_always_ptrset == false',
+ ! 'always_to_cnt == 0', and therefore 'gomp_map_vars_existing' doesn't update
+ ! the 'GOMP_MAP_TO_PSET'.
+ ! The device-side array descriptor doesn't get updated, so 'b' still appears
+ ! as "allocated":
+ !TODO Why does 'present (b)' still work here?
+ !$acc serial present (b) copyout (id1_2)
+ call verify_n1_deallocated (.true.)
+ !TODO Use of 'b'.
+ id1_2 = ubound (b, 1)
+ !$acc end serial
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma acc serial map\(force_present:\*\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:\(integer\(kind=[0-9]+\)\[0:\] \* restrict\) b\.data \[pointer assign, bias: 0\]\) map\(from:id1_2\)$} 1 original } }
+ ! { dg-final { scan-tree-dump-times {(?n)^ *#pragma omp target oacc_serial map\(force_present:MEM <integer\(kind=[0-9]+\)\[0:\]> \[\(integer\(kind=[0-9]+\)\[0:\] \*\)[^\]]+\] \[len: [^\]]+\]\) map\(to:b \[pointer set, len: [0-9]+\]\) map\(alloc:b\.data \[pointer assign, bias: 0\]\) map\(from:id1_2 \[len: [0-9]+\]\)$} 1 gimple } }
+
+
+ ! Restart the procedure, with different array dimensions.
+
+ allocate (b(n2_lb:n2_ub))
+ call verify_n2_allocated
+ if (.not.acc_is_present (b)) error stop
+ !$acc serial
+ call verify_n2_allocated
+ !$acc end serial
+
+ do i = n2_lb, n2_ub
+ b(i) = i + 20
+ end do
+
+ call acc_update_device (b)
+ !$acc serial
+ call verify_n2_allocated
+ !$acc end serial
+
+ b = -40
+
+ !$acc parallel
+ call verify_n2_values (20)
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ call verify_n2_values (20)
+ !$acc end parallel
+
+ call acc_update_self (b)
+ call verify_n2_allocated
+
+ do i = n2_lb, n2_ub
+ if (b(i) /= i + 20) error stop
+ b(i) = b(i) - 40
+ end do
+
+ !$acc update device (b)
+ !$acc serial
+ call verify_n2_allocated
+ !$acc end serial
+
+ b = -41
+
+ !$acc parallel
+ call verify_n2_values (-20)
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ call verify_n2_values (-20)
+ !$acc end parallel
+
+ !$acc update self (b)
+ call verify_n2_allocated
+
+ do i = n2_lb, n2_ub
+ if (b(i) /= i - 20) error stop
+ b(i) = b(i) + 10
+ end do
+
+ !$acc serial present (b) copy (id1_2)
+ call verify_n2_allocated
+ !TODO Use of 'b':
+ id1_2 = ubound (b, 1)
+ !$acc end serial
+
+ !$acc parallel
+ call verify_n2_values (-20)
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ call verify_n2_values (-20)
+ !$acc end parallel
+
+ call verify_n2_allocated
+ if (.not.acc_is_present (b)) error stop
+
+ deallocate (b)
+ !if (acc_is_present (b)) error stop
+ call verify_n2_deallocated (.false.)
+ !$acc serial
+ call verify_n2_allocated
+ !$acc end serial
+
+ !$acc serial present (b) copy (id1_2)
+ call verify_n2_deallocated (.true.)
+ !TODO Use of 'b':
+ id1_2 = ubound (b, 1)
+ !$acc end serial
+
+end program test
+
+
+subroutine verify_initial
+ use vars
+ implicit none
+ !$acc routine seq
+
+ if (allocated (b)) error stop "verify_initial allocated"
+ if (any (lbound (b) /= [0])) error stop "verify_initial lbound"
+ if (any (ubound (b) /= [0])) error stop "verify_initial ubound"
+end subroutine verify_initial
+
+subroutine verify_n1_allocated
+ use vars
+ implicit none
+ !$acc routine seq
+
+ if (.not.allocated (b)) error stop "verify_n1_allocated allocated"
+ if (any (lbound (b) /= [n1_lb])) error stop "verify_n1_allocated lbound"
+ if (any (ubound (b) /= [n1_ub])) error stop "verify_n1_allocated ubound"
+end subroutine verify_n1_allocated
+
+subroutine verify_n1_values (addend)
+ use vars
+ implicit none
+ !$acc routine gang
+ integer, value :: addend
+ integer :: i
+
+ !$acc loop
+ do i = n1_lb, n1_ub
+ if (b(i) /= i + addend) error stop
+ end do
+end subroutine verify_n1_values
+
+subroutine verify_n1_deallocated (expect_allocated)
+ use vars
+ implicit none
+ !$acc routine seq
+ logical, value :: expect_allocated
+
+ if (allocated(b) .neqv. expect_allocated) error stop "verify_n1_deallocated allocated"
+ ! Apparently 'deallocate'ing doesn't unset the bounds.
+ if (any (lbound (b) /= [n1_lb])) error stop "verify_n1_deallocated lbound"
+ if (any (ubound (b) /= [n1_ub])) error stop "verify_n1_deallocated ubound"
+end subroutine verify_n1_deallocated
+
+subroutine verify_n2_allocated
+ use vars
+ implicit none
+ !$acc routine seq
+
+ if (.not.allocated(b)) error stop "verify_n2_allocated allocated"
+ if (any (lbound (b) /= [n2_lb])) error stop "verify_n2_allocated lbound"
+ if (any (ubound (b) /= [n2_ub])) error stop "verify_n2_allocated ubound"
+end subroutine verify_n2_allocated
+
+subroutine verify_n2_values (addend)
+ use vars
+ implicit none
+ !$acc routine gang
+ integer, value :: addend
+ integer :: i
+
+ !$acc loop
+ do i = n2_lb, n2_ub
+ if (b(i) /= i + addend) error stop
+ end do
+end subroutine verify_n2_values
+
+subroutine verify_n2_deallocated (expect_allocated)
+ use vars
+ implicit none
+ !$acc routine seq
+ logical, value :: expect_allocated
+
+ if (allocated(b) .neqv. expect_allocated) error stop "verify_n2_deallocated allocated"
+ ! Apparently 'deallocate'ing doesn't unset the bounds.
+ if (any (lbound (b) /= [n2_lb])) error stop "verify_n2_deallocated lbound"
+ if (any (ubound (b) /= [n2_ub])) error stop "verify_n2_deallocated ubound"
+end subroutine verify_n2_deallocated
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-create-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-create-1.f90
new file mode 100644
index 0000000..057b5eb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-create-1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+
+module m
+integer :: mint
+!$acc declare create (mint)
+end module m
+
+program p
+use m
+
+mint = 0
+
+!$acc serial
+! { dg-warning {using .vector_length \(32\)., ignoring 1} "" { target openacc_nvidia_accel_selected } .-1 }
+mint = 5
+!$acc end serial
+
+!$acc update host(mint)
+
+if (mint.ne.5) stop 1
+
+end program p
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-create-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-create-2.f90
new file mode 100644
index 0000000..dd7c979
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-create-2.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+
+module m
+integer, allocatable :: mint
+!$acc declare create (mint)
+end module m
+
+program p
+use m
+
+allocate(mint)
+
+mint = 0
+
+!$acc serial
+! { dg-warning {using .vector_length \(32\)., ignoring 1} "" { target openacc_nvidia_accel_selected } .-1 }
+mint = 5
+!$acc end serial
+
+!$acc update host(mint)
+
+if (mint.ne.5) stop 1
+
+deallocate(mint)
+
+end program p
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-create-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-create-3.f90
new file mode 100644
index 0000000..7cceaa5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-create-3.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+
+module m
+integer, allocatable :: mint(:)
+!$acc declare create (mint)
+end module m
+
+program p
+use m
+
+allocate(mint(1:20))
+
+mint = 0
+
+!$acc serial
+! { dg-warning {using .vector_length \(32\)., ignoring 1} "" { target openacc_nvidia_accel_selected } .-1 }
+mint = 5
+!$acc end serial
+
+!$acc update host(mint)
+
+if (any(mint.ne.5)) stop 1
+
+deallocate(mint)
+
+end program p
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90
new file mode 100644
index 0000000..276a172
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/deviceptr-1.f90
@@ -0,0 +1,197 @@
+! { dg-do run }
+
+! Test the deviceptr clause with various directives
+! and in combination with other directives where
+! the deviceptr variable is implied.
+
+subroutine subr1 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc data deviceptr (a)
+
+ !$acc parallel copy (b)
+ do i = 1, N
+ a(i) = i * 2
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+ !$acc end data
+
+end subroutine
+
+subroutine subr2 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ !$acc declare deviceptr (a)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc parallel copy (b)
+ do i = 1, N
+ a(i) = i * 4
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr3 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ !$acc declare deviceptr (a)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc kernels copy (b)
+ do i = 1, N
+ a(i) = i * 8
+ b(i) = a(i)
+ end do
+ !$acc end kernels
+
+end subroutine
+
+subroutine subr4 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc parallel deviceptr (a) copy (b)
+ do i = 1, N
+ a(i) = i * 16
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr5 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc kernels deviceptr (a) copy (b)
+ do i = 1, N
+ a(i) = i * 32
+ b(i) = a(i)
+ end do
+ !$acc end kernels
+
+end subroutine
+
+subroutine subr6 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc parallel deviceptr (a) copy (b)
+ do i = 1, N
+ b(i) = i
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr7 (a, b)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: i = 0
+
+ !$acc data deviceptr (a)
+
+ !$acc parallel copy (b)
+ do i = 1, N
+ a(i) = i * 2
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+ !$acc parallel copy (b)
+ do i = 1, N
+ a(i) = b(i) * 2
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+ !$acc end data
+
+end subroutine
+
+program main
+ use iso_c_binding, only: c_ptr, c_f_pointer
+ implicit none
+ type (c_ptr) :: cp
+ integer, parameter :: N = 8
+ integer, pointer :: fp(:)
+ integer :: i = 0
+ integer :: b(N)
+
+ interface
+ function acc_malloc (s) bind (C)
+ use iso_c_binding, only: c_ptr, c_size_t
+ integer (c_size_t), value :: s
+ type (c_ptr) :: acc_malloc
+ end function
+ end interface
+
+ cp = acc_malloc (N * sizeof (fp(N)))
+ call c_f_pointer (cp, fp, [N])
+
+ call subr1 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 2) call abort
+ end do
+
+ call subr2 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 4) call abort
+ end do
+
+ call subr3 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 8) call abort
+ end do
+
+ call subr4 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 16) call abort
+ end do
+
+ call subr5 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 32) call abort
+ end do
+
+ call subr6 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i) call abort
+ end do
+
+ call subr7 (fp, b)
+
+ do i = 1, N
+ if (b(i) .ne. i * 4) call abort
+ end do
+
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/firstprivate-int.f90 b/libgomp/testsuite/libgomp.oacc-fortran/firstprivate-int.f90
new file mode 100644
index 0000000..abc175f3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/firstprivate-int.f90
@@ -0,0 +1,209 @@
+! Verify the GOMP_MAP_FIRSTPRIVATE_INT optimziation on various types.
+
+! { dg-do run }
+
+program test
+ use iso_fortran_env, only: integer_kinds
+ implicit none
+
+ integer (kind=1) :: i1i, i1o
+ integer (kind=2) :: i2i, i2o
+ integer (kind=4) :: i4i, i4o
+ integer (kind=8) :: i8i, i8o
+! Use highest-precision integer, which might be less than '16'
+! assume integer_kinds == logical_kinds
+ integer (kind=maxval(integer_kinds)) :: i16i, i16o
+
+ logical (kind=1) :: l1i, l1o
+ logical (kind=2) :: l2i, l2o
+ logical (kind=4) :: l4i, l4o
+ logical (kind=8) :: l8i, l8o
+ logical (kind=maxval(integer_kinds)) :: l16i, l16o
+
+ real (kind=4) :: r4i, r4o
+ real (kind=8) :: r8i, r8o
+
+ complex (kind=4) :: c4i, c4o
+ complex (kind=8) :: c8i, c8o
+
+ character (kind=1) :: ch1i, ch1o
+ character (kind=4) :: ch4i, ch4o
+
+ i1i = 1
+ i2i = 2
+ i4i = 3
+ i8i = 4
+ i16i = 5
+
+ l1i = .true.
+ l2i = .false.
+ l4i = .true.
+ l8i = .true.
+ l16i = .false.
+
+ r4i = .5
+ r8i = .25
+
+ c4i = (2, -2)
+ c8i = (4, -4)
+
+ ch1i = "a"
+ ch4i = "b"
+
+ !$acc parallel firstprivate(i1i, i2i, i4i, i8i, i16i) &
+ !$acc copyout(i1o, i2o, i4o, i8o, i16o) &
+ !$acc firstprivate(l1i, l2i, l4i, l8i, l16i) &
+ !$acc copyout(l1o, l2o, l4o, l8o, l16o) &
+ !$acc firstprivate(r4i, r8i) copyout(r4o, r8o) &
+ !$acc firstprivate(c4i, c8i) copyout(c4o, c8o) &
+ !$acc firstprivate(ch1i, ch4i) &
+ !$acc copyout(ch1o, ch4o)
+ i1o = i1i
+ i2o = i2i
+ i4o = i4i
+ i8o = i8i
+ i16o = i16i
+
+ l1o = l1i
+ l2o = l2i
+ l4o = l4i
+ l8o = l8i
+ l16o = l16i
+
+ r4o = r4i
+ r8o = r8i
+
+ c4o = c4i
+ c8o = c8i
+
+ ch1o = ch1i
+ ch4o = ch4i
+ !$acc end parallel
+
+ if (i1i /= i1o) stop 1
+ if (i2i /= i2o) stop 2
+ if (i4i /= i4o) stop 3
+ if (i8i /= i8o) stop 4
+ if (i16i /= i16o) stop 5
+
+ if (l1i .neqv. l1o) stop 6
+ if (l2i .neqv. l2o) stop 7
+ if (l4i .neqv. l4o) stop 8
+ if (l8i .neqv. l8o) stop 9
+ if (l16i .neqv. l16o) stop 10
+
+ if (r4i /= r4o) stop 11
+ if (r8i /= r8o) stop 12
+
+ if (c4i /= c4o) stop 13
+ if (c8i /= c8o) stop 14
+
+ if (ch1i /= ch1o) stop 15
+ if (ch4i /= ch4o) stop 16
+
+ call subtest(i1i, i2i, i4i, i8i, i16i, i1o, i2o, i4o, i8o, i16o, &
+ l1i, l2i, l4i, l8i, l16i, l1o, l2o, l4o, l8o, l16o, &
+ r4i, r8i, r4o, r8o, c4i, c8i, c4o, c8o, &
+ ch1i, ch4i, ch1o, ch4o)
+end program test
+
+subroutine subtest(i1i, i2i, i4i, i8i, i16i, i1o, i2o, i4o, i8o, i16o, &
+ l1i, l2i, l4i, l8i, l16i, l1o, l2o, l4o, l8o, l16o, &
+ r4i, r8i, r4o, r8o, c4i, c8i, c4o, c8o, &
+ ch1i, ch4i, ch1o, ch4o)
+ use iso_fortran_env, only: integer_kinds
+ implicit none
+
+ integer (kind=1) :: i1i, i1o
+ integer (kind=2) :: i2i, i2o
+ integer (kind=4) :: i4i, i4o
+ integer (kind=8) :: i8i, i8o
+ integer (kind=maxval(integer_kinds)) :: i16i, i16o
+
+ logical (kind=1) :: l1i, l1o
+ logical (kind=2) :: l2i, l2o
+ logical (kind=4) :: l4i, l4o
+ logical (kind=8) :: l8i, l8o
+ logical (kind=maxval(integer_kinds)) :: l16i, l16o
+
+ real (kind=4) :: r4i, r4o
+ real (kind=8) :: r8i, r8o
+
+ complex (kind=4) :: c4i, c4o
+ complex (kind=8) :: c8i, c8o
+
+ character (kind=1) :: ch1i, ch1o
+ character (kind=4) :: ch4i, ch4o
+
+ i1i = -i1i
+ i2i = -i2i
+ i4i = -i4i
+ i8i = -i8i
+ i16i = -i16i
+
+ l1i = .not. l1i
+ l2i = .not. l2i
+ l4i = .not. l4i
+ l8i = .not. l8i
+ l16i = .not. l16i
+
+ r4i = -r4i
+ r8i = -r8i
+
+ c4i = -c4i
+ c8i = -c8i
+
+ ch1i = "z"
+ ch4i = "y"
+
+ !$acc parallel firstprivate(i1i, i2i, i4i, i8i, i16i) &
+ !$acc copyout(i1o, i2o, i4o, i8o, i16o) &
+ !$acc firstprivate(l1i, l2i, l4i, l8i, l16i) &
+ !$acc copyout(l1o, l2o, l4o, l8o, l16o) &
+ !$acc firstprivate(r4i, r8i) copyout(r4o, r8o) &
+ !$acc firstprivate(c4i, c8i) copyout(c4o, c8o) &
+ !$acc firstprivate(ch1i, ch4i) &
+ !$acc copyout(ch1o, ch4o)
+ i1o = i1i
+ i2o = i2i
+ i4o = i4i
+ i8o = i8i
+ i16o = i16i
+
+ l1o = l1i
+ l2o = l2i
+ l4o = l4i
+ l8o = l8i
+ l16o = l16i
+
+ r4o = r4i
+ r8o = r8i
+
+ c4o = c4i
+ c8o = c8i
+
+ ch1o = ch1i
+ ch4o = ch4i
+ !$acc end parallel
+
+ if (i1i /= i1o) stop 17
+ if (i2i /= i2o) stop 18
+ if (i4i /= i4o) stop 19
+ if (i8i /= i8o) stop 20
+ if (i16i /= i16o) stop 21
+
+ if (l1i .neqv. l1o) stop 22
+ if (l2i .neqv. l2o) stop 23
+ if (l4i .neqv. l4o) stop 24
+ if (l8i .neqv. l8o) stop 25
+ if (l16i .neqv. l16o) stop 26
+
+ if (r4i /= r4o) stop 27
+ if (r8i /= r8o) stop 28
+
+ if (c4i /= c4o) stop 29
+ if (c8i /= c8o) stop 30
+
+ if (ch1i /= ch1o) stop 31
+ if (ch4i /= ch4o) stop 32
+end subroutine subtest
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-1.f90
new file mode 100644
index 0000000..8b173c7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program p
+implicit none
+integer :: myarr(10)
+
+myarr = 0
+
+call subr(myarr)
+
+if (myarr(5).ne.5) stop 1
+
+contains
+
+subroutine subr(arr)
+implicit none
+integer :: arr(*)
+
+!$acc enter data copyin(arr(1:10))
+
+!$acc serial
+! { dg-warning {using .vector_length \(32\)., ignoring 1} "" { target openacc_nvidia_accel_selected } .-1 }
+arr(5) = 5
+!$acc end serial
+
+!$acc exit data copyout(arr(1:10))
+
+end subroutine subr
+end program p
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-2.f90
new file mode 100644
index 0000000..659fe8e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/nonlexical-assumed-size-2.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+
+program p
+implicit none
+integer :: myarr(10)
+
+myarr = 0
+
+call subr(myarr)
+
+if (myarr(5).ne.5) stop 1
+
+contains
+
+subroutine subr(arr)
+implicit none
+integer :: arr(*)
+
+! At first glance, it might not be obvious how this works. The "enter data"
+! and "exit data" operations expand to a pair of mapping nodes for OpenACC,
+! GOMP_MAP_{TO/FROM} and GOMP_MAP_POINTER. The former maps the array data,
+! and the latter creates a separate mapping on the target for the pointer
+! itself with a bias so it represents the "zeroth" element.
+
+!$acc enter data copyin(arr(2:8))
+
+! ...then this implicit mapping creates a zero-length array section
+! (GOMP_MAP_ZERO_LEN_ARRAY_SECTION) followed by another GOMP_MAP_POINTER for
+! 'arr'. But now that pointer is already "present" on the target, so is not
+! overwritten.
+
+!$acc serial
+! { dg-warning {using .vector_length \(32\)., ignoring 1} "" { target openacc_nvidia_accel_selected } .-1 }
+! This access is then done via the on-target pointer.
+arr(5) = 5
+!$acc end serial
+
+!$acc exit data copyout(arr(2:8))
+
+end subroutine subr
+end program p
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/openacc_version-1.f b/libgomp/testsuite/libgomp.oacc-fortran/openacc_version-1.f
index 36e9844..8d4e3f3 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/openacc_version-1.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/openacc_version-1.f
@@ -4,6 +4,6 @@
implicit none
include "openacc_lib.h"
- if (openacc_version .ne. 201711) STOP 1
+ if (openacc_version .ne. 201811) STOP 1
end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/openacc_version-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/openacc_version-2.f90
index e815bc1..c9946c2 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/openacc_version-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/openacc_version-2.f90
@@ -4,6 +4,6 @@ program main
use openacc
implicit none
- if (openacc_version .ne. 201711) STOP 1
+ if (openacc_version .ne. 201811) STOP 1
end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90
index df69362..30a55bc 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90
@@ -44,7 +44,7 @@ contains
! { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-2 }
!$acc loop gang private(x)
! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
- ! { dg-note {variable 'x' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
+ ! { dg-note {variable 'x' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } .-2 }
do i = 1, 32
x = i * 2;
arr(i) = arr(i) + x
@@ -72,7 +72,7 @@ contains
! { dg-warning "region is worker partitioned but does not contain worker partitioned code" "" { target *-*-* } .-1 }
!$acc loop gang private(pt)
! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
- ! { dg-note {variable 'pt' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
+ ! { dg-note {variable 'pt' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } .-2 }
do i = 0, 31
pt%x = i
pt%y = i * 2
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90
index 0bb05b9..91564b2 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90
@@ -34,8 +34,7 @@ contains
!$acc parallel num_gangs(ng) copy(rg)
!$acc loop reduction(+:rg) gang
- ! { dg-bogus {'rg\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'rg\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'rg\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
rg = rg + array(i)
end do
@@ -43,8 +42,7 @@ contains
!$acc parallel num_workers(nw) copy(rw)
!$acc loop reduction(+:rw) worker
- ! { dg-bogus {'rw\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'rw\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'rw\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
rw = rw + array(i)
end do
@@ -52,8 +50,7 @@ contains
!$acc parallel vector_length(vl) copy(rv)
!$acc loop reduction(+:rv) vector
- ! { dg-bogus {'rv\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'rv\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'rv\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
rv = rv + array(i)
end do
@@ -61,8 +58,7 @@ contains
!$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
!$acc loop reduction(+:rc) gang worker vector
- ! { dg-bogus {'rc\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'rc\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'rc\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
rc = rc + array(i)
end do
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/parallel-reduction.f90 b/libgomp/testsuite/libgomp.oacc-fortran/parallel-reduction.f90
index a7b7ade..2b289c2 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/parallel-reduction.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/parallel-reduction.f90
@@ -46,11 +46,9 @@ subroutine redsub(s1, s2, n)
integer :: s1, s2, n
!$acc parallel reduction(+:s1,s2) num_gangs (10) copy(s1)
- ! { dg-bogus {'s1\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'s1\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
- ! { dg-bogus {'s2\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-3 }
- ! { dg-note {'s2\.[0-9]+' was declared here} {} { target *-*-* } .-4 }
- ! { dg-bogus "\[Ww\]arning: region is gang partitioned but does not contain gang partitioned code" "TODO 'reduction'" { xfail *-*-* } .-5 }
+ ! { dg-bogus {'s1\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
+ ! { dg-bogus {'s2\.[0-9]+' is used uninitialized} "" { target *-*-* } .-2 }
+ ! { dg-bogus "\[Ww\]arning: region is gang partitioned but does not contain gang partitioned code" "TODO 'reduction'" { xfail *-*-* } .-3 }
s1 = s1 + 1
s2 = s2 + 1
!$acc end parallel
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr70643.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr70643.f90
index 5082e36..a9f00ab 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/pr70643.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr70643.f90
@@ -18,8 +18,7 @@ SUBROUTINE reduction_kernel(x_min,x_max,y_min,y_max,arr,sum)
!$ACC DATA PRESENT(arr) COPY(sum)
!$ACC PARALLEL LOOP REDUCTION(+ : sum)
- ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
DO k=y_min,y_max
DO j=x_min,x_max
sum=sum+arr(j,k)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr70828-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-2.f90
new file mode 100644
index 0000000..22a9566
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-2.f90
@@ -0,0 +1,31 @@
+! Subarrays declared on data construct: assumed-shape array.
+
+subroutine s1(n, arr)
+ integer :: n
+ integer :: arr(n)
+
+ !$acc data copy(arr(5:n-10))
+ !$acc parallel loop
+ do i = 10, n - 10
+ arr(i) = i
+ end do
+ !$acc end parallel loop
+ !$acc end data
+end subroutine s1
+
+program test
+ integer, parameter :: n = 100
+ integer i, data(n)
+
+ data(:) = 0
+
+ call s1(n, data)
+
+ do i = 1, n
+ if ((i < 10 .or. i > n-10)) then
+ if ((data(i) .ne. 0)) call abort
+ else if (data(i) .ne. i) then
+ call abort
+ end if
+ end do
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr70828-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-3.f90
new file mode 100644
index 0000000..ff17d10
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-3.f90
@@ -0,0 +1,34 @@
+! Subarrays declared on data construct: deferred-shape array.
+
+subroutine s1(n, arr)
+ integer :: n
+ integer :: arr(n)
+
+ !$acc data copy(arr(5:n-10))
+ !$acc parallel loop
+ do i = 10, n - 10
+ arr(i) = i
+ end do
+ !$acc end parallel loop
+ !$acc end data
+end subroutine s1
+
+program test
+ integer, parameter :: n = 100
+ integer i
+ integer, allocatable :: data(:)
+
+ allocate (data(1:n))
+
+ data(:) = 0
+
+ call s1(n, data)
+
+ do i = 1, n
+ if ((i < 10 .or. i > n-10)) then
+ if ((data(i) .ne. 0)) call abort
+ else if (data(i) .ne. i) then
+ call abort
+ end if
+ end do
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr70828-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-4.f90
new file mode 100644
index 0000000..01da999
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-4.f90
@@ -0,0 +1,31 @@
+! Subarrays declared on data construct: assumed-size array.
+
+subroutine s1(n, arr)
+ integer :: n
+ integer :: arr(*)
+
+ !$acc data copy(arr(5:n-10))
+ !$acc parallel loop
+ do i = 10, n - 10
+ arr(i) = i
+ end do
+ !$acc end parallel loop
+ !$acc end data
+end subroutine s1
+
+program test
+ integer, parameter :: n = 100
+ integer i, data(n)
+
+ data(:) = 0
+
+ call s1(n, data)
+
+ do i = 1, n
+ if ((i < 10 .or. i > n-10)) then
+ if ((data(i) .ne. 0)) call abort
+ else if (data(i) .ne. i) then
+ call abort
+ end if
+ end do
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr70828-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-5.f90
new file mode 100644
index 0000000..8a16e3d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-5.f90
@@ -0,0 +1,29 @@
+! Subarrays on parallel construct (no data construct): assumed-size array.
+
+subroutine s1(n, arr)
+ integer :: n
+ integer :: arr(*)
+
+ !$acc parallel loop copy(arr(5:n-10))
+ do i = 10, n - 10
+ arr(i) = i
+ end do
+ !$acc end parallel loop
+end subroutine s1
+
+program test
+ integer, parameter :: n = 100
+ integer i, data(n)
+
+ data(:) = 0
+
+ call s1(n, data)
+
+ do i = 1, n
+ if ((i < 10 .or. i > n-10)) then
+ if ((data(i) .ne. 0)) call abort
+ else if (data(i) .ne. i) then
+ call abort
+ end if
+ end do
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr70828-6.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-6.f90
new file mode 100644
index 0000000..e99c364
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr70828-6.f90
@@ -0,0 +1,28 @@
+! Subarrays declared on data construct: allocatable array (with array
+! descriptor).
+
+program test
+ integer, parameter :: n = 100
+ integer i
+ integer, allocatable :: data(:)
+
+ allocate (data(1:n))
+
+ data(:) = 0
+
+ !$acc data copy(data(5:n-10))
+ !$acc parallel loop
+ do i = 10, n - 10
+ data(i) = i
+ end do
+ !$acc end parallel loop
+ !$acc end data
+
+ do i = 1, n
+ if ((i < 10 .or. i > n-10)) then
+ if ((data(i) .ne. 0)) call abort
+ else if (data(i) .ne. i) then
+ call abort
+ end if
+ end do
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/pr70828.f90 b/libgomp/testsuite/libgomp.oacc-fortran/pr70828.f90
new file mode 100644
index 0000000..f87d232
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/pr70828.f90
@@ -0,0 +1,24 @@
+! Subarrays on data construct: explicit-shape array.
+
+program test
+ integer, parameter :: n = 100
+ integer i, data(n)
+
+ data(:) = 0
+
+ !$acc data copy(data(5:n-10))
+ !$acc parallel loop
+ do i = 10, n - 10
+ data(i) = i
+ end do
+ !$acc end parallel loop
+ !$acc end data
+
+ do i = 1, n
+ if ((i < 10 .or. i > n-10)) then
+ if ((data(i) .ne. 0)) call abort
+ else if (data(i) .ne. i) then
+ call abort
+ end if
+ end do
+end program test
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/privatized-ref-1.f95 b/libgomp/testsuite/libgomp.oacc-fortran/privatized-ref-1.f95
index b027d14..1b3367d 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/privatized-ref-1.f95
+++ b/libgomp/testsuite/libgomp.oacc-fortran/privatized-ref-1.f95
@@ -78,7 +78,7 @@ contains
!$acc loop collapse(2) gang private(t1) ! { dg-line l_loop[incr c_loop] }
! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
- ! { dg-note {variable 't1' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
+ ! { dg-note {variable 't1' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } l_loop$c_loop }
do i=0,255
do j=1,256
t1 = (i * 256 + j) * 97
@@ -103,7 +103,7 @@ contains
do i=0,255
!$acc loop worker private(t1) ! { dg-line l_loop[incr c_loop] }
! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
- ! { dg-note {variable 't1' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
+ ! { dg-note {variable 't1' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } l_loop$c_loop }
do j=1,256
t1 = (i * 256 + j) * 99
res(i * 256 + j) = t1
@@ -127,7 +127,7 @@ contains
do i=0,255
!$acc loop vector private(t1) ! { dg-line l_loop[incr c_loop] }
! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
- ! { dg-note {variable 't1' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
+ ! { dg-note {variable 't1' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } l_loop$c_loop }
do j=1,256
t1 = (i * 256 + j) * 101
res(i * 256 + j) = t1
@@ -149,7 +149,7 @@ contains
!$acc loop collapse(2) gang worker vector private(t1) ! { dg-line l_loop[incr c_loop] }
! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
- ! { dg-note {variable 't1' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } l_loop$c_loop }
+ ! { dg-note {variable 't1' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { xfail *-*-* } l_loop$c_loop }
do i=0,255
do j=1,256
t1 = (i * 256 + j) * 103
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-10.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-10.f90
new file mode 100644
index 0000000..f766524
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-10.f90
@@ -0,0 +1,598 @@
+! { dg-do run }
+
+! integer array reductions
+
+program main
+ implicit none
+
+ integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32
+ integer :: i, j
+ integer, dimension (n) :: vresult, rg, rw, rv, rc
+ logical, dimension (n) :: lrg, lrw, lrv, lrc, lvresult
+ integer, dimension (n) :: array
+
+ do i = 1, n
+ array(i) = i
+ end do
+
+ !
+ ! '+' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(+:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = rg(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(+:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = rw(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(+:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = rv(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(+:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = rc(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = vresult(j) + array(i)
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 1
+ if (count (rw .ne. vresult) .ne. 0) STOP 2
+ if (count (rv .ne. vresult) .ne. 0) STOP 3
+ if (count (rc .ne. vresult) .ne. 0) STOP 4
+
+ !
+ ! '*' reductions
+ !
+
+ rg = 1
+ rw = 1
+ rv = 1
+ rc = 1
+ vresult = 1
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(*:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = rg(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(*:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = rw(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(*:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = rv(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(*:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = rc(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = vresult(j) * array(i)
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 5
+ if (count (rw .ne. vresult) .ne. 0) STOP 6
+ if (count (rv .ne. vresult) .ne. 0) STOP 7
+ if (count (rc .ne. vresult) .ne. 0) STOP 8
+
+ !
+ ! 'max' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(max:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = max (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(max:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = max (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(max:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = max (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(max:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = max (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = max (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 9
+ if (count (rw .ne. vresult) .ne. 0) STOP 10
+ if (count (rv .ne. vresult) .ne. 0) STOP 11
+ if (count (rc .ne. vresult) .ne. 0) STOP 12
+
+ !
+ ! 'min' reductions
+ !
+
+ rg = n + 1
+ rw = n + 1
+ rv = n + 1
+ rc = n + 1
+ vresult = n + 1
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(min:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = min (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(min:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = min (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(min:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = min (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(min:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = min (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = min (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 13
+ if (count (rw .ne. vresult) .ne. 0) STOP 14
+ if (count (rv .ne. vresult) .ne. 0) STOP 15
+ if (count (rc .ne. vresult) .ne. 0) STOP 16
+
+ !
+ ! 'iand' reductions
+ !
+
+ rg = 1
+ rw = 1
+ rv = 1
+ rc = 1
+ vresult = 1
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(iand:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = iand (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(iand:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = iand (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(iand:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = iand (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(iand:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = iand (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = iand (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 17
+ if (count (rw .ne. vresult) .ne. 0) STOP 18
+ if (count (rv .ne. vresult) .ne. 0) STOP 19
+ if (count (rc .ne. vresult) .ne. 0) STOP 20
+
+ !
+ ! 'ior' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(ior:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = ior (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(ior:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = ior (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(ior:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = ior (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(ior:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = ior (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = ior (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 21
+ if (count (rw .ne. vresult) .ne. 0) STOP 22
+ if (count (rv .ne. vresult) .ne. 0) STOP 23
+ if (count (rc .ne. vresult) .ne. 0) STOP 24
+
+ !
+ ! 'ieor' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(ieor:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = ieor (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(ieor:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = ieor (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(ieor:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = ieor (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(ieor:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = ieor (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = ieor (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 25
+ if (count (rw .ne. vresult) .ne. 0) STOP 26
+ if (count (rv .ne. vresult) .ne. 0) STOP 27
+ if (count (rc .ne. vresult) .ne. 0) STOP 28
+
+ !
+ ! '.and.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.and.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.and.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.and.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.and.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 29
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 30
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 31
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 32
+
+ !
+ ! '.or.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.or.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.or.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.or.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.or.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 33
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 34
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 35
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 36
+
+ !
+ ! '.eqv.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.eqv.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.eqv.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.eqv.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.eqv.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 37
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 38
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 39
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 40
+
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-11.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-11.f90
new file mode 100644
index 0000000..220871a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-11.f90
@@ -0,0 +1,424 @@
+! { dg-do run }
+
+! real array reductions
+
+program main
+ implicit none
+
+ integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32
+ integer :: i, j
+ real, dimension (n) :: vresult, rg, rw, rv, rc
+ logical, dimension (n) :: lrg, lrw, lrv, lrc, lvresult
+ real, dimension (n) :: array
+
+ do i = 1, n
+ array(i) = i
+ end do
+
+ !
+ ! '+' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(+:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = rg(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(+:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = rw(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(+:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = rv(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(+:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = rc(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = vresult(j) + array(i)
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 1
+ if (count (rw .ne. vresult) .ne. 0) STOP 2
+ if (count (rv .ne. vresult) .ne. 0) STOP 3
+ if (count (rc .ne. vresult) .ne. 0) STOP 4
+
+ !
+ ! '*' reductions
+ !
+
+ rg = 1
+ rw = 1
+ rv = 1
+ rc = 1
+ vresult = 1
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(*:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = rg(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(*:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = rw(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(*:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = rv(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(*:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = rc(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = vresult(j) * array(i)
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 5
+ if (count (rw .ne. vresult) .ne. 0) STOP 6
+ if (count (rv .ne. vresult) .ne. 0) STOP 7
+ if (count (rc .ne. vresult) .ne. 0) STOP 8
+
+ !
+ ! 'max' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(max:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = max (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(max:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = max (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(max:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = max (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(max:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = max (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = max (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 9
+ if (count (rw .ne. vresult) .ne. 0) STOP 10
+ if (count (rv .ne. vresult) .ne. 0) STOP 11
+ if (count (rc .ne. vresult) .ne. 0) STOP 12
+
+ !
+ ! 'min' reductions
+ !
+
+ rg = n + 1
+ rw = n + 1
+ rv = n + 1
+ rc = n + 1
+ vresult = n + 1
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(min:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = min (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(min:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = min (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(min:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = min (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(min:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = min (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = min (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 13
+ if (count (rw .ne. vresult) .ne. 0) STOP 14
+ if (count (rv .ne. vresult) .ne. 0) STOP 15
+ if (count (rc .ne. vresult) .ne. 0) STOP 16
+
+ !
+ ! '.and.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.and.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.and.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.and.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.and.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 17
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 18
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 19
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 20
+
+ !
+ ! '.or.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.or.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.or.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.or.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.or.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 21
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 22
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 23
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 24
+
+ !
+ ! '.eqv.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.eqv.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.eqv.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.eqv.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.eqv.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 25
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 26
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 27
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 28
+
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-12.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-12.f90
new file mode 100644
index 0000000..d89d8ed
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-12.f90
@@ -0,0 +1,424 @@
+! { dg-do run }
+
+! double precision array reductions
+
+program main
+ implicit none
+
+ integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32
+ integer :: i, j
+ double precision, dimension (n) :: vresult, rg, rw, rv, rc
+ logical, dimension (n) :: lrg, lrw, lrv, lrc, lvresult
+ double precision, dimension (n) :: array
+
+ do i = 1, n
+ array(i) = i
+ end do
+
+ !
+ ! '+' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(+:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = rg(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(+:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = rw(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(+:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = rv(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(+:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = rc(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = vresult(j) + array(i)
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 1
+ if (count (rw .ne. vresult) .ne. 0) STOP 2
+ if (count (rv .ne. vresult) .ne. 0) STOP 3
+ if (count (rc .ne. vresult) .ne. 0) STOP 4
+
+ !
+ ! '*' reductions
+ !
+
+ rg = 1
+ rw = 1
+ rv = 1
+ rc = 1
+ vresult = 1
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(*:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = rg(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(*:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = rw(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(*:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = rv(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(*:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = rc(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = vresult(j) * array(i)
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 5
+ if (count (rw .ne. vresult) .ne. 0) STOP 6
+ if (count (rv .ne. vresult) .ne. 0) STOP 7
+ if (count (rc .ne. vresult) .ne. 0) STOP 8
+
+ !
+ ! 'max' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(max:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = max (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(max:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = max (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(max:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = max (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(max:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = max (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = max (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 9
+ if (count (rw .ne. vresult) .ne. 0) STOP 10
+ if (count (rv .ne. vresult) .ne. 0) STOP 11
+ if (count (rc .ne. vresult) .ne. 0) STOP 12
+
+ !
+ ! 'min' reductions
+ !
+
+ rg = n + 1
+ rw = n + 1
+ rv = n + 1
+ rc = n + 1
+ vresult = n + 1
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(min:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = min (rg(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(min:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = min (rw(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(min:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = min (rv(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(min:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = min (rc(j), array(i))
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = min (vresult(j), array(i))
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 13
+ if (count (rw .ne. vresult) .ne. 0) STOP 14
+ if (count (rv .ne. vresult) .ne. 0) STOP 15
+ if (count (rc .ne. vresult) .ne. 0) STOP 16
+
+ !
+ ! '.and.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.and.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.and.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.and.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.and.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .and. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 17
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 18
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 19
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 20
+
+ !
+ ! '.or.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.or.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.or.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.or.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.or.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .or. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 21
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 22
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 23
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 24
+
+ !
+ ! '.eqv.' reductions
+ !
+
+ lrg = .true.
+ lrw = .true.
+ lrv = .true.
+ lrc = .true.
+ lvresult = .true.
+
+ !$acc parallel num_gangs(ng) copy(lrg)
+ !$acc loop reduction(.eqv.:lrg) gang
+ do i = 1, n
+ do j = 1, n
+ lrg(j) = lrg(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(lrw)
+ !$acc loop reduction(.eqv.:lrw) worker
+ do i = 1, n
+ do j = 1, n
+ lrw(j) = lrw(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(lrv)
+ !$acc loop reduction(.eqv.:lrv) vector
+ do i = 1, n
+ do j = 1, n
+ lrv(j) = lrv(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(lrc)
+ !$acc loop reduction(.eqv.:lrc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ lrc(j) = lrc(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ lvresult(j) = lvresult(j) .eqv. (array(i) .ge. 5)
+ end do
+ end do
+
+ if (count (lrg .neqv. lvresult) .ne. 0) STOP 25
+ if (count (lrw .neqv. lvresult) .ne. 0) STOP 26
+ if (count (lrv .neqv. lvresult) .ne. 0) STOP 27
+ if (count (lrc .neqv. lvresult) .ne. 0) STOP 28
+
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-13.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-13.f90
new file mode 100644
index 0000000..701cbb9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-13.f90
@@ -0,0 +1,134 @@
+! { dg-do run }
+
+! complex array reductions
+
+program main
+ implicit none
+
+ integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32
+ integer :: i, j
+ complex, dimension (n) :: vresult, rg, rw, rv, rc
+ logical, dimension (n) :: lrg, lrw, lrv, lrc, lvresult
+ complex, dimension (n) :: array
+
+ do i = 1, n
+ array(i) = i
+ end do
+
+ !
+ ! '+' reductions
+ !
+
+ rg = 0
+ rw = 0
+ rv = 0
+ rc = 0
+ vresult = 0
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(+:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = rg(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(+:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = rw(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(+:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = rv(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(+:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = rc(j) + array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = vresult(j) + array(i)
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 1
+ if (count (rw .ne. vresult) .ne. 0) STOP 2
+ if (count (rv .ne. vresult) .ne. 0) STOP 3
+ if (count (rc .ne. vresult) .ne. 0) STOP 4
+
+ !
+ ! '*' reductions
+ !
+
+ rg = 1
+ rw = 1
+ rv = 1
+ rc = 1
+ vresult = 1
+
+ !$acc parallel num_gangs(ng) copy(rg)
+ !$acc loop reduction(*:rg) gang
+ do i = 1, n
+ do j = 1, n
+ rg(j) = rg(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_workers(nw) copy(rw)
+ !$acc loop reduction(*:rw) worker
+ do i = 1, n
+ do j = 1, n
+ rw(j) = rw(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel vector_length(vl) copy(rv)
+ !$acc loop reduction(*:rv) vector
+ do i = 1, n
+ do j = 1, n
+ rv(j) = rv(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc)
+ !$acc loop reduction(*:rc) gang worker vector
+ do i = 1, n
+ do j = 1, n
+ rc(j) = rc(j) * array(i)
+ end do
+ end do
+ !$acc end parallel
+
+ ! Verify the results
+ do i = 1, n
+ do j = 1, n
+ vresult(j) = vresult(j) * array(i)
+ end do
+ end do
+
+ if (count (rg .ne. vresult) .ne. 0) STOP 5
+ if (count (rw .ne. vresult) .ne. 0) STOP 6
+ if (count (rv .ne. vresult) .ne. 0) STOP 7
+ if (count (rc .ne. vresult) .ne. 0) STOP 8
+
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-14.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-14.f90
new file mode 100644
index 0000000..95e56c9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-14.f90
@@ -0,0 +1,68 @@
+! { dg-do run }
+
+! record type reductions
+
+program main
+ implicit none
+
+ type t1
+ integer :: i
+ real :: r
+ end type t1
+
+ type t2
+ real :: r
+ integer :: i
+ double precision :: d
+ end type t2
+
+ double precision, parameter :: e = 0.001
+ integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32
+ integer :: i
+ type(t1) :: v1, a1
+ type (t2) :: v2, a2
+
+ v1%i = 0
+ v1%r = 0
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(v1)
+ !$acc loop reduction (+:v1)
+ do i = 1, n
+ v1%i = v1%i + 1
+ v1%r = v1%r + 2
+ end do
+ !$acc end parallel
+ a1%i = 0
+ a1%r = 0
+ do i = 1, n
+ a1%i = a1%i + 1
+ a1%r = a1%r + 2
+ end do
+ if (v1%i .ne. a1%i) STOP 1
+ if (v1%r .ne. a1%r) STOP 2
+
+ v2%i = 1
+ v2%r = 1
+ v2%d = 1
+ !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(v2)
+ !$acc loop reduction (*:v2)
+ do i = 1, n
+ v2%i = v2%i * 2
+ v2%r = v2%r * 1.1
+ v2%d = v2%d * 1.3
+ end do
+ !$acc end parallel
+ a2%i = 1
+ a2%r = 1
+ a2%d = 1
+ do i = 1, n
+ a2%i = a2%i * 2
+ a2%r = a2%r * 1.1
+ a2%d = a2%d * 1.3
+ end do
+
+ if (v2%i .ne. a2%i) STOP 3
+ if (v2%r .ne. a2%r) STOP 4
+ if (abs (v2%d - a2%d) .ge. e) STOP 5
+
+end program main
+
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-15.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-15.f90
new file mode 100644
index 0000000..7a36fb2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-15.f90
@@ -0,0 +1,98 @@
+! { dg-do run }
+! { dg-additional-options "-cpp" }
+
+#define ARRAY_BODY(ARRAY, MIN, MAX) \
+ do i = 1, 10; \
+ do j = MIN, MAX; \
+ ARRAY(j) = ARRAY(j) + 1; \
+ end do; \
+ end do
+
+program main
+ implicit none
+ integer :: i, j, max = 6, two = 2, three = 3, four = 4, five = 5, six = 6
+ integer :: a(6) = (/ 5, 1, 1, 5, 9, 9 /)
+ integer :: o(6)
+ o = a
+
+ !$acc parallel
+ !$acc loop reduction(+:a(2:3))
+ ARRAY_BODY (a, 2, 3)
+ !$acc end parallel
+ ARRAY_BODY (o, 2, 3)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 1
+ end do
+
+ !$acc parallel copy(a(4:6))
+ !$acc loop reduction(+:a(4:6))
+ ARRAY_BODY (a, 4, 6)
+ !$acc end parallel
+ ARRAY_BODY (o, 4, 6)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 2
+ end do
+
+ !$acc parallel copy(a)
+ !$acc loop reduction(+:a(1:6))
+ ARRAY_BODY (a, 1, 6)
+ !$acc end parallel
+ ARRAY_BODY (o, 1, 6)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 3
+ end do
+
+ !$acc parallel
+ !$acc loop reduction(+:a)
+ ARRAY_BODY (a, 4, 4)
+ !$acc end parallel
+ ARRAY_BODY (o, 4, 4)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 4
+ end do
+
+ !$acc parallel copy(a)
+ !$acc loop reduction(+:a)
+ ARRAY_BODY (a, 4, 6)
+ !$acc end parallel
+ ARRAY_BODY (o, 4, 6)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 5
+ end do
+
+#if !defined(ACC_DEVICE_TYPE_host)
+
+ !$acc parallel loop reduction(+:a)
+ ARRAY_BODY (a, 2, 4)
+ !$acc end parallel loop
+ ARRAY_BODY (o, 2, 4)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 6
+ end do
+
+ !$acc parallel loop reduction(+:a(2:4))
+ ARRAY_BODY (a, 2, 4)
+ !$acc end parallel loop
+ ARRAY_BODY (o, 2, 4)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 7
+ end do
+
+ !$acc parallel reduction(+:a)
+ ARRAY_BODY (a, 3, 4)
+ !$acc end parallel
+ ARRAY_BODY (o, 3, 4)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 8
+ end do
+
+ !$acc parallel reduction(+:a(2:3))
+ ARRAY_BODY (a, 2, 3)
+ !$acc end parallel
+ ARRAY_BODY (o, 2, 3)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 9
+ end do
+#endif
+
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-16.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-16.f90
new file mode 100644
index 0000000..c524f2a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-16.f90
@@ -0,0 +1,99 @@
+! { dg-do run }
+! { dg-additional-options "-cpp" }
+
+#define ARRAY_BODY(ARRAY, MIN, MAX) \
+ do i = 1, 10; \
+ do j = MIN, MAX; \
+ ARRAY(j) = ARRAY(j) + 1; \
+ end do; \
+ end do
+
+program main
+ implicit none
+ integer :: i, j, max = 6, one = 1, two = 2, three = 3, four = 4, five = 5, six = 6
+ integer :: a(6) = (/ 5, 1, 1, 5, 9, 9 /)
+ integer :: o(6)
+ o = a
+
+ !$acc parallel
+ !$acc loop reduction(+:a(two:three))
+ ARRAY_BODY (a, two, three)
+ !$acc end parallel
+
+ ARRAY_BODY (o, two, three)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 1
+ end do
+
+ !$acc parallel copy(a(four:six))
+ !$acc loop reduction(+:a(four:six))
+ ARRAY_BODY (a, four, six)
+ !$acc end parallel
+ ARRAY_BODY (o, four, six)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 2
+ end do
+
+ !$acc parallel copy(a)
+ !$acc loop reduction(+:a(one:six))
+ ARRAY_BODY (a, one, six)
+ !$acc end parallel
+ ARRAY_BODY (o, one, six)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 3
+ end do
+
+ !$acc parallel
+ !$acc loop reduction(+:a)
+ ARRAY_BODY (a, four, four)
+ !$acc end parallel
+ ARRAY_BODY (o, four, four)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 4
+ end do
+
+ !$acc parallel copy(a)
+ !$acc loop reduction(+:a)
+ ARRAY_BODY (a, four, six)
+ !$acc end parallel
+ ARRAY_BODY (o, four, six)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 5
+ end do
+
+#if !defined(ACC_DEVICE_TYPE_host)
+
+ !$acc parallel loop reduction(+:a)
+ ARRAY_BODY (a, two, four)
+ !$acc end parallel loop
+ ARRAY_BODY (o, two, four)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 6
+ end do
+
+ !$acc parallel loop reduction(+:a(two:four))
+ ARRAY_BODY (a, two, four)
+ !$acc end parallel loop
+ ARRAY_BODY (o, two, four)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 7
+ end do
+
+ !$acc parallel reduction(+:a)
+ ARRAY_BODY (a, three, four)
+ !$acc end parallel
+ ARRAY_BODY (o, three, four)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 8
+ end do
+
+ !$acc parallel reduction(+:a(two:three))
+ ARRAY_BODY (a, two, three)
+ !$acc end parallel
+ ARRAY_BODY (o, two, three)
+ do i = 1, max
+ if (a(i) .ne. o(i)) STOP 9
+ end do
+#endif
+
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f90
index 88a691f..30fb30a 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-5.f90
@@ -38,8 +38,7 @@ subroutine redsub_gang(sum, n, c)
!$acc parallel copyin (n, c) num_gangs(n) copy(sum)
!$acc loop reduction(+:sum) gang
- ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
sum = sum + c
end do
@@ -54,8 +53,7 @@ subroutine redsub_worker(sum, n, c)
!$acc parallel copyin (n, c) num_workers(4) vector_length (32) copy(sum)
! { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-1 }
!$acc loop reduction(+:sum) worker
- ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
sum = sum + c
end do
@@ -69,8 +67,7 @@ subroutine redsub_vector(sum, n, c)
!$acc parallel copyin (n, c) vector_length(32) copy(sum)
!$acc loop reduction(+:sum) vector
- ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
sum = sum + c
end do
@@ -84,8 +81,7 @@ subroutine redsub_combined(sum, n, c)
!$acc parallel num_gangs (8) num_workers (4) vector_length(32) copy(sum)
!$acc loop reduction(+:sum) gang worker vector
- ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
sum = sum + c
end do
@@ -102,12 +98,10 @@ subroutine redsub_nested(sum, n, c)
!$acc parallel num_gangs (8) copy(sum)
!$acc loop reduction(+:sum) gang
- ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, ii
!$acc loop reduction(+:sum) vector
- ! { dg-bogus {'sum\.[0-9]+' may be used uninitialized} TODO { xfail { ! __OPTIMIZE__ } } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target { ! __OPTIMIZE__ } } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' may be used uninitialized} "" { target { ! __OPTIMIZE__ } } .-1 }
do j = 1, jj
sum = sum + c
end do
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-7.f90
index 38148f5..03a58a5 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/reduction-7.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-7.f90
@@ -64,8 +64,7 @@ subroutine redsub_bogus(sum, n)
!$acc parallel firstprivate(sum)
!$acc loop gang worker vector reduction (+:sum)
- ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do i = 1, n
sum = sum + 1
end do
@@ -84,8 +83,7 @@ subroutine redsub_combined(sum, n, arr)
sum = i;
!$acc loop reduction(+:sum)
- ! { dg-bogus {'sum\.[0-9]+' may be used uninitialized} TODO { xfail { ! __OPTIMIZE__ } } .-1 }
- ! { dg-note {'sum\.[0-9]+' was declared here} {} { target { ! __OPTIMIZE__ } } .-2 }
+ ! { dg-bogus {'sum\.[0-9]+' may be used uninitialized} "" { target { ! __OPTIMIZE__ } } .-1 }
do j = 1, n
sum = sum + 1
end do
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reduction-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reduction-9.f90
new file mode 100644
index 0000000..fd64d88
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reduction-9.f90
@@ -0,0 +1,54 @@
+! Test gang reductions on dummy variables.
+
+! { dg-do run }
+
+program main
+ implicit none
+
+ integer g, w, v, c
+
+ g = 0
+ w = 0
+ v = 0
+ c = 0
+
+ call reduction (g, w, v, c)
+
+ if (g /= 10) call abort
+ if (w /= 10) call abort
+ if (v /= 10) call abort
+ if (c /= 100) call abort
+end program main
+
+subroutine reduction (g, w, v, c)
+ implicit none
+
+ integer g, w, v, c, i
+
+ !$acc parallel
+ !$acc loop reduction(+:g) gang
+ do i = 1, 10
+ g = g + 1
+ end do
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc loop reduction(+:w) worker
+ do i = 1, 10
+ w = w + 1
+ end do
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc loop reduction(+:v) vector
+ do i = 1, 10
+ v = v + 1
+ end do
+ !$acc end parallel
+
+ !$acc parallel loop reduction(+:c) gang worker vector
+ do i = 1, 100
+ c = c + 1
+ end do
+ !$acc end parallel loop
+end subroutine reduction
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/reference-reductions.f90 b/libgomp/testsuite/libgomp.oacc-fortran/reference-reductions.f90
index 055d225..635b1b0 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/reference-reductions.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/reference-reductions.f90
@@ -16,12 +16,10 @@ subroutine param_reduction(var)
!$acc parallel copy(var)
!$acc loop reduction(+ : var) gang
- ! { dg-bogus {'var\.[0-9]+' is used uninitialized} TODO { xfail *-*-* } .-1 }
- ! { dg-note {'var\.[0-9]+' was declared here} {} { target *-*-* } .-2 }
+ ! { dg-bogus {'var\.[0-9]+' is used uninitialized} "" { target *-*-* } .-1 }
do k=1,10
!$acc loop vector reduction(+ : var)
- ! { dg-bogus {'var\.[0-9]+' may be used uninitialized} TODO { xfail { ! __OPTIMIZE__ } } .-1 }
- ! { dg-note {'var\.[0-9]+' was declared here} {} { target { ! __OPTIMIZE__ } } .-2 }
+ ! { dg-bogus {'var\.[0-9]+' may be used uninitialized} "" { target { ! __OPTIMIZE__ } } .-1 }
do j=1,100
var = var + 1.0
enddo
diff --git a/libgomp/usmpin-allocator.c b/libgomp/usmpin-allocator.c
new file mode 100644
index 0000000..311bda5
--- /dev/null
+++ b/libgomp/usmpin-allocator.c
@@ -0,0 +1,319 @@
+/* Copyright (C) 2023 Free Software Foundation, Inc.
+
+ This file is part of the GNU Offloading and Multi Processing Library
+ (libgomp).
+
+ Libgomp is free software; you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3, or (at your option)
+ any later version.
+
+ Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU General Public License for
+ more details.
+
+ Under Section 7 of GPL version 3, you are granted additional
+ permissions described in the GCC Runtime Library Exception, version
+ 3.1, as published by the Free Software Foundation.
+
+ You should have received a copy of the GNU General Public License and
+ a copy of the GCC Runtime Library Exception along with this program;
+ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+ <http://www.gnu.org/licenses/>. */
+
+/* This is a simple "malloc" implementation intended for use with Unified
+ Shared Memory and Pinned Memory. It allocates memory from a pool allocated
+ and configured by the device plugin (for USM), or the OS-specific allocator
+ (for pinned).
+
+ This implementation keeps the allocated/free chain in a side-table (splay
+ tree) to ensure that the allocation routine does not migrate all the USM
+ pages back into host memory. Keeping the meta-data elsewhere is also useful
+ for pinned memory, which is typically an extremely limited resource. */
+
+#include <string.h>
+#include "libgomp.h"
+
+/* Use a splay tree to track allocations. */
+
+typedef struct usmpin_splay_tree_node_s *usmpin_splay_tree_node;
+typedef struct usmpin_splay_tree_s *usmpin_splay_tree;
+typedef struct usmpin_splay_tree_key_s *usmpin_splay_tree_key;
+
+struct usmpin_splay_tree_key_s {
+ void *base;
+ size_t size;
+};
+
+static inline int
+usmpin_splay_compare (usmpin_splay_tree_key x, usmpin_splay_tree_key y)
+{
+ return (x->base == y->base ? 0
+ : x->base > y->base ? 1
+ : -1);
+}
+
+#define splay_tree_prefix usmpin
+#include "splay-tree.h"
+
+/* 128-byte granularity means GPU cache-line aligned. */
+#define ALIGN(VAR) (((VAR) + 127) & ~127)
+
+/* The context data prevents the need for global state. */
+struct usmpin_context {
+ int lock;
+ struct usmpin_splay_tree_s allocations;
+ struct usmpin_splay_tree_s free_space;
+};
+
+usmpin_ctx_p
+usmpin_init_context ()
+{
+ return calloc (1, sizeof (struct usmpin_context));
+}
+
+/* Coalesce contiguous free space into one entry. This considers the entries
+ either side of the root node only, so it should be called each time a new
+ entry in inserted into the root. */
+
+static void
+usmpin_coalesce_free_space (usmpin_ctx_p ctx)
+{
+ usmpin_splay_tree_node prev, next, node = ctx->free_space.root;
+
+ for (prev = node->left; prev && prev->right; prev = prev->right)
+ ;
+ for (next = node->right; next && next->left; next = next->left)
+ ;
+
+ /* Coalesce adjacent free chunks. */
+ if (next
+ && node->key.base + node->key.size == next->key.base)
+ {
+ /* Free chunk follows. */
+ node->key.size += next->key.size;
+ usmpin_splay_tree_remove (&ctx->free_space, &next->key);
+ free (next);
+ }
+ if (prev
+ && prev->key.base + prev->key.size == node->key.base)
+ {
+ /* Free chunk precedes. */
+ prev->key.size += node->key.size;
+ usmpin_splay_tree_remove (&ctx->free_space, &node->key);
+ free (node);
+ }
+}
+
+/* Add a new memory region into the free chain. This is how the USM heap is
+ initialized and extended. If the new region is contiguous with an existing
+ region then any free space will be coalesced. */
+
+void
+usmpin_register_memory (usmpin_ctx_p ctx, char *base, size_t size)
+{
+ if (base == NULL || ctx == NULL)
+ return;
+
+ while (__atomic_exchange_n (&ctx->lock, 1, MEMMODEL_ACQUIRE) == 1)
+ ;
+
+ usmpin_splay_tree_node node;
+ node = malloc (sizeof (struct usmpin_splay_tree_node_s));
+ node->key.base = base;
+ node->key.size = size;
+ node->left = NULL;
+ node->right = NULL;
+ usmpin_splay_tree_insert (&ctx->free_space, node);
+ usmpin_coalesce_free_space (ctx);
+
+ __atomic_store_n (&ctx->lock, 0, MEMMODEL_RELEASE);
+}
+
+/* This splay_tree_foreach callback selects the first free space large enough
+ to hold the allocation needed. Since the splay_tree walk may start in the
+ middle the "first" isn't necessarily the "leftmost" entry. */
+
+struct usmpin_callback_data {
+ size_t size;
+ usmpin_splay_tree_node found;
+};
+
+static int
+usmpin_alloc_callback (usmpin_splay_tree_key key, void *data)
+{
+ struct usmpin_callback_data *cbd = (struct usmpin_callback_data *)data;
+
+ if (key->size >= cbd->size)
+ {
+ cbd->found = (usmpin_splay_tree_node)key;
+ return 1;
+ }
+
+ return 0;
+}
+
+/* USM "malloc". Selects and moves and address range from ctx->free_space to
+ ctx->allocations, while leaving any excess in ctx->free_space. */
+
+void *
+usmpin_alloc (usmpin_ctx_p ctx, size_t size)
+{
+ if (ctx == NULL)
+ return NULL;
+
+ /* Memory is allocated in N-byte granularity. */
+ size = ALIGN (size);
+
+ /* Acquire the lock. */
+ while (__atomic_exchange_n (&ctx->lock, 1, MEMMODEL_ACQUIRE) == 1)
+ ;
+
+ if (!ctx->free_space.root)
+ {
+ /* No memory registered, or no free space. */
+ __atomic_store_n (&ctx->lock, 0, MEMMODEL_RELEASE);
+ return NULL;
+ }
+
+ /* Find a suitable free block. */
+ struct usmpin_callback_data cbd = {size, NULL};
+ usmpin_splay_tree_foreach_lazy (&ctx->free_space, usmpin_alloc_callback,
+ &cbd);
+ usmpin_splay_tree_node freenode = cbd.found;
+
+ void *result = NULL;
+ if (freenode)
+ {
+ /* Allocation successful. */
+ result = freenode->key.base;
+ usmpin_splay_tree_node allocnode = malloc (sizeof (*allocnode));
+ allocnode->key.base = result;
+ allocnode->key.size = size;
+ allocnode->left = NULL;
+ allocnode->right = NULL;
+ usmpin_splay_tree_insert (&ctx->allocations, allocnode);
+
+ /* Update the free chain. */
+ size_t stillfree_size = freenode->key.size - size;
+ if (stillfree_size > 0)
+ {
+ freenode->key.base = freenode->key.base + size;
+ freenode->key.size = stillfree_size;
+ }
+ else
+ {
+ usmpin_splay_tree_remove (&ctx->free_space, &freenode->key);
+ free (freenode);
+ }
+ }
+
+ /* Release the lock. */
+ __atomic_store_n (&ctx->lock, 0, MEMMODEL_RELEASE);
+
+ return result;
+}
+
+/* USM "free". Moves an address range from ctx->allocations to
+ ctx->free_space and merges that record with any contiguous free memory. */
+
+void
+usmpin_free (usmpin_ctx_p ctx, void *addr)
+{
+ if (ctx == NULL)
+ return;
+
+ /* Acquire the lock. */
+ while (__atomic_exchange_n (&ctx->lock, 1, MEMMODEL_ACQUIRE) == 1)
+ ;
+
+ /* Convert the memory map to free. */
+ struct usmpin_splay_tree_key_s key = {addr};
+ usmpin_splay_tree_key found = usmpin_splay_tree_lookup (&ctx->allocations,
+ &key);
+ if (!found)
+ GOMP_PLUGIN_fatal ("invalid free");
+ usmpin_splay_tree_remove (&ctx->allocations, &key);
+ usmpin_splay_tree_insert (&ctx->free_space, (usmpin_splay_tree_node)found);
+ usmpin_coalesce_free_space (ctx);
+
+ /* Release the lock. */
+ __atomic_store_n (&ctx->lock, 0, MEMMODEL_RELEASE);
+}
+
+/* USM "realloc". Works in-place, if possible; reallocates otherwise. */
+
+void *
+usmpin_realloc (usmpin_ctx_p ctx, void *addr, size_t newsize)
+{
+ if (ctx == NULL)
+ return NULL;
+
+ newsize = ALIGN (newsize);
+
+ /* Acquire the lock. */
+ while (__atomic_exchange_n (&ctx->lock, 1, MEMMODEL_ACQUIRE) == 1)
+ ;
+
+ /* Convert the memory map to free. */
+ struct usmpin_splay_tree_key_s key = {addr};
+ usmpin_splay_tree_key found = usmpin_splay_tree_lookup (&ctx->allocations,
+ &key);
+ if (!found)
+ GOMP_PLUGIN_fatal ("invalid realloc");
+
+ if (newsize == found->size)
+ ; /* Nothing to do. */
+ else if (newsize < found->size)
+ {
+ /* We're reducing the allocation size. */
+ usmpin_splay_tree_node newfree = malloc (sizeof (*newfree));
+ newfree->key.base = found->base + newsize;
+ newfree->key.size = found->size - newsize;
+ newfree->left = NULL;
+ newfree->right = NULL;
+ usmpin_splay_tree_insert (&ctx->free_space, newfree);
+ usmpin_coalesce_free_space (ctx);
+ }
+ else
+ {
+ /* We're extending the allocation. */
+ struct usmpin_splay_tree_key_s freekey = {addr + found->size};
+ usmpin_splay_tree_key foundfree;
+ foundfree = usmpin_splay_tree_lookup (&ctx->free_space, &freekey);
+ if (foundfree && foundfree->size >= newsize - found->size)
+ {
+ /* Allocation can be expanded in place. */
+ foundfree->base += found->size;
+ foundfree->size -= newsize - found->size;
+ found->size = newsize;
+
+ if (foundfree->size == 0)
+ usmpin_splay_tree_remove (&ctx->free_space, &freekey);
+ }
+ else
+ {
+ /* Allocation must be relocated.
+ Release the lock and use alloc/free. */
+ __atomic_store_n (&ctx->lock, 0, MEMMODEL_RELEASE);
+
+ void *newaddr = usmpin_alloc (ctx, newsize);
+ if (!newaddr)
+ return NULL;
+
+ memcpy (newaddr, addr, found->size);
+ usmpin_free (ctx, addr);
+ return newaddr;
+ }
+ }
+
+ /* Release the lock. */
+ __atomic_store_n (&ctx->lock, 0, MEMMODEL_RELEASE);
+ return addr;
+}
+
+/* Include the splay tree code inline, with the prefixes added. */
+#define splay_tree_prefix usmpin
+#define splay_tree_c
+#include "splay-tree.h"