gfc_namelist *namelist, *namelist_tail;
+ /* The tlink field is used in the front end to carry the module
+ declaration of separate module procedures so that the characteristics
+ can be compared with the corresponding declaration in a submodule. In
+ translation this field carries a linked list of symbols that require
+ deferred initialization. */
+ struct gfc_symbol *tlink;
+
/* Change management fields. Symbols that might be modified by the
current statement have the mark member nonzero. Of these symbols,
symbols with old_symbol equal to NULL are symbols created within
the current statement. Otherwise, old_symbol points to a copy of
the old symbol. gfc_new is used in symbol.cc to flag new symbols.
comp_mark is used to indicate variables which have component accesses
- in OpenMP/OpenACC directive clauses. */
+ in OpenMP/OpenACC directive clauses (cf. c-typeck.cc:c_finish_omp_clauses,
+ map_field_head).
+ data_mark is used to check duplicate mappings for OpenMP data-sharing
+ clauses (see firstprivate_head/lastprivate_head in the above function).
+ dev_mark is used to check duplicate mappings for OpenMP
+ is_device_ptr/has_device_addr clauses (see is_on_device_head in above
+ function).
+ gen_mark is used to check duplicate mappings for OpenMP
+ use_device_ptr/use_device_addr/private/shared clauses (see generic_head in
+ above functon).
+ reduc_mark is used to check duplicate mappings for OpenMP reduction
+ clauses. */
struct gfc_symbol *old_symbol;
- unsigned mark:1, comp_mark:1, gfc_new:1;
-
- /* The tlink field is used in the front end to carry the module
- declaration of separate module procedures so that the characteristics
- can be compared with the corresponding declaration in a submodule. In
- translation this field carries a linked list of symbols that require
- deferred initialization. */
- struct gfc_symbol *tlink;
+ unsigned mark:1, comp_mark:1, data_mark:1, dev_mark:1, gen_mark:1;
+ unsigned reduc_mark:1, gfc_new:1;
/* Nonzero if all equivalences associated with this symbol have been
processed. */
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 && (!n->sym->attr.dummy || n->sym->ns != ns)))
&& list != OMP_LIST_LASTPRIVATE
&& list != OMP_LIST_ALIGNED
&& list != OMP_LIST_DEPEND
- && (list != OMP_LIST_MAP || openacc)
&& list != OMP_LIST_FROM
&& list != OMP_LIST_TO
&& (list != OMP_LIST_REDUCTION || !openacc)
- && list != OMP_LIST_REDUCTION_INSCAN
- && list != OMP_LIST_REDUCTION_TASK
- && list != OMP_LIST_IN_REDUCTION
- && list != OMP_LIST_TASK_REDUCTION
&& list != OMP_LIST_ALLOCATE)
for (n = omp_clauses->lists[list]; n; n = n->next)
{
for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
component_ref_p = true;
- if ((!component_ref_p && n->sym->comp_mark)
- || (component_ref_p && n->sym->mark))
- gfc_error ("Symbol %qs has mixed component and non-component "
- "accesses at %L", n->sym->name, &n->where);
+ 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 (n->sym->mark)
gfc_error ("Symbol %qs present on multiple clauses at %L",
n->sym->name, &n->where);
}
}
+ /* 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++)
for (n = omp_clauses->lists[list]; n; n = n->next)
- if (n->sym->mark)
+ 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->mark = 0;
- }
+ 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->mark)
+ 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->mark = 1;
+ n->sym->data_mark = 1;
}
for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
- n->sym->mark = 0;
+ n->sym->data_mark = 0;
for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
{
- if (n->sym->mark)
+ 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->mark = 1;
+ n->sym->data_mark = 1;
}
for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
--- /dev/null
+integer :: y
+
+!$omp target has_device_addr(y) firstprivate(y) ! { dg-error "Symbol 'y' present on multiple clauses" }
+!$omp end target
+
+end
--- /dev/null
+program p
+integer :: y
+
+!$omp target map(y) firstprivate(y) ! { dg-error "Symbol 'y' present on both data and map clauses" }
+y = y + 1
+!$omp end target
+
+!$omp target simd map(y) firstprivate(y) ! { dg-error "Symbol 'y' present on both data and map clauses" }
+do i=1,1
+ y = y + 1
+end do
+!$omp end target simd
+
+end program p
--- /dev/null
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+integer :: x, y
+
+! EXEC_OMP_TARGET_TEAMS
+
+!$omp target teams map(x) firstprivate(x)
+x = x + 1
+!$omp end target teams
+
+!$omp target teams map(x) firstprivate(y)
+x = y + 1
+!$omp end target teams
+
+! EXEC_OMP_TARGET_TEAMS_DISTRIBUTE
+
+!$omp target teams distribute map(x) firstprivate(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target teams distribute
+
+!$omp target teams distribute map(x) firstprivate(y)
+do i=1,1
+ x = y + 1
+end do
+!$omp end target teams distribute
+
+! EXEC_OMP_TARGET_TEAMS_LOOP
+
+!$omp target teams loop map(x) firstprivate(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target teams loop
+
+!$omp target teams loop map(x) firstprivate(y)
+do i=1,1
+ x = y + 1
+end do
+!$omp end target teams loop
+
+! EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD
+
+!$omp target teams distribute simd map(x) firstprivate(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target teams distribute simd
+
+!$omp target teams distribute simd map(x) firstprivate(y)
+do i=1,1
+ x = y + 1
+end do
+!$omp end target teams distribute simd
+
+! EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO
+
+!$omp target teams distribute parallel do map(x) firstprivate(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target teams distribute parallel do
+
+!$omp target teams distribute parallel do map(x) firstprivate(y)
+do i=1,1
+ x = y + 1
+end do
+!$omp end target teams distribute parallel do
+
+! EXEC_OMP_TARGET_PARALLEL
+
+!$omp target parallel map(x) firstprivate(x)
+x = x + 1
+!$omp end target parallel
+
+!$omp target parallel map(x) firstprivate(y)
+x = y + 1
+!$omp end target parallel
+
+! EXEC_OMP_TARGET_PARALLEL_DO
+
+!$omp target parallel do map(x) firstprivate(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target parallel do
+
+!$omp target parallel do map(x) firstprivate(y)
+do i=1,1
+ x = y + 1
+end do
+!$omp end target parallel do
+
+! EXEC_OMP_TARGET_PARALLEL_LOOP
+
+!$omp target parallel loop map(x) firstprivate(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target parallel loop
+
+!$omp target parallel loop map(x) firstprivate(y)
+do i=1,1
+ x = y + 1
+end do
+!$omp end target parallel loop
+
+! EXEC_OMP_TARGET_PARALLEL_DO_SIMD
+
+!$omp target parallel do simd map(x) firstprivate(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target parallel do simd
+
+!$omp target parallel do simd map(x) firstprivate(y)
+do i=1,1
+ x = y + 1
+end do
+!$omp end target parallel do simd
+
+! EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD
+
+!$omp target teams distribute parallel do simd map(x) firstprivate(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target teams distribute parallel do simd
+
+!$omp target teams distribute parallel do simd map(x) firstprivate(y)
+do i=1,1
+ x = y + 1
+end do
+!$omp end target teams distribute parallel do simd
+
+! { dg-final { scan-tree-dump-times {omp target map\(tofrom:x\)} 10 "original" } }
+! { dg-final { scan-tree-dump-times {omp target firstprivate\(y\) map\(tofrom:x\)} 10 "original" } }
+
+! { dg-final { scan-tree-dump-times {omp teams firstprivate\(x\)} 6 "original" } }
+! { dg-final { scan-tree-dump-times {omp teams firstprivate\(y\)} 6 "original" } }
+
+! { dg-final { scan-tree-dump-times {omp parallel firstprivate\(x\)} 6 "original" } }
+! { dg-final { scan-tree-dump-times {omp parallel firstprivate\(y\)} 6 "original" } }
+
+end
--- /dev/null
+integer :: x, y
+
+!$omp target in_reduction(+: x) private(x) ! { dg-error "Symbol 'x' present on multiple clauses" }
+x = x + 1
+!$omp end target
+
+!$omp target in_reduction(+: y) firstprivate(y) ! { dg-error "Symbol 'y' present on both data and map clauses" }
+y = y + 1
+!$omp end target
+
+end
--- /dev/null
+! { dg-do compile }
+
+integer :: x
+
+!$omp target map(x) private(x) ! { dg-error "Symbol 'x' present on multiple clauses" }
+x = x + 1
+!$omp end target
+
+end
--- /dev/null
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+integer :: x
+
+!$omp target simd map(x) private(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target simd
+
+!$omp target teams distribute simd map(x) private(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target teams distribute simd
+
+!$omp target parallel do simd map(x) private(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target parallel do simd
+
+!$omp target teams distribute parallel do simd map(x) private(x)
+do i=1,1
+ x = x + 1
+end do
+!$omp end target teams distribute parallel do simd
+
+! { dg-final { scan-tree-dump-times {omp target map\(tofrom:x\)} 4 "original" } }
+! { dg-final { scan-tree-dump-times {(?n)omp simd.* private\(x\)} 4 "original" } }
+
+end
--- /dev/null
+! { dg-do compile }
+
+integer, allocatable :: x
+integer, pointer :: y
+
+!$omp target map(x) has_device_addr(x) ! { dg-error "Symbol 'x' present on multiple clauses" }
+!$omp end target
+
+!$omp target map(y) is_device_ptr(y) ! { dg-error "Symbol 'y' present on multiple clauses" }
+!$omp end target
+
+!$omp target firstprivate(x) has_device_addr(x) ! { dg-error "Symbol 'x' present on multiple clauses" }
+!$omp end target
+
+!$omp target firstprivate(y) is_device_ptr(y) ! { dg-error "Symbol 'y' present on multiple clauses" }
+!$omp end target
+
+end
--- /dev/null
+! { dg-do compile }
+
+program p
+ integer, allocatable :: a
+ !$omp target map(tofrom: a, a) ! { dg-error "Symbol 'a' present on multiple clauses" }
+ !$omp end target
+end
projects / platform / upstream / gcc.git / commitdiff