[Patch] Fortran/OpenMP: Fix __builtin_omp_is_initial_device
Patches gfc_conv_procedure_call (+ called functions).
Found via OpenMP_VV which uses rather pointlessly 'if
(omp_is_initial_device() .eqv. .true.)' – instead of using 'if (omp_…())'.
This failed with an ICE as the middle end did not like 'if (
== )' comparisons.
The initial idea was to create a new builtin, returning logical(4)
instead of int, but 'logical(4)' is not readily available and adding
support to 5 FE did not seem to be the most sensible.
In addition, I realized that the current code used
__builtin_omp_is_initial_device also when an address was needed, which
the ME does not handle. (It strictly compile-time expands the builtin.)
Thus, I moved it to the call site – plus handle the type conversion if
needed.
[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.]
OK for mainline?
Tobias
Fortran/OpenMP: Fix __builtin_omp_is_initial_device
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 )
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:
* 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; add is_builtin intent-out argument.
(gfc_conv_procedure_call): Use it.
* types.def (BT_BOOL): Fix type by using bool_type_node.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/target-is-initial-device-3.f90: New test.
gcc/fortran/trans-decl.cc | 9
gcc/fortran/trans-expr.cc | 34 ---
gcc/fortran/types.def | 3 +-
.../libgomp.fortran/target-is-initial-device-3.f90 | 50 ++
4 files changed, 79 insertions(+), 17 deletions(-)
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..e27c5e62055 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -4381,13 +4381,24 @@ 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);
+
+ return NULL_TREE;
+}
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 +4415,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 +6339,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 +8180,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
Re: [Fortran, Patch, PR51815, v3] Fix parsing of substring refs in coarrays.
Hi Harald,
I agree that the gfc_match_array_ref() is not needed for error recovery or
helps anyhow. I therefore removed it. I left the new error message in, because
in the case that c = x(:)(2:5) is in a subroutine, like in pr102532.f90, then I
get no error. Neither without return MATCH_ERROR nor with it. Therefore I think
the gfc_error_now() can help.
I have bootstrapped and regtested the modified patch again on
x86_64-pc-linux-gnu / Fedora 39 before committing it as:
gcc-15-4171-g0ad2c76bea2
Thanks for the review and the fruitful discussion. I hope that this solution
will fix the bug and also improve gfortran's user experience a tiny little bit.
Thanks again and regards,
Andre
On Mon, 7 Oct 2024 22:58:23 +0200
Harald Anlauf wrote:
> Hi Andre,
>
> On 10/7/24 11:04, Andre Vehreschild wrote:
> > Hi Harald,
> >
> > thank you for your input. I still have some small nits to discuss to make
> > everyone happy. Therefore:
> >
> >> this seems to go into the right direction - except that I am not a
> >> great fan of gfc_error_now, as that tries to paper over deficiencies
> >> in error recovery.
> >
> > Me either, but when I remove the gfc_error_now() and only do
> >
> >> if (gfc_peek_ascii_char () == '(')
> >>return MATCH_ERROR;
> >
> > as you proposed, then no error is given for:
> >
> > character(:), allocatable :: x[:]
> > character(:), allocatable :: c
> > c = x(:)(2:5)
> >
> > I.e. nothing at all.
>
> hmmm, without the hunk in question I do get:
>
> 4 | c = x(:)(2:5)
>| 1
> Error: Unclassifiable statement at (1)
>
>
> which is the same when doing a return MATCH_ERROR;
>
> When I simply use:
>
> if (gfc_peek_ascii_char () == '(')
> {
> gfc_error ("Unexpected array/substring ref at %C");
> return MATCH_ERROR;
> }
>
> this already generates:
>
> 4 | c = x(:)(2:5)
>| 1
> Error: Unexpected array/substring ref at (1)
>
>
> > Therefore at the moment I prefer to stick to the initial> solution
> with the gfc_error_now, which not only gives an error in the
> > associate, but also when one just does an array/substring-ref outside of
> > parentheses. And I like the new error message, because I consider it more
> > helpful than just a syntax error or the invalid association target message.
> > What do you think?
>
> The motivation for my asking is based on the following naive thinking
> (assuming that x is of type character):
>
> x(:)(2:5)! could be a rank mismatch when x is an array
> x[1](:)(2:5) ! is always a syntax error
> x(:)[1](2:5) ! could by diagnosed as a rank mismatch
>
> That is of course wishful thinking on my side. No compiler
> matches this completely, and diagnosing a syntax error is
> certainly acceptable behavior. (Some other brand shows funny
> diagnostics coming likely from the resolution phase).
>
> >> Is there a reason that you do not check the return value of
> >> gfc_match_array_ref?
> >
> > What am I to do with the result? We are in an error case independent of the
> > result of gfc_match_array_ref. The intention of using that routine here was
> > to digest the unexpected input and allow for (easier|better) error
> > recovery.
>
> Do you have an example that shows the use of gfc_match_array_ref here?
> Commenting it out doesn't seem to make a difference in the error case
> here, unless I missed something.
>
> > May> be I should just put a comment on it, to make it more clear. Or
> is there
> > another way to help the parser recover from an error?
>
> Well, I am not the expert to answer that. Without gfc_error_now,
> we're more likely seeing errors coming from the parsing of the
> associate, and here I would point to Paul as the one with the most
> experience. I would hope that the parsing of associate would see
> if an error was issued for the associate target and allow that error
> to be emitted.
>
> > Sorry for the additional round. But this error has been around for so long,
> > that it doesn't matter, if we need another day to come up with a solution.
>
> Indeed! :-)
>
> > Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
>
> I am fine with your solution. Diagnostics can be improved later
> any time...
>
> > Regards,
> > Andre
>
> Thanks for your patience!
>
> Harald
>
> >
> >> Indeed your suggestion (or the shortened version above) improves
> >> the diagnostics ("user experience") also for this variant:
> >>
> >> subroutine foo
> >> character(:), allocatable :: x[:]
> >> character(:), dimension(:), allocatable :: c[:]
> >> type t
> >> character(:), allocatable :: x[:]
> >> character(:), dimension(:), allocatable :: c[:]
> >> end type t
> >> type(t) :: z
> >> associate (y => x(:)(2:))
> >> end associate
> >> associate (a => c(:)(:)(2:))
> >> end associate
> >> associate (y => z%x(:)(2:))
> >> end associate
> >> associate (a => z%c(:)(:)(2:))
> >> end a
