OpenMP: Handle unlisted items in 'omp allocators' + exec. 'omp allocate'
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_omp_node): Show clauses for
EXEC_OMP_ALLOCATE and EXEC_OMP_ALLOCATORS.
* openmp.cc (resolve_omp_clauses): Process nonlisted items
for EXEC_OMP_ALLOCATE and EXEC_OMP_ALLOCATORS.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/allocate-14.f90: Add new checks.
* gfortran.dg/gomp/allocate-5.f90: Remove items from an allocate-stmt
that are not explicitly/implicited listed in 'omp allocate'.
gcc/fortran/dump-parse-tree.cc | 2 +
gcc/fortran/openmp.cc | 112 ++++++++++++++++++++++++-
gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 | 41 +++++++++
gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 4 +-
4 files changed, 155 insertions(+), 4 deletions(-)
@@ -2241,6 +2241,8 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
+ case EXEC_OMP_ALLOCATE:
+ case EXEC_OMP_ALLOCATORS:
case EXEC_OMP_ASSUME:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
@@ -7924,10 +7924,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& code->block->next->op == EXEC_ALLOCATE)
{
gfc_alloc *a;
+ gfc_omp_namelist *n_null = NULL;
for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
{
if (n->sym == NULL)
- continue;
+ {
+ n_null = n;
+ continue;
+ }
if (n->sym->attr.codimension)
gfc_error ("Unexpected coarray %qs in %<allocate%> at %L",
n->sym->name, &n->where);
@@ -7940,8 +7944,112 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"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. */
+ gfc_alloc *a_prev = NULL;
+ gfc_alloc *extra_alloc = NULL, *extra_alloc_last = NULL;
+ for (a = code->block->next->ext.alloc.list; a; )
+ {
+ 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)
+ break;
+ if (n == NULL && n_null == NULL)
+ {
+ if (!extra_alloc)
+ extra_alloc = extra_alloc_last = a;
+ else
+ {
+ extra_alloc_last->next = a;
+ extra_alloc_last = a;
+ }
+ a = a->next;
+ if (code->block->next->ext.alloc.list == extra_alloc_last)
+ code->block->next->ext.alloc.list = a;
+ else
+ a_prev->next = a;
+ extra_alloc_last->next = NULL;
+ continue;
+ }
+ 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);
+ if (n_null->sym == NULL)
+ n_null->sym = a->expr->symtree->n.sym;
+ else
+ {
+ n = n_null->next;
+ n_null->next = gfc_get_omp_namelist ();
+ n_null->next->next = n;
+ n_null->next->sym = a->expr->symtree->n.sym;
+ n_null->next->u2.allocator = n_null->u2.allocator;
+ n_null->next->u.align
+ = gfc_copy_expr (n_null->u.align);
+ n_null->next->where = n_null->where;
+ n_null = n_null->next;
+ }
+ }
+ }
+ a_prev = a;
+ a = a->next;
+ }
+ if (n_null && n_null->sym == NULL)
+ {
+ if (n_null == omp_clauses->lists[OMP_LIST_ALLOCATE])
+ omp_clauses->lists[OMP_LIST_ALLOCATE] = n_null->next;
+ else
+ {
+ for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;
+ n = n->next)
+ if (n->next == n_null)
+ break;
+ n->next = n_null->next;
+ n_null->next = NULL;
+ gfc_free_omp_namelist (n_null, false, true, false);
+ }
+ }
+ if (extra_alloc)
+ {
+ /* 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",
+ extra_alloc->expr->symtree->n.sym->name,
+ &extra_alloc->expr->where);
+ gfc_code *c = code->block->next;
+ gfc_code *cn = code->next;
+ code->next = gfc_get_code (c->op);
+ code->next->next = cn;
+ cn = code->next;
+ cn->loc = c->loc;
+ cn->expr1 = gfc_copy_expr (cn->expr1);
+ cn->expr2 = gfc_copy_expr (cn->expr2);
+ cn->expr3 = gfc_copy_expr (cn->expr3);
+ cn->ext.alloc.ts = cn->ext.alloc.ts;
+ cn->ext.alloc.list = extra_alloc;
+ cn->ext.alloc.arr_spec_from_expr3
+ = c->ext.alloc.arr_spec_from_expr3;
+ cn->ext.alloc.expr3_not_explicit
+ = c->ext.alloc.expr3_not_explicit;
+ }
}
-
}
/* OpenACC reductions. */
@@ -93,3 +93,44 @@ subroutine c_and_func_ptrs
!$omp allocate(cfunptr) ! OK? A normal derived-type var?
!$omp allocate(p) ! { dg-error "Argument 'p' at .1. to declarative !.OMP ALLOCATE directive must be a variable" }
end
+
+
+subroutine coarray_2
+ use m
+ implicit none
+ integer :: x
+ integer, allocatable :: a, b, c[:], d
+ x = 5 ! executable stmt
+ !$omp allocate(a,b) align(16)
+ !$omp allocate ! { dg-error "Unexpected coarray 'c' in 'allocate' at .1., implicitly listed in '!.OMP ALLOCATE' at .2." }
+ !$omp allocate(d) align(32)
+ allocate(a,b,c[*],d) ! { dg-error "Unexpected coarray 'c' in 'allocate' at .1., implicitly listed in '!.OMP ALLOCATE' at .2." }
+end
+
+
+subroutine coarray_3
+ use m
+ implicit none
+ integer :: x
+ integer, allocatable :: a, b, c[:], d
+ x = 5 ! executable stmt
+ !$omp allocators allocate(align(16): a,b) allocate(align(32) : d)
+ allocate(a,b,c[*],d) ! OK - Fortran allocator used for 'C'
+end
+
+
+subroutine unclear
+ use m
+ implicit none
+ integer :: x
+ integer, allocatable :: a, b, c[:], d
+
+ ! OpenMP is unclear which allocator is used for 'C' - the fortran one or the OpenMP one.
+ ! GCC therefore rejects it.
+
+ x = 5 ! executable stmt
+
+ !$omp allocate(a,b) align(16)
+ !$omp allocate(d) align(32)
+ allocate(a,b,c[*],d) ! { dg-error "'c' listed in 'allocate' statement at .1. but it is neither explicitly in listed in the '!.OMP ALLOCATE' directive nor exists a directive without argument list" }
+end
@@ -46,8 +46,8 @@ subroutine two(c,x2,y2)
!$omp flush ! some executable statement
!$omp allocate(a) ! { dg-message "not yet supported" }
- allocate(a,b(4),c(3,4))
- deallocate(a,b,c)
+ allocate(a)
+ deallocate(a)
!$omp allocate(x1,y1,x2,y2) ! { dg-message "not yet supported" }
allocate(x1,y1,x2(5),y2(5))