From: Tobias Burnus Date: Mon, 27 Jul 2026 17:27:50 +0000 (+0200) Subject: OpenMP: Fortran + ME - update for spatial dimensions + message clause X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=a0694cfb5b488dfeb65623444a14cab57e7df6bd;p=thirdparty%2Fgcc.git OpenMP: Fortran + ME - update for spatial dimensions + message clause Add 'message' + 'severity' clause to target, teams, and parallel. Translate those and handle strict/dims modifiers to num_teams, thread_limit and num_threads - the latter also permits multiple values without 'dims'. With this commit, the 'sorry, unimplemented' is moved from the Fortran front end to the middle end (omp-expand.cc). Note that parser support for C and C++ still has to be added. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_omp_clauses): Fix 'message' clause name. * openmp.cc (gfc_match_omp_clauses): Improve num_team's error diagnostic. (OMP_PARALLEL_CLAUSES, OMP_TARGET_CLAUSES, OMP_TEAMS_CLAUSES): Add OMP_CLAUSE_MESSAGE and OMP_CLAUSE_SEVERITY. * trans-openmp.cc (gfc_split_omp_clauses): Handle message/severity. (gfc_trans_omp_clauses): Likewise; replace 'sorry' by updated tree generation for num_teams, num_threads, thread_num clauses. gcc/ChangeLog: * gimplify.cc (gimplify_scan_omp_clauses): Handle also TREE_LIST for num_teams, num_threads, thread_num clauses. Add message clause to switch statement. * omp-expand.cc (expand_parallel_call, expand_teams_call, get_target_arguments): Handle, mostly with 'sorry, unimplemented', the 'dims' and 'strict' modifiers and the 'message' clause. * omp-low.cc (scan_sharing_clauses): Add message clause to switch. (lower_omp_teams): Handle TREE_LIST for num_threads + thread_num. * tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_MESSAGE. * tree-pretty-print.cc (dump_omp_clause): Handle 'message' clause, update num_teams, num_threads, thread_num clause printing. * tree.cc (omp_clause_num_ops, omp_clause_code_name): Update for message clause. * tree.h (OMP_CLAUSE_NUM_THREADS_STRICT, OMP_CLAUSE_THREAD_LIMIT_STRICT, OMP_CLAUSE_NUM_TEAMS_DIMS, OMP_CLAUSE_NUM_THREADS_DIMS, OMP_CLAUSE_THREAD_LIMIT_DIMS, OMP_CLAUSE_MESSAGE_EXPR, OMP_CLAUSE_MESSAGE_LEN, OMP_CLAUSE_MESSAGE_SEVERITY_WARN): New. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/spatial-dimensions-1.f90: Move to gimple dumps and extend tree-dump checking. * gfortran.dg/gomp/spatial-dimensions-2.f90: Remove sorry and check omplower and ompexp tree dumps. * gfortran.dg/gomp/spatial-dimensions-3.f90: Update dg-error. * gfortran.dg/gomp/spatial-dimensions-4.f90: New test. * gfortran.dg/gomp/spatial-dimensions-5.f90: New test. --- diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 3f1b35b715a..8d13acd8656 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -2456,7 +2456,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } if (omp_clauses->message) { - fputs (" ERROR (", dumpfile); + fputs (" MESSAGE (", dumpfile); show_expr (omp_clauses->message); fputc (')', dumpfile); } diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index d151aff8a45..3613dc8bd45 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -4135,6 +4135,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, goto error; } c->num_teams_dims = true; + continue; } else if (gfc_match ("%e ", &expr) == MATCH_YES) { @@ -4143,21 +4144,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if (gfc_peek_ascii_char () == ':') { expr = NULL; - if (gfc_match (": %e ", &expr) != MATCH_YES) - goto error; - c->num_teams_list->next = gfc_get_expr_list(); - c->num_teams_list->next->expr = expr; + if (gfc_match (": %e ", &expr) == MATCH_YES) + { + c->num_teams_list->next = gfc_get_expr_list(); + c->num_teams_list->next->expr = expr; + if (gfc_match (") ") == MATCH_YES) + continue; + } } - if (gfc_match (") ") != MATCH_YES) - goto error; + else if (gfc_match (") ") == MATCH_YES) + continue; } - else - { - gfc_error ("Expected either %<[lower-expr : ] upper-expr%> or " + gfc_error ("Expected either %<[lower-expr : ] upper-expr%> or " "% at %C"); - goto error; - } - continue; + goto error; } if ((mask & OMP_CLAUSE_NUM_THREADS) && (m = gfc_match_dupl_check (!c->num_threads_list, @@ -5534,7 +5534,8 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE) + | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE | OMP_CLAUSE_MESSAGE \ + | OMP_CLAUSE_SEVERITY) #define OMP_DECLARE_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \ | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \ @@ -5583,7 +5584,8 @@ cleanup: | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \ | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE \ | OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_USES_ALLOCATORS \ - | OMP_CLAUSE_DYN_GROUPPRIVATE | OMP_CLAUSE_DEVICE_TYPE) + | OMP_CLAUSE_DYN_GROUPPRIVATE | OMP_CLAUSE_DEVICE_TYPE \ + | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY) #define OMP_TARGET_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR) @@ -5599,7 +5601,8 @@ cleanup: #define OMP_TEAMS_CLAUSES \ (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) + | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE \ + | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \ diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 52b1554ac33..31a84d51f16 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -5640,6 +5640,35 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->message || clauses->severity != OMP_SEVERITY_UNSET) + { + tree message = NULL_TREE; + tree len = NULL_TREE; + + if (clauses->message) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->message); + gfc_add_block_to_block (block, &se.pre); + message = se.expr; + len = se.string_length; + if (!DECL_P (se.expr)) + message = gfc_evaluate_now (message, block); + gfc_add_block_to_block (block, &se.post); + + if (!POINTER_TYPE_P (TREE_TYPE (message))) + /* To ensure an ARRAY_TYPE is not passed as such. */ + message = gfc_build_addr_expr (NULL, message); + } + + c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_MESSAGE); + OMP_CLAUSE_MESSAGE_EXPR (c) = message; + OMP_CLAUSE_MESSAGE_LEN (c) = len; + if (clauses->severity == OMP_SEVERITY_WARNING) + OMP_CLAUSE_MESSAGE_SEVERITY_WARN (c) = 1; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); + } + if (clauses->novariants) { tree novariants_var; @@ -5672,29 +5701,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->num_threads_list) { - tree num_threads; - - if (clauses->num_threads_dims) - sorry_at (gfc_get_location (&clauses->num_threads_list->expr->where), - "% with % modifier"); - else if (clauses->num_threads_strict) - sorry_at (gfc_get_location (&clauses->num_threads_list->expr->where), - "% with % modifier"); - else if (clauses->num_threads_list->next) - { - gfc_expr *expr = clauses->num_threads_list->next->expr; - sorry_at (gfc_get_location (&expr->where), - "% with more than one argument"); - } - - gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->num_threads_list->expr); - gfc_add_block_to_block (block, &se.pre); - num_threads = gfc_evaluate_now (se.expr, block); - gfc_add_block_to_block (block, &se.post); - + tree num_threads = NULL_TREE; + for (gfc_expr_list *el = clauses->num_threads_list; el; el = el->next) + num_threads = tree_cons (NULL_TREE, + gfc_convert_expr_to_tree (block, el->expr), + num_threads); c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_THREADS); - OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads; + OMP_CLAUSE_NUM_THREADS_EXPR (c) = nreverse (num_threads); + OMP_CLAUSE_NUM_THREADS_STRICT (c) = clauses->num_threads_strict; + OMP_CLAUSE_NUM_THREADS_DIMS (c) = clauses->num_threads_dims; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -5995,32 +6010,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->num_teams_list) { - tree num_teams_lower = NULL_TREE, num_teams_upper; - - if (clauses->num_teams_dims) - sorry_at (gfc_get_location (&clauses->num_teams_list->expr->where), - "% with % modifier"); - - gfc_expr_list *el = clauses->num_teams_list; - if (el->next) - { - gfc_init_se (&se, NULL); - gfc_conv_expr (&se, el->expr); - gfc_add_block_to_block (block, &se.pre); - num_teams_lower = gfc_evaluate_now (se.expr, block); - gfc_add_block_to_block (block, &se.post); - el = el->next; - } - - gfc_init_se (&se, NULL); - gfc_conv_expr (&se, el->expr); - gfc_add_block_to_block (block, &se.pre); - num_teams_upper = gfc_evaluate_now (se.expr, block); - gfc_add_block_to_block (block, &se.post); - + tree num_teams = NULL_TREE; + for (gfc_expr_list *el = clauses->num_teams_list; el; el = el->next) + num_teams = tree_cons (NULL_TREE, + gfc_convert_expr_to_tree (block, el->expr), + num_teams); c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS); - OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = num_teams_lower; - OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams_upper; + OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = NULL_TREE; + OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = nreverse (num_teams); + OMP_CLAUSE_NUM_TEAMS_DIMS (c) = clauses->num_teams_dims; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -6045,22 +6043,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->thread_limit_list) { - tree thread_limit; - - if (clauses->thread_limit_dims) - sorry_at (gfc_get_location (&clauses->thread_limit_list->expr->where), - "% with % modifier"); - else if (clauses->thread_limit_strict) - sorry_at (gfc_get_location (&clauses->thread_limit_list->expr->where), - "% with % modifier"); - gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->thread_limit_list->expr); - gfc_add_block_to_block (block, &se.pre); - thread_limit = gfc_evaluate_now (se.expr, block); - gfc_add_block_to_block (block, &se.post); - + tree thread_limit = NULL_TREE; + for (gfc_expr_list *el = clauses->thread_limit_list; el; el = el->next) + thread_limit = tree_cons (NULL_TREE, + gfc_convert_expr_to_tree (block, el->expr), + thread_limit); c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREAD_LIMIT); - OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit; + OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = nreverse (thread_limit); + OMP_CLAUSE_THREAD_LIMIT_STRICT (c) = clauses->thread_limit_strict; + OMP_CLAUSE_THREAD_LIMIT_DIMS (c) = clauses->thread_limit_dims; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -8527,6 +8518,10 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->nowait; clausesa[GFC_OMP_SPLIT_TARGET].device_type = code->ext.omp_clauses->device_type; + clausesa[GFC_OMP_SPLIT_TARGET].message + = code->ext.omp_clauses->message; + clausesa[GFC_OMP_SPLIT_TARGET].severity + = code->ext.omp_clauses->severity; } if (mask & GFC_OMP_MASK_TEAMS) { @@ -8547,6 +8542,11 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing = code->ext.omp_clauses->default_sharing; + /* Message is used on target, teams, and parallel. */ + clausesa[GFC_OMP_SPLIT_TEAMS].message + = code->ext.omp_clauses->message; + clausesa[GFC_OMP_SPLIT_TEAMS].severity + = code->ext.omp_clauses->severity; } if (mask & GFC_OMP_MASK_DISTRIBUTE) { @@ -8589,6 +8589,10 @@ gfc_split_omp_clauses (gfc_code *code, /* And this is copied to all. */ clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr = code->ext.omp_clauses->if_expr; + clausesa[GFC_OMP_SPLIT_PARALLEL].message + = code->ext.omp_clauses->message; + clausesa[GFC_OMP_SPLIT_PARALLEL].severity + = code->ext.omp_clauses->severity; } if (mask & GFC_OMP_MASK_MASKED) clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter; diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index 223b55b7e93..ed637d2de46 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -14829,7 +14829,23 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, case OMP_CLAUSE_WORKER: case OMP_CLAUSE_VECTOR: if (OMP_CLAUSE_OPERAND (c, 0) - && !is_gimple_min_invariant (OMP_CLAUSE_OPERAND (c, 0))) + && TREE_CODE (OMP_CLAUSE_OPERAND (c, 0)) == TREE_LIST) + { + for (tree t = OMP_CLAUSE_OPERAND (c, 0); t; t = TREE_CHAIN (t)) + if (!is_gimple_min_invariant (TREE_VALUE (t))) + { + if (error_operand_p (TREE_VALUE (t))) + { + remove = true; + break; + } + TREE_VALUE (t) + = get_initialized_tmp_var (TREE_VALUE (t), pre_p, + NULL, true); + } + } + else if (OMP_CLAUSE_OPERAND (c, 0) + && !is_gimple_min_invariant (OMP_CLAUSE_OPERAND (c, 0))) { if (error_operand_p (OMP_CLAUSE_OPERAND (c, 0))) { @@ -14877,6 +14893,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, case OMP_CLAUSE_SEQ: case OMP_CLAUSE_INDEPENDENT: case OMP_CLAUSE_MERGEABLE: + case OMP_CLAUSE_MESSAGE: case OMP_CLAUSE_PROC_BIND: case OMP_CLAUSE_SAFELEN: case OMP_CLAUSE_SIMDLEN: @@ -16432,6 +16449,7 @@ end_adjust_omp_map_clause: case OMP_CLAUSE_EXCLUSIVE: case OMP_CLAUSE_USES_ALLOCATORS: case OMP_CLAUSE_DEVICE_TYPE: + case OMP_CLAUSE_MESSAGE: break; case OMP_CLAUSE_NOHOST: diff --git a/gcc/omp-expand.cc b/gcc/omp-expand.cc index 0d801e0d68a..d6c44ebdbe2 100644 --- a/gcc/omp-expand.cc +++ b/gcc/omp-expand.cc @@ -661,6 +661,25 @@ expand_parallel_call (struct omp_region *region, basic_block bb, { val = OMP_CLAUSE_NUM_THREADS_EXPR (c); clause_loc = OMP_CLAUSE_LOCATION (c); + if (TREE_CODE (val) == TREE_LIST) + { + if (OMP_CLAUSE_NUM_THREADS_DIMS (c) + && (TREE_CHAIN (val) || OMP_CLAUSE_NUM_THREADS_STRICT (c))) + /* Accept 'dim(1),relaxed'. */ + sorry_at (clause_loc, + "% clause with % modifier"); + else if (TREE_CHAIN (val)) + sorry_at (clause_loc, + "% clause with more than one argument"); + else if (OMP_CLAUSE_NUM_THREADS_STRICT (c)) + sorry_at (clause_loc, + "% clause with % modifier"); + val = TREE_VALUE (val); + } + else if (OMP_CLAUSE_NUM_THREADS_STRICT (c)) + sorry_at (clause_loc, + "% clause with % modifier"); + /* FIXME: Handle OMP_CLAUSE_MESSAGE (only relevant with 'strict'). */ } else clause_loc = gimple_location (entry_stmt); @@ -969,20 +988,54 @@ expand_teams_call (basic_block bb, gomp_teams *entry_stmt) { tree clauses = gimple_omp_teams_clauses (entry_stmt); tree num_teams = omp_find_clause (clauses, OMP_CLAUSE_NUM_TEAMS); + tree thread_limit = omp_find_clause (clauses, OMP_CLAUSE_THREAD_LIMIT); + tree message = omp_find_clause (clauses, OMP_CLAUSE_MESSAGE); + if (message + && ((thread_limit && OMP_CLAUSE_THREAD_LIMIT_STRICT (thread_limit)) + || (num_teams && (TREE_CODE (num_teams) != INTEGER_CST + || tree_int_cst_sgn (num_teams) < 0)))) + sorry_at (OMP_CLAUSE_LOCATION (message), "% clause"); if (num_teams == NULL_TREE) num_teams = build_int_cst (unsigned_type_node, 0); else { - num_teams = OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (num_teams); - num_teams = fold_convert (unsigned_type_node, num_teams); + tree expr = OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (num_teams); + /* FIXME: Implement lower-bound handling as well; however, currently, + on the host the use-specified value is always used. */ + if (TREE_CODE (expr) == TREE_LIST + && OMP_CLAUSE_NUM_TEAMS_DIMS (num_teams) + && TREE_CHAIN (expr)) + { + sorry_at (OMP_CLAUSE_LOCATION (num_teams), + "% clause with % modifier"); + expr = TREE_VALUE (expr); + } + else if (TREE_CODE (expr) == TREE_LIST) + expr = (TREE_CHAIN (expr) + ? TREE_VALUE (TREE_CHAIN (expr)) : TREE_VALUE (expr)); + num_teams = fold_convert (unsigned_type_node, expr); } - tree thread_limit = omp_find_clause (clauses, OMP_CLAUSE_THREAD_LIMIT); if (thread_limit == NULL_TREE) thread_limit = build_int_cst (unsigned_type_node, 0); else { - thread_limit = OMP_CLAUSE_THREAD_LIMIT_EXPR (thread_limit); - thread_limit = fold_convert (unsigned_type_node, thread_limit); + tree expr = OMP_CLAUSE_THREAD_LIMIT_EXPR (thread_limit); + if (TREE_CODE (expr) == TREE_LIST) + { + if (OMP_CLAUSE_THREAD_LIMIT_DIMS (thread_limit) + && (TREE_CHAIN (expr) + || OMP_CLAUSE_THREAD_LIMIT_STRICT (thread_limit))) + sorry_at (OMP_CLAUSE_LOCATION (thread_limit), + "% clause with % modifier"); + else if (OMP_CLAUSE_THREAD_LIMIT_STRICT (thread_limit)) + sorry_at (OMP_CLAUSE_LOCATION (thread_limit), + "% clause with % modifier"); + expr = TREE_VALUE (expr); + } + else if (OMP_CLAUSE_THREAD_LIMIT_STRICT (thread_limit)) + sorry_at (OMP_CLAUSE_LOCATION (thread_limit), + "% clause with % modifier"); + thread_limit = fold_convert (unsigned_type_node, expr); } gimple_stmt_iterator gsi = gsi_last_nondebug_bb (bb); @@ -1000,7 +1053,7 @@ expand_teams_call (basic_block bb, gomp_teams *entry_stmt) args->quick_push (t1); args->quick_push (num_teams); args->quick_push (thread_limit); - /* For future extensibility. */ + /* For future extensibility: flags. */ args->quick_push (build_zero_cst (unsigned_type_node)); t = build_call_expr_loc_vec (UNKNOWN_LOCATION, @@ -9935,22 +9988,64 @@ get_target_arguments (gimple_stmt_iterator *gsi, gomp_target *tgt_stmt) { auto_vec args; tree clauses = gimple_omp_target_clauses (tgt_stmt); - tree t, c = omp_find_clause (clauses, OMP_CLAUSE_NUM_TEAMS); - if (c) - t = OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c); + tree num_teams = omp_find_clause (clauses, OMP_CLAUSE_NUM_TEAMS); + tree thread_limit = omp_find_clause (clauses, OMP_CLAUSE_THREAD_LIMIT); + tree message = omp_find_clause (clauses, OMP_CLAUSE_MESSAGE); + if (message) + /* FIXME: error termination checking also requires to check + OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR not only UPPER, i.e. it + needs to be passed to the runtime! Note that both target and + a nested teams can have a 'message' clause - and both take a + thread_limit clause. */ + sorry_at (OMP_CLAUSE_LOCATION (message), "% clause"); + if (num_teams) + { + tree expr = OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (num_teams); + /* FIXME: Update omp-low.cc's lower_omp_teams when implementing. */ + if (TREE_CODE (expr) == TREE_LIST + && OMP_CLAUSE_NUM_TEAMS_DIMS (num_teams) + && TREE_CHAIN (expr)) + { + sorry_at (OMP_CLAUSE_LOCATION (num_teams), + "% clause with % modifier"); + num_teams = TREE_VALUE (expr); + } + else if (TREE_CODE (expr) == TREE_LIST) + num_teams = (TREE_CHAIN (expr) + ? TREE_VALUE (TREE_CHAIN (expr)) : TREE_VALUE (expr)); + else + num_teams = expr; + } else - t = integer_minus_one_node; + num_teams = integer_minus_one_node; push_target_argument_according_to_value (gsi, GOMP_TARGET_ARG_DEVICE_ALL, - GOMP_TARGET_ARG_NUM_TEAMS, t, &args); - - c = omp_find_clause (clauses, OMP_CLAUSE_THREAD_LIMIT); - if (c) - t = OMP_CLAUSE_THREAD_LIMIT_EXPR (c); + GOMP_TARGET_ARG_NUM_TEAMS, + num_teams, &args); + if (thread_limit) + { + tree expr = OMP_CLAUSE_THREAD_LIMIT_EXPR (thread_limit); + if (TREE_CODE (expr) == TREE_LIST) + { + if (OMP_CLAUSE_THREAD_LIMIT_DIMS (thread_limit) + && (TREE_CHAIN (expr) + || OMP_CLAUSE_THREAD_LIMIT_STRICT (thread_limit))) + sorry_at (OMP_CLAUSE_LOCATION (thread_limit), + "% clause with % modifier"); + else if (OMP_CLAUSE_THREAD_LIMIT_STRICT (thread_limit)) + sorry_at (OMP_CLAUSE_LOCATION (thread_limit), + "% clause with % modifier"); + expr = TREE_VALUE (expr); + } + else if (OMP_CLAUSE_THREAD_LIMIT_STRICT (thread_limit)) + sorry_at (OMP_CLAUSE_LOCATION (thread_limit), + "% clause with % modifier"); + thread_limit = expr; + } else - t = integer_minus_one_node; + thread_limit = integer_minus_one_node; push_target_argument_according_to_value (gsi, GOMP_TARGET_ARG_DEVICE_ALL, - GOMP_TARGET_ARG_THREAD_LIMIT, t, - &args); + GOMP_TARGET_ARG_THREAD_LIMIT, + thread_limit, &args); /* Produce more, perhaps device specific, arguments here. */ diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index 19ec304dc81..567f0f82f2c 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -1858,6 +1858,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) case OMP_CLAUSE_INIT: case OMP_CLAUSE_USE: case OMP_CLAUSE_DESTROY: + case OMP_CLAUSE_MESSAGE: break; case OMP_CLAUSE__CACHE_: @@ -2061,6 +2062,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) case OMP_CLAUSE_DESTROY: case OMP_CLAUSE_DEVICE_TYPE: case OMP_CLAUSE_USES_ALLOCATORS: + case OMP_CLAUSE_MESSAGE: break; case OMP_CLAUSE__CACHE_: @@ -15051,6 +15053,14 @@ lower_omp_teams (gimple_stmt_iterator *gsi_p, omp_context *ctx) fb_rvalue); } num_teams = OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (num_teams); + // FIXME: Handle dim(x), cf. omp-expand.cc's get_target_arguments. */ + if (TREE_CODE (num_teams) == TREE_LIST && TREE_CHAIN (num_teams)) + { + num_teams_lower = TREE_VALUE (num_teams); + num_teams = TREE_VALUE (TREE_CHAIN (num_teams)); + } + else if (TREE_CODE (num_teams) == TREE_LIST) + num_teams = TREE_VALUE (num_teams); num_teams = fold_convert (unsigned_type_node, num_teams); gimplify_expr (&num_teams, &bind_body, NULL, is_gimple_val, fb_rvalue); } @@ -15063,6 +15073,9 @@ lower_omp_teams (gimple_stmt_iterator *gsi_p, omp_context *ctx) else { thread_limit = OMP_CLAUSE_THREAD_LIMIT_EXPR (thread_limit); + // FIXME: Handle dim(x), cf. omp-expand.cc's get_target_arguments. */ + if (TREE_CODE (thread_limit) == TREE_LIST) + thread_limit = TREE_VALUE (thread_limit); thread_limit = fold_convert (unsigned_type_node, thread_limit); gimplify_expr (&thread_limit, &bind_body, NULL, is_gimple_val, fb_rvalue); diff --git a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-1.f90 b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-1.f90 index 94349180f5e..6e000cb49c4 100644 --- a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-1.f90 @@ -1,116 +1,181 @@ ! { dg-do compile } -! { dg-additional-options "-fdump-tree-original" } - -subroutine one_a -!$omp teams num_teams(dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } -!$omp& thread_limit ( dims ( 4 ) : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } -!$omp parallel num_threads(dims(3): 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +! { dg-additional-options "-O0 -fdump-tree-gimple -fdump-tree-omplower -fdump-tree-ompexp" } + +subroutine one_a(x) +implicit none +integer :: x +!$omp teams num_teams(dims(3) : 1,2,3) & +!$omp& thread_limit ( dims ( 4 ) : 1, 2, 3, 4) +! { dg-message "sorry, unimplemented: 'thread_limit' clause with 'dims' modifier" "" { target *-*-* } .-1 } +! { dg-message "sorry, unimplemented: 'num_teams' clause with 'dims' modifier" "" { target *-*-* } .-2 } +!$omp parallel num_threads(dims(3): 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' clause with 'dims' modifier" } + x = 1 !$omp end parallel !$omp end teams end -subroutine one_b -!$omp teams num_teams(dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } -!$omp& thread_limit ( dims ( 4 ) , relaxed : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } -!$omp parallel num_threads(dims(3) , relaxed : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +! As the error is printed in 'omp-expand.cc', it is shown only once and not for all of the following +! cases. This also affects omp-lower. Hence: +! { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_teams_reg " 1 "ompexp" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_parallel " 1 "ompexp" } } + +subroutine one_b(x) +implicit none +integer :: x +!$omp teams num_teams(dims(3) : 1,2,3) & +!$omp& thread_limit ( dims ( 4 ) , relaxed : 1, 2, 3, 4) +!$omp parallel num_threads(dims(3) , relaxed : 1,2,3) + x = 1 !$omp end parallel !$omp end teams end -subroutine one_c -!$omp teams num_teams(dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } -!$omp& thread_limit ( dims ( 4 ) , strict : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } -!$omp parallel num_threads(dims(3) , strict : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +subroutine one_c(x) +implicit none +integer :: x +!$omp teams num_teams(dims(3) : 11,22,33) & +!$omp& thread_limit ( dims ( 4 ) , strict : 11, 22, 33, 44) +!$omp parallel num_threads(dims(3) , strict : 11,22,33) + x = 1 !$omp end parallel !$omp end teams end -subroutine one_d -!$omp teams num_teams ( dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } -!$omp& thread_limit ( relaxed , dims ( 4 ) : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } -!$omp parallel num_threads( relaxed , dims(3) : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +subroutine one_d(x) +implicit none +integer :: x +!$omp teams num_teams ( dims(3) : 1,2,3) & +!$omp& thread_limit ( relaxed , dims ( 4 ) : 111, 222, 333, 444) +!$omp parallel num_threads( relaxed , dims(3) : 111,222,333) + x = 1 !$omp end parallel !$omp end teams end -subroutine one_e -!$omp teams num_teams ( dims(3) : 1,2,3) & ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } -!$omp& thread_limit ( strict , dims ( 4 ) : 1, 2, 3, 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'dims' modifier" } -!$omp parallel num_threads( strict , dims(3) : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'dims' modifier" } +subroutine one_e(x) +implicit none +integer :: x +!$omp teams num_teams ( dims(3) : 1,2,3) & +!$omp& thread_limit ( strict , dims ( 4 ) : 1111, 2222, 3333, 4444) +!$omp parallel num_threads( strict , dims(3) : 1111,2222,3333) + x = 1 !$omp end parallel !$omp end teams end -subroutine two -!$omp teams thread_limit (strict : 4) ! { dg-message "sorry, unimplemented: 'thread_limit' with 'strict' modifier" } -!$omp parallel num_threads(strict : 2) ! { dg-message "sorry, unimplemented: 'num_threads' with 'strict' modifier" } +subroutine two(x) +implicit none +integer :: x +!$omp teams thread_limit (strict : 4) +!$omp parallel num_threads(strict : 2) + x = 1 !$omp end parallel !$omp end teams end -subroutine zero -!$omp teams num_teams(1234) thread_limit ( 2345) ! OK -!$omp parallel num_threads( 3456) ! OK +subroutine zero(x) +implicit none +integer :: x +!$omp teams num_teams(1234) thread_limit ( 2345) ! OK - old code +!$omp parallel num_threads( 3456) ! OK - old code + x = 1 !$omp end parallel !$omp end teams !$omp teams num_teams(123:456) + x = 1 !$omp end teams end -subroutine three -!$omp teams num_teams(4567) thread_limit (relaxed : 5678) ! OK -!$omp parallel num_threads(relaxed : 6789) ! OK +subroutine three(x) +implicit none +integer :: x +!$omp teams num_teams(4567) thread_limit (relaxed : 5678) ! OK - old code + 'relaxed' +!$omp parallel num_threads(relaxed : 6789) ! OK - old code + 'relaxed' + x = 1 !$omp end parallel !$omp end teams end -subroutine four -!$omp parallel num_threads(1 , 2 , 3 ) ! { dg-message "sorry, unimplemented: 'num_threads' with more than one argument" } +subroutine four(x) +implicit none +integer :: x +!$omp parallel num_threads(1 , 2 , 3 ) + x = 1 !$omp end parallel end -subroutine five -!$omp parallel num_threads(relaxed : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with more than one argument" } +subroutine five(x) +implicit none +integer :: x +!$omp parallel num_threads(relaxed : 11,22,333) + x = 1 !$omp end parallel end -subroutine six -!$omp parallel num_threads(strict : 1,2,3) ! { dg-message "sorry, unimplemented: 'num_threads' with 'strict' modifier" } +subroutine six(x) +implicit none +integer :: x +!$omp parallel num_threads(strict : 111,222,333) + x = 1 !$omp end parallel end -subroutine seven +subroutine seven(x) +implicit none +integer :: x integer :: static, relaxed, dims(2) - !$omp teams num_teams(static) thread_limit (static) ! OK + !$omp teams num_teams(static) thread_limit (static) ! OK - old code (using variable name that looks like a modifier name) !$omp parallel num_threads(static) ! OK + x = 1 !$omp end parallel !$omp end teams !$omp teams num_teams(relaxed) thread_limit (relaxed) ! OK !$omp parallel num_threads(relaxed) ! OK + x = 1 !$omp end parallel !$omp end teams !$omp teams num_teams(dims(2)) thread_limit (dims(2)) ! OK !$omp parallel num_threads(dims(2)) ! OK + x = 1 !$omp end parallel !$omp end teams end subroutine -! Check that the tree is correctly generated: - -! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(1234\\) thread_limit\\(2345\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(3456\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(4567\\) thread_limit\\(5678\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(6789\\)" 1 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(123:456\\)" 1 "original" } } - -! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = static;" 3 "original" } } -! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = relaxed;" 3 "original" } } -! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = dims\\\[1\\\];" 3 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(D\\.\[0-9\]+\\) thread_limit\\(D\\.\[0-9\]+\\)" 3 "original" } } -! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(D\\.\[0-9\]+\\)" 3 "original" } } +! Check that the tree is correctly generated (gimple tree) + +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):1, 2, 3\\) thread_limit\\(strict,dims\\(\\):1, 2, 3, 4\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(strict,dims\\(\\):1, 2, 3\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):1, 2, 3\\) thread_limit\\(dims\\(\\):1, 2, 3, 4\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(dims\\(\\):1, 2, 3\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):11, 22, 33\\) thread_limit\\(strict,dims\\(\\):11, 22, 33, 44\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(strict,dims\\(\\):11, 22, 33\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):1, 2, 3\\) thread_limit\\(dims\\(\\):111, 222, 333, 444\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(dims\\(\\):111, 222, 333\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):1, 2, 3\\) thread_limit\\(strict,dims\\(\\):1111, 2222, 3333, 4444\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(strict,dims\\(\\):1111, 2222, 3333\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams thread_limit\\(strict:4\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(strict:2\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(1234\\) thread_limit\\(2345\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(3456\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(123, 456\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(4567\\) thread_limit\\(5678\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(6789\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(1, 2, 3\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(11, 22, 333\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(strict:111, 222, 333\\) shared\\(x\\)" 1 "gimple" } } + +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = static;" 3 "gimple" } } +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = relaxed;" 3 "gimple" } } +! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = dims\\\[1\\\];" 3 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(_\[0-9\]+\\) thread_limit\\(_\[0-9\]+\\) shared\\(static\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(_\[0-9\]+\\) thread_limit\\(_\[0-9\]+\\) shared\\(relaxed\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(_\[0-9\]+\\) thread_limit\\(_\[0-9\]+\\) shared\\(dims\\) shared\\(x\\)" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel num_threads\\(D\\.\[0-9\]+\\) shared\\(x\\)" 3 "gimple" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-2.f90 b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-2.f90 index db570df86f9..0bafa0610ab 100644 --- a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-2.f90 @@ -1,5 +1,5 @@ ! { dg-do compile } -! { dg-additional-options "-fdump-tree-original" } +! { dg-additional-options "-fdump-tree-omplower -fdump-tree-ompexp" } ! This testcase is ambigous in Fortran ! cf. OpenMP Spec Issues 4998 @@ -13,10 +13,12 @@ subroutine sub integer, parameter :: dims(2) = [11,22] !... - !$omp teams num_teams( dims(1) : 256 ) ! { dg-message "sorry, unimplemented: 'num_teams' with 'dims' modifier" } + !$omp teams num_teams( dims(1) : 256 ) !$omp end teams end -! ... hence: 'num_teams(256)' and not 'num_teams(11:256)' +! ... hence: 'num_teams(dims():256)' and not 'num_teams(11:256)' +! regarded as idenical to num_teams(256) (undimensional case) -! { dg-final { scan-tree-dump "#pragma omp teams num_teams\\(256\\)" "original" } } +! { dg-final { scan-tree-dump "#pragma omp teams num_teams\\(dims\\(\\):256\\)" "omplower" } } +! { dg-final { scan-tree-dump "__builtin_GOMP_teams_reg \\(sub_._omp_fn.0, 0B, 256, 0, 0\\);" "ompexp" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-3.f90 b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-3.f90 index 22b9f23f640..372924d55da 100644 --- a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-3.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-3.f90 @@ -90,22 +90,22 @@ subroutine three !$omp teams num_teams( ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } block; end block - !$omp teams num_teams( dims ! { dg-error "Failed to match clause" } + !$omp teams num_teams( dims ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list' at .1." } block; end block - !$omp teams num_teams( dims(1) ! { dg-error "Invalid character in name" } + !$omp teams num_teams( dims(1) ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } block; end block !$omp teams num_teams( dims(1) : ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } block; end block - !$omp teams num_teams( dims(1) : 1 ! { dg-error "Syntax error in OpenMP expression" } + !$omp teams num_teams( dims(1) : 1 ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } block; end block - !$omp teams num_teams( 5 : ! { dg-error "Invalid character in name" } + !$omp teams num_teams( 5 : ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } block; end block - !$omp teams num_teams( 5 : 5 ! { dg-error "Failed to match clause" } + !$omp teams num_teams( 5 : 5 ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list' at .1." } block; end block end @@ -168,7 +168,7 @@ subroutine five end subroutine six - !$omp teams num_teams (dims(1), dims(1) : 1) ! { dg-error "Invalid character in name" } + !$omp teams num_teams (dims(1), dims(1) : 1) ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } block; end block @@ -241,7 +241,7 @@ subroutine six end subroutine subroutine seven - !$omp teams num_teams (2,2) ! { dg-error "Failed to match clause" } + !$omp teams num_teams (2,2) ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list'" } block; end block !$omp teams thread_limit (2,2) ! { dg-error "Without the DIM modifier, only a single integer expression may be specified" } @@ -249,4 +249,10 @@ subroutine seven !$omp parallel num_threads (2,2) ! OK block; end block + + !$omp teams num_teams(39 ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list' at .1." } + block; end block + + !$omp teams num_teams(strict : 4 : 5 ) ! { dg-error "Expected either '\\\[lower-expr : \\\] upper-expr' or 'dims\\(N\\): expr-list' at .1." } + block; end block end diff --git a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-4.f90 b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-4.f90 new file mode 100644 index 00000000000..8f574740462 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-4.f90 @@ -0,0 +1,99 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-omplower -fdump-tree-ompexp" } + +! For ompexp, only check teams + parallel and not target (teams) + +! Note: The following tests code that produces identical code to 5.x +! even though OpenMP 6.0 features are used. Namely: +! - relaxed modifier +! - relaxed, dims(1) modiefiers +! - message clause with parallel and teams - if there is num_teams clause +! (For target (teams), there is an implicit 'num_teams'; to avoid +! complex sorry code, message + target (teams) is rejected.) + +subroutine sub(x) +implicit none +integer :: x, i + +!$omp target thread_limit(relaxed : 11) +block + x = 1 +end block +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-2\\) thread_limit\\(11\\) firstprivate\\(x\\) \\\[child fn" 1 "omplower" } } + +!$omp target parallel do simd thread_limit(relaxed, dims(1) : 22) +do i = 1, 1 + x = 1 +end do +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-2\\) thread_limit\\(dims\\(\\):22\\) map\\(tofrom:i \\\[len: 4\\\] \\\[runtime_implicit\\\]\\) firstprivate\\(x\\) \\\[child fn" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel lastprivate\\(i\\) shared\\(x\\) \\\[child fn" 1 "omplower" } } + +!$omp target teams thread_limit(relaxed : 31) num_teams(dims(1) : 33) +block + x = 1 +end block +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-1\\) thread_limit\\(31\\) firstprivate\\(x\\) \\\[child fn" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):33\\) thread_limit\\(31\\) shared\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_teams4 \\(33, 33, 31, D.\[0-9]+\\);" 1 "ompexp" } } + + +!$omp target teams distribute parallel do simd thread_limit(relaxed : 41) num_teams(dims(1) : 43) num_threads( dims ( 1 ) , relaxed : 44) +do i = 1, 1 + x = 1 +end do +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-1\\) thread_limit\\(41\\) map\\(tofrom:i \\\[len: 4\\\] \\\[runtime_implicit\\\]\\) firstprivate\\(x\\) \\\[child fn" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):43\\) thread_limit\\(41\\) shared\\(i\\) shared\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel _looptemp_\\(D.\[0-9\]+\\) _looptemp_\\(D.\[0-9\]+\\) num_threads\\(dims\\(\\):44\\) lastprivate\\(i\\) shared\\(x\\) \\\[child fn" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_parallel \\(sub_._omp_fn.\[0-9]+, &.omp_data_o.\[0-9]+, 44, 0\\);" 1 "ompexp" } } + +!$omp teams thread_limit(relaxed : 51) num_teams(dims(1) : 53) +block +end block +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):53\\) thread_limit\\(51\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_teams_reg \\(sub_._omp_fn.\[0-9\]+, 0B, 53, 51, 0\\);" 1 "ompexp" } } + +!$omp teams distribute parallel do simd thread_limit(relaxed : 61) num_teams(dims(1) : 63) num_threads(relaxed, dims(1) : 64) +do i = 1, 1 + x = 1 +end do +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):63\\) thread_limit\\(61\\) shared\\(i\\) shared\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel _looptemp_\\(D.\[0-9\]+\\) _looptemp_\\(D.\[0-9\]+\\) num_threads\\(dims\\(\\):64\\) lastprivate\\(i\\) shared\\(x\\) \\\[child fn" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_teams_reg \\(sub_._omp_fn.\[0-9\]+, &.omp_data_o.\[0-9\]+, 63, 61, 0\\);" 1 "ompexp" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_parallel \\(sub_._omp_fn.\[0-9\]+, &.omp_data_o.\[0-9\]+, 64, 0\\);" 1 "ompexp" } } + +!$omp parallel num_threads(relaxed, dims(1) : 77) message("my77") severity(fatal) +block + x = 1 +end block +! { dg-final { scan-tree-dump-times "#pragma omp parallel message\\(.my77. \\\[len:4\\\]\\)severity\\(fatal\\) num_threads\\(dims\\(\\):77\\) shared\\(x\\) \\\[child fn" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_parallel \\(sub_._omp_fn.\[0-9\]+, &.omp_data_o.\[0-9\]+, 77, 0\\);" 1 "ompexp" } } + + +!$omp parallel num_threads(relaxed : 88) message("my78") severity(warning) +block + x = 1 +end block +! { dg-final { scan-tree-dump-times "#pragma omp parallel message\\(.my78. \\\[len:4\\\]\\) severity\\(warning\\) num_threads\\(88\\) shared\\(x\\) \\\[child fn" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_parallel \\(sub_._omp_fn.\[0-9\]+, &.omp_data_o.\[0-9\]+, 88, 0\\);" 1 "ompexp" } } + +!$omp teams thread_limit(relaxed : 91) num_teams(1 : 93) +block + x = 1 +end block +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(1, 93\\) thread_limit\\(91\\) shared\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_teams_reg \\(sub_._omp_fn.\[0-9\]+, &.omp_data_o.\[0-9\]+, 93, 91, 0\\);" 1 "ompexp" } } + +!$omp target teams thread_limit(relaxed : 991) num_teams(191 : 993) +block + x = 1 +end block +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-1\\) thread_limit\\(991\\) firstprivate\\(x\\) \\\[child fn" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(191, 993\\) thread_limit\\(991\\) shared\\(x\\)" 1 "omplower" } } + +!$omp teams thread_limit(relaxed : 1231) message("my1234") severity(warning) +block +end block +! { dg-final { scan-tree-dump-times "#pragma omp teams message\\(.my1234. \\\[len:6\\\]\\) severity\\(warning\\) thread_limit\\(1231\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_teams_reg \\(sub_._omp_fn.\[0-9\]+, 0B, 0, 1231, 0\\);" 1 "ompexp" } } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-5.f90 b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-5.f90 new file mode 100644 index 00000000000..3ec3435ecd7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/spatial-dimensions-5.f90 @@ -0,0 +1,84 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-gimple" } + +subroutine sub(x) +implicit none +integer :: x, i + +!$omp target teams distribute parallel do num_teams(11 : 22) thread_limit(strict,dims(3) : 11,12,13) num_threads(relaxed: 23,45,53) message("first") severity(warning) +do i = 1,1 + x = 0 +end do +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-1\\) message\\(.first. \\\[len:5\\\]\\) severity\\(warning\\) thread_limit\\(strict,dims\\(\\):11, 12, 13\\) firstprivate\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(11, 22\\) thread_limit\\(strict,dims\\(\\):11, 12, 13\\) message\\(.first. \\\[len:5\\\]\\) severity\\(warning\\) shared\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel message\\(.first. \\\[len:5\\\]\\) severity\\(warning\\) num_threads\\(23, 45, 53\\) shared\\(x\\)" 1 "omplower" } } +end + +! { dg-message "sorry, unimplemented: 'num_threads' clause with more than one argument" "" { target *-*-* } 8 } +! { dg-message "sorry, unimplemented: 'message' clause" "" { target *-*-* } 8 } +! { dg-message "sorry, unimplemented: 'thread_limit' clause with 'dims' modifier" "" { target *-*-* } 8 } + + +subroutine sub2(x) +implicit none +integer :: x, i + +!$omp target teams distribute parallel do num_teams(dims(4): 111,222,333, 324) thread_limit(relaxed : 11) num_threads(strict: 445,553) message("second") severity(fatal) +do i = 1,1 + x = 0 +end do +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-1\\) message\\(.second. \\\[len:6\\\]\\)severity\\(fatal\\) thread_limit\\(11\\) firstprivate\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp teams num_teams\\(dims\\(\\):111, 222, 333, 324\\) thread_limit\\(11\\) message\\(.second. \\\[len:6\\\]\\)severity\\(fatal\\) shared\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel message\\(.second. \\\[len:6\\\]\\)severity\\(fatal\\) num_threads\\(strict:445, 553\\) shared\\(x\\)" 1 "omplower" } } + +!$omp teams distribute parallel do num_teams(11 : 55) thread_limit(strict : 11) num_threads(relaxed: 23,45,53) message("third") severity(warning) +do i = 1,1 + x = 0 +end do +! { dg-final { scan-tree-dump-times "#pragma omp teams message\\(.third. \\\[len:5\\\]\\) severity\\(warning\\) num_teams\\(11, 55\\) thread_limit\\(strict:11\\) shared\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel message\\(.third. \\\[len:5\\\]\\) severity\\(warning\\) num_threads\\(23, 45, 53\\) shared\\(x\\)" 1 "omplower" } } + +!$omp teams distribute parallel do num_teams(dims(2): 1111,33) thread_limit(dims(3) : 11,3,480) num_threads(strict, dims(2): 445,553) message("fourth") severity(fatal) +do i = 1,1 + x = 0 +end do +! { dg-final { scan-tree-dump-times "#pragma omp teams message\\(.fourth. \\\[len:5\\\]\\)severity\\(fatal\\) num_teams\\(dims\\(\\):1111, 33\\) thread_limit\\(strict,dims\\(\\):11, 3, 480\\) shared\\(x\\)" 1 "omplower" } } +! { dg-final { scan-tree-dump-times "#pragma omp parallel message\\(.fourth. \\\[len:5\\\]\\)severity\\(fatal\\) num_threads\\(strict,dims\\(\\):445, 553\\) shared\\(x\\)" 1 "omplower" } } + +!$omp target message("tgt1") severity(warning) thread_limit(strict : 1454) +block + x = 0 +end block +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-2\\) message\\(.tgt1. \\\[len:4\\\]\\) severity\\(warning\\) thread_limit\\(strict:1454\\) firstprivate\\(x\\)" 1 "omplower" } } + +!$omp target message("tgt2") severity(fatal) thread_limit(relaxed : 454) +block + x = 0 +end block +! { dg-final { scan-tree-dump-times "#pragma omp target num_teams\\(-2\\) message\\(.tgt2. \\\[len:4\\\]\\)severity\\(fatal\\) thread_limit\\(454\\) firstprivate\\(x\\)" 1 "omplower" } } + +!$omp teams num_teams(14 : 34) message("teams") severity(fatal) +block + x = 0 +end block +! { dg-final { scan-tree-dump-times "#pragma omp teams message\\(.teams. \\\[len:5\\\]\\)severity\\(fatal\\) num_teams\\(14, 34\\) shared\\(x\\)" 1 "omplower" } } + +!$omp teams thread_limit(relaxed, dims(2): 514 , 384) severity(warning) +block + x = 0 +end block +! { dg-final { scan-tree-dump-times "#pragma omp teams severity\\(warning\\) thread_limit\\(dims\\(\\):514, 384\\) shared\\(x\\)" 1 "omplower" } } + +!$omp parallel num_threads(relaxed, dims(2): 514 , 384) severity(warning) +block + x = 0 +end block +! { dg-final { scan-tree-dump-times "#pragma omp parallel severity\\(warning\\) num_threads\\(dims\\(\\):514, 384\\) shared\\(x\\)" 1 "omplower" } } + +!$omp parallel num_threads(strict: 847 , 3523, 53) message("parallel") +block + x = 0 +end block +! { dg-final { scan-tree-dump-times "#pragma omp parallel message\\(.parallel. \\\[len:8\\\]\\)severity\\(fatal\\) num_threads\\(strict:847, 3523, 53\\) shared\\(x\\)" 1 "omplower" } } + +end diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 918e077af1b..3ac0d56fc99 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -602,6 +602,13 @@ enum omp_clause_code { /* OpenMP clause: uses_allocators. */ OMP_CLAUSE_USES_ALLOCATORS, + + /* OpenMP clause: message (string-expr). + If the string expr is not null terminated, the length needs to be + stored in OMP_CLAUSE_MESSAGE_LEN. + Note that the 'severity' clause is handled as flag to 'message': + OMP_CLAUSE_MESSAGE_SEVERITY_WARN. */ + OMP_CLAUSE_MESSAGE }; #undef DEFTREESTRUCT diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc index b470a9dee7b..bd60e5c15c1 100644 --- a/gcc/tree-pretty-print.cc +++ b/gcc/tree-pretty-print.cc @@ -704,6 +704,16 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case OMP_CLAUSE_NUM_THREADS: pp_string (pp, "num_threads("); + if (OMP_CLAUSE_NUM_THREADS_STRICT (clause)) + pp_string (pp, "strict"); + if (OMP_CLAUSE_NUM_THREADS_STRICT (clause) + && OMP_CLAUSE_NUM_THREADS_DIMS (clause)) + pp_comma (pp); + if (OMP_CLAUSE_NUM_THREADS_DIMS (clause)) + pp_string (pp, "dims()"); + if (OMP_CLAUSE_NUM_THREADS_STRICT (clause) + || OMP_CLAUSE_NUM_THREADS_DIMS (clause)) + pp_colon (pp); dump_generic_node (pp, OMP_CLAUSE_NUM_THREADS_EXPR (clause), spc, flags, false); pp_right_paren (pp); @@ -820,6 +830,29 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) pp_string (pp, "mergeable"); break; + case OMP_CLAUSE_MESSAGE: + if (OMP_CLAUSE_MESSAGE_EXPR (clause)) + { + pp_string (pp, "message("); + dump_generic_node (pp, OMP_CLAUSE_MESSAGE_EXPR (clause), + spc, flags, false); + if (OMP_CLAUSE_MESSAGE_LEN (clause)) + { + pp_string (pp, " [len:"); + dump_generic_node (pp, OMP_CLAUSE_MESSAGE_LEN (clause), + spc, flags, false); + pp_right_bracket (pp); + } + pp_right_paren (pp); + if (OMP_CLAUSE_MESSAGE_SEVERITY_WARN (clause)) + pp_space (pp); + } + if (OMP_CLAUSE_MESSAGE_SEVERITY_WARN (clause)) + pp_string (pp, "severity(warning)"); + else + pp_string (pp, "severity(fatal)"); + break; + case OMP_CLAUSE_LINEAR: pp_string (pp, "linear("); if (OMP_CLAUSE_LINEAR_OLD_LINEAR_MODIFIER (clause)) @@ -1272,6 +1305,8 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case OMP_CLAUSE_NUM_TEAMS: pp_string (pp, "num_teams("); + if (OMP_CLAUSE_NUM_TEAMS_DIMS (clause)) + pp_string (pp, "dims():"); if (OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (clause)) { dump_generic_node (pp, OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (clause), @@ -1285,6 +1320,16 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case OMP_CLAUSE_THREAD_LIMIT: pp_string (pp, "thread_limit("); + if (OMP_CLAUSE_THREAD_LIMIT_STRICT (clause)) + pp_string (pp, "strict"); + if (OMP_CLAUSE_THREAD_LIMIT_STRICT (clause) + && OMP_CLAUSE_THREAD_LIMIT_DIMS (clause)) + pp_comma (pp); + if (OMP_CLAUSE_THREAD_LIMIT_DIMS (clause)) + pp_string (pp, "dims()"); + if (OMP_CLAUSE_THREAD_LIMIT_STRICT (clause) + || OMP_CLAUSE_THREAD_LIMIT_DIMS (clause)) + pp_colon (pp); dump_generic_node (pp, OMP_CLAUSE_THREAD_LIMIT_EXPR (clause), spc, flags, false); pp_right_paren (pp); diff --git a/gcc/tree.cc b/gcc/tree.cc index 977bdaa0845..b8006809322 100644 --- a/gcc/tree.cc +++ b/gcc/tree.cc @@ -400,6 +400,7 @@ unsigned const char omp_clause_num_ops[] = 1, /* OMP_CLAUSE_NOCONTEXT */ 1, /* OMP_CLAUSE_DYN_GROUPPRIVATE */ 3, /* OMP_CLAUSE_USES_ALLOCATORS */ + 2, /* OMP_CLAUSE_MESSAGE */ }; const char * const omp_clause_code_name[] = @@ -505,6 +506,7 @@ const char * const omp_clause_code_name[] = "nocontext", "dyn_groupprivate", "uses_allocators", + "message" }; /* Unless specific to OpenACC, we tend to internally maintain OpenMP-centric diff --git a/gcc/tree.h b/gcc/tree.h index d038d2afd33..1ccbf848d9b 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1864,6 +1864,16 @@ class auto_suppress_location_wrappers TREE_PRIVATE (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_GRAINSIZE)) #define OMP_CLAUSE_NUM_TASKS_STRICT(NODE) \ TREE_PRIVATE (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_TASKS)) +#define OMP_CLAUSE_NUM_THREADS_STRICT(NODE) \ + TREE_PRIVATE (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_THREADS)) +#define OMP_CLAUSE_THREAD_LIMIT_STRICT(NODE) \ + TREE_PRIVATE (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_THREAD_LIMIT)) +#define OMP_CLAUSE_NUM_TEAMS_DIMS(NODE) \ + TREE_PROTECTED (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_TEAMS)) +#define OMP_CLAUSE_NUM_THREADS_DIMS(NODE) \ + TREE_PROTECTED (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_NUM_THREADS)) +#define OMP_CLAUSE_THREAD_LIMIT_DIMS(NODE) \ + TREE_PROTECTED (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_THREAD_LIMIT)) /* OpenACC clause expressions */ #define OMP_CLAUSE_EXPR(NODE, CLAUSE) \ @@ -1909,6 +1919,17 @@ class auto_suppress_location_wrappers #define OMP_CLAUSE_DOACROSS_DEPEND(NODE) \ TREE_PROTECTED (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_DOACROSS)) +/* If the string passed to the 'message' clause is not null terminated, + OMP_CLAUSE_MESSAGE_LEN must be set. */ +#define OMP_CLAUSE_MESSAGE_EXPR(NODE) \ + OMP_CLAUSE_OPERAND ( \ + OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_MESSAGE), 0) +#define OMP_CLAUSE_MESSAGE_LEN(NODE) \ + OMP_CLAUSE_OPERAND ( \ + OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_MESSAGE), 1) +#define OMP_CLAUSE_MESSAGE_SEVERITY_WARN(NODE) \ + (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_MESSAGE)->base.public_flag) + #define OMP_CLAUSE_MAP_KIND(NODE) \ ((enum gomp_map_kind) OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_MAP)->omp_clause.subcode.map_kind) #define OMP_CLAUSE_SET_MAP_KIND(NODE, MAP_KIND) \