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(-) diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 68122e3e6fd..1440524f971 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -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: diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 1cc65d7fa49..95e0aaafa58 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -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 % 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 % at " + "%L, implicitly listed in %" + " 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 % statement at %L but " + "it is neither explicitly in listed in the " + "% 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. */ diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 index 8ff9c252e49..4fed19249a3 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-14.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 index bf9c781dcc5..35c7b1ba5bf 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 @@ -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))