[Patch] C, C++, Fortran, OpenMP: Add support for device-modifiers for 'omp target device'

2021-07-07 Thread Marcel Vollweiler

This patch adds device-modifiers to the device clause:

   #pragma omp target device ([ device-modifier :] integer-expression)

where device-modifier is either 'ancestor' or 'device_num'.

The 'device_num' case

   #pragma omp target device (device_num : integer-expression)

is treated in the same way as

   #pragma omp target device (integer-expression)

before.

For the 'ancestor' case

   #pragma omp target device (ancestor: integer-expression)

a message 'sorry, not yet implemented' is output.


-
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München 
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank 
Thürauf
OpenMP: Add support for device-modifiers for 'omp target device'

gcc/c/ChangeLog:

* c-parser.c (c_parser_omp_clause_device): Add support for 
device-modifiers for 'omp target device'.

gcc/cp/ChangeLog:

* parser.c (cp_parser_omp_clause_device): Add support for 
device-modifiers for 'omp target device'.

gcc/fortran/ChangeLog:

* openmp.c (gfc_match_omp_clauses): Add support for 
device-modifiers for 'omp target device'.

gcc/testsuite/ChangeLog:

* c-c++-common/gomp/target-device-1.c: New test.
* c-c++-common/gomp/target-device-2.c: New test.
* gfortran.dg/gomp/target-device-1.f90: New test.
* gfortran.dg/gomp/target-device-2.f90: New test.

diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c
index 9a56e0c..defc52d 100644
--- a/gcc/c/c-parser.c
+++ b/gcc/c/c-parser.c
@@ -15864,37 +15864,117 @@ c_parser_omp_clause_map (c_parser *parser, tree list)
 }
 
 /* OpenMP 4.0:
-   device ( expression ) */
+   device ( expression )
+
+   OpenMP 5.0:
+   device ( [device-modifier :] integer-expression )
+
+   device-modifier:
+ ancestor | device_num */
 
 static tree
 c_parser_omp_clause_device (c_parser *parser, tree list)
 {
   location_t clause_loc = c_parser_peek_token (parser)->location;
+  location_t expr_loc;
+  c_expr expr;
+  tree c, t;
+
   matching_parens parens;
-  if (parens.require_open (parser))
+  if (!parens.require_open (parser))
+return list;
+
+  int pos = 1;
+  int pos_colon = 0;
+  while (c_parser_peek_nth_token_raw (parser, pos)->type == CPP_NAME
+|| c_parser_peek_nth_token_raw (parser, pos)->type == CPP_COLON
+|| c_parser_peek_nth_token_raw (parser, pos)->type == CPP_COMMA)
 {
-  location_t expr_loc = c_parser_peek_token (parser)->location;
-  c_expr expr = c_parser_expr_no_commas (parser, NULL);
-  expr = convert_lvalue_to_rvalue (expr_loc, expr, false, true);
-  tree c, t = expr.value;
-  t = c_fully_fold (t, false, NULL);
+  if (c_parser_peek_nth_token_raw (parser, pos)->type == CPP_COLON)
+   {
+ pos_colon = pos;
+ break;
+   }
+  pos++;
+}
 
-  parens.skip_until_found_close (parser);
+  const char *err_msg;
+  if (pos_colon == 1)
+{
+  err_msg = "expected device-modifier % or %";
+  goto invalid_kind;
+}
 
-  if (!INTEGRAL_TYPE_P (TREE_TYPE (t)))
+  if (pos_colon > 1)
+{
+  if (c_parser_peek_nth_token_raw (parser, 1)->type == CPP_NAME)
{
- c_parser_error (parser, "expected integer expression");
- return list;
+ c_token *tok = c_parser_peek_token (parser);
+ const char *p = IDENTIFIER_POINTER (tok->value);
+ if (strcmp ("ancestor", p) == 0)
+   {
+ if (pos_colon > 2)
+   {
+ err_msg = "expected only one device-modifier % or "
+   "%";
+ goto invalid_kind;
+   }
+
+ sorry_at (tok->location, "% not yet supported");
+ c_parser_skip_until_found (parser, CPP_CLOSE_PAREN, NULL);
+ return list;
+   }
+ else if (strcmp ("device_num", p) == 0)
+   {
+ if (pos_colon > 2)
+   {
+ err_msg = "expected only one device-modifier % or "
+   "%";
+ goto invalid_kind;
+   }
+ c_parser_consume_token (parser);
+ c_parser_peek_token (parser);
+ c_parser_consume_token (parser);
+   }
+ else
+   {
+ err_msg = "expected device-modifier % or "
+   "%";
+ goto invalid_kind;
+   }
+   }
+  else
+   {
+ err_msg = "expected device-modifier % or %";
+ goto invalid_kind;
}
+}
 
-  check_no_duplicate_clause (list, OMP_CLAUSE_DEVICE, "device");
+  expr_loc = c_parser_peek_token (parser)->location;
+  expr = c_parser_expr_no_commas (parser, NULL);
+  expr = convert_lvalue_to_rvalue (expr_loc, expr, false, true);
+  c, t = expr.value;
+  t = c_fully_fold (t, false, NULL);
 
-  c = build_omp_clause (clause_loc, OMP_CLAUSE_DEVICE);
-  OMP_CLAUSE_DEVICE_ID (c) = t;
-  OMP_CLAUSE_CHAIN (c) = list;
-  list = c;

*Ping* [Patch] Fortran: Fix bind(C) character length checks

2021-07-07 Thread Burnus, Tobias
*Ping*

I intent to incorporate Sandra's suggestions, except for the beginning of line 
spacing - that's needed to avoid exceeding the 80 character line limit. I did 
not include an updated patch as just pinging is easier on a mobile during 
vacation :-)

