https://gcc.gnu.org/g:8bb7a53a0df5c5c6eb41ae689cba5e1a7b814875
commit r17-5077-g8bb7a53a0df5c5c6eb41ae689cba5e1a7b814875 Author: Tobias Burnus <[email protected]> Date: Mon Oct 12 08:29:37 2026 +0200 OpenMP/Fortran: Handle simdlen's 'scaled' modifier; for > / >= checks, enforce const check [PR127723] Follow up to commit r17-4947-gfbcafeec06a661 by adding support for Fortran. Namely, the OpenMP simdlen clause to 'simd' and 'declare simd' gained the 'scaled' modifier that accepts a numeric type and an optional divisor expression: simdlen( [ scaled(type-name [, divisor_expr ] ) : ] length_expr) where divisor_expr and length_expr must be >= 1 and constant. In the module handling, there was a preexisting bug that for module-file reading: mio_omp_declare_simd_clauses wrote the keyword "simdlen" to the module file - but did not read it; its caller for 'declare simd' read it but the caller for the 'declare variant' context selector didn't, leading to a read error when 'simdlen' appeared in declare-variant 'match' clause. As resolve_positive_int_expr/resolve_nonnegative_int_expr only warned when the violated the condition - and didn't enforce the constantness, a boolean argument was added such that either an error is printed when not constant or violating the > / >= 0 condition - or non-constant values are accepteded - with (only) a warning when constant and violating the the > / >= 0 condition. (The later matches the current behavior.) Hence, all callers had to be updated, which lead to testcase updates as well (for OpenMP and OpenACC). PR middle-end/127723 gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_clauses): Add simdlen_type and simdlen_divisor for simdlen. * module.cc (mio_omp_declare_simd_clauses): Handle scaled; consume "simdlen" token on reading. (mio_omp_declare_simd): Remove the latter. * openmp.cc (gfc_free_omp_clauses): Free simdlen_divisor. (gfc_match_omp_clauses): Parse 'scaled' modifier to 'simdlen'. (resolve_scalar_int_expr): Return boolean. (resolve_positive_int_expr, resolve_nonnegative_int_expr): Additional boolean WARN argument, if false, require constant argument and fail with an error. (resolve_oacc_loop_blocks): Update positive/nonnegative const argument checking. (resolve_omp_clauses): Likewise; handle simdlen_type/divisor. * trans-openmp.cc (gfc_trans_omp_clauses, gfc_split_omp_clauses): Handle simdlen clause's simdlen_type and simdlen_divisor. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/clauses-1.f90: Fix testcase: priority must be a constant expression. * gfortran.dg/gomp/masked-1.f90: Likewise. * gfortran.dg/gomp/target2.f90: Likewise. * gfortran.dg/gomp/taskloop-1.f90: Likewise. * gfortran.dg/gomp/taskloop-2.f90: Add diagnostic check for a non-const priority. * gfortran.dg/goacc/loop-2-kernels-tile.f95: Update dg-warn/error. * gfortran.dg/goacc/loop-2-parallel-tile.f95: Likewise. * gfortran.dg/goacc/loop-2-serial-tile.f95: Likewise. * gfortran.dg/goacc/tile-1.f90: Likewise. * gfortran.dg/gomp/atomic-18.f90: Likewise. * gfortran.dg/gomp/atomic-2.f90: Likewise. * gfortran.dg/gomp/pr67500.f90: Likewise. * gfortran.dg/gomp/pr77516.f90: Likewise. * gfortran.dg/gomp/tile-7.f90: Likewise. * gfortran.dg/gomp/simdlen-scaled-1.f90: New test. * gfortran.dg/gomp/simdlen-scaled-2.f90: New test. * gfortran.dg/gomp/simdlen-scaled-3.f90: New test. * gfortran.dg/gomp/simdlen-scaled-4.f90: New test. * gfortran.dg/gomp/simdlen-scaled-5-1.f90: New test. * gfortran.dg/gomp/simdlen-scaled-5-2.f90: New test. libgomp/ChangeLog: * testsuite/libgomp.fortran/nestedfn5.f90: Fix testcase: safelen must be constant. Diff: --- gcc/fortran/gfortran.h | 7 + gcc/fortran/module.cc | 26 ++- gcc/fortran/openmp.cc | 184 +++++++++++++++------ gcc/fortran/trans-openmp.cc | 44 ++--- .../gfortran.dg/goacc/loop-2-kernels-tile.f95 | 8 +- .../gfortran.dg/goacc/loop-2-parallel-tile.f95 | 8 +- .../gfortran.dg/goacc/loop-2-serial-tile.f95 | 8 +- gcc/testsuite/gfortran.dg/goacc/tile-1.f90 | 28 ++-- gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 | 3 +- gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 | 3 +- gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 | 15 +- gcc/testsuite/gfortran.dg/gomp/masked-1.f90 | 5 +- gcc/testsuite/gfortran.dg/gomp/pr67500.f90 | 8 +- gcc/testsuite/gfortran.dg/gomp/pr77516.f90 | 2 +- .../gfortran.dg/gomp/simdlen-scaled-1.f90 | 44 +++++ .../gfortran.dg/gomp/simdlen-scaled-2.f90 | 28 ++++ .../gfortran.dg/gomp/simdlen-scaled-3.f90 | 49 ++++++ .../gfortran.dg/gomp/simdlen-scaled-4.f90 | 75 +++++++++ .../gfortran.dg/gomp/simdlen-scaled-5-1.f90 | 75 +++++++++ .../gfortran.dg/gomp/simdlen-scaled-5-2.f90 | 40 +++++ gcc/testsuite/gfortran.dg/gomp/target2.f90 | 5 +- gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90 | 5 +- gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90 | 4 + gcc/testsuite/gfortran.dg/gomp/tile-7.f90 | 2 +- libgomp/testsuite/libgomp.fortran/nestedfn5.f90 | 6 +- 25 files changed, 560 insertions(+), 122 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index a1badd0bde8a..4e41133d5fcf 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1716,6 +1716,13 @@ typedef struct gfc_omp_clauses struct gfc_expr *chunk_size; struct gfc_expr *safelen_expr; struct gfc_expr *simdlen_expr; + struct + { + bt type; + int kind; + } + simdlen_type; + struct gfc_expr *simdlen_divisor; struct gfc_expr_list *num_teams_list; struct gfc_expr *device; struct gfc_expr_list *thread_limit_list; diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index 798e7d9ca1d2..ea86a091f699 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -4389,6 +4389,8 @@ static const mstring omp_declare_simd_clauses[] = minit ("UNIFORM", 3), minit ("LINEAR", 4), minit ("ALIGNED", 5), + minit ("SIMDLEN_TYP", 6), + minit ("SIMDLEN_DIV", 7), minit ("LINEAR_REF", 33), minit ("LINEAR_VAL", 34), minit ("LINEAR_UVAL", 35), @@ -4435,12 +4437,26 @@ mio_omp_declare_simd_clauses (gfc_omp_clauses **clausesp) mio_symbol_ref (&n->sym); mio_expr (&n->expr); } + if (clauses->simdlen_type.type != BT_UNKNOWN) + { + gfc_typespec ts = {}; + ts.type = clauses->simdlen_type.type; + ts.kind = clauses->simdlen_type.kind; + mio_name (6, omp_declare_simd_clauses); + mio_typespec (&ts); + if (clauses->simdlen_divisor) + { + mio_name (7, omp_declare_simd_clauses); + mio_expr (&clauses->simdlen_divisor); + } + } } else { if (peek_atom () != ATOM_NAME) return; + require_atom (ATOM_NAME); gfc_omp_namelist **ptrs[3] = { NULL, NULL, NULL }; gfc_omp_clauses *clauses = *clausesp = gfc_get_omp_clauses (); ptrs[0] = &clauses->lists[OMP_LIST_UNIFORM]; @@ -4468,6 +4484,15 @@ mio_omp_declare_simd_clauses (gfc_omp_clauses **clausesp) if (t != 3) mio_expr (&n->expr); break; + case 6: + { + gfc_typespec ts; + mio_typespec (&ts); + clauses->simdlen_type.type = ts.type; + clauses->simdlen_type.kind = ts.kind; + break; + } + case 7: mio_expr (&clauses->simdlen_divisor); break; case 33: case 34: case 35: @@ -4517,7 +4542,6 @@ mio_omp_declare_simd (gfc_namespace *ns, gfc_omp_declare_simd **odsp) return; } - require_atom (ATOM_NAME); *odsp = ods = gfc_get_omp_declare_simd (); ods->where = gfc_current_locus; ods->proc_name = ns->proc_name; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index a2c825401e30..0ed83519a643 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -202,6 +202,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->chunk_size); gfc_free_expr (c->safelen_expr); gfc_free_expr (c->simdlen_expr); + gfc_free_expr (c->simdlen_divisor); gfc_free_expr (c->device); gfc_free_expr (c->dyn_groupprivate); gfc_free_expr (c->dist_chunk_size); @@ -4833,11 +4834,55 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_SIMDLEN) - && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen", true, - &c->simdlen_expr)) != MATCH_NO) + && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen", + true)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; + if (gfc_match ("scaled ( ") == MATCH_YES) + { + old_loc = gfc_current_locus; + gfc_typespec ts; + /* This does not match 'type(integer)'; should it? */ + if (gfc_match_type_spec (&ts) != MATCH_YES + || (ts.type != BT_INTEGER && ts.type != BT_UNSIGNED + && ts.type != BT_REAL && ts.type != BT_COMPLEX)) + { + gfc_error ("Expected numerical type name at %L", + &old_loc); + goto error; + } + c->simdlen_type.type = ts.type; + c->simdlen_type.kind = ts.kind; + if (gfc_match (" , ") == MATCH_YES) + { + if (gfc_match_expr (&c->simdlen_divisor) != MATCH_YES) + { + gfc_error ("Expected divisor expression at %C"); + goto error; + } + } + if (gfc_match (" ) ") != MATCH_YES) + { + gfc_error ("Expected %<)%> at %C"); + goto error; + } + if (gfc_match (" : ") != MATCH_YES) + { + gfc_error ("Expected %<:%> at %C"); + goto error; + } + } + if (gfc_match_expr (&c->simdlen_expr) != MATCH_YES) + { + gfc_error ("Expected length expression at %C"); + goto error; + } + if (gfc_match (" ) ") != MATCH_YES) + { + gfc_error ("Expected %<)%> at %C"); + goto error; + } continue; } if ((mask & OMP_CLAUSE_SIMD) @@ -9423,38 +9468,64 @@ oacc_is_loop (gfc_code *code) || code->op == EXEC_OACC_LOOP; } -static void +static bool resolve_scalar_int_expr (gfc_expr *expr, const char *clause) { if (!gfc_resolve_expr (expr) || expr->ts.type != BT_INTEGER || expr->rank != 0) - gfc_error ("%s clause at %L requires a scalar INTEGER expression", - clause, &expr->where); + { + gfc_error ("%s clause at %L requires a scalar INTEGER expression", + clause, &expr->where); + return false; + } + return true; } +/* Require that EXPR is a scalar constant integer expression; it shall be a + positive number: If WARN is true, a warning is printed if constant and + not positive. If WARN is false, an error is printed if it is either not + constant or not positive. CLAUSE is used in the diagnostic output. */ + static void -resolve_positive_int_expr (gfc_expr *expr, const char *clause) +resolve_positive_int_expr (gfc_expr *expr, const char *clause, bool warn) { - resolve_scalar_int_expr (expr, clause); - if (expr->expr_type == EXPR_CONSTANT - && expr->ts.type == BT_INTEGER + if (!resolve_scalar_int_expr (expr, clause)) + return; + if (warn + && expr->expr_type == EXPR_CONSTANT && mpz_sgn (expr->value.integer) <= 0) gfc_warning ((flag_openmp || flag_openmp_simd) ? OPT_Wopenmp : 0, "INTEGER expression of %s clause at %L must be positive", clause, &expr->where); + else if (!warn + && (expr->expr_type != EXPR_CONSTANT + || mpz_sgn (expr->value.integer) <= 0)) + gfc_error ("INTEGER expression of %s clause at %L must be positive and " + "constant", clause, &expr->where); } +/* Require that EXPR is a scalar constant integer expression; it shall be a + nonnegative number: If WARN is true, a warning is printed if constant and + negative. If WARN is false, an error is printed if it is either not constant + or negative. CLAUSE is used in the diagnostic output. */ + static void -resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause) +resolve_nonnegative_int_expr (gfc_expr *expr, const char *clause, bool warn) { - resolve_scalar_int_expr (expr, clause); - if (expr->expr_type == EXPR_CONSTANT - && expr->ts.type == BT_INTEGER + if (!resolve_scalar_int_expr (expr, clause)) + return; + if (warn + && expr->expr_type == EXPR_CONSTANT && mpz_sgn (expr->value.integer) < 0) gfc_warning ((flag_openmp || flag_openmp_simd) ? OPT_Wopenmp : 0, "INTEGER expression of %s clause at %L must be non-negative", clause, &expr->where); + else if (!warn + && (expr->expr_type != EXPR_CONSTANT + || mpz_sgn (expr->value.integer) < 0)) + gfc_error ("INTEGER expression of %s clause at %L must be non-negtive and " + "constant", clause, &expr->where); } /* Emits error when symbol is pointer, cray pointer or cray pointee @@ -10868,11 +10939,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } for (el = omp_clauses->num_threads_list; el; el = el->next) - resolve_positive_int_expr (el->expr, "NUM_THREADS"); + resolve_positive_int_expr (el->expr, "NUM_THREADS", true); if (omp_clauses->dyn_groupprivate) resolve_nonnegative_int_expr (omp_clauses->dyn_groupprivate, - "DYN_GROUPPRIVATE"); + "DYN_GROUPPRIVATE", true); if (omp_clauses->chunk_size) { gfc_expr *expr = omp_clauses->chunk_size; @@ -11669,11 +11740,35 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } } if (omp_clauses->safelen_expr) - resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN"); + resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN", false); if (omp_clauses->simdlen_expr) - resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN"); + resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN", false); + if (omp_clauses->simdlen_divisor + && (!gfc_resolve_expr (omp_clauses->simdlen_divisor) + || omp_clauses->simdlen_divisor->ts.type != BT_INTEGER + || omp_clauses->simdlen_divisor->rank != 0 + || omp_clauses->simdlen_divisor->expr_type != EXPR_CONSTANT + || mpz_sgn (omp_clauses->simdlen_divisor->value.integer) <= 0)) + gfc_error ("Divisor expression at %L of the SCALED modifier to SIMDLEN must" + " be a positive scalar constant integer expression", + &omp_clauses->simdlen_divisor->where); + /* Check that safelen >= simdlen * scaled; however, scaled is + unknown, hence, assume scaled == 1 as conservative estimate. + we need to repeat some const check as the program still continues + after the error diagnostic above. */ + if (omp_clauses->safelen_expr && omp_clauses->simdlen_expr + + && omp_clauses->safelen_expr->expr_type == EXPR_CONSTANT + && omp_clauses->simdlen_expr->ts.type == BT_INTEGER + && omp_clauses->simdlen_expr->expr_type == EXPR_CONSTANT + && omp_clauses->simdlen_expr->ts.type == BT_INTEGER + && mpz_cmp (omp_clauses->safelen_expr->value.integer, + omp_clauses->simdlen_expr->value.integer) < 0) + gfc_error ("SIMDLEN at %L must be smaller or equal to SAFELEN at %L", + &omp_clauses->simdlen_expr->where, + &omp_clauses->safelen_expr->where); for (el = omp_clauses->num_teams_list; el; el = el->next) - resolve_positive_int_expr (el->expr, "NUM_TEAMS"); + resolve_positive_int_expr (el->expr, "NUM_TEAMS", true); if (omp_clauses->num_teams_list && omp_clauses->num_teams_list->next && !omp_clauses->num_teams_dims @@ -11687,18 +11782,19 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (omp_clauses->device) resolve_scalar_int_expr (omp_clauses->device, "DEVICE"); if (omp_clauses->filter) - resolve_nonnegative_int_expr (omp_clauses->filter, "FILTER"); + resolve_nonnegative_int_expr (omp_clauses->filter, "FILTER", true); if (omp_clauses->hint) { - resolve_scalar_int_expr (omp_clauses->hint, "HINT"); - if (omp_clauses->hint->ts.type != BT_INTEGER - || omp_clauses->hint->expr_type != EXPR_CONSTANT - || mpz_sgn (omp_clauses->hint->value.integer) < 0) + if (!gfc_resolve_expr (omp_clauses->hint) + || omp_clauses->hint->rank != 0 + || omp_clauses->hint->ts.type != BT_INTEGER + || omp_clauses->hint->expr_type != EXPR_CONSTANT + || mpz_sgn (omp_clauses->hint->value.integer) < 0) gfc_error ("Value of HINT clause at %L shall be a valid " "constant hint expression", &omp_clauses->hint->where); } if (omp_clauses->priority) - resolve_nonnegative_int_expr (omp_clauses->priority, "PRIORITY"); + resolve_nonnegative_int_expr (omp_clauses->priority, "PRIORITY", false); if (omp_clauses->dist_chunk_size) { gfc_expr *expr = omp_clauses->dist_chunk_size; @@ -11708,11 +11804,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "a scalar INTEGER expression", &expr->where); } for (el = omp_clauses->thread_limit_list; el; el = el->next) - resolve_positive_int_expr (el->expr, "THREAD_LIMIT"); + resolve_positive_int_expr (el->expr, "THREAD_LIMIT", true); if (omp_clauses->grainsize) - resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE"); + resolve_positive_int_expr (omp_clauses->grainsize, "GRAINSIZE", true); if (omp_clauses->num_tasks) - resolve_positive_int_expr (omp_clauses->num_tasks, "NUM_TASKS"); + resolve_positive_int_expr (omp_clauses->num_tasks, "NUM_TASKS", true); if (omp_clauses->grainsize && omp_clauses->num_tasks) gfc_error ("%<GRAINSIZE%> clause at %L must not be used together with " "%<NUM_TASKS%> clause", &omp_clauses->grainsize->where); @@ -11734,20 +11830,21 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("At least one of the clauses %<DEVICE_TYPE%> and %<DEVICE_NUM%> " "should be present in %<SET%> directive at %L", &code->loc); if (omp_clauses->num_gangs_expr) - resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS"); + resolve_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS", true); if (omp_clauses->num_workers_expr) - resolve_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS"); + resolve_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS", + true); if (omp_clauses->vector_length_expr) resolve_positive_int_expr (omp_clauses->vector_length_expr, - "VECTOR_LENGTH"); + "VECTOR_LENGTH", true); if (omp_clauses->gang_num_expr) - resolve_positive_int_expr (omp_clauses->gang_num_expr, "GANG"); + resolve_positive_int_expr (omp_clauses->gang_num_expr, "GANG", true); if (omp_clauses->gang_static_expr) - resolve_positive_int_expr (omp_clauses->gang_static_expr, "GANG"); + resolve_positive_int_expr (omp_clauses->gang_static_expr, "GANG", true); if (omp_clauses->worker_expr) - resolve_positive_int_expr (omp_clauses->worker_expr, "WORKER"); + resolve_positive_int_expr (omp_clauses->worker_expr, "WORKER", true); if (omp_clauses->vector_expr) - resolve_positive_int_expr (omp_clauses->vector_expr, "VECTOR"); + resolve_positive_int_expr (omp_clauses->vector_expr, "VECTOR", true); for (el = omp_clauses->wait_list; el; el = el->next) resolve_scalar_int_expr (el->expr, "WAIT"); if (omp_clauses->collapse && omp_clauses->tile_list) @@ -11785,17 +11882,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, { gfc_expr_list *el; for (el = omp_clauses->sizes_list; el; el = el->next) - { - resolve_scalar_int_expr (el->expr, "SIZES"); - if (el->expr->expr_type != EXPR_CONSTANT) - gfc_error ("SIZES requires constant expression at %L", - &el->expr->where); - else if (el->expr->expr_type == EXPR_CONSTANT - && el->expr->ts.type == BT_INTEGER - && mpz_sgn (el->expr->value.integer) <= 0) - gfc_error ("INTEGER expression of %s clause at %L must be " - "positive", "SIZES", &el->expr->where); - } + resolve_positive_int_expr (el->expr, "SIZES", false); } if (!openacc && omp_clauses->detach) @@ -14128,12 +14215,7 @@ resolve_oacc_loop_blocks (gfc_code *code) mpz_set_si (el->expr->value.integer, 0); } else - { - resolve_positive_int_expr (el->expr, "TILE"); - if (el->expr->expr_type != EXPR_CONSTANT) - gfc_error ("TILE requires constant expression at %L", - &code->loc); - } + resolve_positive_int_expr (el->expr, "TILE", false); } } } diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 3e4375f6d601..b6a9373ab51b 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -5985,27 +5985,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (clauses->simdlen_expr) { - if (declare_simd) - { - c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN); - OMP_CLAUSE_SIMDLEN_EXPR (c) - = gfc_conv_constant_to_tree (clauses->simdlen_expr); - omp_clauses = gfc_trans_add_clause (c, omp_clauses); - } - else - { - tree simdlen_var; - - gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->simdlen_expr); - gfc_add_block_to_block (block, &se.pre); - simdlen_var = gfc_evaluate_now (se.expr, block); - gfc_add_block_to_block (block, &se.post); + c = build_omp_clause (gfc_get_location (&clauses->simdlen_expr->where), + OMP_CLAUSE_SIMDLEN); + OMP_CLAUSE_SIMDLEN_EXPR (c) + = gfc_conv_constant_to_tree (clauses->simdlen_expr); + if (clauses->simdlen_type.type != BT_UNKNOWN) + { + gfc_typespec ts = {}; + ts.type = clauses->simdlen_type.type; + ts.kind = clauses->simdlen_type.kind; + OMP_CLAUSE_SIMDLEN_TYPE (c) + = gfc_typenode_for_spec (&ts, 0); + } + if (clauses->simdlen_divisor) + OMP_CLAUSE_SIMDLEN_DIVISOR (c) + = gfc_conv_constant_to_tree (clauses->simdlen_divisor); + omp_clauses = gfc_trans_add_clause (c, omp_clauses); - c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN); - OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var; - omp_clauses = gfc_trans_add_clause (c, omp_clauses); - } + if (declare_simd && OMP_CLAUSE_SIMDLEN_TYPE (c)) + /* By contrast, for 'simd', the sorry is in the middle end. */ + sorry_at (OMP_CLAUSE_LOCATION (c), + "%<simdlen%> clause with %<scaled%> modifier"); } if (clauses->num_teams_list) @@ -8706,6 +8706,10 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->safelen_expr; clausesa[GFC_OMP_SPLIT_SIMD].simdlen_expr = code->ext.omp_clauses->simdlen_expr; + clausesa[GFC_OMP_SPLIT_SIMD].simdlen_type + = code->ext.omp_clauses->simdlen_type; + clausesa[GFC_OMP_SPLIT_SIMD].simdlen_divisor + = code->ext.omp_clauses->simdlen_divisor; clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED] = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED]; /* Duplicate collapse. */ diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95 index afc8a278cacd..97ea857afa7f 100644 --- a/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-kernels-tile.f95 @@ -29,10 +29,10 @@ program test DO j = 1,10 ENDDO ENDDO - !$acc loop tile(-1) ! { dg-warning "must be positive" } + !$acc loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo - !$acc loop tile(i) ! { dg-error "constant expression" } + !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } @@ -82,10 +82,10 @@ program test DO j = 1,10 ENDDO ENDDO - !$acc kernels loop tile(-1) ! { dg-warning "must be positive" } + !$acc kernels loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo - !$acc kernels loop tile(i) ! { dg-error "constant expression" } + !$acc kernels loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo !$acc kernels loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95 index 4bfca748f75e..5039c2e7940d 100644 --- a/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-parallel-tile.f95 @@ -20,10 +20,10 @@ program test DO j = 1,10 ENDDO ENDDO - !$acc loop tile(-1) ! { dg-warning "must be positive" } + !$acc loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo - !$acc loop tile(i) ! { dg-error "constant expression" } + !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } @@ -73,10 +73,10 @@ program test DO j = 1,10 ENDDO ENDDO - !$acc parallel loop tile(-1) ! { dg-warning "must be positive" } + !$acc parallel loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo - !$acc parallel loop tile(i) ! { dg-error "constant expression" } + !$acc parallel loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo !$acc parallel loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95 index 79d8d1b9d477..25f200881c73 100644 --- a/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/loop-2-serial-tile.f95 @@ -20,10 +20,10 @@ program test DO j = 1,10 ENDDO ENDDO - !$acc loop tile(-1) ! { dg-warning "must be positive" } + !$acc loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo - !$acc loop tile(i) ! { dg-error "constant expression" } + !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } @@ -73,10 +73,10 @@ program test DO j = 1,10 ENDDO ENDDO - !$acc serial loop tile(-1) ! { dg-warning "must be positive" } + !$acc serial loop tile(-1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo - !$acc serial loop tile(i) ! { dg-error "constant expression" } + !$acc serial loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1,10 enddo !$acc serial loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } diff --git a/gcc/testsuite/gfortran.dg/goacc/tile-1.f90 b/gcc/testsuite/gfortran.dg/goacc/tile-1.f90 index f609b127df98..316ccccbd6cd 100644 --- a/gcc/testsuite/gfortran.dg/goacc/tile-1.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/tile-1.f90 @@ -44,17 +44,17 @@ subroutine parloop do i = 1, n end do - !$acc parallel loop tile(-3) ! { dg-warning "must be positive" } + !$acc parallel loop tile(-3) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n end do - !$acc parallel loop tile(10, -3) ! { dg-warning "must be positive" } + !$acc parallel loop tile(10, -3) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n do j = 1, n end do end do - !$acc parallel loop tile(-100, 10, 5) ! { dg-warning "must be positive" } + !$acc parallel loop tile(-100, 10, 5) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n do j = 1, n do k = 1, n @@ -68,13 +68,13 @@ subroutine parloop end do end do - !$acc parallel loop tile(1, a) ! { dg-error "constant expression" } + !$acc parallel loop tile(1, a) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n do j = 1, n end do end do - !$acc parallel loop tile(a, 1) ! { dg-error "constant expression" } + !$acc parallel loop tile(a, 1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n do j = 1, n end do @@ -114,11 +114,11 @@ subroutine par end do end do - !$acc loop tile(-2) ! { dg-warning "must be positive" } + !$acc loop tile(-2) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n end do - !$acc loop tile(i) ! { dg-error "constant expression" } + !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n end do @@ -195,11 +195,11 @@ subroutine kern end do end do - !$acc loop tile(-2) ! { dg-warning "must be positive" } + !$acc loop tile(-2) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n end do - !$acc loop tile(i) ! { dg-error "constant expression" } + !$acc loop tile(i) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n end do @@ -295,17 +295,17 @@ subroutine kernsloop do i = 1, n end do - !$acc kernels loop tile(-3) ! { dg-warning "must be positive" } + !$acc kernels loop tile(-3) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n end do - !$acc kernels loop tile(10, -3) ! { dg-warning "must be positive" } + !$acc kernels loop tile(10, -3) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n do j = 1, n end do end do - !$acc kernels loop tile(-100, 10, 5) ! { dg-warning "must be positive" } + !$acc kernels loop tile(-100, 10, 5) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n do j = 1, n do k = 1, n @@ -319,13 +319,13 @@ subroutine kernsloop end do end do - !$acc kernels loop tile(1, a) ! { dg-error "constant expression" } + !$acc kernels loop tile(1, a) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n do j = 1, n end do end do - !$acc kernels loop tile(a, 1) ! { dg-error "constant expression" } + !$acc kernels loop tile(a, 1) ! { dg-error "INTEGER expression of TILE clause at .1. must be positive and constant" } do i = 1, n do j = 1, n end do diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 index 6c8f44a1e9e2..301c7d995242 100644 --- a/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/atomic-18.f90 @@ -18,8 +18,7 @@ integer, value :: j !$omp atomic hint(j + 2) ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" } i = i + 1 !$omp atomic hint(f) - ! { dg-error "HINT clause at .1. requires a scalar INTEGER expression" "" { target *-*-* } .-1 } - ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-2 } + ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-1 } i = i + 1 !$omp atomic foobar ! { dg-error "Failed to match clause" } i = i + 1 diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 index b6c1b6a519e4..a77f407e84f6 100644 --- a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 @@ -4,8 +4,7 @@ subroutine bar integer :: i, v real :: f !$omp atomic update acq_rel hint("abc") - ! { dg-error "HINT clause at .1. requires a scalar INTEGER expression" "" { target *-*-* } .-1 } - ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-2 } + ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-1 } i = i + 1 !$omp end atomic diff --git a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 index 0c91ae5ff3ea..2fdfe7da887f 100644 --- a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 @@ -26,12 +26,13 @@ module m contains -subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd, ntm) +subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, q, dd, ntm) !$omp declare target (foo) - integer :: d, m, p, idp, s, nte, tl, nth, g, nta, pp, q, dd, ntm + integer :: d, m, p, idp, s, nte, tl, nth, g, nta, q, dd, ntm logical :: i1, i2, i3, fi pointer :: q integer :: i + integer, parameter :: pp = 3 !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & @@ -73,11 +74,12 @@ subroutine qux (p) end do end -subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd, ntm) - integer :: d, m, p, idp, s, nte, tl, nth, g, nta, pp, q, dd, ntm +subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, q, dd, ntm) + integer :: d, m, p, idp, s, nte, tl, nth, g, nta, q, dd, ntm logical :: i1, i2, i3, fi pointer :: q integer :: i + integer, parameter :: pp = 3 !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & @@ -132,11 +134,12 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd end do end -subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd, ntm) - integer :: d, m, p, idp, s, nte, tl, nth, g, nta, pp, q, dd(0:5), ntm +subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, q, dd, ntm) + integer :: d, m, p, idp, s, nte, tl, nth, g, nta, q, dd(0:5), ntm logical :: i1, i2, i3, fi pointer :: q integer :: i + integer, parameter :: pp = 3 !$omp do simd & !$omp& private (p) firstprivate (f) lastprivate (l) linear (ll:1) reduction(+:r) schedule(static, 4) collapse(1) & diff --git a/gcc/testsuite/gfortran.dg/gomp/masked-1.f90 b/gcc/testsuite/gfortran.dg/gomp/masked-1.f90 index 2b2526ac7127..1502e8724af4 100644 --- a/gcc/testsuite/gfortran.dg/gomp/masked-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/masked-1.f90 @@ -42,13 +42,14 @@ subroutine foo (x, a) !$omp end masked end -subroutine foobar (d, f, fi, p, s, g, i1, i2, l, ll, nth, ntm, pp, q, r, r2) +subroutine foobar (d, f, fi, p, s, g, i1, i2, l, ll, nth, ntm, q, r, r2) implicit none (type, external) logical :: i1, i2, fi - integer :: i, d, f, p, s, g, l, ll, nth, ntm, pp, q, r, r2 + integer :: i, d, f, p, s, g, l, ll, nth, ntm, q, r, r2 allocatable :: q integer, save :: t !$omp threadprivate (t) + integer, parameter :: pp = 3 !$omp parallel masked & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) & diff --git a/gcc/testsuite/gfortran.dg/gomp/pr67500.f90 b/gcc/testsuite/gfortran.dg/gomp/pr67500.f90 index 1cecdc485781..f1526f0a9034 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr67500.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr67500.f90 @@ -10,11 +10,11 @@ subroutine f2 end subroutine f3 (i) - !$omp declare simd simdlen(-2) ! { dg-warning "INTEGER expression of SIMDLEN clause at .1. must be positive" } + !$omp declare simd simdlen(-2) ! { dg-error "INTEGER expression of SIMDLEN clause at .1. must be positive and constant" } end subroutine subroutine f4 - !$omp declare simd simdlen(0) ! { dg-warning "INTEGER expression of SIMDLEN clause at .1. must be positive" } + !$omp declare simd simdlen(0) ! { dg-error "INTEGER expression of SIMDLEN clause at .1. must be positive and constant" } end subroutine foo(p, d, n) @@ -31,11 +31,11 @@ subroutine foo(p, d, n) do i = 1, 16 end do - !$omp simd safelen(-2) ! { dg-warning "INTEGER expression of SAFELEN clause at .1. must be positive" } + !$omp simd safelen(-2) ! { dg-error "INTEGER expression of SAFELEN clause at .1. must be positive and constant" } do i = 1, 16 end do - !$omp simd safelen(0) ! { dg-warning "INTEGER expression of SAFELEN clause at .1. must be positive" } + !$omp simd safelen(0) ! { dg-error "INTEGER expression of SAFELEN clause at .1. must be positive and constant" } do i = 1, 16 end do diff --git a/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 b/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 index 9c0a95b9f79a..0c3259797e0a 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr77516.f90 @@ -4,7 +4,7 @@ program pr77516 integer :: i, x x = 0 -!$omp simd safelen(0) reduction(+:x) ! { dg-warning "must be positive" } +!$omp simd safelen(0) reduction(+:x) ! { dg-error "INTEGER expression of SAFELEN clause at .1. must be positive and constant" } do i = 1, 8 x = x + 1 end do diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-1.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-1.f90 new file mode 100644 index 000000000000..b5dd987d11a6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-1.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-gimple -w -funsigned" } + +! PR middle-end/127723 + +module m + implicit none +contains + subroutine g1(a) + integer :: a + !$omp declare simd simdlen(scaled(integer, 1): 1) +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 } + end + + subroutine g1a(a) + integer :: a + !$omp declare simd simdlen(scaled(integer ( kind = 4 ), 4): 4) +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 } + end + + subroutine g2(a) + integer :: a + !$omp declare simd simdlen(scaled(double precision, 2): 2) +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 } + end + + subroutine g3(a) + integer :: a + !$omp declare simd simdlen(scaled(complex(8)): 4) +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 } + end + + subroutine g4 (a) + integer :: a + !$omp declare simd simdlen(scaled(unsigned(2)): 4) +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } .-1 } + end +end + +! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),1\\):1\\)\\)\\)\\)" "gimple" } } +! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),4\\):4\\)\\)\\)\\)" "gimple" } } +! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(real\\(kind=8\\),2\\):2\\)\\)\\)\\)" "gimple" } } +! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(complex\\(kind=8\\)\\):4\\)\\)\\)\\)" "gimple" } } +! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare simd \\(simdlen\\(scaled\\(unsigned\\(kind=2\\)\\):4\\)\\)\\)\\)" "gimple" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-2.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-2.f90 new file mode 100644 index 000000000000..4bcfff454725 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-2.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original -w" } + +! PR middle-end/127723 + +subroutine f(n, a, d) + integer :: i, n, a(*) + real :: d(*) + + !$omp simd simdlen(scaled(integer,1): 1) ! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" } + do i = 1, 1 + a(i) = a(i) + 5 + end do + + !$omp simd simdlen(scaled(integer(8)): 2) ! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" } + do i = 1, 1 + a(i) = a(i) + 5 + end do + + !$omp simd simdlen(scaled(complex(4), 4): 8) ! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" } + do i = 1, 1 + d(i) = 0.0 + end do +end + +! { dg-final { scan-tree-dump "#pragma omp simd linear\\(i:1\\) simdlen\\(scaled\\(integer\\(kind=4\\),1\\):1\\)" "original" } } +! { dg-final { scan-tree-dump "#pragma omp simd linear\\(i:1\\) simdlen\\(scaled\\(integer\\(kind=8\\)\\):2\\)" "original" } } +! { dg-final { scan-tree-dump "#pragma omp simd linear\\(i:1\\) simdlen\\(scaled\\(complex\\(kind=4\\),4\\):8\\)" "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-3.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-3.f90 new file mode 100644 index 000000000000..363376147d6c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-3.f90 @@ -0,0 +1,49 @@ +! { dg-do compile } + +! PR middle-end/127723 + +module m + implicit none + type t + end type t +contains +subroutine f (n, a, d) + integer :: i, n, a(*) + real :: d(*) + + !$omp simd simdlen(scaled(integer,1)) ! { dg-error "Expected '\\:' at .1." } + do i = 1, 1 + a(i) = a(i) + 5 + end do + + !$omp simd simdlen(scaled(integer + 3): 2) ! { dg-error "Expected '\\)' at .1." } + do i = 1, 1 + a(i) = a(i) + 5 + end do + + !$omp simd simdlen(scaled(4): 8) ! { dg-error "Expected numerical type name at .1." } + do i = 1, 1 + d(i) = 0.0 + end do + + !$omp simd simdlen(scaled(type(t)): 8) ! { dg-error "Expected numerical type name at .1." } + do i = 1, 1 + d(i) = 0.0 + end do + + !$omp simd simdlen(scaled(real, n): 8) ! { dg-error "Divisor expression at .1. of the SCALED modifier to SIMDLEN must be a positive scalar constant integer expression" } + do i = 1, 1 + d(i) = 0.0 + end do + + !$omp simd simdlen(scaled(complex, 0): 8) ! { dg-error "Divisor expression at .1. of the SCALED modifier to SIMDLEN must be a positive scalar constant integer expression" } + do i = 1, 1 + d(i) = 0.0 + end do + + !$omp simd simdlen(scaled(complex, 1, 0): 8) ! { dg-error "Expected '\\)' at .1." } + do i = 1, 1 + d(i) = 0.0 + end do +end +end diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-4.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-4.f90 new file mode 100644 index 000000000000..55d4d7257f29 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-4.f90 @@ -0,0 +1,75 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-gimple -w" } + +! PR middle-end/127723 + +module m + implicit none + interface + subroutine fvarInt3(x); integer, value :: x; end + subroutine fvarInt2(x); integer, value :: x; end + subroutine fvarInt0(x); integer, value :: x; end + subroutine fvar0(x); integer, value :: x; end + end interface +contains +subroutine fbase (x) + integer, value :: x + !$omp declare_variant(fvarInt3) match(construct={parallel,simd(simdlen(scaled(integer,2): 8))}) + !$omp declare_variant(fvarInt2) match(construct={simd(simdlen(scaled(integer,2): 8))}) + !$omp declare_variant(fvarInt0) match(construct={simd(simdlen(scaled(integer): 8))}) + !$omp declare_variant(fvar0) match(construct={simd(simdlen(4))}) +end +end + +subroutine f() + use m + implicit none + integer :: i + + !$omp simd simdlen(scaled(integer,2): 8) + do i = 1, 1 + call fbase (1); ! -> fvarInt2 + end do + + !$omp parallel + block + !$omp simd simdlen(scaled(integer,2): 8) + do i = 1, 1 + call fbase (11); ! -> fvarInt2 + end do + end block + + + !$omp simd simdlen(scaled(integer): 8) + do i = 1, 1 + call fbase (2); ! -> fvarInt0 + end do + + !$omp simd simdlen(4) + do i = 1, 1 + call fbase (3); ! -> fvar0 + end do + + !$omp simd simdlen(8) + do i = 1, 1 + call fbase (4); ! -> fbase + end do +end subroutine + +! Once implemented remove ... +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 17 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 18 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 19 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 29 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 36 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 43 } + +! ... and the following XFAIL should work ... (it fails because the clause is removed) +! { dg-final { scan-tree-dump-times "fvarint2 \\(1\\);" 1 "gimple" { xfail *-*-* } } } +! { dg-final { scan-tree-dump-times "fvarint3 \\(11\\);" 1 "gimple" { xfail *-*-* } } } +! { dg-final { scan-tree-dump-times "fvarint0 \\(2\\);" 1 "gimple" { xfail *-*-* } } } + +! { dg-final { scan-tree-dump-times "fvar0 \\(3\\);" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "fbase \\(4\\);" 1 "gimple" } } + +! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare variant base \\(fvar0 match construct = {simd \\(simdlen\\(4\\)\\)}\\), omp declare variant base \\(fvarint0 match construct = {simd \\(simdlen\\(scaled\\(integer\\(kind=4\\)\\):8\\)\\)}\\), omp declare variant base \\(fvarint2 match construct = {simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),2\\):8\\)\\)}\\), omp declare variant base \\(fvarint3 match construct = {parallel, simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),2\\):8\\)\\)}\\)\\)\\)" "gimple" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-1.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-1.f90 new file mode 100644 index 000000000000..55d4d7257f29 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-1.f90 @@ -0,0 +1,75 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-gimple -w" } + +! PR middle-end/127723 + +module m + implicit none + interface + subroutine fvarInt3(x); integer, value :: x; end + subroutine fvarInt2(x); integer, value :: x; end + subroutine fvarInt0(x); integer, value :: x; end + subroutine fvar0(x); integer, value :: x; end + end interface +contains +subroutine fbase (x) + integer, value :: x + !$omp declare_variant(fvarInt3) match(construct={parallel,simd(simdlen(scaled(integer,2): 8))}) + !$omp declare_variant(fvarInt2) match(construct={simd(simdlen(scaled(integer,2): 8))}) + !$omp declare_variant(fvarInt0) match(construct={simd(simdlen(scaled(integer): 8))}) + !$omp declare_variant(fvar0) match(construct={simd(simdlen(4))}) +end +end + +subroutine f() + use m + implicit none + integer :: i + + !$omp simd simdlen(scaled(integer,2): 8) + do i = 1, 1 + call fbase (1); ! -> fvarInt2 + end do + + !$omp parallel + block + !$omp simd simdlen(scaled(integer,2): 8) + do i = 1, 1 + call fbase (11); ! -> fvarInt2 + end do + end block + + + !$omp simd simdlen(scaled(integer): 8) + do i = 1, 1 + call fbase (2); ! -> fvarInt0 + end do + + !$omp simd simdlen(4) + do i = 1, 1 + call fbase (3); ! -> fvar0 + end do + + !$omp simd simdlen(8) + do i = 1, 1 + call fbase (4); ! -> fbase + end do +end subroutine + +! Once implemented remove ... +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 17 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 18 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 19 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 29 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 36 } +! { dg-message "sorry, unimplemented: 'simdlen' clause with 'scaled' modifier" "" { target *-*-* } 43 } + +! ... and the following XFAIL should work ... (it fails because the clause is removed) +! { dg-final { scan-tree-dump-times "fvarint2 \\(1\\);" 1 "gimple" { xfail *-*-* } } } +! { dg-final { scan-tree-dump-times "fvarint3 \\(11\\);" 1 "gimple" { xfail *-*-* } } } +! { dg-final { scan-tree-dump-times "fvarint0 \\(2\\);" 1 "gimple" { xfail *-*-* } } } + +! { dg-final { scan-tree-dump-times "fvar0 \\(3\\);" 1 "gimple" } } +! { dg-final { scan-tree-dump-times "fbase \\(4\\);" 1 "gimple" } } + +! { dg-final { scan-tree-dump "__attribute__\\(\\(omp declare variant base \\(fvar0 match construct = {simd \\(simdlen\\(4\\)\\)}\\), omp declare variant base \\(fvarint0 match construct = {simd \\(simdlen\\(scaled\\(integer\\(kind=4\\)\\):8\\)\\)}\\), omp declare variant base \\(fvarint2 match construct = {simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),2\\):8\\)\\)}\\), omp declare variant base \\(fvarint3 match construct = {parallel, simd \\(simdlen\\(scaled\\(integer\\(kind=4\\),2\\):8\\)\\)}\\)\\)\\)" "gimple" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-2.f90 b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-2.f90 new file mode 100644 index 000000000000..a3e108825384 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/simdlen-scaled-5-2.f90 @@ -0,0 +1,40 @@ +! { dg-do compile { target skip-all-targets } } + +! Used via simdlen-scaled-5-1.f90 + +! PR middle-end/127723 + +subroutine f() + use m + implicit none + integer :: i + + !$omp simd simdlen(scaled(integer,2): 8) + do i = 1, 1 + call fbase (1); ! -> fvarInt2 + end do + + !$omp parallel + block + !$omp simd simdlen(scaled(integer,2): 8) + do i = 1, 1 + call fbase (11); ! -> fvarInt2 + end do + end block + + + !$omp simd simdlen(scaled(integer): 8) + do i = 1, 1 + call fbase (2); ! -> fvarInt0 + end do + + !$omp simd simdlen(4) + do i = 1, 1 + call fbase (3); ! -> fvar0 + end do + + !$omp simd simdlen(8) + do i = 1, 1 + call fbase (4); ! -> fbase + end do +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/target2.f90 b/gcc/testsuite/gfortran.dg/gomp/target2.f90 index dfe0ec3aefac..1a4cc350cc58 100644 --- a/gcc/testsuite/gfortran.dg/gomp/target2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/target2.f90 @@ -1,8 +1,9 @@ ! { dg-do compile } ! { dg-additional-options "-ffree-line-length-160" } -subroutine foo (n, s, t, u, v, w) - integer :: n, i, s, t, u, v, w +subroutine foo (n, t, u, v, w) + integer :: n, i, t, u, v, w + integer, parameter :: s = 4 common /bar/ i !$omp simd safelen(s + 1) do i = 1, n diff --git a/gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90 b/gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90 index 46901712a246..e3fef34b219d 100644 --- a/gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/taskloop-1.f90 @@ -7,13 +7,14 @@ module m !$omp declare target to(f, l, ll, r, r2) end module m -subroutine foo(fi, p, pp, g, s, nta, nth, ntm, i1, i2, i3, q) +subroutine foo(fi, p, g, s, nta, nth, ntm, i1, i2, i3, q) use m implicit none - integer, value :: p, pp, g, s, nta, nth, ntm + integer, value :: p, g, s, nta, nth, ntm logical, value :: fi, i1, i2, i3 integer, pointer :: q(:) integer :: i + integer, parameter :: pp = 3 !$omp taskgroup task_reduction(+:r2) !allocate (r2) !$omp taskloop simd & diff --git a/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90 b/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90 index 15ddea8e69d4..6a81295d5468 100644 --- a/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/taskloop-2.f90 @@ -41,6 +41,10 @@ end do !$omp parallel master taskloop simd reduction(inscan, +: r) ! { dg-error "'inscan' REDUCTION clause on construct other than DO, SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD" } do i = 1, 64 ! { dg-error "OMP SCAN between two structured block sequences" "" { target *-*-* } .-1 } end do + +!$omp parallel master taskloop reduction(+: r) priority(r) ! { dg-error "INTEGER expression of PRIORITY clause at .1. must be non-negtive and constant" } +do i = 1, 64 +end do end diff --git a/gcc/testsuite/gfortran.dg/gomp/tile-7.f90 b/gcc/testsuite/gfortran.dg/gomp/tile-7.f90 index 58559331c5f1..2e35e891c571 100644 --- a/gcc/testsuite/gfortran.dg/gomp/tile-7.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/tile-7.f90 @@ -14,7 +14,7 @@ subroutine test end do !$omp end tile - !$omp tile sizes(i) ! { dg-error "SIZES requires constant expression" } + !$omp tile sizes(i) ! { dg-error "INTEGER expression of SIZES clause at .1. must be positive and constant" } do i = 1,100 call dummy(i) end do diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 index 28c9b00da67f..63210966a2fc 100644 --- a/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 +++ b/libgomp/testsuite/libgomp.fortran/nestedfn5.f90 @@ -11,7 +11,7 @@ end subroutine bar (q) use iso_c_binding, only: c_ptr, c_loc, c_int - integer :: a, b, c, d(2:3,4:5), q(19:), h, k, m, n, o, p + integer :: a, b, c, d(2:3,4:5), q(19:), h, m, o, p integer(c_int), target :: e(64) type (c_ptr) :: f, g(64) logical :: l @@ -80,9 +80,10 @@ contains c = 100 h = 8 m = 0 - n = 64 o = 16 if (l) stop 6 + block + integer, parameter :: n = 64 !$omp target teams distribute parallel do simd if (.not.l) device(a) & !$omp & num_teams(b) dist_schedule(static, c) num_threads (h) & !$omp & reduction (+: m) safelen (n) schedule(static, o) & @@ -91,6 +92,7 @@ contains m = m + 1 end do !$omp end target teams distribute parallel do simd + end block if (m /= 64) stop 7 !$omp end target data end subroutine foo
