From c3cb71ef35522f46afa6f11ee376cdcb73b893e8 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 5 Dec 2019 15:18:39 +0000 Subject: [PATCH] =?utf8?q?OpenMP]=20Fix=20use=5Fdevice=5F=E2=80=A6=20with?= =?utf8?q?=20absent=20optional=20arg?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit gcc/fortran/ * trans-openmp.c (gfc_omp_is_optional_argument, gfc_omp_check_optional_argument): Handle type(c_ptr),value which uses a hidden argument for the is-present check. gcc/ * omp-low.c (lower_omp_target): For use_device_ptr/use_derice_addr and Fortran's optional arguments, unconditionally add the is-present condition before the libgomp call. libgomp/ * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Add 'type(c_ptr), value' test case. Conditionally map the per-value passed arguments. From-SVN: r279004 --- gcc/ChangeLog | 6 +++ gcc/fortran/ChangeLog | 5 +++ gcc/fortran/trans-openmp.c | 13 ++++-- gcc/omp-low.c | 15 ++----- gcc/testsuite/ChangeLog | 6 +++ .../libgomp.fortran/use_device_ptr-optional-2.f90 | 51 +++++++++++++++++----- 6 files changed, 68 insertions(+), 28 deletions(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 83d66f1..87dc67e 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,9 @@ +2019-12-05 Tobias Burnus + + * omp-low.c (lower_omp_target): For use_device_ptr/use_derice_addr + and Fortran's optional arguments, unconditionally add the is-present + condition before the libgomp call. + 2019-12-05 Richard Sandiford PR middle-end/92768 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2cdee32..04861c7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2019-12-05 Tobias Burnus + + * trans-openmp.c (gfc_omp_is_optional_argument, + gfc_omp_check_optional_argument): Handle type(c_ptr),value which uses a + 2019-12-05 Jakub Jelinek PR fortran/92781 diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 3a4f962..2f9456d 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -60,7 +60,8 @@ gfc_omp_is_allocatable_or_ptr (const_tree decl) /* True if the argument is an optional argument; except that false is also returned for arguments with the value attribute (nonpointers) and for - assumed-shape variables (decl is a local variable containing arg->data). */ + assumed-shape variables (decl is a local variable containing arg->data). + Note that pvoid_type_node is for 'type(c_ptr), value. */ static bool gfc_omp_is_optional_argument (const_tree decl) @@ -68,6 +69,7 @@ gfc_omp_is_optional_argument (const_tree decl) return (TREE_CODE (decl) == PARM_DECL && DECL_LANG_SPECIFIC (decl) && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE + && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))) && GFC_DECL_OPTIONAL_ARGUMENT (decl)); } @@ -99,9 +101,12 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check) || !GFC_DECL_OPTIONAL_ARGUMENT (decl)) return NULL_TREE; - /* For VALUE, the scalar variable is passed as is but a hidden argument - denotes the value. Cf. trans-expr.c. */ - if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE) + /* Scalars with VALUE attribute which are passed by value use a hidden + argument to denote the present status. They are passed as nonpointer type + with one exception: 'type(c_ptr), value' as 'void*'. */ + /* Cf. trans-expr.c's gfc_conv_expr_present. */ + if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE + || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) { char name[GFC_MAX_SYMBOL_LEN + 2]; tree tree_name; diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 19132f7..b0168d7 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -11981,8 +11981,6 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) case OMP_CLAUSE_USE_DEVICE_PTR: case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_IS_DEVICE_PTR: - bool do_optional_check; - do_optional_check = false; ovar = OMP_CLAUSE_DECL (c); var = lookup_decl_in_outer_ctx (ovar, ctx); @@ -12004,10 +12002,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) } type = TREE_TYPE (ovar); if (lang_hooks.decls.omp_array_data (ovar, true)) - { - var = lang_hooks.decls.omp_array_data (ovar, false); - do_optional_check = true; - } + var = lang_hooks.decls.omp_array_data (ovar, false); else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR && !omp_is_reference (ovar) && !omp_is_allocatable_or_ptr (ovar)) @@ -12025,16 +12020,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) && !omp_is_allocatable_or_ptr (ovar)) || (omp_is_reference (ovar) && omp_is_allocatable_or_ptr (ovar)))) - { - var = build_simple_mem_ref (var); - do_optional_check = true; - } + var = build_simple_mem_ref (var); var = fold_convert (TREE_TYPE (x), var); } } tree present; - present = (do_optional_check - ? omp_check_optional_argument (ovar, true) : NULL_TREE); + present = omp_check_optional_argument (ovar, true); if (present) { tree null_label = create_artificial_label (UNKNOWN_LOCATION); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b2c6d10..34e5783 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2019-12-05 Tobias Burnus + + * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Add + 'type(c_ptr), value' test case. Conditionally map the per-value + passed arguments. + 2019-12-05 Richard Sandiford PR middle-end/92768 diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 index 41abf17..6eefbe1 100644 --- a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 +++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 @@ -1,33 +1,60 @@ ! Check whether absent optional arguments are properly ! handled with use_device_{addr,ptr}. program main + use iso_c_binding, only: c_ptr, c_loc, c_associated implicit none (type, external) call foo() contains - subroutine foo(v, w, x, y, z) + subroutine foo(v, w, x, y, z, cptr, cptr_in) integer, target, optional, value :: v integer, target, optional :: w integer, target, optional :: x(:) integer, target, optional, allocatable :: y integer, target, optional, allocatable :: z(:) + type(c_ptr), target, optional, value :: cptr + type(c_ptr), target, optional, value, intent(in) :: cptr_in integer :: d - !$omp target data map(d) use_device_addr(v, w, x, y, z) - if(present(v)) stop 1 - if(present(w)) stop 2 - if(present(x)) stop 3 - if(present(y)) stop 4 - if(present(z)) stop 5 + ! Need to map per-VALUE arguments, if present + if (present(v)) then + !$omp target enter data map(to:v) + stop 1 ! – but it shall not be present in this test case. + end if + if (present(cptr)) then + !$omp target enter data map(to:cptr) + stop 2 ! – but it shall not be present in this test case. + end if + if (present(cptr_in)) then + !$omp target enter data map(to:cptr_in) + stop 3 ! – but it shall not be present in this test case. + end if + + !$omp target data map(d) use_device_addr(v, w, x, y, z, cptr, cptr_in) + if (present(v)) then; v = 5; stop 11; endif + if (present(w)) then; w = 5; stop 12; endif + if (present(x)) then; x(1) = 5; stop 13; endif + if (present(y)) then; y = 5; stop 14; endif + if (present(z)) then; z(1) = 5; stop 15; endif + if (present(cptr)) then; cptr = c_loc(v); stop 16; endif + if (present(cptr_in)) then + if (c_associated(cptr_in, c_loc(x))) stop 26 + stop 27 + endif !$omp end target data ! Using 'v' in use_device_ptr gives an ICE ! TODO: Find out what the OpenMP spec permits for use_device_ptr - !$omp target data map(d) use_device_ptr(w, x, y, z) - if(present(w)) stop 6 - if(present(x)) stop 7 - if(present(y)) stop 8 - if(present(z)) stop 9 + !$omp target data map(d) use_device_ptr(w, x, y, z, cptr, cptr_in) + if (present(w)) then; w = 5; stop 21; endif + if (present(x)) then; x(1) = 5; stop 22; endif + if (present(y)) then; y = 5; stop 23; endif + if (present(z)) then; z(1) = 5; stop 24; endif + if (present(cptr)) then; cptr = c_loc(x); stop 25; endif + if (present(cptr_in)) then + if (c_associated(cptr_in, c_loc(x))) stop 26 + stop 27 + endif !$omp end target data end subroutine foo end program main -- 2.7.4