Thanks,

Tobias

Loosemore, Sandra wrote:

On 7/1/21 11:08 AM, Tobias Burnus wrote:
> Hi all,
>
> this patch came up when discussing Sandra's TS29113 patch internally.
> There is presumably also some overlap with José's patches.
>
> This patch tries to rectify the BIND(C) CHARACTER handling on the
> diagnostic side, only. That is: what to accept and what
> to reject for which Fortran standard.
>
>
> The rules are:
>
> * [F2003-F2018] Interoperable is character(len=1)
>→ F2018, 18.3.1  Interoperability of intrinsic types
>(General, unchanged)
>
> * Fortran 2008: In some cases, const-length chars are
>permitted as well:
>→ F2018, 18.3.4  Interoperability of scalar variables
>→ F2018, 18.3.5  Interoperability of array variables
>→ F2018, 18.3.6  Interoperability of procedures and procedure interfaces
>   [= F2008, 15.3.{4,5,6}
> For global vars with bind(C), 18.3.4 + 18.3.5 applies directly (TODO:
> Add support, not in this patch)
> For passed-by ref dummy arguments, 18.3.4 + 18.3.5 are referenced in
> - F2008: R1229  proc-language-binding-spec is language-binding-spec
>   C1255 (R1229) 
> - F2018, F2018, C1554
>
> While it is not very clearly spelt out, I regard 'char parm[4]'
> interoperable with 'character(len=4) :: a', 'character(len=2) :: b(2)'
> and 'character(len=1) :: c(4)' for both global variables and for
> dummy arguments.
>
> * Fortran 2018/TS29113:  Uses additionally CFI array descriptor
>- allocatable, pointer:  must be len=:
>- nonallocatable/nonpointer: len=* → implies array descriptor also
>  for assumed-size/explicit-size/scalar arguments.
>- All which all passed by an array descriptor already without further
>  restrictions: assumed-shape, assumed-rank, i.e. len= seems
>  to be also fine
> → 18.3.6 under item (5) bullet point 2 and 3 plus (6).
>
>
> I hope I got the conditions right. I also fixed an issue with
> character(len=5) :: str – the code in trans-expr.c did crash for
> scalars  (decl.c did not check any constraints for arrays).
> I believe the condition is wrong and for len= no descriptor
> is used.
>
> Any comments, remarks?

I gave this patch a try on my TS 29113 last night.  Changing the error
messages kind of screwed up my list of FAILs, but I did see that it also
caught some invalid character arguments in
interoperability/typecodes-scalar.f90 and
interoperability/typecodes-scalar-ext.f90 (which are already broken by 2
other major gfortran bugs I still need to file PRs for).  :-S

I haven't tried to review the patch WRT correctness with the
requirements of the standard yet, but I have a few nits about error
messages

> +   /* F2018, 18.3.6 (6).  */
> +   if (!sym->ts.deferred)
> + {
> +   gfc_error ("Allocatable and pointer character dummy "
> +  "argument %qs at %L must have deferred length "
> +  "as procedure %qs is BIND(C)", sym->name,
> +  &sym->declared_at, sym->ns->proc_name->name);
> +   retval = false;
> + }

This is the error the two aforementioned test cases started giving, but
message is confusing and doesn't read well (it was a pointer dummy, not
"allocatable and pointer").  Maybe just s/and/or/, or customize the
message depending on which one it is?

> +   gfc_error ("Character dummy argument %qs at %L must be "
> +  "of constant length or assumed length, "
> +  "unless it has assumed-shape or assumed-rank, "
> +  "as procedure %qs has the BIND(C) attribute",
> +  sym->name, &sym->declared_at,
> +  sym->ns->proc_name->name);

I don't think either "assumed-shape" or "assumed-rank" should be
hyphenated in this context unless that exact hyphenation is a term of
art in the Fortran standard or other technical documentation.  In normal
English, adjective phrases are usually only hyphenated when they appear
immediately before the noun they modify; "assumed-shape array", but "an
array with assumed shape".

> +   else if (!gfc_notify_std (GFC_STD_F2018,
> + "Character dummy argument %qs at %L"
> + " with nonconstant length as "
> + "procedure %qs is BIND(C)",
> + sym->name, &sym->declared_at,
> + sym->ns->proc_name->name))
> + retval = false;
> + }

Elsewhere the convention seems to be to format strings sp