https://gcc.gnu.org/g:ed9c430bd0f50c340c317e641f79ab8bd182293b
commit ed9c430bd0f50c340c317e641f79ab8bd182293b Author: Tobias Burnus <[email protected]> Date: Mon Jun 22 11:04:41 2026 +0200 OpenMP/Fortran: Split-off check_omp_clauses_dupl_syms from resolve_omp_clauses Move all duplicate checks from resolve_omp_clauses to an extra function and call it; note that the check is based on n->sym such that the n->expr does not need to be resolved. gcc/fortran/ChangeLog: * openmp.cc (check_omp_clauses_dupl_syms): New; moved code from ... (resolve_omp_clauses): ... here. Call new function. Suggested-by: Julian Brown <[email protected]> (cherry picked from commit 2e41731c2e0e82fec8710827af716676cdd1eb5d) Diff: --- gcc/fortran/openmp.cc | 423 ++++++++++++++++++++++++++------------------------ 1 file changed, 224 insertions(+), 199 deletions(-) diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 6072fbe47eb9..2c0b5eb76b0b 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -9442,6 +9442,226 @@ resolve_omp_allocate_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } +/* Diagnose list items that appear multiple times in OpenMP or OpenACC clauses, + unless permitted by the specification. */ + +static void +check_omp_clauses_dupl_syms (gfc_code *code, gfc_omp_clauses *omp_clauses, + bool openacc) +{ + gfc_omp_namelist *n; + enum gfc_omp_list_type list; + + /* Check that no symbol appears on multiple clauses, except that + a symbol can appear on both firstprivate and lastprivate. */ + for (list = OMP_LIST_FIRST; list < OMP_LIST_NUM; + list = gfc_omp_list_type (list + 1)) + for (n = omp_clauses->lists[list]; n; n = n->next) + { + if (!n->sym) /* omp_all_memory. */ + continue; + n->sym->mark = 0; + n->sym->comp_mark = 0; + n->sym->data_mark = 0; + n->sym->dev_mark = 0; + n->sym->gen_mark = 0; + n->sym->reduc_mark = 0; + } + for (list = OMP_LIST_FIRST; list < OMP_LIST_NUM; + list = gfc_omp_list_type (list + 1)) + if (list != OMP_LIST_FIRSTPRIVATE + && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALIGNED + && list != OMP_LIST_DEPEND + && list != OMP_LIST_FROM + && list != OMP_LIST_TO + && list != OMP_LIST_INTEROP + && (list != OMP_LIST_REDUCTION || !openacc) + && list != OMP_LIST_ALLOCATE) + for (n = omp_clauses->lists[list]; n; n = n->next) + { + bool component_ref_p = false; + + /* Allow multiple components of the same (e.g. derived-type) + variable here. Duplicate components are detected elsewhere. */ + if (n->expr && n->expr->expr_type == EXPR_VARIABLE) + for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT) + component_ref_p = true; + if ((list == OMP_LIST_IS_DEVICE_PTR + || list == OMP_LIST_HAS_DEVICE_ADDR) + && !component_ref_p) + { + if (n->sym->gen_mark + || n->sym->dev_mark + || n->sym->reduc_mark + || n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->dev_mark = 1; + } + else if ((list == OMP_LIST_USE_DEVICE_PTR + || list == OMP_LIST_USE_DEVICE_ADDR + || list == OMP_LIST_PRIVATE + || list == OMP_LIST_SHARED) + && !component_ref_p) + { + if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + { + n->sym->gen_mark = 1; + /* Set both generic and device bits if we have + use_device_*(x) or shared(x). This allows us to diagnose + "map(x) private(x)" below. */ + if (list != OMP_LIST_PRIVATE) + n->sym->dev_mark = 1; + } + } + else if ((list == OMP_LIST_REDUCTION + || list == OMP_LIST_REDUCTION_TASK + || list == OMP_LIST_REDUCTION_INSCAN + || list == OMP_LIST_IN_REDUCTION + || list == OMP_LIST_TASK_REDUCTION) + && !component_ref_p) + { + /* Attempts to mix reduction types are diagnosed below. */ + if (n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + n->sym->reduc_mark = 1; + } + else if ((!component_ref_p && n->sym->comp_mark) + || (component_ref_p && n->sym->mark)) + { + if (openacc) + gfc_error ("Symbol %qs has mixed component and non-component " + "accesses at %L", n->sym->name, &n->where); + } + else if ((openacc || list != OMP_LIST_MAP) && n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + { + if (component_ref_p) + n->sym->comp_mark = 1; + else + n->sym->mark = 1; + } + } + + /* Detect specifically the case where we have "map(x) private(x)" and raise + an error. If we have "...simd" combined directives though, the "private" + applies to the simd part, so this is permitted though. */ + for (n = omp_clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next) + if (n->sym->mark + && n->sym->gen_mark + && !n->sym->dev_mark + && !n->sym->reduc_mark + && code->op != EXEC_OMP_TARGET_SIMD + && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + + gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1); + for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; + list = gfc_omp_list_type (list + 1)) + for (n = omp_clauses->lists[list]; n; n = n->next) + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + { + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + n->sym->data_mark = n->sym->gen_mark = n->sym->dev_mark = 0; + } + else if (n->sym->mark + && code->op != EXEC_OMP_TARGET_TEAMS + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE + && code->op != EXEC_OMP_TARGET_TEAMS_LOOP + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO + && code->op != EXEC_OMP_TARGET_PARALLEL + && code->op != EXEC_OMP_TARGET_PARALLEL_DO + && code->op != EXEC_OMP_TARGET_PARALLEL_LOOP + && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) + gfc_error ("Symbol %qs present on both data and map clauses " + "at %L", n->sym->name, &n->where); + + for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next) + { + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->data_mark = 1; + } + + /* LASTPRIVATE clauses. */ + for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) + n->sym->data_mark = 0; + for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) + { + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->data_mark = 1; + } + + /* ALIGNED clauses. */ + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + n->sym->mark = 0; + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->mark = 1; + } + + /* FROM and TO clauses. */ + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + n->sym->mark = 0; + for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next) + if (n->expr == NULL) + n->sym->mark = 1; + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + { + if (n->expr == NULL && n->sym->mark) + gfc_error ("Symbol %qs present on both FROM and TO clauses at %L", + n->sym->name, &n->where); + else + n->sym->mark = 1; + } + + /* OpenACC reductions. */ + if (openacc) + { + for (n = omp_clauses->lists[OMP_LIST_REDUCTION]; n; n = n->next) + n->sym->mark = 0; + for (n = omp_clauses->lists[OMP_LIST_REDUCTION]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->mark = 1; + + /* OpenACC does not support reductions on arrays. */ + if (n->sym->as) + gfc_error ("Array %qs is not permitted in reduction at %L", + n->sym->name, &n->where); + } + } +} + + /* OpenMP directive resolving routines. */ static void @@ -9472,6 +9692,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (ns == NULL) ns = gfc_current_ns; + check_omp_clauses_dupl_syms (code, omp_clauses, openacc); + if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse) gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L", &code->loc); @@ -9702,20 +9924,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer " "of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where); - /* Check that no symbol appears on multiple clauses, except that - a symbol can appear on both firstprivate and lastprivate. */ + /* Check that list items are variables. */ for (list = OMP_LIST_FIRST; list < OMP_LIST_NUM; list = gfc_omp_list_type (list + 1)) for (n = omp_clauses->lists[list]; n; n = n->next) { if (!n->sym) /* omp_all_memory. */ continue; - n->sym->mark = 0; - n->sym->comp_mark = 0; - n->sym->data_mark = 0; - n->sym->dev_mark = 0; - n->sym->gen_mark = 0; - n->sym->reduc_mark = 0; if (n->sym->attr.flavor == FL_VARIABLE || n->sym->attr.proc_pointer || (!code @@ -9778,6 +9993,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("Object %qs is not a variable at %L", n->sym->name, &n->where); } + if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]) { locus *loc = &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where; @@ -9797,91 +10013,6 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "REDUCTION clause at %L", loc); } - for (list = OMP_LIST_FIRST; list < OMP_LIST_NUM; - list = gfc_omp_list_type (list + 1)) - if (list != OMP_LIST_FIRSTPRIVATE - && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_ALIGNED - && list != OMP_LIST_DEPEND - && list != OMP_LIST_FROM - && list != OMP_LIST_TO - && list != OMP_LIST_INTEROP - && (list != OMP_LIST_REDUCTION || !openacc) - && list != OMP_LIST_ALLOCATE) - for (n = omp_clauses->lists[list]; n; n = n->next) - { - bool component_ref_p = false; - - /* Allow multiple components of the same (e.g. derived-type) - variable here. Duplicate components are detected elsewhere. */ - if (n->expr && n->expr->expr_type == EXPR_VARIABLE) - for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT) - component_ref_p = true; - if ((list == OMP_LIST_IS_DEVICE_PTR - || list == OMP_LIST_HAS_DEVICE_ADDR) - && !component_ref_p) - { - if (n->sym->gen_mark - || n->sym->dev_mark - || n->sym->reduc_mark - || n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->dev_mark = 1; - } - else if ((list == OMP_LIST_USE_DEVICE_PTR - || list == OMP_LIST_USE_DEVICE_ADDR - || list == OMP_LIST_PRIVATE - || list == OMP_LIST_SHARED) - && !component_ref_p) - { - if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - { - n->sym->gen_mark = 1; - /* Set both generic and device bits if we have - use_device_*(x) or shared(x). This allows us to diagnose - "map(x) private(x)" below. */ - if (list != OMP_LIST_PRIVATE) - n->sym->dev_mark = 1; - } - } - else if ((list == OMP_LIST_REDUCTION - || list == OMP_LIST_REDUCTION_TASK - || list == OMP_LIST_REDUCTION_INSCAN - || list == OMP_LIST_IN_REDUCTION - || list == OMP_LIST_TASK_REDUCTION) - && !component_ref_p) - { - /* Attempts to mix reduction types are diagnosed below. */ - if (n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - n->sym->reduc_mark = 1; - } - else if ((!component_ref_p && n->sym->comp_mark) - || (component_ref_p && n->sym->mark)) - { - if (openacc) - gfc_error ("Symbol %qs has mixed component and non-component " - "accesses at %L", n->sym->name, &n->where); - } - else if ((openacc || list != OMP_LIST_MAP) && n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - { - if (component_ref_p) - n->sym->comp_mark = 1; - else - n->sym->mark = 1; - } - } - if (code && code->op == EXEC_OMP_INTEROP && omp_clauses->lists[OMP_LIST_DEPEND]) @@ -9922,114 +10053,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->name, &n->where, clause_names[list]); } - /* Detect specifically the case where we have "map(x) private(x)" and raise - an error. If we have "...simd" combined directives though, the "private" - applies to the simd part, so this is permitted though. */ - for (n = omp_clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next) - if (n->sym->mark - && n->sym->gen_mark - && !n->sym->dev_mark - && !n->sym->reduc_mark - && code->op != EXEC_OMP_TARGET_SIMD - && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - - gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1); - for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; - list = gfc_omp_list_type (list + 1)) - for (n = omp_clauses->lists[list]; n; n = n->next) - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - { - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - n->sym->data_mark = n->sym->gen_mark = n->sym->dev_mark = 0; - } - else if (n->sym->mark - && code->op != EXEC_OMP_TARGET_TEAMS - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE - && code->op != EXEC_OMP_TARGET_TEAMS_LOOP - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO - && code->op != EXEC_OMP_TARGET_PARALLEL - && code->op != EXEC_OMP_TARGET_PARALLEL_DO - && code->op != EXEC_OMP_TARGET_PARALLEL_LOOP - && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) - gfc_error ("Symbol %qs present on both data and map clauses " - "at %L", n->sym->name, &n->where); - - for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next) - { - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->data_mark = 1; - } - for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) - n->sym->data_mark = 0; - - for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) - { - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->data_mark = 1; - } - - for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) - n->sym->mark = 0; - - for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) - { - if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->mark = 1; - } - resolve_omp_allocate_clauses (code, omp_clauses, ns); - /* OpenACC reductions. */ - if (openacc) - { - for (n = omp_clauses->lists[OMP_LIST_REDUCTION]; n; n = n->next) - n->sym->mark = 0; - - for (n = omp_clauses->lists[OMP_LIST_REDUCTION]; n; n = n->next) - { - if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->mark = 1; - - /* OpenACC does not support reductions on arrays. */ - if (n->sym->as) - gfc_error ("Array %qs is not permitted in reduction at %L", - n->sym->name, &n->where); - } - } - - for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) - n->sym->mark = 0; - for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next) - if (n->expr == NULL) - n->sym->mark = 1; - for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) - { - if (n->expr == NULL && n->sym->mark) - gfc_error ("Symbol %qs present on both FROM and TO clauses at %L", - n->sym->name, &n->where); - else - n->sym->mark = 1; - } - bool has_inscan = false, has_notinscan = false; for (enum gfc_omp_list_type list = OMP_LIST_FIRST; list < OMP_LIST_NUM; list = gfc_omp_list_type (list + 1))
