+2021-08-31 Marcel Vollweiler <marcel@codesourcery.com>
+
+ Backported from master:
+ 2021-08-31 Marcel Vollweiler <marcel@codesourcery.com>
+
+ * c-parser.c (c_parser_omp_clause_device): Parse device-modifiers 'device_num'
+ and 'ancestor' in 'target device' clauses.
+ * parser.c (cp_parser_omp_clause_device): Parse device-modifiers 'device_num'
+ and 'ancestor' in 'target device' clauses.
+ * semantics.c (finish_omp_clauses): Error handling. Constant device ids must
+ evaluate to '1' if 'ancestor' is used.
+ * gfortran.h: Add variable for 'ancestor' in struct gfc_omp_clauses.
+ * openmp.c (gfc_match_omp_clauses): Parse device-modifiers 'device_num'
+ and 'ancestor' in 'target device' clauses.
+ * trans-openmp.c (gfc_trans_omp_clauses): Set OMP_CLAUSE_DEVICE_ANCESTOR.
+ * gimplify.c (gimplify_scan_omp_clauses): Error handling. 'ancestor' only
+ allowed on target constructs and only with particular other clauses.
+ * omp-expand.c (expand_omp_target): Output of 'sorry, not supported' if
+ 'ancestor' is used.
+ * omp-low.c (check_omp_nesting_restrictions): Error handling. No nested OpenMP
+ structs when 'ancestor' is used.
+ (scan_omp_1_stmt): No usage of OpenMP runtime routines in a target region when
+ 'ancestor' is used.
+ * tree-pretty-print.c (dump_omp_clause): Append 'ancestor'.
+ * tree.h (OMP_CLAUSE_DEVICE_ANCESTOR): Define macro.
+ * c-c++-common/gomp/target-device-1.c: New test.
+ * c-c++-common/gomp/target-device-2.c: New test.
+ * c-c++-common/gomp/target-device-ancestor-1.c: New test.
+ * c-c++-common/gomp/target-device-ancestor-2.c: New test.
+ * c-c++-common/gomp/target-device-ancestor-3.c: New test.
+ * c-c++-common/gomp/target-device-ancestor-4.c: New test.
+ * gfortran.dg/gomp/target-device-1.f90: New test.
+ * gfortran.dg/gomp/target-device-2.f90: New test.
+ * gfortran.dg/gomp/target-device-ancestor-1.f90: New test.
+ * gfortran.dg/gomp/target-device-ancestor-2.f90: New test.
+ * gfortran.dg/gomp/target-device-ancestor-3.f90: New test.
+ * gfortran.dg/gomp/target-device-ancestor-4.f90: New test.
+
+
2021-08-23 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
}
/* 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;
- matching_parens parens;
- if (parens.require_open (parser))
- {
- 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);
+ location_t expr_loc;
+ c_expr expr;
+ tree c, t;
+ bool ancestor = false;
- parens.skip_until_found_close (parser);
+ matching_parens parens;
+ if (!parens.require_open (parser))
+ return list;
- if (!INTEGRAL_TYPE_P (TREE_TYPE (t)))
+ if (c_parser_next_token_is (parser, CPP_NAME)
+ && c_parser_peek_2nd_token (parser)->type == CPP_COLON)
+ {
+ c_token *tok = c_parser_peek_token (parser);
+ const char *p = IDENTIFIER_POINTER (tok->value);
+ if (strcmp ("ancestor", p) == 0)
{
- c_parser_error (parser, "expected integer expression");
+ /* A requires directive with the reverse_offload clause must be
+ specified. */
+ if ((omp_requires_mask & OMP_REQUIRES_REVERSE_OFFLOAD) == 0)
+ {
+ error_at (tok->location, "%<ancestor%> device modifier not "
+ "preceded by %<requires%> directive "
+ "with %<reverse_offload%> clause");
+ parens.skip_until_found_close (parser);
+ return list;
+ }
+ ancestor = true;
+ }
+ else if (strcmp ("device_num", p) == 0)
+ ;
+ else
+ {
+ error_at (tok->location, "expected %<ancestor%> or %<device_num%>");
+ parens.skip_until_found_close (parser);
return list;
}
+ c_parser_consume_token (parser);
+ c_parser_consume_token (parser);
+ }
- 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);
+ 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;
+ parens.skip_until_found_close (parser);
+
+ if (!INTEGRAL_TYPE_P (TREE_TYPE (t)))
+ {
+ c_parser_error (parser, "expected integer expression");
+ return list;
}
+ if (ancestor && TREE_CODE (t) == INTEGER_CST && !integer_onep (t))
+ {
+ error_at (expr_loc, "the %<device%> clause expression must evaluate to "
+ "%<1%>");
+ return list;
+ }
+
+ check_no_duplicate_clause (list, OMP_CLAUSE_DEVICE, "device");
+
+ c = build_omp_clause (clause_loc, OMP_CLAUSE_DEVICE);
+ OMP_CLAUSE_DEVICE_ID (c) = t;
+ OMP_CLAUSE_CHAIN (c) = list;
+ OMP_CLAUSE_DEVICE_ANCESTOR (c) = ancestor;
+
+ list = c;
return list;
}
}
/* OpenMP 4.0:
- device ( expression ) */
+ device ( expression )
+
+ OpenMP 5.0:
+ device ( [device-modifier :] integer-expression )
+
+ device-modifier:
+ ancestor | device_num */
static tree
cp_parser_omp_clause_device (cp_parser *parser, tree list,
location_t location)
{
tree t, c;
+ bool ancestor = false;
matching_parens parens;
if (!parens.require_open (parser))
return list;
+ if (cp_lexer_next_token_is (parser->lexer, CPP_NAME)
+ && cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON))
+ {
+ cp_token *tok = cp_lexer_peek_token (parser->lexer);
+ const char *p = IDENTIFIER_POINTER (tok->u.value);
+ if (strcmp ("ancestor", p) == 0)
+ {
+ ancestor = true;
+
+ /* A requires directive with the reverse_offload clause must be
+ specified. */
+ if ((omp_requires_mask & OMP_REQUIRES_REVERSE_OFFLOAD) == 0)
+ {
+ error_at (tok->location, "%<ancestor%> device modifier not "
+ "preceded by %<requires%> directive "
+ "with %<reverse_offload%> clause");
+ cp_parser_skip_to_closing_parenthesis (parser, true, false, true);
+ return list;
+ }
+ }
+ else if (strcmp ("device_num", p) == 0)
+ ;
+ else
+ {
+ error_at (tok->location, "expected %<ancestor%> or %<device_num%>");
+ cp_parser_skip_to_closing_parenthesis (parser, true, false, true);
+ return list;
+ }
+ cp_lexer_consume_token (parser->lexer);
+ cp_lexer_consume_token (parser->lexer);
+ }
+
t = cp_parser_assignment_expression (parser);
if (t == error_mark_node
c = build_omp_clause (location, OMP_CLAUSE_DEVICE);
OMP_CLAUSE_DEVICE_ID (c) = t;
OMP_CLAUSE_CHAIN (c) = list;
+ OMP_CLAUSE_DEVICE_ANCESTOR (c) = ancestor;
return c;
}
"%<device%> id must be integral");
remove = true;
}
+ else if (OMP_CLAUSE_DEVICE_ANCESTOR (c)
+ && TREE_CODE (t) == INTEGER_CST
+ && !integer_onep (t))
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "the %<device%> clause expression must evaluate to "
+ "%<1%>");
+ remove = true;
+ }
else
{
t = mark_rvalue_use (t);
struct gfc_expr *dist_chunk_size;
struct gfc_expr *message;
const char *critical_name;
+ bool ancestor;
enum gfc_omp_default_sharing default_sharing;
enum gfc_omp_atomic_op atomic_op;
enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
continue;
if ((mask & OMP_CLAUSE_DEVICE)
&& !openacc
- && (m = gfc_match_dupl_check (!c->device, "device", true,
- &c->device)) != MATCH_NO)
+ && ((m = gfc_match_dupl_check (!c->device, "device", true))
+ != MATCH_NO))
{
if (m == MATCH_ERROR)
goto error;
+ c->ancestor = false;
+ if (gfc_match ("device_num : ") == MATCH_YES)
+ {
+ if (gfc_match ("%e )", &c->device) != MATCH_YES)
+ {
+ gfc_error ("Expected integer expression at %C");
+ break;
+ }
+ }
+ else if (gfc_match ("ancestor : ") == MATCH_YES)
+ {
+ c->ancestor = true;
+ if (!(gfc_current_ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD))
+ {
+ gfc_error ("%<ancestor%> device modifier not "
+ "preceded by %<requires%> directive "
+ "with %<reverse_offload%> clause at %C");
+ break;
+ }
+ locus old_loc2 = gfc_current_locus;
+ if (gfc_match ("%e )", &c->device) == MATCH_YES)
+ {
+ int device = 0;
+ if (!gfc_extract_int (c->device, &device) && device != 1)
+ {
+ gfc_current_locus = old_loc2;
+ gfc_error ("the %<device%> clause expression must "
+ "evaluate to %<1%> at %C");
+ break;
+ }
+ }
+ else
+ {
+ gfc_error ("Expected integer expression at %C");
+ break;
+ }
+ }
+ else if (gfc_match ("%e )", &c->device) != MATCH_YES)
+ {
+ gfc_error ("Expected integer expression or a single device-"
+ "modifier %<device_num%> or %<ancestor%> at %C");
+ break;
+ }
continue;
}
if ((mask & OMP_CLAUSE_DEVICE)
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE);
OMP_CLAUSE_DEVICE_ID (c) = device;
+
+ if (clauses->ancestor)
+ OMP_CLAUSE_DEVICE_ANCESTOR (c) = 1;
+
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
case OMP_CLAUSE_THREAD_LIMIT:
case OMP_CLAUSE_DIST_SCHEDULE:
case OMP_CLAUSE_DEVICE:
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEVICE
+ && OMP_CLAUSE_DEVICE_ANCESTOR (c))
+ {
+ if (code != OMP_TARGET)
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "%<device%> clause with %<ancestor%> is only "
+ "allowed on %<target%> construct");
+ remove = true;
+ break;
+ }
+
+ tree clauses = *orig_list_p;
+ for (; clauses ; clauses = OMP_CLAUSE_CHAIN (clauses))
+ if (OMP_CLAUSE_CODE (clauses) != OMP_CLAUSE_DEVICE
+ && OMP_CLAUSE_CODE (clauses) != OMP_CLAUSE_FIRSTPRIVATE
+ && OMP_CLAUSE_CODE (clauses) != OMP_CLAUSE_PRIVATE
+ && OMP_CLAUSE_CODE (clauses) != OMP_CLAUSE_DEFAULTMAP
+ && OMP_CLAUSE_CODE (clauses) != OMP_CLAUSE_MAP
+ )
+ {
+ error_at (OMP_CLAUSE_LOCATION (c),
+ "with %<ancestor%>, only the %<device%>, "
+ "%<firstprivate%>, %<private%>, %<defaultmap%>, "
+ "and %<map%> clauses may appear on the "
+ "construct");
+ remove = true;
+ break;
+ }
+ }
+ /* Fall through. */
+
case OMP_CLAUSE_PRIORITY:
case OMP_CLAUSE_GRAINSIZE:
case OMP_CLAUSE_NUM_TASKS:
{
device = OMP_CLAUSE_DEVICE_ID (c);
device_loc = OMP_CLAUSE_LOCATION (c);
+ if (OMP_CLAUSE_DEVICE_ANCESTOR (c))
+ sorry_at (device_loc, "%<ancestor%> not yet supported");
}
else
{
if (gimple_code (ctx->stmt) == GIMPLE_OMP_TARGET
&& gimple_omp_target_kind (ctx->stmt) == GF_OMP_TARGET_KIND_REGION)
{
+ c = omp_find_clause (gimple_omp_target_clauses (ctx->stmt),
+ OMP_CLAUSE_DEVICE);
+ if (c && OMP_CLAUSE_DEVICE_ANCESTOR (c))
+ {
+ error_at (gimple_location (stmt),
+ "OpenMP constructs are not allowed in target region "
+ "with %<ancestor%>");
+ return false;
+ }
+
if (gimple_code (stmt) == GIMPLE_OMP_TEAMS && !ctx->teams_nested_p)
ctx->teams_nested_p = true;
else
"OpenMP runtime API call %qD in a region with "
"%<order(concurrent)%> clause", fndecl);
}
+ if (gimple_code (ctx->stmt) == GIMPLE_OMP_TARGET
+ && (gimple_omp_target_kind (ctx->stmt)
+ == GF_OMP_TARGET_KIND_REGION))
+ {
+ tree tgt_clauses = gimple_omp_target_clauses (ctx->stmt);
+ tree c = omp_find_clause (tgt_clauses, OMP_CLAUSE_DEVICE);
+ if (c && OMP_CLAUSE_DEVICE_ANCESTOR (c))
+ error_at (gimple_location (stmt),
+ "OpenMP runtime API call %qD in a region with "
+ "%<device(ancestor)%> clause", fndecl);
+ }
}
}
}
--- /dev/null
+/* { dg-do compile } */
+
+void
+foo (int n)
+{
+ /* Test to ensure that 'device_num' is parsed correctly in device clauses. */
+
+ #pragma omp target device (1)
+ ;
+
+ #pragma omp target device (n)
+ ;
+
+ #pragma omp target device (n + 1)
+ ;
+
+ #pragma omp target device (device_num : 1)
+ ;
+
+ #pragma omp target device (device_num : n)
+ ;
+
+ #pragma omp target device (device_num : n + 1)
+ ;
+
+ #pragma omp target device (invalid : 1) /* { dg-error "expected 'ancestor' or 'device_num'" "" { target *-*-* } } */
+ /* { dg-error "expected '\\)' before 'invalid'" "" { target c } .-1 } */
+ ;
+
+ #pragma omp target device (device_num : n, n) /* { dg-error "expected '\\)' before ','" } */
+ ;
+}
--- /dev/null
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+ /* Test to ensure that device-modifier 'device_num' is parsed correctly in
+ device clauses. */
+
+void
+foo (void)
+{
+ #pragma omp target device (device_num : 42)
+ ;
+}
+
+/* { dg-final { scan-tree-dump "pragma omp target \[^\n\r)]*device\\(42\\)" "original" } } */
--- /dev/null
+/* { dg-do compile } */
+
+void
+foo (void)
+{
+ /* Ensure that a 'requires' directive with the 'reverse_offload' clause was
+ specified. */
+
+ #pragma omp target device (ancestor : 1) /* { dg-error "'ancestor' device modifier not preceded by 'requires' directive with 'reverse_offload' clause" } */
+ /* { dg-error "expected '\\)' before 'ancestor'" "" { target c } .-1 } */
+
+ ;
+}
--- /dev/null
+/* { dg-do compile } */
+
+#pragma omp requires reverse_offload /* { dg-message "sorry, unimplemented: 'reverse_offload' clause on 'requires' directive not supported yet" } */
+
+void
+foo (int n)
+{
+ /* The following test is marked with 'xfail' because a previous 'sorry' from
+ 'reverse_offload' suppresses the 'sorry' for 'ancestor'. */
+ #pragma omp target device (ancestor: 1) /* { dg-message "" "sorry, unimplemented: 'ancestor' not yet supported" { xfail *-*-* } } */
+ ;
+
+
+ /* Ensure that the integer expression in the 'device' clause for
+ device-modifier 'ancestor' evaluates to '1' in case of a constant. */
+
+ #pragma omp target device (ancestor : 1)
+ ;
+ #pragma omp target device (ancestor : 42) /* { dg-error "the 'device' clause expression must evaluate to '1'" } */
+ ;
+
+ #pragma omp target device (ancestor : n) /* { dg-message "" "sorry, unimplemented: 'ancestor' not yet supported" { xfail *-*-* } } */
+ ;
+ #pragma omp target device (ancestor : n + 1) /* { dg-message "" "sorry, unimplemented: 'ancestor' not yet supported" { xfail *-*-* } } */
+ ;
+
+
+ /* Ensure that only one 'device' clause appears on the construct. */
+
+ #pragma omp target device (17) device (42) /* { dg-error "too many 'device' clauses" } */
+ ;
+
+
+ /* Ensure that with 'ancestor' only the 'device', 'firstprivate', 'private',
+ 'defaultmap', and 'map' clauses appear on the construct. */
+
+ #pragma omp target nowait device (ancestor: 1) /* { dg-error "with 'ancestor', only the 'device', 'firstprivate', 'private', 'defaultmap', and 'map' clauses may appear on the construct" } */
+ ;
+ #pragma omp target device (ancestor: 1) nowait /* { dg-error "with 'ancestor', only the 'device', 'firstprivate', 'private', 'defaultmap', and 'map' clauses may appear on the construct" } */
+ ;
+ #pragma omp target nowait device (42)
+ ;
+ #pragma omp target nowait device (device_num: 42)
+ ;
+
+ int a = 0, b = 0, c = 0;
+ #pragma omp target device (ancestor: 1) firstprivate (a) private (b) defaultmap (none) map (c)
+ ;
+
+
+ /* Ensure that 'ancestor' is only used with 'target' constructs (not with
+ 'target data', 'target update' etc.). */
+
+ #pragma omp target data map (a) device (ancestor: 1) /* { dg-error "'device' clause with 'ancestor' is only allowed on 'target' construct" } */
+ ;
+ #pragma omp target enter data map (to: a) device (ancestor: 1) /* { dg-error "'device' clause with 'ancestor' is only allowed on 'target' construct" } */
+ #pragma omp target exit data map (from: a) device (ancestor: 1) /* { dg-error "'device' clause with 'ancestor' is only allowed on 'target' construct" } */
+ #pragma omp target update to (a) device (ancestor: 1) /* { dg-error "'device' clause with 'ancestor' is only allowed on 'target' construct" "" { target *-*-* } } */
+
+
+ /* Ensure that no OpenMP constructs appear inside target regions with
+ 'ancestor'. */
+
+ #pragma omp target device (ancestor: 1)
+ {
+ #pragma omp teams /* { dg-error "OpenMP constructs are not allowed in target region with 'ancestor'" } */
+ ;
+ }
+
+ #pragma omp target device (device_num: 1)
+ {
+ #pragma omp teams
+ ;
+ }
+
+ #pragma omp target device (1)
+ {
+ #pragma omp teams
+ ;
+ }
+
+}
--- /dev/null
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+int omp_get_num_teams (void);
+
+#ifdef __cplusplus
+}
+#endif
+
+/* { dg-do compile } */
+
+#pragma omp requires reverse_offload /* { dg-message "sorry, unimplemented: 'reverse_offload' clause on 'requires' directive not supported yet" } */
+
+void
+foo (void)
+{
+ /* Ensure that no calls to OpenMP API runtime routines are allowed inside the
+ corresponding target region. */
+
+ int a;
+
+ #pragma omp target device (ancestor: 1)
+ {
+ a = omp_get_num_teams (); /* { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_teams\[^\n\r]*' in a region with 'device\\(ancestor\\)' clause" } */
+ }
+
+ #pragma omp target device (device_num: 1)
+ {
+ a = omp_get_num_teams ();
+ }
+
+ #pragma omp target device (1)
+ {
+ a = omp_get_num_teams ();
+ }
+}
--- /dev/null
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+ /* Test to ensure that device-modifier 'ancestor' is parsed correctly in
+ device clauses. */
+
+#pragma omp requires reverse_offload /* { dg-message "sorry, unimplemented: 'reverse_offload' clause on 'requires' directive not supported yet" } */
+
+void
+foo (void)
+{
+ #pragma omp target device (ancestor: 1) /* { dg-message "" "sorry, unimplemented: 'ancestor' not yet supported" { xfail *-*-* } } */
+ ;
+
+}
+
+/* { dg-final { scan-tree-dump "pragma omp target \[^\n\r)]*device\\(ancestor:1\\)" "original" } } */
--- /dev/null
+! { dg-do compile }
+
+implicit none
+
+integer :: n
+
+!$omp target device (1)
+!$omp end target
+
+!$omp target device (n)
+!$omp end target
+
+!$omp target device (n + 1)
+!$omp end target
+
+!$omp target device (device_num : 1)
+!$omp end target
+
+!$omp target device (device_num : n)
+!$omp end target
+
+!$omp target device (device_num : n + 1)
+!$omp end target
+
+!$omp target device (invalid : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device ( : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device ( , : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (ancestor, device_num : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (ancestor, device_num, ancestor : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (device_num device_num : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (ancestor device_num : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (device_num, invalid : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (ancestor, invalid : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (ancestor, , , : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (invalid, ancestor : 1) ! { dg-error "xpected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (invalid, invalid, ancestor : 1) ! { dg-error "xpected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (device_num invalid : 1) ! { dg-error "Expected integer expression or a single device-modifier 'device_num' or 'ancestor' at" }
+! !$omp end target
+
+!$omp target device (device_num : n, n) ! { dg-error "Expected integer expression" }
+! !$omp end target
+
+end
--- /dev/null
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+! Test to ensure that device-modifier 'device_num' is parsed correctly in
+! device clauses.
+
+!$omp target device (device_num : 42)
+!$omp end target
+
+end
+
+! { dg-final { scan-tree-dump "pragma omp target \[^\n\r)]*device\\(42\\)" "original" } }
--- /dev/null
+! { dg-do compile }
+
+! Ensure that a 'requires' directive with the 'reverse_offload' clause was
+! specified.
+
+!$omp target device (ancestor:1) ! { dg-error "'ancestor' device modifier not preceded by 'requires' directive with 'reverse_offload' clause" }
+! !$omp end target
+
+end
\ No newline at end of file
--- /dev/null
+! { dg-do compile }
+
+implicit none
+
+integer :: a, b, c
+
+!$omp requires reverse_offload ! { dg-error "Sorry, 'reverse_offload' clause at \\(1\\) on REQUIRES directive is not yet supported" }
+
+
+! The following test case is marked with 'xfail' because a previous 'sorry' from
+! 'reverse_offload' suppresses the 'sorry' for 'ancestor'.
+
+!$omp target device (ancestor: 1) ! { dg-message "" "sorry, unimplemented: 'ancestor' not yet supported" { xfail *-*-* } }
+!$omp end target
+
+!$omp target device (ancestor : a) ! { dg-message "" "sorry, unimplemented: 'ancestor' not yet supported" { xfail *-*-* } }
+!$omp end target
+
+!$omp target device (ancestor : a + 1) ! { dg-message "" "sorry, unimplemented: 'ancestor' not yet supported" { xfail *-*-* } }
+!$omp end target
+
+
+! Ensure that the integer expression in the 'device' clause for
+! device-modifier 'ancestor' evaluates to '1' in case of a constant.
+
+!$omp target device (ancestor: 42) ! { dg-error "the 'device' clause expression must evaluate to '1'" }
+! !$omp end target
+
+!$omp target device (device_num:42)
+!$omp end target
+
+!$omp target device (42)
+!$omp end target
+
+
+! Ensure that no OpenMP constructs appear inside target regions with 'ancestor'.
+! The following test case is marked with 'xfail' because a previous 'sorry' from
+! 'reverse_offload' suppresses the 'sorry' for 'ancestor'.
+
+!$omp target device (ancestor: 1)
+ !$omp teams ! { dg-error "" "OpenMP constructs are not allowed in target region with 'ancestor'" { xfail *-*-* } }
+ !$omp end teams
+!$omp end target
+
+!$omp target device (device_num: 1)
+ !$omp teams
+ !$omp end teams
+!$omp end target
+
+!$omp target device (1)
+ !$omp teams
+ !$omp end teams
+!$omp end target
+
+
+! Ensure that with 'ancestor' only the 'device', 'firstprivate', 'private',
+! 'defaultmap', and 'map' clauses appear on the construct.
+! The following test case is marked with 'xfail' because a previous 'sorry' from
+! 'reverse_offload' suppresses the 'sorry' for 'ancestor'.
+
+!$omp target nowait device (ancestor: 1) ! { dg-error "" "with 'ancestor', only the 'device', 'firstprivate', 'private', 'defaultmap', and 'map' clauses may appear on the construct" { xfail *-*-* } }
+!$omp end target
+
+!$omp target device (ancestor: 1) nowait ! { dg-error "" "with 'ancestor', only the 'device', 'firstprivate', 'private', 'defaultmap', and 'map' clauses may appear on the construct" { xfail *-*-* } }
+!$omp end target
+
+!$omp target nowait device (device_num: 1)
+!$omp end target
+
+!$omp target nowait device (1)
+!$omp end target
+
+!$omp target device (ancestor: 1) firstprivate (a) private (b) defaultmap (none) map (c)
+!$omp end target
+
+
+! Ensure that 'ancestor' is only used with 'target' constructs (not with
+! 'target data', 'target update' etc.).
+! The following test case is marked with 'xfail' because a previous 'sorry' from
+! 'reverse_offload' suppresses the 'sorry' for 'ancestor'.
+
+!$omp target data map (a) device (ancestor: 1) ! { dg-error "" "'device' clause with 'ancestor' is only allowed on 'target' construct" { xfail *-*-* } }
+!$omp end target data
+
+!$omp target enter data map (to: a) device (ancestor: 1) ! { dg-error "" "'device' clause with 'ancestor' is only allowed on 'target' construct" { xfail *-*-* } }
+!$omp target exit data map (from: a) device (ancestor: 1) ! { dg-error "" "'device' clause with 'ancestor' is only allowed on 'target' construct" { xfail *-*-* } }
+
+!$omp target update to (a) device (ancestor: 1) ! { dg-error "'device' clause with 'ancestor' is only allowed on 'target' construct" "" { xfail *-*-* } }
+! { dg-error "with 'ancestor', only the 'device', 'firstprivate', 'private', 'defaultmap', and 'map' clauses may appear on the construct" "" { xfail *-*-* } .-1 }
+
+
+end
\ No newline at end of file
--- /dev/null
+! { dg-do compile }
+
+! This testcase ensure that no calls to OpenMP API runtime routines are allowed
+! inside the corresponding target region.
+
+module my_omp_mod
+ use iso_c_binding
+ interface
+ integer function omp_get_thread_num ()
+ end
+ end interface
+end
+
+subroutine f1 ()
+ use my_omp_mod
+ implicit none
+ integer :: n
+
+ !$omp requires reverse_offload ! { dg-error "Sorry, 'reverse_offload' clause at \\(1\\) on REQUIRES directive is not yet supported" }
+
+ !$omp target device (ancestor : 1)
+ n = omp_get_thread_num () ! { dg-error "" "OpenMP runtime API call 'omp_get_thread_num' in a region with 'device\\(ancestor\\)' clause" { xfail *-*-* } }
+ !$omp end target
+
+ !$omp target device (device_num : 1)
+ n = omp_get_thread_num ()
+ !$omp end target
+
+ !$omp target device (1)
+ n = omp_get_thread_num ()
+ !$omp end target
+
+end
\ No newline at end of file
--- /dev/null
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+! Test to ensure that device-modifier 'ancestor' is parsed correctly in
+! device clauses.
+
+!$omp requires reverse_offload ! { dg-error "Sorry, 'reverse_offload' clause at \\(1\\) on REQUIRES directive is not yet supported" }
+
+!$omp target device (ancestor : 1) ! { dg-message "" "sorry, unimplemented: 'ancestor' not yet supported" { xfail *-*-* } }
+!$omp end target
+
+end
+
+! { dg-final { scan-tree-dump "pragma omp target \[^\n\r)]*device\\(ancestor:1\\)" "original" } }
case OMP_CLAUSE_DEVICE:
pp_string (pp, "device(");
+ if (OMP_CLAUSE_DEVICE_ANCESTOR (clause))
+ pp_string (pp, "ancestor:");
dump_generic_node (pp, OMP_CLAUSE_DEVICE_ID (clause),
spc, flags, false);
pp_right_paren (pp);
#define OMP_CLAUSE_DEVICE_TYPE_KIND(NODE) \
(OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_DEVICE_TYPE)->omp_clause.subcode.device_type_kind)
+/* True if there is a device clause with a device-modifier 'ancestor'. */
+#define OMP_CLAUSE_DEVICE_ANCESTOR(NODE) \
+ (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_DEVICE)->base.public_flag)
+
#define OMP_CLAUSE_COLLAPSE_EXPR(NODE) \
OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_COLLAPSE), 0)
#define OMP_CLAUSE_COLLAPSE_ITERVAR(NODE) \
projects / thirdparty / gcc.git / commitdiff
