}
+/* Resolve the OpenMP ALLOCATE clauses. */
+
+static void
+resolve_omp_allocate_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
+ gfc_namespace *ns)
+{
+ gfc_omp_namelist *n;
+ enum gfc_omp_list_type list;
+
+ if (!omp_clauses->lists[OMP_LIST_ALLOCATE])
+ return;
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ {
+ if (n->u2.allocator
+ && (!gfc_resolve_expr (n->u2.allocator)
+ || n->u2.allocator->ts.type != BT_INTEGER
+ || n->u2.allocator->rank != 0
+ || n->u2.allocator->ts.kind != gfc_c_intptr_kind))
+ {
+ gfc_error ("Expected integer expression of the "
+ "%<omp_allocator_handle_kind%> kind at %L",
+ &n->u2.allocator->where);
+ break;
+ }
+ if (!n->u.align)
+ continue;
+ HOST_WIDE_INT alignment = 0;
+ if (!gfc_resolve_expr (n->u.align)
+ || n->u.align->ts.type != BT_INTEGER
+ || n->u.align->rank != 0
+ || n->u.align->expr_type != EXPR_CONSTANT
+ || gfc_extract_hwi (n->u.align, &alignment)
+ || alignment <= 0
+ || !pow2p_hwi (alignment))
+ {
+ gfc_error ("ALIGN requires a scalar positive constant integer "
+ "alignment expression at %L that is a power of two",
+ &n->u.align->where);
+ break;
+ }
+ }
+
+ /* Check for 2 things here.
+ 1. There is no duplication of variable in allocate clause.
+ 2. Variable in allocate clause are also present in some
+ privatization clase (non-composite case). */
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ if (n->sym)
+ n->sym->mark = 0;
+
+ gfc_omp_namelist *prev = NULL;
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; )
+ {
+ if (n->sym == NULL)
+ {
+ n = n->next;
+ continue;
+ }
+ if (n->sym->mark == 1)
+ {
+ gfc_warning (OPT_Wopenmp, "%qs appears more than once in "
+ "%<allocate%> at %L" , n->sym->name, &n->where);
+ /* We have already seen this variable so it is a duplicate.
+ Remove it. */
+ if (prev != NULL && prev->next == n)
+ {
+ prev->next = n->next;
+ n->next = NULL;
+ gfc_free_omp_namelist (n, OMP_LIST_ALLOCATE);
+ n = prev->next;
+ }
+ continue;
+ }
+ n->sym->mark = 1;
+ prev = n;
+ n = n->next;
+ }
+
+ /* Non-composite constructs. */
+ if (code && code->op < EXEC_OMP_DO_SIMD)
+ {
+ for (list = OMP_LIST_FIRST; list < OMP_LIST_NUM;
+ list = gfc_omp_list_type (list + 1))
+ switch (list)
+ {
+ case OMP_LIST_PRIVATE:
+ case OMP_LIST_FIRSTPRIVATE:
+ case OMP_LIST_LASTPRIVATE:
+ case OMP_LIST_REDUCTION:
+ case OMP_LIST_REDUCTION_INSCAN:
+ case OMP_LIST_REDUCTION_TASK:
+ case OMP_LIST_IN_REDUCTION:
+ case OMP_LIST_TASK_REDUCTION:
+ case OMP_LIST_LINEAR:
+ for (n = omp_clauses->lists[list]; n; n = n->next)
+ n->sym->mark = 0;
+ break;
+ default:
+ break;
+ }
+
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ if (n->sym->mark == 1)
+ gfc_error ("%qs specified in %<allocate%> clause at %L but not "
+ "in an explicit privatization clause",
+ n->sym->name, &n->where);
+ }
+ if (!(code
+ && (code->op == EXEC_OMP_ALLOCATORS || code->op == EXEC_OMP_ALLOCATE)
+ && code->block
+ && code->block->next
+ && code->block->next->op == EXEC_ALLOCATE))
+ return;
+
+ if (code->op == EXEC_OMP_ALLOCATE)
+ gfc_warning (OPT_Wdeprecated_openmp,
+ "The use of one or more %<allocate%> directives with "
+ "an associated %<allocate%> statement at %L is "
+ "deprecated since OpenMP 5.2, use an %<allocators%> "
+ "directive", &code->loc);
+ gfc_alloc *a;
+ gfc_omp_namelist *n_null = NULL;
+ bool missing_allocator = false;
+ gfc_symbol *missing_allocator_sym = NULL;
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ {
+ if (n->u2.allocator == NULL)
+ {
+ if (!missing_allocator_sym)
+ missing_allocator_sym = n->sym;
+ missing_allocator = true;
+ }
+ if (n->sym == NULL)
+ {
+ n_null = n;
+ continue;
+ }
+ if (n->sym->attr.codimension)
+ gfc_error ("Unexpected coarray %qs in %<allocate%> at %L",
+ n->sym->name, &n->where);
+ for (a = code->block->next->ext.alloc.list; a; a = a->next)
+ if (a->expr->expr_type == EXPR_VARIABLE
+ && a->expr->symtree->n.sym == n->sym)
+ {
+ gfc_ref *ref;
+ for (ref = a->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_COMPONENT)
+ break;
+ if (ref == NULL)
+ break;
+ }
+ if (a == NULL)
+ gfc_error ("%qs specified in %<allocate%> at %L but not "
+ "in the associated ALLOCATE statement",
+ n->sym->name, &n->where);
+ }
+ /* If there is an ALLOCATE directive without list argument, a
+ namelist with its allocator/align clauses and n->sym = NULL is
+ created during parsing; here, we add all not otherwise specified
+ items from the Fortran allocate to that list.
+ For an ALLOCATORS directive, not listed items use the normal
+ Fortran way.
+ The behavior of an ALLOCATE directive that does not list all
+ arguments but there is no directive without list argument is not
+ well specified. Thus, we reject such code below. In OpenMP 5.2
+ the executable ALLOCATE directive is deprecated and in 6.0
+ deleted such that no spec clarification is to be expected. */
+ for (a = code->block->next->ext.alloc.list; a; a = a->next)
+ if (a->expr->expr_type == EXPR_VARIABLE)
+ {
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
+ if (a->expr->symtree->n.sym == n->sym)
+ {
+ gfc_ref *ref;
+ for (ref = a->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_COMPONENT)
+ break;
+ if (ref == NULL)
+ break;
+ }
+ if (n == NULL && n_null == NULL)
+ {
+ /* OK for ALLOCATORS but for ALLOCATE: Unspecified whether
+ that should use the default allocator of OpenMP or the
+ Fortran allocator. Thus, just reject it. */
+ if (code->op == EXEC_OMP_ALLOCATE)
+ gfc_error ("%qs listed in %<allocate%> statement at %L "
+ "but it is neither explicitly in listed in "
+ "the %<!$OMP ALLOCATE%> directive nor exists"
+ " a directive without argument list",
+ a->expr->symtree->n.sym->name,
+ &a->expr->where);
+ break;
+ }
+ if (n == NULL)
+ {
+ if (a->expr->symtree->n.sym->attr.codimension)
+ gfc_error ("Unexpected coarray %qs in %<allocate%> at "
+ "%L, implicitly listed in %<!$OMP ALLOCATE%>"
+ " at %L", a->expr->symtree->n.sym->name,
+ &a->expr->where, &n_null->where);
+ break;
+ }
+ }
+ gfc_namespace *prog_unit = ns;
+ while (prog_unit->parent)
+ prog_unit = prog_unit->parent;
+ gfc_namespace *fn_ns = ns;
+ while (fn_ns)
+ {
+ if (ns->proc_name
+ && (ns->proc_name->attr.subroutine
+ || ns->proc_name->attr.function))
+ break;
+ fn_ns = fn_ns->parent;
+ }
+ if (missing_allocator
+ && !(prog_unit->omp_requires & OMP_REQ_DYNAMIC_ALLOCATORS)
+ && ((fn_ns && fn_ns->proc_name->attr.omp_declare_target)
+ || omp_clauses->contained_in_target_construct))
+ {
+ if (code->op == EXEC_OMP_ALLOCATORS)
+ gfc_error ("ALLOCATORS directive at %L inside a target region "
+ "must specify an ALLOCATOR modifier for %qs",
+ &code->loc, missing_allocator_sym->name);
+ else if (missing_allocator_sym)
+ gfc_error ("ALLOCATE directive at %L inside a target region "
+ "must specify an ALLOCATOR clause for %qs",
+ &code->loc, missing_allocator_sym->name);
+ else
+ gfc_error ("ALLOCATE directive at %L inside a target region "
+ "must specify an ALLOCATOR clause", &code->loc);
+ }
+}
+
+
/* OpenMP directive resolving routines. */
static void
n->sym->mark = 1;
}
- if (omp_clauses->lists[OMP_LIST_ALLOCATE])
- {
- for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
- {
- if (n->u2.allocator
- && (!gfc_resolve_expr (n->u2.allocator)
- || n->u2.allocator->ts.type != BT_INTEGER
- || n->u2.allocator->rank != 0
- || n->u2.allocator->ts.kind != gfc_c_intptr_kind))
- {
- gfc_error ("Expected integer expression of the "
- "%<omp_allocator_handle_kind%> kind at %L",
- &n->u2.allocator->where);
- break;
- }
- if (!n->u.align)
- continue;
- HOST_WIDE_INT alignment = 0;
- if (!gfc_resolve_expr (n->u.align)
- || n->u.align->ts.type != BT_INTEGER
- || n->u.align->rank != 0
- || n->u.align->expr_type != EXPR_CONSTANT
- || gfc_extract_hwi (n->u.align, &alignment)
- || alignment <= 0
- || !pow2p_hwi (alignment))
- {
- gfc_error ("ALIGN requires a scalar positive constant integer "
- "alignment expression at %L that is a power of two",
- &n->u.align->where);
- break;
- }
- }
-
- /* Check for 2 things here.
- 1. There is no duplication of variable in allocate clause.
- 2. Variable in allocate clause are also present in some
- privatization clase (non-composite case). */
- for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
- if (n->sym)
- n->sym->mark = 0;
-
- gfc_omp_namelist *prev = NULL;
- for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; )
- {
- if (n->sym == NULL)
- {
- n = n->next;
- continue;
- }
- if (n->sym->mark == 1)
- {
- gfc_warning (OPT_Wopenmp, "%qs appears more than once in "
- "%<allocate%> at %L" , n->sym->name, &n->where);
- /* We have already seen this variable so it is a duplicate.
- Remove it. */
- if (prev != NULL && prev->next == n)
- {
- prev->next = n->next;
- n->next = NULL;
- gfc_free_omp_namelist (n, OMP_LIST_ALLOCATE);
- n = prev->next;
- }
- continue;
- }
- n->sym->mark = 1;
- prev = n;
- n = n->next;
- }
-
- /* Non-composite constructs. */
- if (code && code->op < EXEC_OMP_DO_SIMD)
- {
- for (list = OMP_LIST_FIRST; list < OMP_LIST_NUM;
- list = gfc_omp_list_type (list + 1))
- switch (list)
- {
- case OMP_LIST_PRIVATE:
- case OMP_LIST_FIRSTPRIVATE:
- case OMP_LIST_LASTPRIVATE:
- case OMP_LIST_REDUCTION:
- case OMP_LIST_REDUCTION_INSCAN:
- case OMP_LIST_REDUCTION_TASK:
- case OMP_LIST_IN_REDUCTION:
- case OMP_LIST_TASK_REDUCTION:
- case OMP_LIST_LINEAR:
- for (n = omp_clauses->lists[list]; n; n = n->next)
- n->sym->mark = 0;
- break;
- default:
- break;
- }
-
- for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
- if (n->sym->mark == 1)
- gfc_error ("%qs specified in %<allocate%> clause at %L but not "
- "in an explicit privatization clause",
- n->sym->name, &n->where);
- }
- if (code
- && (code->op == EXEC_OMP_ALLOCATORS || code->op == EXEC_OMP_ALLOCATE)
- && code->block
- && code->block->next
- && code->block->next->op == EXEC_ALLOCATE)
- {
- if (code->op == EXEC_OMP_ALLOCATE)
- gfc_warning (OPT_Wdeprecated_openmp,
- "The use of one or more %<allocate%> directives with "
- "an associated %<allocate%> statement at %L is "
- "deprecated since OpenMP 5.2, use an %<allocators%> "
- "directive", &code->loc);
- gfc_alloc *a;
- gfc_omp_namelist *n_null = NULL;
- bool missing_allocator = false;
- gfc_symbol *missing_allocator_sym = NULL;
- for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
- {
- if (n->u2.allocator == NULL)
- {
- if (!missing_allocator_sym)
- missing_allocator_sym = n->sym;
- missing_allocator = true;
- }
- if (n->sym == NULL)
- {
- n_null = n;
- continue;
- }
- if (n->sym->attr.codimension)
- gfc_error ("Unexpected coarray %qs in %<allocate%> at %L",
- n->sym->name, &n->where);
- for (a = code->block->next->ext.alloc.list; a; a = a->next)
- if (a->expr->expr_type == EXPR_VARIABLE
- && a->expr->symtree->n.sym == n->sym)
- {
- gfc_ref *ref;
- for (ref = a->expr->ref; ref; ref = ref->next)
- if (ref->type == REF_COMPONENT)
- break;
- if (ref == NULL)
- break;
- }
- if (a == NULL)
- gfc_error ("%qs specified in %<allocate%> at %L but not "
- "in the associated ALLOCATE statement",
- n->sym->name, &n->where);
- }
- /* If there is an ALLOCATE directive without list argument, a
- namelist with its allocator/align clauses and n->sym = NULL is
- created during parsing; here, we add all not otherwise specified
- items from the Fortran allocate to that list.
- For an ALLOCATORS directive, not listed items use the normal
- Fortran way.
- The behavior of an ALLOCATE directive that does not list all
- arguments but there is no directive without list argument is not
- well specified. Thus, we reject such code below. In OpenMP 5.2
- the executable ALLOCATE directive is deprecated and in 6.0
- deleted such that no spec clarification is to be expected. */
- for (a = code->block->next->ext.alloc.list; a; a = a->next)
- if (a->expr->expr_type == EXPR_VARIABLE)
- {
- for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
- if (a->expr->symtree->n.sym == n->sym)
- {
- gfc_ref *ref;
- for (ref = a->expr->ref; ref; ref = ref->next)
- if (ref->type == REF_COMPONENT)
- break;
- if (ref == NULL)
- break;
- }
- if (n == NULL && n_null == NULL)
- {
- /* OK for ALLOCATORS but for ALLOCATE: Unspecified whether
- that should use the default allocator of OpenMP or the
- Fortran allocator. Thus, just reject it. */
- if (code->op == EXEC_OMP_ALLOCATE)
- gfc_error ("%qs listed in %<allocate%> statement at %L "
- "but it is neither explicitly in listed in "
- "the %<!$OMP ALLOCATE%> directive nor exists"
- " a directive without argument list",
- a->expr->symtree->n.sym->name,
- &a->expr->where);
- break;
- }
- if (n == NULL)
- {
- if (a->expr->symtree->n.sym->attr.codimension)
- gfc_error ("Unexpected coarray %qs in %<allocate%> at "
- "%L, implicitly listed in %<!$OMP ALLOCATE%>"
- " at %L", a->expr->symtree->n.sym->name,
- &a->expr->where, &n_null->where);
- break;
- }
- }
- gfc_namespace *prog_unit = ns;
- while (prog_unit->parent)
- prog_unit = prog_unit->parent;
- gfc_namespace *fn_ns = ns;
- while (fn_ns)
- {
- if (ns->proc_name
- && (ns->proc_name->attr.subroutine
- || ns->proc_name->attr.function))
- break;
- fn_ns = fn_ns->parent;
- }
- if (missing_allocator
- && !(prog_unit->omp_requires & OMP_REQ_DYNAMIC_ALLOCATORS)
- && ((fn_ns && fn_ns->proc_name->attr.omp_declare_target)
- || omp_clauses->contained_in_target_construct))
- {
- if (code->op == EXEC_OMP_ALLOCATORS)
- gfc_error ("ALLOCATORS directive at %L inside a target region "
- "must specify an ALLOCATOR modifier for %qs",
- &code->loc, missing_allocator_sym->name);
- else if (missing_allocator_sym)
- gfc_error ("ALLOCATE directive at %L inside a target region "
- "must specify an ALLOCATOR clause for %qs",
- &code->loc, missing_allocator_sym->name);
- else
- gfc_error ("ALLOCATE directive at %L inside a target region "
- "must specify an ALLOCATOR clause", &code->loc);
- }
-
- }
- }
+ resolve_omp_allocate_clauses (code, omp_clauses, ns);
/* OpenACC reductions. */
if (openacc)
projects / thirdparty / gcc.git / commitdiff
