Hi Tobias!
On 2024-10-13T10:21:01+0200, Tobias Burnus <tbur...@baylibre.com> wrote:
> Now pushed as r15-4298-g3269a722b7a036.
> Tobias Burnus wrote:
>> Anyone feeling like reviewing this patch?
Yes. But please allow for more than 1 1/2 work days.
>> Tobias Burnus write:
>>> Tobias Burnus wrote:
>>>> Sometimes waiting a bit leads to better code …
>>>>
>>>> Tobias Burnus wrote:
>>>>> ...
>>>>> [I guess, we eventually want to add support for more builtins. For
>>>>> instance, acc_on_device would be a candidate, but I could imagine
>>>>> some additional builtins.]
>>>>
>>>> I have now implemented acc_on_device and I think the new fix-up
>>>> function is way is nicer.
Thanks for looking into this!
>>>> Thus, this patch does:
I wonder why you didn't make these several orthogonal changes into
several separate patches?
>>>> * (v1) Fix omp_is_initial_device → do only replace when used in
>>>> calls (and not when used as function pointer/actual to a dummy
>>>> function) + fix ICE due to integer(4) != logical(4) in the middle end.
No. 1.
>>>> * (new) For OpenACC, use a builtin for acc_on_device + actually do
>>>> compile-time optimization when offloading is not configured.
No. 2. This resolved
PR82250 "Fortran OpenACC acc_on_device early folding", right?
(..., which you recently had duplicated as
PR116269 "[OpenACC] acc_on_device – compile-time optimization fails",
right?)
Please:
git mv gfortran.dg/goacc/acc_on_device-2{-off,_-fno-openacc}.f95
..., and add a 's%-fno-openacc%-fno-builtin-acc_on_device' variant.
Hmm, why can't 'gfortran.dg/goacc/acc_on_device-2.f95' be un-XFAILed?
>>>> * (new) libgomp.texi: Typo fixes accumulated, fix wording
No. 3.
>>>> and for
>>>> acc_on_device, add a note that compile-time folding may be done (and
>>>> how it can be disabled).
Into No. 2.
>>>> For OpenACC, I now mix compile time folding vs. runtime to ensure
>>>> that it works.
No. 4.
And this:
--- a/gcc/fortran/types.def
+++ b/gcc/fortran/types.def
-DEF_PRIMITIVE_TYPE (BT_BOOL,
- (*lang_hooks.types.type_for_size) (BOOL_TYPE_SIZE, 1))
+DEF_PRIMITIVE_TYPE (BT_BOOL, boolean_type_node)
... is yet another unrelated change? No. 5.
>>>> Tested on x86-64 without and with offloading configured, running
>>>> with nvptx offloading.
>>>> PS: The testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
>>>> example is not completely clear to me; however, the new optimization
>>>> causes that without offloading enabled, the dump message is not
>>>> shown. I tried to understand it better with
>>>> -fno-builtin-acc_on_device, but that then caused link errors as the
>>>> device function wasn't optimizated away, leaving me puzzled. — At
>>>> the end, I just changed the dg-* and did not try to understand the
>>>> issue.
Why then not wait for someone else to help look into that? :-)
On 2024-10-10T10:31:13+0200, Tobias Burnus <tbur...@baylibre.com> wrote:
> Fortran: Use OpenACC's acc_on_device builtin, fix OpenMP'
> __builtin_is_initial_device
Missing 'omp_' in '__builtin_[omp_]is_initial_device'.
I just received a SIGKID; to be continued in follow-on emails.
Grüße
Thomas
> It turned out that 'if (omp_is_initial_device() .eqv. true)' gave an ICE
> due to comparing 'int' with 'logical(4)'. When digging deeper, it also
> turned out that when the procedure pointer is needed, the builtin cannot
> be used, either. (Follow up to r15-2799-gf1bfba3a9b3f31 )
> Extend the code to also use the builtin acc_on_device with OpenACC,
> which was previously only used in C/C++. Additionally, fix folding
> when offloading is not enabled.
>
> Fixes additionally the BT_BOOL data type, which was 'char'/integer(1)
> instead of bool, backing the booleaness; use bool_type_node as the rest
> of GCC.
>
> gcc/fortran/ChangeLog:
>
> * gfortran.h (gfc_option_t): Add disable_acc_on_device.
> * options.cc (gfc_handle_option): Handle -fno-builtin-acc_on_device.
> * trans-decl.cc (gfc_get_extern_function_decl): Move
> __builtin_omp_is_initial_device handling to ...
> * trans-expr.cc (get_builtin_fn): ... this new function.
> (conv_function_val): Call it.
> (update_builtin_function): New.
> (gfc_conv_procedure_call): Call it.
> * types.def (BT_BOOL): Fix type by using bool_type_node.
>
> gcc/ChangeLog:
>
> * gimple-fold.cc (gimple_fold_builtin_acc_on_device): Also fold
> when offloading is not configured.
>
> libgomp/ChangeLog:
>
> * libgomp.texi (TR13): Fix minor typos.
> (omp_is_initial_device): Improve wording.
> (acc_on_device): Note how to disable the builtin.
> * testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90: Remove TODO.
> * testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f: Likewise.
> Add -fno-builtin-acc_on_device.
> * testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f: Likewise.
> * testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c: Update
> dg- as !offloading_enabled now compile-time expands acc_on_device.
> * testsuite/libgomp.fortran/target-is-initial-device-3.f90: New test.
> * testsuite/libgomp.oacc-fortran/acc_on_device-2.f90: New test.
>
> gcc/fortran/gfortran.h | 3 +-
> gcc/fortran/options.cc | 5 +-
> gcc/fortran/trans-decl.cc | 9 ----
> gcc/fortran/trans-expr.cc | 58
> +++++++++++++++++++---
> gcc/fortran/types.def | 3 +-
> gcc/gimple-fold.cc | 2 +-
> libgomp/libgomp.texi | 18 ++++---
> .../libgomp.fortran/target-is-initial-device-3.f90 | 50 +++++++++++++++++++
> .../libgomp.oacc-c-c++-common/routine-nohost-1.c | 3 +-
> .../libgomp.oacc-fortran/acc_on_device-1-1.f90 | 5 --
> .../libgomp.oacc-fortran/acc_on_device-1-2.f | 7 +--
> .../libgomp.oacc-fortran/acc_on_device-1-3.f | 7 +--
> .../libgomp.oacc-fortran/acc_on_device-2.f90 | 40 +++++++++++++++
> 13 files changed, 164 insertions(+), 46 deletions(-)
>
> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index 917866a7ef0..680e7f7b75b 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -3200,7 +3200,8 @@ typedef struct
> int flag_init_logical;
> int flag_init_character;
> char flag_init_character_value;
> - int disable_omp_is_initial_device;
> + bool disable_omp_is_initial_device;
> + bool disable_acc_on_device;
>
> int fpe;
> int fpe_summary;
> diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
> index 6f2579ad9de..4920691dba6 100644
> --- a/gcc/fortran/options.cc
> +++ b/gcc/fortran/options.cc
> @@ -864,11 +864,14 @@ gfc_handle_option (size_t scode, const char *arg,
> HOST_WIDE_INT value,
> break;
>
> case OPT_fbuiltin_:
> - /* We only handle -fno-builtin-omp_is_initial_device. */
> + /* We only handle -fno-builtin-omp_is_initial_device
> + and -fno-builtin-acc_on_device. */
> if (value)
> return false; /* Not supported. */
> if (!strcmp ("omp_is_initial_device", arg))
> gfc_option.disable_omp_is_initial_device = true;
> + else if (!strcmp ("acc_on_device", arg))
> + gfc_option.disable_acc_on_device = true;
> else
> warning (0, "command-line option %<-fno-builtin-%s%> is not valid for "
> "Fortran", arg);
> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> index 2586c6d7a79..56b6202510e 100644
> --- a/gcc/fortran/trans-decl.cc
> +++ b/gcc/fortran/trans-decl.cc
> @@ -2231,15 +2231,6 @@ gfc_get_extern_function_decl (gfc_symbol * sym,
> gfc_actual_arglist *actual_args,
> to know that. */
> gcc_assert (!(sym->attr.entry || sym->attr.entry_master));
>
> - if (!gfc_option.disable_omp_is_initial_device
> - && flag_openmp && sym->attr.function && sym->ts.type == BT_LOGICAL
> - && !strcmp (sym->name, "omp_is_initial_device"))
> - {
> - sym->backend_decl
> - = builtin_decl_explicit (BUILT_IN_OMP_IS_INITIAL_DEVICE);
> - return sym->backend_decl;
> - }
> -
> if (sym->attr.proc_pointer)
> return get_proc_pointer_decl (sym);
>
> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
> index 9f223a1314a..8094171eb27 100644
> --- a/gcc/fortran/trans-expr.cc
> +++ b/gcc/fortran/trans-expr.cc
> @@ -4381,13 +4381,51 @@ conv_base_obj_fcn_val (gfc_se * se, tree base_object,
> gfc_expr * expr)
> se->expr = build_fold_addr_expr_loc (input_location, se->expr);
> }
>
> +static tree
> +get_builtin_fn (gfc_symbol * sym)
> +{
> + if (!gfc_option.disable_omp_is_initial_device
> + && flag_openmp && sym->attr.function && sym->ts.type == BT_LOGICAL
> + && !strcmp (sym->name, "omp_is_initial_device"))
> + return builtin_decl_explicit (BUILT_IN_OMP_IS_INITIAL_DEVICE);
> +
> + if (!gfc_option.disable_acc_on_device
> + && flag_openacc && sym->attr.function && sym->ts.type == BT_LOGICAL
> + && !strcmp (sym->name, "acc_on_device_h"))
> + return builtin_decl_explicit (BUILT_IN_ACC_ON_DEVICE);
> +
> + return NULL_TREE;
> +}
> +
> +static tree
> +update_builtin_function (tree fn_call, gfc_symbol *sym)
> +{
> + tree fn = TREE_OPERAND (CALL_EXPR_FN (fn_call), 0);
> +
> + if (DECL_FUNCTION_CODE (fn) == BUILT_IN_OMP_IS_INITIAL_DEVICE)
> + /* In Fortran omp_is_initial_device returns logical(4)
> + but the builtin uses 'int'. */
> + return fold_convert (TREE_TYPE (TREE_TYPE (sym->backend_decl)), fn_call);
> +
> + else if (DECL_FUNCTION_CODE (fn) == BUILT_IN_ACC_ON_DEVICE)
> + {
> + /* Likewise for the return type; additionally, the argument it a
> + call-by-value int, Fortran has a by-reference 'integer(4)'. */
> + tree arg = build_fold_indirect_ref_loc (input_location,
> + CALL_EXPR_ARG (fn_call, 0));
> + CALL_EXPR_ARG (fn_call, 0) = fold_convert (integer_type_node, arg);
> + return fold_convert (TREE_TYPE (TREE_TYPE (sym->backend_decl)),
> fn_call);
> + }
> + return fn_call;
> +}
>
> static void
> -conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr,
> - gfc_actual_arglist *actual_args)
> +conv_function_val (gfc_se * se, bool *is_builtin, gfc_symbol * sym,
> + gfc_expr * expr, gfc_actual_arglist *actual_args)
> {
> tree tmp;
>
> + *is_builtin = false;
> if (gfc_is_proc_ptr_comp (expr))
> tmp = get_proc_ptr_comp (expr);
> else if (sym->attr.dummy)
> @@ -4404,9 +4442,13 @@ conv_function_val (gfc_se * se, gfc_symbol * sym,
> gfc_expr * expr,
> if (!sym->backend_decl)
> sym->backend_decl = gfc_get_extern_function_decl (sym, actual_args);
>
> - TREE_USED (sym->backend_decl) = 1;
> -
> - tmp = sym->backend_decl;
> + if ((tmp = get_builtin_fn (sym)) != NULL_TREE)
> + *is_builtin = true;
> + else
> + {
> + TREE_USED (sym->backend_decl) = 1;
> + tmp = sym->backend_decl;
> + }
>
> if (sym->attr.cray_pointee)
> {
> @@ -6324,6 +6366,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
> gfc_actual_arglist *arg;
> int has_alternate_specifier = 0;
> bool need_interface_mapping;
> + bool is_builtin;
> bool callee_alloc;
> bool ulim_copy;
> gfc_typespec ts;
> @@ -8164,7 +8207,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
>
> /* Generate the actual call. */
> if (base_object == NULL_TREE)
> - conv_function_val (se, sym, expr, args);
> + conv_function_val (se, &is_builtin, sym, expr, args);
> else
> conv_base_obj_fcn_val (se, base_object, expr);
>
> @@ -8189,6 +8232,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
> fntype = TREE_TYPE (TREE_TYPE (se->expr));
> se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
>
> + if (is_builtin)
> + se->expr = update_builtin_function (se->expr, sym);
> +
> /* Allocatable scalar function results must be freed and nullified
> after use. This necessitates the creation of a temporary to
> hold the result to prevent duplicate calls. */
> diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def
> index 390cc9542f7..aa61750ec59 100644
> --- a/gcc/fortran/types.def
> +++ b/gcc/fortran/types.def
> @@ -45,8 +45,7 @@ along with GCC; see the file COPYING3. If not see
> the type pointed to. */
>
> DEF_PRIMITIVE_TYPE (BT_VOID, void_type_node)
> -DEF_PRIMITIVE_TYPE (BT_BOOL,
> - (*lang_hooks.types.type_for_size) (BOOL_TYPE_SIZE, 1))
> +DEF_PRIMITIVE_TYPE (BT_BOOL, boolean_type_node)
> DEF_PRIMITIVE_TYPE (BT_INT, integer_type_node)
> DEF_PRIMITIVE_TYPE (BT_UINT, unsigned_type_node)
> DEF_PRIMITIVE_TYPE (BT_LONG, long_integer_type_node)
> diff --git a/gcc/gimple-fold.cc b/gcc/gimple-fold.cc
> index 942de7720fd..9a84483f9bf 100644
> --- a/gcc/gimple-fold.cc
> +++ b/gcc/gimple-fold.cc
> @@ -4190,7 +4190,7 @@ static bool
> gimple_fold_builtin_acc_on_device (gimple_stmt_iterator *gsi, tree arg0)
> {
> /* Defer folding until we know which compiler we're in. */
> - if (symtab->state != EXPANSION)
> + if (ENABLE_OFFLOADING && symtab->state != EXPANSION)
> return false;
>
> unsigned val_host = GOMP_DEVICE_HOST;
> diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
> index cc44efdd937..6860963f368 100644
> --- a/libgomp/libgomp.texi
> +++ b/libgomp/libgomp.texi
> @@ -547,7 +547,7 @@ Technical Report (TR) 13 is the third preview for OpenMP
> 6.0.
> @item @code{no_openmp_constructs} assumptions clause @tab N @tab
> @item Restriction for @code{ordered} regarding loop-transforming directives
> @tab N @tab
> -@item @code{apply} code to loop-transforming constructs @tab N @tab
> +@item @code{apply} clause to loop-transforming constructs @tab N @tab
> @item Non-constant values in the @code{sizes} clause @tab N @tab
> @item @code{fuse} loop-transformation construct @tab N @tab
> @item @code{interchange} loop-transformation construct @tab N @tab
> @@ -573,7 +573,7 @@ Technical Report (TR) 13 is the third preview for OpenMP
> 6.0.
> @item New @code{priority} clause to @code{target}, @code{target_enter_data},
> @code{target_data}, @code{target_exit_data} and @code{target_update}
> @tab N @tab
> -@item New @code{device_type} clause to the @code{target} directive.
> +@item New @code{device_type} clause to the @code{target} directive
> @tab N @tab
> @item @code{target_data} as composite construct @tab N @tab
> @item @code{nowait} clause with reverse-offload @code{target} directives
> @@ -584,7 +584,7 @@ Technical Report (TR) 13 is the third preview for OpenMP
> 6.0.
> @item @code{memscope} clause to @code{atomic} and @code{flush} @tab N @tab
> @item New @code{transparent} clause for multi-generational task-dependence
> graphs
> @tab N @tab
> -@item The @code{cancel} construct new completes tasks with unfulfilled events
> +@item The @code{cancel} construct now completes tasks with unfulfilled events
> @tab N @tab
> @item @code{omp_fulfill_event} routine was restricted regarding fulfillment
> of
> event variables @tab N @tab
> @@ -622,7 +622,7 @@ Technical Report (TR) 13 is the third preview for OpenMP
> 6.0.
> @item @code{ompt_get_buffer_limits} OMPT routine @tab N @tab
> @end multitable
>
> -@unnumberedsubsec Deprecated features, unless listed above.
> +@unnumberedsubsec Deprecated features, unless listed above
> @multitable @columnfractions .60 .10 .25
> @item Deprecation of omitting the optional white space to separate adjacent
> keywords in the directive-name in Fortran (fixed and free source form)
> @@ -1915,9 +1915,9 @@ This function returns @code{true} if currently running
> on the host device,
> @code{false} otherwise. Here, @code{true} and @code{false} represent
> their language-specific counterparts.
>
> -Note that in GCC this value is already folded to a constant in the compiler;
> -compile with @option{-fno-builtin-omp_is_initial_device} if a run-time
> function
> -is desired.
> +Note that in GCC this function call is already folded to a constant in the
> +compiler; compile with @option{-fno-builtin-omp_is_initial_device} if a
> +run-time function is desired.
>
> @item @emph{C/C++}:
> @multitable @columnfractions .20 .80
> @@ -4886,6 +4886,10 @@ In Fortran, @code{true} is returned. If the program is
> not executing
> on the specified device type C/C++ returns zero, while Fortran
> returns @code{false}.
>
> +Note that in GCC, depending on @var{devicetype}, the function call might
> +be folded to a constant in the compiler; compile with
> +@option{-fno-builtin-acc_on_device} if a run-time function is desired.
> +
> @item @emph{C/C++}:
> @multitable @columnfractions .20 .80
> @item @emph{Prototype}: @tab @code{acc_on_device(acc_device_t devicetype);}
> diff --git a/libgomp/testsuite/libgomp.fortran/target-is-initial-device-3.f90
> b/libgomp/testsuite/libgomp.fortran/target-is-initial-device-3.f90
> new file mode 100644
> index 00000000000..3ce24f1757d
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/target-is-initial-device-3.f90
> @@ -0,0 +1,50 @@
> +! { dg-additional-options "-fdump-tree-original" }
> +!
> +! Check that EXPR_EQ works with __builtin_omp_is_initial_device,
> +! which returns an 'int' while Fortran uses 'logical(4)'.
> +!
> +! Check that 'call ff (omp_is_initial_device)' accesses the library
> +! function and not the builtin.
> +!
> +! { dg-final { scan-tree-dump-times "__builtin_omp_is_initial_device \\(\\)"
> 14 "original" } } */
> +! { dg-final { scan-tree-dump "ff \\(omp_is_initial_device\\);" "original" }
> } */
> +!
> +program main
> + use omp_lib, only: omp_is_initial_device
> + implicit none (type, external)
> +
> + logical(1) :: t1
> + logical(2) :: f2
> + t1 = .true.
> + f2 = .false.
> +
> + if (omp_is_initial_device () .eqv. .true.) then
> + else
> + stop 1
> + end if
> + if (omp_is_initial_device () .neqv. .true.) stop 2
> + if (omp_is_initial_device () .eqv. .false.) stop 3
> + if (omp_is_initial_device () .neqv. .false.) then
> + else
> + stop 4
> + end if
> +
> + if (omp_is_initial_device () .neqv. .true._1) stop 5
> + if (omp_is_initial_device () .eqv. .false._1) stop 6
> + if (omp_is_initial_device () .neqv. .true._2) stop 7
> + if (omp_is_initial_device () .eqv. .false._2) stop 8
> + if (omp_is_initial_device () .neqv. .true._4) stop 9
> + if (omp_is_initial_device () .eqv. .false._4) stop 10
> + if (omp_is_initial_device () .neqv. .true._8) stop 11
> + if (omp_is_initial_device () .eqv. .false._8) stop 12
> +
> + if (omp_is_initial_device () .neqv. t1) stop 13
> + if (omp_is_initial_device () .eqv. f2) stop 14
> +
> + call ff (omp_is_initial_device)
> +contains
> + subroutine ff(xx)
> + procedure (omp_is_initial_device) :: xx
> + if (.not. xx ()) stop 15
> + end
> +end
> diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
> b/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
> index 7dc7459e5fe..e64711b536b 100644
> --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
> +++ b/libgomp/testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c
> @@ -36,8 +36,7 @@ static int fact_nohost(int n)
>
> return fact(n);
> }
> -/* { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'fact_nohost' has
> 'nohost' clause\.$} 1 oaccloops { target c } } }
> - { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'int
> fact_nohost\(int\)' has 'nohost' clause\.$} 1 oaccloops { target { c++ && { !
> offloading_enabled } } } } }
> +/* { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'fact_nohost' has
> 'nohost' clause\.$} 1 oaccloops { target { c && offloading_enabled } } } }
> { dg-final { scan-tree-dump-times {(?n)^OpenACC routine
> 'fact_nohost\(int\)' has 'nohost' clause\.$} 1 oaccloops { target { c++ &&
> offloading_enabled } } } }
> TODO See PR101551 for 'offloading_enabled' differences. */
>
> diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90
> b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90
> index cd599e5d0e3..89748204f05 100644
> --- a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-1.f90
> @@ -7,11 +7,6 @@
> ! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
> ! for testing/documenting aspects of that functionality.
>
> -! TODO: Have to disable the acc_on_device builtin for we want to test the
> -! libgomp library function? The command line option
> -! '-fno-builtin-acc_on_device' is valid for C/C++/ObjC/ObjC++ but not for
> -! Fortran.
> -
> use openacc
> implicit none
>
> diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
> b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
> index eb3daba0188..e31e0fc715b 100644
> --- a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
> @@ -1,5 +1,5 @@
> ! { dg-do run }
> -! { dg-additional-options "-cpp" }
> +! { dg-additional-options "-cpp -fno-builtin-acc_on_device" }
>
> ! { dg-additional-options "-fopt-info-all-omp" }
> ! { dg-additional-options "--param=openacc-privatization=noisy" }
> @@ -7,11 +7,6 @@
> ! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
> ! for testing/documenting aspects of that functionality.
>
> -! TODO: Have to disable the acc_on_device builtin for we want to test
> -! the libgomp library function? The command line option
> -! '-fno-builtin-acc_on_device' is valid for C/C++/ObjC/ObjC++ but not
> -! for Fortran.
> -
> USE OPENACC
> IMPLICIT NONE
>
> diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f
> b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f
> index 5f500c19481..0595be241f8 100644
> --- a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-3.f
> @@ -1,5 +1,5 @@
> ! { dg-do run }
> -! { dg-additional-options "-cpp" }
> +! { dg-additional-options "-cpp -fno-builtin-acc_on_device" }
>
> ! { dg-additional-options "-fopt-info-all-omp" }
> ! { dg-additional-options "--param=openacc-privatization=noisy" }
> @@ -7,11 +7,6 @@
> ! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
> ! for testing/documenting aspects of that functionality.
>
> -! TODO: Have to disable the acc_on_device builtin for we want to test
> -! the libgomp library function? The command line option
> -! '-fno-builtin-acc_on_device' is valid for C/C++/ObjC/ObjC++ but not
> -! for Fortran.
> -
> IMPLICIT NONE
> INCLUDE "openacc_lib.h"
>
> diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-2.f90
> b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-2.f90
> new file mode 100644
> index 00000000000..39d4357dd55
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-2.f90
> @@ -0,0 +1,40 @@
> +! { dg-do link }
> +
> +! Check whether 'acc_on_device()' is properly compile-time optimized. */
> +
> +! { dg-additional-options "-fdump-tree-gimple -fdump-tree-optimized" }
> +! { dg-additional-options -foffload-options=-fdump-tree-optimized { target {
> offload_device_nvptx || offload_target_amdgcn } } }
> +
> +! { dg-final { scan-tree-dump-times "acc_on_device" 1 "gimple" } }
> +
> +! { dg-final { scan-tree-dump-not "acc_on_device" "optimized" } }
> +
> +! { dg-final { only_for_offload_target amdgcn-amdhsa
> scan-offload-tree-dump-not "acc_on_device" "optimized" { target
> offload_target_amdgcn } } }
> +! { dg-final { only_for_offload_target nvptx-none scan-offload-tree-dump-not
> "acc_on_device" "optimized" { target offload_target_nvptx } } }
> +
> +
> +module m
> + integer :: xxxx
> + !$acc declare device_resident(xxxx)
> +contains
> + subroutine set_var
> + !$acc routine
> + use openacc
> + implicit none (type, external)
> + if (acc_on_device(acc_device_host)) then
> + xxxx = 1234
> + else
> + xxxx = 4242
> + end if
> + end
> +end module m
> +
> +
> +program main
> + use m
> + call set_var
> + !$acc serial
> + ! { dg-warning "using 'vector_length \\(32\\)', ignoring 1" "" { target
> openacc_nvidia_accel_selected } .-1 }
> + call set_var
> + !$acc end serial
> +end
