* [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). @ 2021-10-22 13:05 Hafiz Abid Qadeer 2021-10-22 13:28 ` Tobias Burnus 2021-11-02 16:27 ` Jakub Jelinek 0 siblings, 2 replies; 28+ messages in thread From: Hafiz Abid Qadeer @ 2021-10-22 13:05 UTC (permalink / raw) To: gcc-patches; +Cc: tobias, jakub, abidh This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not yet support the allocator-modifier as specified in OpenMP 5.1. The allocate clause is already supported in C/C++. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE. * gfortran.h (OMP_LIST_ALLOCATE): New enum value. (allocate): New member in gfc_symbol. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE. (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES) (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES) (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES) (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE. (OMP_TASKGROUP_CLAUSES): New (gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of 'OMP_CLAUSE_TASK_REDUCTION' (resolve_omp_clauses): Handle OMP_LIST_ALLOCATE. (resolve_omp_do): Avoid warning when loop iteration variable is in allocate clause. * trans-openmp.c (gfc_trans_omp_clauses): Handle translation of allocate clause. (gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-1.f90: New test. * gfortran.dg/gomp/allocate-2.f90: New test. * gfortran.dg/gomp/collapse1.f90: Update error message. * gfortran.dg/gomp/openmp-simd-4.f90: Likewise. libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.c: New test. * testsuite/libgomp.fortran/allocate-1.f90: New test. --- gcc/fortran/dump-parse-tree.c | 1 + gcc/fortran/gfortran.h | 5 + gcc/fortran/openmp.c | 140 +++++++- gcc/fortran/trans-openmp.c | 34 ++ gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 | 123 +++++++ gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 | 45 +++ gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +- .../gfortran.dg/gomp/openmp-simd-4.f90 | 6 +- .../testsuite/libgomp.fortran/allocate-1.c | 7 + .../testsuite/libgomp.fortran/allocate-1.f90 | 333 ++++++++++++++++++ 10 files changed, 675 insertions(+), 21 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.f90 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 14a307856fc..66af802ec36 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1685,6 +1685,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break; case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break; + case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break; case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break; case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break; default: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 66192c07d8c..feae00052cc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1388,6 +1388,7 @@ enum OMP_LIST_USE_DEVICE_PTR, OMP_LIST_USE_DEVICE_ADDR, OMP_LIST_NONTEMPORAL, + OMP_LIST_ALLOCATE, OMP_LIST_NUM }; @@ -1880,6 +1881,10 @@ typedef struct gfc_symbol according to the Fortran standard. */ unsigned pass_as_value:1; + /* Used to check if a variable used in allocate clause has also been + used in privatization clause. */ + unsigned allocate:1; + int refs; struct gfc_namespace *ns; /* namespace containing this symbol */ diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index dcf22ac2c2f..aac8d2580a4 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -911,6 +911,7 @@ enum omp_mask1 OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ + OMP_CLAUSE_ALLOCATE, /* OpenMP 5.0. */ OMP_CLAUSE_BIND, /* OpenMP 5.0. */ OMP_CLAUSE_FILTER, /* OpenMP 5.1. */ OMP_CLAUSE_AT, /* OpenMP 5.1. */ @@ -1540,6 +1541,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } continue; } + if ((mask & OMP_CLAUSE_ALLOCATE) + && gfc_match ("allocate ( ") == MATCH_YES) + { + gfc_expr *allocator = NULL; + old_loc = gfc_current_locus; + m = gfc_match_expr (&allocator); + if (m != MATCH_YES) + { + gfc_error ("Expected allocator or variable list at %C"); + goto error; + } + if (gfc_match (" : ") != MATCH_YES) + { + /* If no ":" then there is no allocator, we backtrack + and read the variable list. */ + allocator = NULL; + gfc_current_locus = old_loc; + } + + gfc_omp_namelist **head = NULL; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], + false, NULL, &head); + + if (m == MATCH_ERROR) + break; + + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + if (allocator) + n->expr = gfc_copy_expr (allocator); + else + n->expr = NULL; + continue; + } if ((mask & OMP_CLAUSE_AT) && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) != MATCH_NO) @@ -3511,7 +3546,7 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_PROC_BIND) + | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE) #define OMP_DECLARE_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \ | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \ @@ -3520,15 +3555,16 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ - | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_LOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + #define OMP_SCOPE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION) #define OMP_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \ | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \ @@ -3539,19 +3575,22 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY) + | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE) #define OMP_TASKLOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \ | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \ | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP \ - | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION) + | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE) +#define OMP_TASKGROUP_CLAUSES \ + (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \ - | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION) + | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \ + | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR) @@ -3567,13 +3606,14 @@ cleanup: #define OMP_TEAMS_CLAUSES \ (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \ - | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_SINGLE_CLAUSES \ - (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_ALLOCATE) #define OMP_ORDERED_CLAUSES \ (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ @@ -5836,7 +5876,7 @@ gfc_match_omp_barrier (void) match gfc_match_omp_taskgroup (void) { - return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION); + return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES); } @@ -6174,7 +6214,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "IN_REDUCTION", "TASK_REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", - "NONTEMPORAL" }; + "NONTEMPORAL", "ALLOCATE" }; STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM); if (omp_clauses == NULL) @@ -6457,7 +6497,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && list != OMP_LIST_REDUCTION_INSCAN && list != OMP_LIST_REDUCTION_TASK && list != OMP_LIST_IN_REDUCTION - && list != OMP_LIST_TASK_REDUCTION) + && list != OMP_LIST_TASK_REDUCTION + && list != OMP_LIST_ALLOCATE) for (n = omp_clauses->lists[list]; n; n = n->next) { bool component_ref_p = false; @@ -6526,6 +6567,70 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->mark = 1; } + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->expr && (n->expr->ts.type != BT_INTEGER + || n->expr->ts.kind != gfc_c_intptr_kind)) + { + gfc_error ("Expected integer expression of the " + "'omp_allocator_handle_kind' kind at %L", &n->expr->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. */ + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + n->sym->allocate = 0; + + gfc_omp_namelist *prev = NULL; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) + { + if (n->sym->allocate == 1) + { + gfc_warning (0, "%qs appears more than once in %<allocate%> " + "clauses 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, 0); + n = prev->next; + } + + continue; + } + n->sym->allocate = 1; + prev = n; + n = n->next; + } + + for (list = 0; list < OMP_LIST_NUM; list++) + 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->allocate = 0; + break; + default: + break; + } + + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym->allocate == 1) + gfc_error ("%qs specified in 'allocate' clause at %L but not in an " + "explicit privatization clause", n->sym->name, &n->where); + /* OpenACC reductions. */ if (openacc) { @@ -8233,19 +8338,20 @@ resolve_omp_do (gfc_code *code) if (code->ext.omp_clauses) for (list = 0; list < OMP_LIST_NUM; list++) if (!is_simd || code->ext.omp_clauses->collapse > 1 - ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALLOCATE) : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_LINEAR)) + && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR)) for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) if (dovar == n->sym) { if (!is_simd || code->ext.omp_clauses->collapse > 1) gfc_error ("%s iteration variable present on clause " - "other than PRIVATE or LASTPRIVATE at %L", - name, &do_code->loc); + "other than PRIVATE, LASTPRIVATE or " + "ALLOCATE at %L", name, &do_code->loc); else gfc_error ("%s iteration variable present on clause " - "other than PRIVATE, LASTPRIVATE or " + "other than PRIVATE, LASTPRIVATE, ALLOCATE or " "LINEAR at %L", name, &do_code->loc); break; } diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index e81c5588c53..cce65f999cb 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2646,6 +2646,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_ALLOCATE: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALLOCATE); + OMP_CLAUSE_DECL (node) = t; + if (n->expr) + { + tree allocator_; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + allocator_ = gfc_evaluate_now (se.expr, block); + OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; case OMP_LIST_LINEAR: { gfc_expr *last_step_expr = NULL; @@ -5857,6 +5879,8 @@ gfc_split_omp_clauses (gfc_code *code, /* First the clauses that are unique to some constructs. */ clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP] = code->ext.omp_clauses->lists[OMP_LIST_MAP]; + clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR] = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR]; clausesa[GFC_OMP_SPLIT_TARGET].device @@ -5883,6 +5907,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_SHARED]; clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing = code->ext.omp_clauses->default_sharing; + clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; } if (mask & GFC_OMP_MASK_DISTRIBUTE) { @@ -5900,6 +5926,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->order_unconstrained; clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_reproducible = code->ext.omp_clauses->order_reproducible; + clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; } if (mask & GFC_OMP_MASK_PARALLEL) { @@ -5921,6 +5949,8 @@ gfc_split_omp_clauses (gfc_code *code, /* And this is copied to all. */ clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr = code->ext.omp_clauses->if_expr; + clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; } if (mask & GFC_OMP_MASK_MASKED) clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter; @@ -5958,6 +5988,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->order_unconstrained; clausesa[GFC_OMP_SPLIT_DO].order_reproducible = code->ext.omp_clauses->order_reproducible; + clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; } if (mask & GFC_OMP_MASK_SIMD) { @@ -6005,6 +6037,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->mergeable; clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP] = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP]; + clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_ALLOCATE] + = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; /* And this is copied to all. */ clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr = code->ext.omp_clauses->if_expr; diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 new file mode 100644 index 00000000000..34dad47a39d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 @@ -0,0 +1,123 @@ +! { dg-do compile } + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 +end module + +subroutine bar (a, b, c) + implicit none + integer :: a + integer :: b + integer :: c + c = a + b +end + +subroutine bar2 (a, b, c) + implicit none + integer :: a + integer :: b(15) + integer :: c + c = a + b(1) +end + +subroutine foo(x, y) + use omp_lib_kinds + implicit none + integer :: x + integer :: z + + integer, dimension(15) :: y + integer :: r + integer :: i + integer (kind=omp_allocator_handle_kind) :: h + r = 0 + h = omp_default_mem_alloc; + + !$omp parallel allocate (x) allocate (h : y) & + !$omp allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z) + call bar2 (x, y, z); + !$omp end parallel + + !$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z) + call bar (0, x, z); + !$omp end task + + !$omp target teams distribute parallel do private (x) firstprivate (y) & + !$omp allocate ((omp_default_mem_alloc + 0):z) allocate & + !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r) + do i = 1, 10 + call bar (0, x, z); + call bar2 (1, y, r); + end do + !$omp end target teams distribute parallel do + + !$omp single private (x) allocate (omp_low_lat_mem_alloc:x) + x=1 + !$omp end single + + !$omp single allocate (omp_low_lat_mem_alloc:x) private (x) + !$omp end single + + !$omp parallel + !$omp do allocate (x) private (x) + do i = 1, 64 + x = 1; + end do + !$omp end parallel + + !$omp sections private (x) allocate (omp_low_lat_mem_alloc: x) + x = 1; + !$omp section + x = 2; + !$omp section + x = 3; + !$omp end sections + + !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r) + call bar (r, r, r); + !$omp end taskgroup + + !$omp teams private (x) firstprivate (y) allocate (h : x, y) + call bar2 (x, y, r); + !$omp end teams + + !$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r) + do i = 1, 16 + call bar (0, r, r); + x = i; + end do + !$omp end taskloop + + !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r) + !$omp taskloop firstprivate (x) in_reduction (+:r) & + !$omp allocate (omp_default_mem_alloc : x, r) + do i = 1, 16 + call bar (x, r, r); + end do + !$omp end taskloop + !$omp end taskgroup + !$omp taskwait +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 new file mode 100644 index 00000000000..88b2d26872d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 @@ -0,0 +1,45 @@ +! { dg-do compile } + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + +end module + +subroutine foo(x) + use omp_lib_kinds + implicit none + integer :: x + + !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=1 + !$omp end task + + !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=2 + !$omp end parallel + + !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=3 + !$omp end parallel + + !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } + x=4 + !$omp end parallel + + !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } + x=5 + !$omp end parallel + + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + x=6 + !$omp end parallel + + !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + x=7 + !$omp end parallel + +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 index 1a06eaba823..01cfc82b760 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 @@ -24,7 +24,7 @@ subroutine collapse1 end do !$omp parallel do collapse(2) shared(j) do i = 1, 3 - do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" } + do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } end do end do !$omp parallel do collapse(2) diff --git a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 index 4a17fb9820e..17375e0eff5 100644 --- a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 @@ -45,17 +45,17 @@ do i = 1, 5 end do !$omp parallel do firstprivate(i) -do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE or LASTPRIVATE" } +do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } x(i) = 42 end do !$omp parallel do simd firstprivate(i) -do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or LINEAR" } +do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE, ALLOCATE or LINEAR" } x(i) = 42 end do !$omp simd linear(i) collapse(2) -do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE or LASTPRIVATE" } +do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } do j = 1, 2 y(j, i) = 52 end do diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c new file mode 100644 index 00000000000..d33acc6feef --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c @@ -0,0 +1,7 @@ +#include <stdint.h> + +int +is_64bit_aligned_ (uintptr_t a) +{ + return ( (a & 0x3f) == 0); +} diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 new file mode 100644 index 00000000000..35d1750b878 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -0,0 +1,333 @@ +! { dg-do run } +! { dg-additional-sources allocate-1.c } +! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" } + +module m + use omp_lib + use iso_c_binding + implicit none + + interface + integer(c_int) function is_64bit_aligned (a) bind(C) + import :: c_int + integer :: a + end + end interface +end module m + +subroutine foo (x, p, q, px, h, fl) + use omp_lib + use iso_c_binding + integer :: x + integer, dimension(4) :: p + integer, dimension(4) :: q + integer :: px + integer (kind=omp_allocator_handle_kind) :: h + integer :: fl + + integer :: y + integer :: r, i, i1, i2, i3, i4, i5 + integer :: l, l3, l4, l5, l6 + integer :: n, n1, n2, n3, n4 + integer :: j2, j3, j4 + integer, dimension(4) :: l2 + integer, dimension(4) :: r2 + integer, target :: xo + integer, target :: yo + integer, dimension(x) :: v + integer, dimension(x) :: w + + type s_type + integer :: a + integer :: b + end type + + type (s_type) :: s + s%a = 27 + s%b = 29 + y = 0 + r = 0 + n = 8 + n2 = 9 + n3 = 10 + n4 = 11 + xo = x + yo = y + + do i = 1, 4 + r2(i) = 0; + end do + + do i = 1, 4 + p(i) = 0; + end do + + do i = 1, 4 + q(i) = 0; + end do + + do i = 1, x + w(i) = i + end do + + !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) + if (x /= 42) then + stop 1 + end if + v(1) = 7 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(v(1)) == 0))) then + stop 2 + end if + + !$omp barrier + y = 1; + x = x + 1 + v(1) = 7 + v(41) = 8 + !$omp barrier + if (x /= 43 .or. y /= 1) then + stop 3 + end if + if (v(1) /= 7 .or. v(41) /= 8) then + stop 4 + end if + !$omp end parallel + + !$omp teams + !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) + + if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then + stop 5 + end if + !$omp barrier + y = 1; + x = x + 1 + w(19) = w(19) + 1 + !$omp barrier + if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then + stop 6 + end if + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(w(1)) == 0))) then + stop 7 + end if + !$omp end parallel + !$omp end teams + + !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16) + do i = 0, 63 + if (x /= 42) then + stop 8 + end if + y = 1; + l = i; + n = n + y + 15; + r = r + i; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(r) == 0) .or. & + (is_64bit_aligned(l) == 0) .or. & + (is_64bit_aligned(n) == 0))) then + stop 9 + end if + end do + !$omp end parallel do + + !$omp parallel + !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3) + do i1 = 0, 63 + l2(1) = i1 + l2(2) = i1 + 1 + l2(3) = i1 + 2 + l2(4) = i1 + 3 + if (i1 < 37) then + l3 = i1 + end if + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l2(1)) == 0) .or. & + (is_64bit_aligned(l3) == 0) .or. & + (is_64bit_aligned(i1) == 0))) then + stop 10 + end if + end do + + !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2) + do i2 = 3, 4 + do j2 = 17, 22, 2 + n2 = n2 + 17 + l4 = i2 * 31 + j2 + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l4) == 0) .or. & + (is_64bit_aligned(n2) == 0) .or. & + (is_64bit_aligned(i2) == 0) .or. & + (is_64bit_aligned(j2) == 0))) then + stop 11 + end if + end do + end do + + !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3) + do i3 = 3, 4 + do j3 = 17, 22, 2 + n3 = n3 + 17 + l5 = i3 * 31 + j3 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(l5) == 0) .or. & + (is_64bit_aligned(n3) == 0) .or. & + (is_64bit_aligned(i3) == 0) .or. & + (is_64bit_aligned(j3) == 0))) then + stop 12 + end if + end do + end do + + !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4) + do i4 = 3, 4 + do j4 = 17, 22,2 + n4 = n4 + 17; + l6 = i4 * 31 + j4; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l6) == 0) .or. & + (is_64bit_aligned(n4) == 0) .or. & + (is_64bit_aligned(i4) == 0) .or. & + (is_64bit_aligned(j4) == 0))) then + stop 13 + end if + end do + end do + + !$omp do lastprivate (i5) allocate (i5) + do i5 = 1, 17, 3 + if ( (and(fl, 2) /= 0) .and. & + (is_64bit_aligned(i5) == 0)) then + stop 14 + end if + end do + + !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2) + do i = 0, 31 + p(3) = p(3) + i; + p(4) = p(4) + (2 * i) + q(1) = q(1) + (3 * i) + q(3) = q(3) + (4 * i) + r2(1) = r2(1) + (5 * i) + r2(4) = r2(4) + (6 * i) + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(q(1)) == 0) .or. & + (is_64bit_aligned(p(1)) == 0) .or. & + (is_64bit_aligned(r2(1)) == 0) )) then + stop 15 + end if + end do + + !$omp task private(y) firstprivate(x) allocate(x, y) + if (x /= 42) then + stop 16 + end if + + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 17 + end if + !$omp end task + + !$omp task private(y) firstprivate(x) allocate(h: x, y) + if (x /= 42) then + stop 16 + end if + + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 17 + end if + !$omp end task + + !$omp task private(y) firstprivate(s) allocate(s, y) + if (s%a /= 27 .or. s%b /= 29) then + stop 18 + end if + + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(s%a) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 19 + end if + !$omp end task + + !$omp task private(y) firstprivate(s) allocate(h: s, y) + if (s%a /= 27 .or. s%b /= 29) then + stop 18 + end if + + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(s%a) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 19 + end if + !$omp end task + + !$omp end parallel + + if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then + stop 20 + end if + + if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then + stop 21 + end if + + if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then + stop 22 + end if + + if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then + stop 23 + end if + + if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then + stop 24 + end if + + if (i5 /= 19) then + stop 24 + end if + + if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) & + .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) & + .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then + stop 25 + end if + +end subroutine + +program main + use omp_lib + integer, dimension(4) :: p + integer, dimension(4) :: q + + type (omp_alloctrait) :: traits(3) + integer (omp_allocator_handle_kind) :: a + + traits = [omp_alloctrait (omp_atk_alignment, 64), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & + omp_alloctrait (omp_atk_pool_size, 8192)] + a = omp_init_allocator (omp_default_mem_space, 3, traits) + if (a == omp_null_allocator) stop 1 + + call omp_set_default_allocator (omp_default_mem_alloc); + call foo (42, p, q, 2, a, 0); + call foo (42, p, q, 2, omp_default_mem_alloc, 0); + call foo (42, p, q, 2, a, 1); + call omp_set_default_allocator (a); + call foo (42, p, q, 2, omp_null_allocator, 3); + call foo (42, p, q, 2, omp_default_mem_alloc, 2); + call omp_destroy_allocator (a); +end -- 2.25.1 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2021-10-22 13:05 [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0) Hafiz Abid Qadeer @ 2021-10-22 13:28 ` Tobias Burnus 2021-11-02 16:27 ` Jakub Jelinek 1 sibling, 0 replies; 28+ messages in thread From: Tobias Burnus @ 2021-10-22 13:28 UTC (permalink / raw) To: Hafiz Abid Qadeer, gcc-patches, fortran; +Cc: jakub Hi all, On 22.10.21 15:05, Hafiz Abid Qadeer wrote: > This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not > yet support the allocator-modifier as specified in OpenMP 5.1. The allocate > clause is already supported in C/C++. I think the following shouldn't block the acceptance of the patch, but I think we eventually need to handle the following as well: type t integer, allocatable :: xx(:) end type type(t) :: tt class(t), allocatable :: cc allocate(t :: cc) tt%xx = [1,2,3,4,5,6] cc%xx = [1,2,3,4,5,6] ! ... !$omp task firstprivate(tt, cc) allocate(h) ... In my spec reading, both tt/cc itself and tt%ii and cc%ii should use the specified allocator. And unless I missed something (I only glanced at the patch so far), it is not handled. But for derived types (except for recursive allocatables, valid since 5.1), I think it can be handled in gfc_omp_clause_copy_ctor / gfc_omp_clause_dtor, but I have not checked whether those support it properly. For CLASS + recursive allocatables, it requires some more changes (which might be provided by my derived-type deep copy patch, of which only 1/3 has been written). Tobias PS: Just a side note, OpenMP has the following for Fortran: "If any operation of the base language causes a reallocation of a variable that is allocated with a memory allocator then that memory allocator will be used to deallocate the current memory and to allocate the new memory. For allocated allocatable components of such variables, the allocator that will be used for the deallocation and allocation is unspecified." ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2021-10-22 13:05 [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0) Hafiz Abid Qadeer 2021-10-22 13:28 ` Tobias Burnus @ 2021-11-02 16:27 ` Jakub Jelinek 2021-11-02 17:54 ` Jakub Jelinek 2021-11-18 19:30 ` Hafiz Abid Qadeer 1 sibling, 2 replies; 28+ messages in thread From: Jakub Jelinek @ 2021-11-02 16:27 UTC (permalink / raw) To: Hafiz Abid Qadeer; +Cc: gcc-patches, tobias On Fri, Oct 22, 2021 at 02:05:02PM +0100, Hafiz Abid Qadeer wrote: > This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not > yet support the allocator-modifier as specified in OpenMP 5.1. The allocate > clause is already supported in C/C++. > > gcc/fortran/ChangeLog: > > * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE. > * gfortran.h (OMP_LIST_ALLOCATE): New enum value. > (allocate): New member in gfc_symbol. > * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE. > (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE Missing . at the end. > (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES) > (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES) > (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES) > (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE. > (OMP_TASKGROUP_CLAUSES): New Likewise. > (gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of > 'OMP_CLAUSE_TASK_REDUCTION' Likewise. Please also drop the ' characters. > @@ -1880,6 +1881,10 @@ typedef struct gfc_symbol > according to the Fortran standard. */ > unsigned pass_as_value:1; > > + /* Used to check if a variable used in allocate clause has also been > + used in privatization clause. */ > + unsigned allocate:1; I think it would be desirable to use omp_allocate here instead of allocate and mention OpenMP in the comment too. Fortran has allocate statement in the language, so not pointing to OpenMP would only cause confusion. > @@ -1540,6 +1541,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, > } > continue; > } > + if ((mask & OMP_CLAUSE_ALLOCATE) > + && gfc_match ("allocate ( ") == MATCH_YES) > + { > + gfc_expr *allocator = NULL; > + old_loc = gfc_current_locus; > + m = gfc_match_expr (&allocator); > + if (m != MATCH_YES) > + { > + gfc_error ("Expected allocator or variable list at %C"); > + goto error; > + } > + if (gfc_match (" : ") != MATCH_YES) > + { > + /* If no ":" then there is no allocator, we backtrack > + and read the variable list. */ > + allocator = NULL; Isn't this a memory leak? I believe Fortran FE expressions are not GC allocated... So, shouldn't there be gfc_free_expr or something similar before clearing it? > + /* 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. */ > + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) > + n->sym->allocate = 0; > + > + gfc_omp_namelist *prev = NULL; > + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) > + { > + if (n->sym->allocate == 1) > + { > + gfc_warning (0, "%qs appears more than once in %<allocate%> " > + "clauses 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, 0); > + n = prev->next; > + } > + > + continue; > + } > + n->sym->allocate = 1; > + prev = n; > + n = n->next; > + } > + > + for (list = 0; list < OMP_LIST_NUM; list++) > + 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->allocate = 0; > + break; > + default: > + break; > + } > + > + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) > + if (n->sym->allocate == 1) > + gfc_error ("%qs specified in 'allocate' clause at %L but not in an " > + "explicit privatization clause", n->sym->name, &n->where); I'm not sure this is what the standard says, certainly C/C++ FE do this quite differently for combined/composite constructs. In particular, we first split the clauses to the individual leaf constructs in c_omp_split_clauses, which for allocate clause is even more complicated because as clarified in 5.2: "The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause and to which a data-sharing attribute clause that may create a private copy of the same list item is applied." so there is the has_dup_allocate stuff, we first duplicate it to all leaf constructs that allow the allocate clause and set has_dup_allocate if it is put on more than one construct, and then if has_dup_allocate is set, do more detailed processing. And finally then {,c_}finish_omp_clauses diagnoses what you are trying above, but only on each leaf construct separately. Now, Fortran is performing the splitting of clauses only much later in trans-openmp.c, I wonder if it doesn't have other issues on combined/composite constructs if it performs other checks only on the clauses on the whole combined/composite construct and not just each leaf separately. I'd say we should move that diagnostics and perhaps other similar later on into a separate routine that is invoked only after the clauses are split or for non-combined/composite construct clauses. Jakub ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2021-11-02 16:27 ` Jakub Jelinek @ 2021-11-02 17:54 ` Jakub Jelinek 2021-11-18 19:30 ` Hafiz Abid Qadeer 1 sibling, 0 replies; 28+ messages in thread From: Jakub Jelinek @ 2021-11-02 17:54 UTC (permalink / raw) To: Hafiz Abid Qadeer, tobias, gcc-patches On Tue, Nov 02, 2021 at 05:27:14PM +0100, Jakub Jelinek via Gcc-patches wrote: > I'm not sure this is what the standard says, certainly C/C++ FE do this > quite differently for combined/composite constructs. > In particular, we first split the clauses to the individual leaf constructs > in c_omp_split_clauses, which for allocate clause is even more complicated > because as clarified in 5.2: > "The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause > and to which a data-sharing attribute clause that may create a private copy of the same list item is > applied." > so there is the has_dup_allocate stuff, we first duplicate it to all leaf > constructs that allow the allocate clause and set has_dup_allocate if it is > put on more than one construct, and then if has_dup_allocate is set, do > more detailed processing. And finally then {,c_}finish_omp_clauses > diagnoses what you are trying above, but only on each leaf construct > separately. > > Now, Fortran is performing the splitting of clauses only much later in > trans-openmp.c, I wonder if it doesn't have other issues on > combined/composite constructs if it performs other checks only on the > clauses on the whole combined/composite construct and not just each leaf > separately. I'd say we should move that diagnostics and perhaps other > similar later on into a separate routine that is invoked only after the > clauses are split or for non-combined/composite construct clauses. Testcases unrelated to allocate clause that have same problematic behavior: void foo (int x) { #pragma omp parallel for simd shared (x) private (x) for (int i = 0; i < 32; i++) ; } is correctly accepted, as per Clauses on Combined and Composite Constructs shared clause goes to parallel construct, private goes to innermost leaf aka simd, so there is no leaf construct with multiple data sharing clauses for x. But: subroutine foo (x) integer :: x, i !$omp parallel do simd shared (x) private (x) do i = 1, 32 end do end subroutine is incorrectly rejected with: 3 | !$omp parallel do simd shared (x) private (x) | 1 Error: Symbol ‘x’ present on multiple clauses at (1) Jakub ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2021-11-02 16:27 ` Jakub Jelinek 2021-11-02 17:54 ` Jakub Jelinek @ 2021-11-18 19:30 ` Hafiz Abid Qadeer 2021-12-20 20:06 ` Jakub Jelinek 1 sibling, 1 reply; 28+ messages in thread From: Hafiz Abid Qadeer @ 2021-11-18 19:30 UTC (permalink / raw) To: Jakub Jelinek, Hafiz Abid Qadeer; +Cc: gcc-patches, tobias [-- Attachment #1: Type: text/plain, Size: 6147 bytes --] On 02/11/2021 16:27, Jakub Jelinek wrote: > On Fri, Oct 22, 2021 at 02:05:02PM +0100, Hafiz Abid Qadeer wrote: >> This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not >> yet support the allocator-modifier as specified in OpenMP 5.1. The allocate >> clause is already supported in C/C++. >> >> gcc/fortran/ChangeLog: >> >> * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE. >> * gfortran.h (OMP_LIST_ALLOCATE): New enum value. >> (allocate): New member in gfc_symbol. >> * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE. >> (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE > > Missing . at the end. Done. > >> (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES) >> (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES) >> (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES) >> (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE. >> (OMP_TASKGROUP_CLAUSES): New > > Likewise. Done. > >> (gfc_match_omp_taskgroup): Use 'OMP_TASKGROUP_CLAUSES' instead of >> 'OMP_CLAUSE_TASK_REDUCTION' > > Likewise. Please also drop the ' characters. Done. > >> @@ -1880,6 +1881,10 @@ typedef struct gfc_symbol >> according to the Fortran standard. */ >> unsigned pass_as_value:1; >> >> + /* Used to check if a variable used in allocate clause has also been >> + used in privatization clause. */ >> + unsigned allocate:1; > > I think it would be desirable to use omp_allocate here instead > of allocate and mention OpenMP in the comment too. > Fortran has allocate statement in the language, so not pointing to > OpenMP would only cause confusion. Done. > >> @@ -1540,6 +1541,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, >> } >> continue; >> } >> + if ((mask & OMP_CLAUSE_ALLOCATE) >> + && gfc_match ("allocate ( ") == MATCH_YES) >> + { >> + gfc_expr *allocator = NULL; >> + old_loc = gfc_current_locus; >> + m = gfc_match_expr (&allocator); >> + if (m != MATCH_YES) >> + { >> + gfc_error ("Expected allocator or variable list at %C"); >> + goto error; >> + } >> + if (gfc_match (" : ") != MATCH_YES) >> + { >> + /* If no ":" then there is no allocator, we backtrack >> + and read the variable list. */ >> + allocator = NULL; > > Isn't this a memory leak? I believe Fortran FE expressions are not GC > allocated... > So, shouldn't there be gfc_free_expr or something similar before clearing it? Done. Also added a call to gfc_free_expr at the end to free it as n->expr points to a copy. > >> + /* 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. */ >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) >> + n->sym->allocate = 0; >> + >> + gfc_omp_namelist *prev = NULL; >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) >> + { >> + if (n->sym->allocate == 1) >> + { >> + gfc_warning (0, "%qs appears more than once in %<allocate%> " >> + "clauses 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, 0); >> + n = prev->next; >> + } >> + >> + continue; >> + } >> + n->sym->allocate = 1; >> + prev = n; >> + n = n->next; >> + } >> + >> + for (list = 0; list < OMP_LIST_NUM; list++) >> + 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->allocate = 0; >> + break; >> + default: >> + break; >> + } >> + >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) >> + if (n->sym->allocate == 1) >> + gfc_error ("%qs specified in 'allocate' clause at %L but not in an " >> + "explicit privatization clause", n->sym->name, &n->where); > > I'm not sure this is what the standard says, certainly C/C++ FE do this > quite differently for combined/composite constructs. > In particular, we first split the clauses to the individual leaf constructs > in c_omp_split_clauses, which for allocate clause is even more complicated > because as clarified in 5.2: > "The effect of the allocate clause is as if it is applied to all leaf constructs that permit the clause > and to which a data-sharing attribute clause that may create a private copy of the same list item is > applied." > so there is the has_dup_allocate stuff, we first duplicate it to all leaf > constructs that allow the allocate clause and set has_dup_allocate if it is > put on more than one construct, and then if has_dup_allocate is set, do > more detailed processing. And finally then {,c_}finish_omp_clauses > diagnoses what you are trying above, but only on each leaf construct > separately. > > Now, Fortran is performing the splitting of clauses only much later in > trans-openmp.c, I wonder if it doesn't have other issues on > combined/composite constructs if it performs other checks only on the > clauses on the whole combined/composite construct and not just each leaf > separately. I'd say we should move that diagnostics and perhaps other > similar later on into a separate routine that is invoked only after the > clauses are split or for non-combined/composite construct clauses. Updated patch keeps the old code but restricts it to non-composite case. For composite constructs, I have added code at the end of gfc_split_omp_clauses to copy allocate clause to all leaf constructs which allow it and have a privatization clause. A new testcase checks for error in this case. Thanks -- Hafiz Abid Qadeer Mentor, a Siemens Business [-- Attachment #2: 0001-gfortran-Add-support-for-allocate-clause-OpenMP-5.0.patch --] [-- Type: text/x-patch, Size: 68641 bytes --] From f3f33856ce473253b30efc5e45032bd8a5a617ca Mon Sep 17 00:00:00 2001 From: Hafiz Abid Qadeer <abidh@codesourcery.com> Date: Fri, 24 Sep 2021 10:04:12 +0100 Subject: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not yet support the allocator-modifier as specified in OpenMP 5.1. The allocate clause is already supported in C/C++. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE. * gfortran.h (OMP_LIST_ALLOCATE): New enum value. (allocate): New member in gfc_symbol. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE. (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES) (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES) (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES) (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE. (OMP_TASKGROUP_CLAUSES): New. (gfc_match_omp_taskgroup): Use OMP_TASKGROUP_CLAUSES instead of OMP_CLAUSE_TASK_REDUCTION. (resolve_omp_clauses): Handle OMP_LIST_ALLOCATE. (resolve_omp_do): Avoid warning when loop iteration variable is in allocate clause. * trans-openmp.c (gfc_trans_omp_clauses): Handle translation of allocate clause. (gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-1.f90: New test. * gfortran.dg/gomp/allocate-2.f90: New test. * gfortran.dg/gomp/allocate-3.f90: New test. * gfortran.dg/gomp/collapse1.f90: Update error message. * gfortran.dg/gomp/openmp-simd-4.f90: Likewise. * gfortran.dg/gomp/clauses-1.f90: Uncomment allocate clause. libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.c: New test. * testsuite/libgomp.fortran/allocate-1.f90: New test. --- gcc/fortran/dump-parse-tree.c | 1 + gcc/fortran/gfortran.h | 4 + gcc/fortran/openmp.c | 148 +++++++- gcc/fortran/trans-openmp.c | 87 +++++ gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 | 123 +++++++ gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 | 45 +++ gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 | 14 + gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 | 272 +++++++------- gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +- .../gfortran.dg/gomp/openmp-simd-4.f90 | 6 +- .../testsuite/libgomp.fortran/allocate-1.c | 7 + .../testsuite/libgomp.fortran/allocate-1.f90 | 333 ++++++++++++++++++ 12 files changed, 885 insertions(+), 157 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.f90 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 04660d5074a..038c0340cbb 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1685,6 +1685,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break; case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break; + case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break; case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break; case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break; default: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1846ee4fd3c..c38875ce1f5 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1391,6 +1391,7 @@ enum OMP_LIST_USE_DEVICE_PTR, OMP_LIST_USE_DEVICE_ADDR, OMP_LIST_NONTEMPORAL, + OMP_LIST_ALLOCATE, OMP_LIST_NUM }; @@ -1884,6 +1885,9 @@ typedef struct gfc_symbol according to the Fortran standard. */ unsigned pass_as_value:1; + /* Used to check restrictions on OpenMP allocate clause. */ + unsigned omp_allocate_clause:1; + int refs; struct gfc_namespace *ns; /* namespace containing this symbol */ diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index d120be81467..d9121767bd6 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -912,6 +912,7 @@ enum omp_mask1 OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ + OMP_CLAUSE_ALLOCATE, /* OpenMP 5.0. */ OMP_CLAUSE_BIND, /* OpenMP 5.0. */ OMP_CLAUSE_FILTER, /* OpenMP 5.1. */ OMP_CLAUSE_AT, /* OpenMP 5.1. */ @@ -1541,6 +1542,42 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } continue; } + if ((mask & OMP_CLAUSE_ALLOCATE) + && gfc_match ("allocate ( ") == MATCH_YES) + { + gfc_expr *allocator = NULL; + old_loc = gfc_current_locus; + m = gfc_match_expr (&allocator); + if (m != MATCH_YES) + { + gfc_error ("Expected allocator or variable list at %C"); + goto error; + } + if (gfc_match (" : ") != MATCH_YES) + { + /* If no ":" then there is no allocator, we backtrack + and read the variable list. */ + gfc_free_expr (allocator); + allocator = NULL; + gfc_current_locus = old_loc; + } + + gfc_omp_namelist **head = NULL; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], + false, NULL, &head); + + if (m == MATCH_ERROR) + break; + + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + if (allocator) + n->expr = gfc_copy_expr (allocator); + else + n->expr = NULL; + gfc_free_expr (allocator); + continue; + } if ((mask & OMP_CLAUSE_AT) && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) != MATCH_NO) @@ -3523,7 +3560,7 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_PROC_BIND) + | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE) #define OMP_DECLARE_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \ | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \ @@ -3532,15 +3569,16 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ - | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_LOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + #define OMP_SCOPE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION) #define OMP_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \ | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \ @@ -3551,20 +3589,22 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY) + | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE) #define OMP_TASKLOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \ | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \ | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP \ - | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION) + | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE) +#define OMP_TASKGROUP_CLAUSES \ + (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \ | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_THREAD_LIMIT) + | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR) @@ -3580,13 +3620,14 @@ cleanup: #define OMP_TEAMS_CLAUSES \ (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \ - | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_SINGLE_CLAUSES \ - (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_ALLOCATE) #define OMP_ORDERED_CLAUSES \ (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ @@ -5849,7 +5890,7 @@ gfc_match_omp_barrier (void) match gfc_match_omp_taskgroup (void) { - return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION); + return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES); } @@ -6187,7 +6228,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "IN_REDUCTION", "TASK_REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", - "NONTEMPORAL" }; + "NONTEMPORAL", "ALLOCATE" }; STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM); if (omp_clauses == NULL) @@ -6473,7 +6514,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && list != OMP_LIST_REDUCTION_INSCAN && list != OMP_LIST_REDUCTION_TASK && list != OMP_LIST_IN_REDUCTION - && list != OMP_LIST_TASK_REDUCTION) + && list != OMP_LIST_TASK_REDUCTION + && list != OMP_LIST_ALLOCATE) for (n = omp_clauses->lists[list]; n; n = n->next) { bool component_ref_p = false; @@ -6542,6 +6584,77 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, 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->expr && (n->expr->ts.type != BT_INTEGER + || n->expr->ts.kind != gfc_c_intptr_kind)) + { + gfc_error ("Expected integer expression of the " + "'omp_allocator_handle_kind' kind at %L", &n->expr->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) + n->sym->omp_allocate_clause = 0; + + gfc_omp_namelist *prev = NULL; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) + { + if (n->sym->omp_allocate_clause == 1) + { + gfc_warning (0, "%qs appears more than once in %<allocate%> " + "clauses 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, 0); + n = prev->next; + } + continue; + } + n->sym->omp_allocate_clause = 1; + prev = n; + n = n->next; + } + + /* non-composite constructs. */ + if (code && code->op < EXEC_OMP_DO_SIMD) + { + for (list = 0; list < OMP_LIST_NUM; list++) + 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->omp_allocate_clause = 0; + break; + default: + break; + } + + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym->omp_allocate_clause == 1) + gfc_error ("%qs specified in 'allocate' clause at %L but not " + "in an explicit privatization clause", + n->sym->name, &n->where); + } + } + /* OpenACC reductions. */ if (openacc) { @@ -8259,19 +8372,20 @@ resolve_omp_do (gfc_code *code) if (code->ext.omp_clauses) for (list = 0; list < OMP_LIST_NUM; list++) if (!is_simd || code->ext.omp_clauses->collapse > 1 - ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALLOCATE) : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_LINEAR)) + && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR)) for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) if (dovar == n->sym) { if (!is_simd || code->ext.omp_clauses->collapse > 1) gfc_error ("%s iteration variable present on clause " - "other than PRIVATE or LASTPRIVATE at %L", - name, &do_code->loc); + "other than PRIVATE, LASTPRIVATE or " + "ALLOCATE at %L", name, &do_code->loc); else gfc_error ("%s iteration variable present on clause " - "other than PRIVATE, LASTPRIVATE or " + "other than PRIVATE, LASTPRIVATE, ALLOCATE or " "LINEAR at %L", name, &do_code->loc); break; } diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 5b3c310ba59..2f77aabd798 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2646,6 +2646,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_ALLOCATE: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced || declare_simd) + { + tree t = gfc_trans_omp_variable (n->sym, declare_simd); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALLOCATE); + OMP_CLAUSE_DECL (node) = t; + if (n->expr) + { + tree allocator_; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + allocator_ = gfc_evaluate_now (se.expr, block); + OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; case OMP_LIST_LINEAR: { gfc_expr *last_step_expr = NULL; @@ -6140,6 +6162,71 @@ gfc_split_omp_clauses (gfc_code *code, == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) && !is_loop) clausesa[GFC_OMP_SPLIT_DO].nowait = true; + + /* Distribute allocate clause to do, parallel, distribute, teams, target + and taskloop. The code below itereates over variables in the + allocate list and checks if that available is also in any + privatization clause on those construct. If yes, then we add it + to the list of 'allocate'ed variables for that construct. If a + variable is found in none of them then we issue an error. */ + + if (code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]) + { + gfc_omp_namelist *alloc_nl, *priv_nl; + gfc_omp_namelist *tails[GFC_OMP_SPLIT_NUM]; + for (alloc_nl = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; + alloc_nl; alloc_nl = alloc_nl->next) + { + bool found = false; + for (int i = GFC_OMP_SPLIT_DO; i <= GFC_OMP_SPLIT_TASKLOOP; i++) + { + gfc_omp_namelist *p; + int list; + for (list = 0; list < OMP_LIST_NUM; list++) + { + 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 (priv_nl = clausesa[i].lists[list]; priv_nl; + priv_nl = priv_nl->next) + if (alloc_nl->sym == priv_nl->sym) + { + found = true; + p = gfc_get_omp_namelist (); + p->sym = alloc_nl->sym; + p->expr = alloc_nl->expr; + p->where = alloc_nl->where; + if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL) + { + clausesa[i].lists[OMP_LIST_ALLOCATE] = p; + tails[i] = p; + } + else + { + tails[i]->next = p; + tails[i] = tails[i]->next; + } + } + break; + default: + break; + } + } + } + if (!found) + gfc_error ("%qs specified in 'allocate' clause at %L but not " + "in an explicit privatization clause", alloc_nl->sym->name, + &alloc_nl->where); + } + } } static tree diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 new file mode 100644 index 00000000000..34dad47a39d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 @@ -0,0 +1,123 @@ +! { dg-do compile } + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 +end module + +subroutine bar (a, b, c) + implicit none + integer :: a + integer :: b + integer :: c + c = a + b +end + +subroutine bar2 (a, b, c) + implicit none + integer :: a + integer :: b(15) + integer :: c + c = a + b(1) +end + +subroutine foo(x, y) + use omp_lib_kinds + implicit none + integer :: x + integer :: z + + integer, dimension(15) :: y + integer :: r + integer :: i + integer (kind=omp_allocator_handle_kind) :: h + r = 0 + h = omp_default_mem_alloc; + + !$omp parallel allocate (x) allocate (h : y) & + !$omp allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z) + call bar2 (x, y, z); + !$omp end parallel + + !$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z) + call bar (0, x, z); + !$omp end task + + !$omp target teams distribute parallel do private (x) firstprivate (y) & + !$omp allocate ((omp_default_mem_alloc + 0):z) allocate & + !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r) + do i = 1, 10 + call bar (0, x, z); + call bar2 (1, y, r); + end do + !$omp end target teams distribute parallel do + + !$omp single private (x) allocate (omp_low_lat_mem_alloc:x) + x=1 + !$omp end single + + !$omp single allocate (omp_low_lat_mem_alloc:x) private (x) + !$omp end single + + !$omp parallel + !$omp do allocate (x) private (x) + do i = 1, 64 + x = 1; + end do + !$omp end parallel + + !$omp sections private (x) allocate (omp_low_lat_mem_alloc: x) + x = 1; + !$omp section + x = 2; + !$omp section + x = 3; + !$omp end sections + + !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r) + call bar (r, r, r); + !$omp end taskgroup + + !$omp teams private (x) firstprivate (y) allocate (h : x, y) + call bar2 (x, y, r); + !$omp end teams + + !$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r) + do i = 1, 16 + call bar (0, r, r); + x = i; + end do + !$omp end taskloop + + !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r) + !$omp taskloop firstprivate (x) in_reduction (+:r) & + !$omp allocate (omp_default_mem_alloc : x, r) + do i = 1, 16 + call bar (x, r, r); + end do + !$omp end taskloop + !$omp end taskgroup + !$omp taskwait +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 new file mode 100644 index 00000000000..88b2d26872d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 @@ -0,0 +1,45 @@ +! { dg-do compile } + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + +end module + +subroutine foo(x) + use omp_lib_kinds + implicit none + integer :: x + + !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=1 + !$omp end task + + !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=2 + !$omp end parallel + + !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=3 + !$omp end parallel + + !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } + x=4 + !$omp end parallel + + !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } + x=5 + !$omp end parallel + + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + x=6 + !$omp end parallel + + !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + x=7 + !$omp end parallel + +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 new file mode 100644 index 00000000000..7b57be980cb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } + +subroutine foo(x) + implicit none + integer :: x + integer :: i + + !$omp parallel do simd private (x) allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + do i = 1, 64 + x = i + end do + !$omp end parallel do simd + +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 index 639f5d19bdb..92801852984 100644 --- a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 @@ -36,8 +36,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -46,8 +46,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -55,8 +55,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute simd & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -81,8 +81,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) copyin(t) - ! FIXME/TODO: allocate (p) + !$omp& lastprivate (l) schedule(static, 4) copyin(t) & + !$omp& allocate (p) do i = 1, 64 ll = ll +1 end do @@ -90,8 +90,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (p) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (p) do i = 1, 64 ll = ll +1 end do @@ -100,8 +100,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -110,8 +110,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -119,8 +119,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute simd & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -140,8 +140,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp do simd & !$omp& private (p) firstprivate (f) lastprivate (l) linear (ll:1) reduction(+:r) schedule(static, 4) collapse(1) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -149,16 +149,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel do & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp parallel do & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -166,16 +166,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel do simd & !$omp& private (p) firstprivate (f) if (i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp parallel sections & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) & + !$omp& allocate (f) !$omp section block; end block !$omp section @@ -185,16 +185,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target parallel & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& depend(inout: dd(0)) in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& depend(inout: dd(0)) in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) !$omp end target parallel nowait !$omp target parallel do & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) depend(inout: dd(0)) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -204,8 +204,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) depend(inout: dd(0)) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -216,8 +216,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -226,15 +226,15 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte - 1:nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) !$omp end target teams nowait !$omp target teams distribute & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) order(concurrent) & - !$omp& collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 end do !$omp end target teams distribute nowait @@ -245,8 +245,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) depend(inout: dd(0)) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -259,8 +259,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -271,8 +271,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -282,34 +282,34 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& safelen(8) simdlen(4) lastprivate (l) linear(ll: 1) aligned(q: 32) reduction(+:r) & !$omp& depend(inout: dd(0)) nontemporal(ntm) if(simd:i3) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do !$omp end target simd nowait - !$omp taskgroup task_reduction(+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction(+:r2) & + !$omp& allocate (r2) !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp end taskgroup - !$omp taskgroup task_reduction(+:r) - ! FIXME/TODO: allocate (r) + !$omp taskgroup task_reduction(+:r) & + !$omp& allocate (r) !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(i1) & !$omp& final(fi) mergeable nogroup priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) in_reduction(+:r) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -319,8 +319,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) if(taskloop: i1) & !$omp& final(fi) priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(+:r) if (simd: i3) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -328,8 +328,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target depend(inout: dd(0)) in_reduction(+:r2) !$omp teams distribute & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & - !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 end do !$omp end target nowait @@ -339,8 +339,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -352,8 +352,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -363,8 +363,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp teams distribute simd & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -374,8 +374,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& lastprivate (l) schedule(static, 4) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -384,8 +384,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) - ! FIXME/TODO: allocate (f) + !$omp& lastprivate (l) schedule(static, 4) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -395,8 +395,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -406,8 +406,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -415,68 +415,68 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp teams distribute simd & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) - ! FIXME/TODO: allocate(f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) & + !$omp& allocate(f) do i = 1, 64 ll = ll +1 end do !$omp parallel master & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) !$omp end parallel master !$omp parallel masked & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d) & + !$omp& allocate (f) !$omp end parallel masked - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) in_reduction(+:r2) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) in_reduction(+:r2) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & - !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -485,8 +485,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -494,8 +494,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -504,8 +504,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -514,14 +514,14 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) & !$omp& untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) @@ -530,8 +530,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) & !$omp& untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) @@ -540,25 +540,25 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) & !$omp& final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -566,8 +566,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & - !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -575,8 +575,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) & - !$omp& copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& copyin(t) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -584,8 +584,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -593,8 +593,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) & !$omp& final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -607,31 +607,31 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel loop & !$omp& private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2) & + !$omp& allocate (f) do l = 1, 64 ll = ll + 1 end do !$omp parallel loop & !$omp& private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2) & + !$omp& allocate (f) do l = 1, 64 ll = ll + 1 end do !$omp teams loop & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & - !$omp& collapse(1) lastprivate (l) bind(teams) - ! FIXME/TODO: allocate (f) + !$omp& collapse(1) lastprivate (l) bind(teams) & + !$omp& allocate (f) do l = 1, 64 end do !$omp teams loop & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & - !$omp& collapse(1) lastprivate (l) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& collapse(1) lastprivate (l) order(concurrent) & + !$omp& allocate (f) do l = 1, 64 end do @@ -639,8 +639,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& depend(inout: dd(0)) lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) & - !$omp& if (target: i1) if (parallel: i2) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& if (target: i1) if (parallel: i2) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target parallel loop nowait @@ -648,8 +648,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams loop & !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target teams loop nowait @@ -657,8 +657,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams loop & !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target teams loop nowait diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 index 1a06eaba823..01cfc82b760 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 @@ -24,7 +24,7 @@ subroutine collapse1 end do !$omp parallel do collapse(2) shared(j) do i = 1, 3 - do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" } + do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } end do end do !$omp parallel do collapse(2) diff --git a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 index 4a17fb9820e..17375e0eff5 100644 --- a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 @@ -45,17 +45,17 @@ do i = 1, 5 end do !$omp parallel do firstprivate(i) -do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE or LASTPRIVATE" } +do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } x(i) = 42 end do !$omp parallel do simd firstprivate(i) -do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or LINEAR" } +do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE, ALLOCATE or LINEAR" } x(i) = 42 end do !$omp simd linear(i) collapse(2) -do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE or LASTPRIVATE" } +do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } do j = 1, 2 y(j, i) = 52 end do diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c new file mode 100644 index 00000000000..d33acc6feef --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c @@ -0,0 +1,7 @@ +#include <stdint.h> + +int +is_64bit_aligned_ (uintptr_t a) +{ + return ( (a & 0x3f) == 0); +} diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 new file mode 100644 index 00000000000..35d1750b878 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -0,0 +1,333 @@ +! { dg-do run } +! { dg-additional-sources allocate-1.c } +! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" } + +module m + use omp_lib + use iso_c_binding + implicit none + + interface + integer(c_int) function is_64bit_aligned (a) bind(C) + import :: c_int + integer :: a + end + end interface +end module m + +subroutine foo (x, p, q, px, h, fl) + use omp_lib + use iso_c_binding + integer :: x + integer, dimension(4) :: p + integer, dimension(4) :: q + integer :: px + integer (kind=omp_allocator_handle_kind) :: h + integer :: fl + + integer :: y + integer :: r, i, i1, i2, i3, i4, i5 + integer :: l, l3, l4, l5, l6 + integer :: n, n1, n2, n3, n4 + integer :: j2, j3, j4 + integer, dimension(4) :: l2 + integer, dimension(4) :: r2 + integer, target :: xo + integer, target :: yo + integer, dimension(x) :: v + integer, dimension(x) :: w + + type s_type + integer :: a + integer :: b + end type + + type (s_type) :: s + s%a = 27 + s%b = 29 + y = 0 + r = 0 + n = 8 + n2 = 9 + n3 = 10 + n4 = 11 + xo = x + yo = y + + do i = 1, 4 + r2(i) = 0; + end do + + do i = 1, 4 + p(i) = 0; + end do + + do i = 1, 4 + q(i) = 0; + end do + + do i = 1, x + w(i) = i + end do + + !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) + if (x /= 42) then + stop 1 + end if + v(1) = 7 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(v(1)) == 0))) then + stop 2 + end if + + !$omp barrier + y = 1; + x = x + 1 + v(1) = 7 + v(41) = 8 + !$omp barrier + if (x /= 43 .or. y /= 1) then + stop 3 + end if + if (v(1) /= 7 .or. v(41) /= 8) then + stop 4 + end if + !$omp end parallel + + !$omp teams + !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) + + if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then + stop 5 + end if + !$omp barrier + y = 1; + x = x + 1 + w(19) = w(19) + 1 + !$omp barrier + if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then + stop 6 + end if + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(w(1)) == 0))) then + stop 7 + end if + !$omp end parallel + !$omp end teams + + !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16) + do i = 0, 63 + if (x /= 42) then + stop 8 + end if + y = 1; + l = i; + n = n + y + 15; + r = r + i; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(r) == 0) .or. & + (is_64bit_aligned(l) == 0) .or. & + (is_64bit_aligned(n) == 0))) then + stop 9 + end if + end do + !$omp end parallel do + + !$omp parallel + !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3) + do i1 = 0, 63 + l2(1) = i1 + l2(2) = i1 + 1 + l2(3) = i1 + 2 + l2(4) = i1 + 3 + if (i1 < 37) then + l3 = i1 + end if + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l2(1)) == 0) .or. & + (is_64bit_aligned(l3) == 0) .or. & + (is_64bit_aligned(i1) == 0))) then + stop 10 + end if + end do + + !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2) + do i2 = 3, 4 + do j2 = 17, 22, 2 + n2 = n2 + 17 + l4 = i2 * 31 + j2 + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l4) == 0) .or. & + (is_64bit_aligned(n2) == 0) .or. & + (is_64bit_aligned(i2) == 0) .or. & + (is_64bit_aligned(j2) == 0))) then + stop 11 + end if + end do + end do + + !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3) + do i3 = 3, 4 + do j3 = 17, 22, 2 + n3 = n3 + 17 + l5 = i3 * 31 + j3 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(l5) == 0) .or. & + (is_64bit_aligned(n3) == 0) .or. & + (is_64bit_aligned(i3) == 0) .or. & + (is_64bit_aligned(j3) == 0))) then + stop 12 + end if + end do + end do + + !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4) + do i4 = 3, 4 + do j4 = 17, 22,2 + n4 = n4 + 17; + l6 = i4 * 31 + j4; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l6) == 0) .or. & + (is_64bit_aligned(n4) == 0) .or. & + (is_64bit_aligned(i4) == 0) .or. & + (is_64bit_aligned(j4) == 0))) then + stop 13 + end if + end do + end do + + !$omp do lastprivate (i5) allocate (i5) + do i5 = 1, 17, 3 + if ( (and(fl, 2) /= 0) .and. & + (is_64bit_aligned(i5) == 0)) then + stop 14 + end if + end do + + !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2) + do i = 0, 31 + p(3) = p(3) + i; + p(4) = p(4) + (2 * i) + q(1) = q(1) + (3 * i) + q(3) = q(3) + (4 * i) + r2(1) = r2(1) + (5 * i) + r2(4) = r2(4) + (6 * i) + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(q(1)) == 0) .or. & + (is_64bit_aligned(p(1)) == 0) .or. & + (is_64bit_aligned(r2(1)) == 0) )) then + stop 15 + end if + end do + + !$omp task private(y) firstprivate(x) allocate(x, y) + if (x /= 42) then + stop 16 + end if + + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 17 + end if + !$omp end task + + !$omp task private(y) firstprivate(x) allocate(h: x, y) + if (x /= 42) then + stop 16 + end if + + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 17 + end if + !$omp end task + + !$omp task private(y) firstprivate(s) allocate(s, y) + if (s%a /= 27 .or. s%b /= 29) then + stop 18 + end if + + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(s%a) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 19 + end if + !$omp end task + + !$omp task private(y) firstprivate(s) allocate(h: s, y) + if (s%a /= 27 .or. s%b /= 29) then + stop 18 + end if + + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(s%a) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 19 + end if + !$omp end task + + !$omp end parallel + + if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then + stop 20 + end if + + if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then + stop 21 + end if + + if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then + stop 22 + end if + + if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then + stop 23 + end if + + if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then + stop 24 + end if + + if (i5 /= 19) then + stop 24 + end if + + if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) & + .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) & + .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then + stop 25 + end if + +end subroutine + +program main + use omp_lib + integer, dimension(4) :: p + integer, dimension(4) :: q + + type (omp_alloctrait) :: traits(3) + integer (omp_allocator_handle_kind) :: a + + traits = [omp_alloctrait (omp_atk_alignment, 64), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & + omp_alloctrait (omp_atk_pool_size, 8192)] + a = omp_init_allocator (omp_default_mem_space, 3, traits) + if (a == omp_null_allocator) stop 1 + + call omp_set_default_allocator (omp_default_mem_alloc); + call foo (42, p, q, 2, a, 0); + call foo (42, p, q, 2, omp_default_mem_alloc, 0); + call foo (42, p, q, 2, a, 1); + call omp_set_default_allocator (a); + call foo (42, p, q, 2, omp_null_allocator, 3); + call foo (42, p, q, 2, omp_default_mem_alloc, 2); + call omp_destroy_allocator (a); +end -- 2.25.1 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2021-11-18 19:30 ` Hafiz Abid Qadeer @ 2021-12-20 20:06 ` Jakub Jelinek 2022-01-11 22:31 ` Hafiz Abid Qadeer 0 siblings, 1 reply; 28+ messages in thread From: Jakub Jelinek @ 2021-12-20 20:06 UTC (permalink / raw) To: Hafiz Abid Qadeer; +Cc: Hafiz Abid Qadeer, gcc-patches, tobias On Thu, Nov 18, 2021 at 07:30:36PM +0000, Hafiz Abid Qadeer wrote: > + if (gfc_match (" : ") != MATCH_YES) > + { > + /* If no ":" then there is no allocator, we backtrack > + and read the variable list. */ > + gfc_free_expr (allocator); > + allocator = NULL; > + gfc_current_locus = old_loc; > + } Ok, no leak above. > + > + gfc_omp_namelist **head = NULL; > + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], > + false, NULL, &head); > + > + if (m == MATCH_ERROR) > + break; But here it leaks. Just call gfc_free_expr (allocator); before break. > + > + gfc_omp_namelist *n; > + for (n = *head; n; n = n->next) > + if (allocator) > + n->expr = gfc_copy_expr (allocator); > + else > + n->expr = NULL; > + gfc_free_expr (allocator); > + continue; > + } > if ((mask & OMP_CLAUSE_AT) > && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) > != MATCH_NO) > + if (omp_clauses->lists[OMP_LIST_ALLOCATE]) > + { > + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) > + if (n->expr && (n->expr->ts.type != BT_INTEGER > + || n->expr->ts.kind != gfc_c_intptr_kind)) > + { > + gfc_error ("Expected integer expression of the " > + "'omp_allocator_handle_kind' kind at %L", &n->expr->where); Formatting, "' should be indented below "Expected > + 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) > + n->sym->omp_allocate_clause = 0; > + > + gfc_omp_namelist *prev = NULL; > + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) > + { > + if (n->sym->omp_allocate_clause == 1) > + { > + gfc_warning (0, "%qs appears more than once in %<allocate%> " > + "clauses 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, 0); > + n = prev->next; > + } > + continue; > + } > + n->sym->omp_allocate_clause = 1; > + prev = n; > + n = n->next; > + } > + > + /* non-composite constructs. */ > + if (code && code->op < EXEC_OMP_DO_SIMD) > + { > + for (list = 0; list < OMP_LIST_NUM; list++) > + 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->omp_allocate_clause = 0; > + break; > + default: > + break; > + } > + > + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) > + if (n->sym->omp_allocate_clause == 1) > + gfc_error ("%qs specified in 'allocate' clause at %L but not " > + "in an explicit privatization clause", > + n->sym->name, &n->where); > + } > + } Do you really need a new omp_allocate_clause bit? From what I can see, other code uses n->sym->mark for such purposes (temporarily marking some symbols). Also, I think allocate clause like the privatization clauses should allow common blocks and I see code that uses the marks uses something like: for (list = OMP_LIST_TO; list != OMP_LIST_NUM; list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM)) for (n = c->lists[list]; n; n = n->next) if (n->sym) n->sym->mark = 0; else if (n->u.common->head) n->u.common->head->mark = 0; So, a question is if the above won't just crash if I specify firstprivate(/foobar/) allocate(/foobar/) etc. > + case OMP_LIST_ALLOCATE: > + for (; n != NULL; n = n->next) > + if (n->sym->attr.referenced || declare_simd) !$omp declare simd doesn't allow allocate clause, so why the above " || declare_simd"? > + { > + tree t = gfc_trans_omp_variable (n->sym, declare_simd); And not , false); above? Jakub ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2021-12-20 20:06 ` Jakub Jelinek @ 2022-01-11 22:31 ` Hafiz Abid Qadeer 2022-01-13 12:50 ` Jakub Jelinek ` (2 more replies) 0 siblings, 3 replies; 28+ messages in thread From: Hafiz Abid Qadeer @ 2022-01-11 22:31 UTC (permalink / raw) To: Jakub Jelinek; +Cc: Hafiz Abid Qadeer, gcc-patches, tobias [-- Attachment #1: Type: text/plain, Size: 5171 bytes --] Hi Jakub Thanks for the review. Please see comments inline. Also note that common block is now allowed in allocate clause as per your comment so there is slight adjustment in the parsing code for that. On 20/12/2021 20:06, Jakub Jelinek wrote: > On Thu, Nov 18, 2021 at 07:30:36PM +0000, Hafiz Abid Qadeer wrote: >> + if (gfc_match (" : ") != MATCH_YES) >> + { >> + /* If no ":" then there is no allocator, we backtrack >> + and read the variable list. */ >> + gfc_free_expr (allocator); >> + allocator = NULL; >> + gfc_current_locus = old_loc; >> + } > > Ok, no leak above. > >> + >> + gfc_omp_namelist **head = NULL; >> + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], >> + false, NULL, &head); >> + >> + if (m == MATCH_ERROR) >> + break; > > But here it leaks. Just call gfc_free_expr (allocator); before break. Done. Although code is a bit different from the last patch. > >> + >> + gfc_omp_namelist *n; >> + for (n = *head; n; n = n->next) >> + if (allocator) >> + n->expr = gfc_copy_expr (allocator); >> + else >> + n->expr = NULL; >> + gfc_free_expr (allocator); >> + continue; >> + } >> if ((mask & OMP_CLAUSE_AT) >> && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) >> != MATCH_NO) > >> + if (omp_clauses->lists[OMP_LIST_ALLOCATE]) >> + { >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) >> + if (n->expr && (n->expr->ts.type != BT_INTEGER >> + || n->expr->ts.kind != gfc_c_intptr_kind)) >> + { >> + gfc_error ("Expected integer expression of the " >> + "'omp_allocator_handle_kind' kind at %L", &n->expr->where); > > Formatting, "' should be indented below "Expected Done. > >> + 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) >> + n->sym->omp_allocate_clause = 0; >> + >> + gfc_omp_namelist *prev = NULL; >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) >> + { >> + if (n->sym->omp_allocate_clause == 1) >> + { >> + gfc_warning (0, "%qs appears more than once in %<allocate%> " >> + "clauses 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, 0); >> + n = prev->next; >> + } >> + continue; >> + } >> + n->sym->omp_allocate_clause = 1; >> + prev = n; >> + n = n->next; >> + } >> + >> + /* non-composite constructs. */ >> + if (code && code->op < EXEC_OMP_DO_SIMD) >> + { >> + for (list = 0; list < OMP_LIST_NUM; list++) >> + 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->omp_allocate_clause = 0; >> + break; >> + default: >> + break; >> + } >> + >> + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) >> + if (n->sym->omp_allocate_clause == 1) >> + gfc_error ("%qs specified in 'allocate' clause at %L but not " >> + "in an explicit privatization clause", >> + n->sym->name, &n->where); >> + } >> + } > > Do you really need a new omp_allocate_clause bit? From what I can see, > other code uses n->sym->mark for such purposes (temporarily marking some > symbols). Done. > Also, I think allocate clause like the privatization clauses should allow > common blocks and I see code that uses the marks uses something like: > for (list = OMP_LIST_TO; list != OMP_LIST_NUM; > list = (list == OMP_LIST_TO ? OMP_LIST_LINK : OMP_LIST_NUM)) > for (n = c->lists[list]; n; n = n->next) > if (n->sym) > n->sym->mark = 0; > else if (n->u.common->head) > n->u.common->head->mark = 0; > So, a question is if the above won't just crash if I specify > firstprivate(/foobar/) allocate(/foobar/) > etc. I don't think we need to go and check n->u.common->head as gfc_match_omp_variable_list has already done it for us. I have added tests to check allocate clause with common blocks and it works fine. > >> + case OMP_LIST_ALLOCATE: >> + for (; n != NULL; n = n->next) >> + if (n->sym->attr.referenced || declare_simd) > > !$omp declare simd doesn't allow allocate clause, so why the > above " || declare_simd"? It was an oversight. Fixed now. > >> + { >> + tree t = gfc_trans_omp_variable (n->sym, declare_simd); > > And not , false); above? Done. Thanks, -- Hafiz Abid Qadeer Mentor, a Siemens Business [-- Attachment #2: 0001-gfortran-Add-support-for-allocate-clause-OpenMP-5.0.patch --] [-- Type: text/x-patch, Size: 68565 bytes --] From d1fb55bff497a20e6feefa50bd03890e7a903c0e Mon Sep 17 00:00:00 2001 From: Hafiz Abid Qadeer <abidh@codesourcery.com> Date: Fri, 24 Sep 2021 10:04:12 +0100 Subject: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not yet support the allocator-modifier as specified in OpenMP 5.1. The allocate clause is already supported in C/C++. gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE. * gfortran.h (OMP_LIST_ALLOCATE): New enum value. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE. (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES) (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES) (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES) (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE. (OMP_TASKGROUP_CLAUSES): New. (gfc_match_omp_taskgroup): Use OMP_TASKGROUP_CLAUSES instead of OMP_CLAUSE_TASK_REDUCTION. (resolve_omp_clauses): Handle OMP_LIST_ALLOCATE. (resolve_omp_do): Avoid warning when loop iteration variable is in allocate clause. * trans-openmp.c (gfc_trans_omp_clauses): Handle translation of allocate clause. (gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-1.f90: New test. * gfortran.dg/gomp/allocate-2.f90: New test. * gfortran.dg/gomp/allocate-3.f90: New test. * gfortran.dg/gomp/collapse1.f90: Update error message. * gfortran.dg/gomp/openmp-simd-4.f90: Likewise. * gfortran.dg/gomp/clauses-1.f90: Uncomment allocate clause. libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.c: New test. * testsuite/libgomp.fortran/allocate-1.f90: New test. --- gcc/fortran/dump-parse-tree.c | 1 + gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.c | 148 +++++++- gcc/fortran/trans-openmp.c | 87 +++++ gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 | 137 +++++++ gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 | 45 +++ gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 | 14 + gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 | 272 +++++++------- gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +- .../gfortran.dg/gomp/openmp-simd-4.f90 | 6 +- .../testsuite/libgomp.fortran/allocate-1.c | 7 + .../testsuite/libgomp.fortran/allocate-1.f90 | 333 ++++++++++++++++++ 12 files changed, 896 insertions(+), 157 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.f90 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 04660d5074a..038c0340cbb 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1685,6 +1685,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break; case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break; + case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break; case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break; case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break; default: diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 1846ee4fd3c..0ef05067850 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1391,6 +1391,7 @@ enum OMP_LIST_USE_DEVICE_PTR, OMP_LIST_USE_DEVICE_ADDR, OMP_LIST_NONTEMPORAL, + OMP_LIST_ALLOCATE, OMP_LIST_NUM }; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index d120be81467..b4d7bb814eb 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -912,6 +912,7 @@ enum omp_mask1 OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ + OMP_CLAUSE_ALLOCATE, /* OpenMP 5.0. */ OMP_CLAUSE_BIND, /* OpenMP 5.0. */ OMP_CLAUSE_FILTER, /* OpenMP 5.1. */ OMP_CLAUSE_AT, /* OpenMP 5.1. */ @@ -1541,6 +1542,41 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } continue; } + if ((mask & OMP_CLAUSE_ALLOCATE) + && gfc_match ("allocate ( ") == MATCH_YES) + { + gfc_expr *allocator = NULL; + old_loc = gfc_current_locus; + m = gfc_match_expr (&allocator); + if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES) + { + /* If no ":" then there is no allocator, we backtrack + and read the variable list. */ + gfc_free_expr (allocator); + allocator = NULL; + gfc_current_locus = old_loc; + } + + gfc_omp_namelist **head = NULL; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], + true, NULL, &head); + + if (m != MATCH_YES) + { + gfc_free_expr (allocator); + gfc_error ("Expected variable list at %C"); + goto error; + } + + gfc_omp_namelist *n; + for (n = *head; n; n = n->next) + if (allocator) + n->expr = gfc_copy_expr (allocator); + else + n->expr = NULL; + gfc_free_expr (allocator); + continue; + } if ((mask & OMP_CLAUSE_AT) && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) != MATCH_NO) @@ -3523,7 +3559,7 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_PROC_BIND) + | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE) #define OMP_DECLARE_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \ | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \ @@ -3532,15 +3568,16 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ - | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_LOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + #define OMP_SCOPE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION) #define OMP_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \ | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \ @@ -3551,20 +3588,22 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY) + | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE) #define OMP_TASKLOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \ | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \ | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP \ - | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION) + | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE) +#define OMP_TASKGROUP_CLAUSES \ + (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \ | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_THREAD_LIMIT) + | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR) @@ -3580,13 +3619,14 @@ cleanup: #define OMP_TEAMS_CLAUSES \ (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \ - | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_SINGLE_CLAUSES \ - (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_ALLOCATE) #define OMP_ORDERED_CLAUSES \ (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ @@ -5849,7 +5889,7 @@ gfc_match_omp_barrier (void) match gfc_match_omp_taskgroup (void) { - return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION); + return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES); } @@ -6187,7 +6227,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "IN_REDUCTION", "TASK_REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", - "NONTEMPORAL" }; + "NONTEMPORAL", "ALLOCATE" }; STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM); if (omp_clauses == NULL) @@ -6473,7 +6513,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && list != OMP_LIST_REDUCTION_INSCAN && list != OMP_LIST_REDUCTION_TASK && list != OMP_LIST_IN_REDUCTION - && list != OMP_LIST_TASK_REDUCTION) + && list != OMP_LIST_TASK_REDUCTION + && list != OMP_LIST_ALLOCATE) for (n = omp_clauses->lists[list]; n; n = n->next) { bool component_ref_p = false; @@ -6542,6 +6583,78 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, 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->expr && (n->expr->ts.type != BT_INTEGER + || n->expr->ts.kind != gfc_c_intptr_kind)) + { + gfc_error ("Expected integer expression of the " + "'omp_allocator_handle_kind' kind at %L", + &n->expr->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) + n->sym->mark = 0; + + gfc_omp_namelist *prev = NULL; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) + { + if (n->sym->mark == 1) + { + gfc_warning (0, "%qs appears more than once in %<allocate%> " + "clauses 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, 0); + 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 = 0; list < OMP_LIST_NUM; list++) + 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); + } + } + /* OpenACC reductions. */ if (openacc) { @@ -8259,19 +8372,20 @@ resolve_omp_do (gfc_code *code) if (code->ext.omp_clauses) for (list = 0; list < OMP_LIST_NUM; list++) if (!is_simd || code->ext.omp_clauses->collapse > 1 - ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALLOCATE) : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_LINEAR)) + && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR)) for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) if (dovar == n->sym) { if (!is_simd || code->ext.omp_clauses->collapse > 1) gfc_error ("%s iteration variable present on clause " - "other than PRIVATE or LASTPRIVATE at %L", - name, &do_code->loc); + "other than PRIVATE, LASTPRIVATE or " + "ALLOCATE at %L", name, &do_code->loc); else gfc_error ("%s iteration variable present on clause " - "other than PRIVATE, LASTPRIVATE or " + "other than PRIVATE, LASTPRIVATE, ALLOCATE or " "LINEAR at %L", name, &do_code->loc); break; } diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 5b3c310ba59..d6293513fd5 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2646,6 +2646,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_ALLOCATE: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced) + { + tree t = gfc_trans_omp_variable (n->sym, false); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALLOCATE); + OMP_CLAUSE_DECL (node) = t; + if (n->expr) + { + tree allocator_; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + allocator_ = gfc_evaluate_now (se.expr, block); + OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; case OMP_LIST_LINEAR: { gfc_expr *last_step_expr = NULL; @@ -6140,6 +6162,71 @@ gfc_split_omp_clauses (gfc_code *code, == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) && !is_loop) clausesa[GFC_OMP_SPLIT_DO].nowait = true; + + /* Distribute allocate clause to do, parallel, distribute, teams, target + and taskloop. The code below itereates over variables in the + allocate list and checks if that available is also in any + privatization clause on those construct. If yes, then we add it + to the list of 'allocate'ed variables for that construct. If a + variable is found in none of them then we issue an error. */ + + if (code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]) + { + gfc_omp_namelist *alloc_nl, *priv_nl; + gfc_omp_namelist *tails[GFC_OMP_SPLIT_NUM]; + for (alloc_nl = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; + alloc_nl; alloc_nl = alloc_nl->next) + { + bool found = false; + for (int i = GFC_OMP_SPLIT_DO; i <= GFC_OMP_SPLIT_TASKLOOP; i++) + { + gfc_omp_namelist *p; + int list; + for (list = 0; list < OMP_LIST_NUM; list++) + { + 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 (priv_nl = clausesa[i].lists[list]; priv_nl; + priv_nl = priv_nl->next) + if (alloc_nl->sym == priv_nl->sym) + { + found = true; + p = gfc_get_omp_namelist (); + p->sym = alloc_nl->sym; + p->expr = alloc_nl->expr; + p->where = alloc_nl->where; + if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL) + { + clausesa[i].lists[OMP_LIST_ALLOCATE] = p; + tails[i] = p; + } + else + { + tails[i]->next = p; + tails[i] = tails[i]->next; + } + } + break; + default: + break; + } + } + } + if (!found) + gfc_error ("%qs specified in 'allocate' clause at %L but not " + "in an explicit privatization clause", alloc_nl->sym->name, + &alloc_nl->where); + } + } } static tree diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 new file mode 100644 index 00000000000..8bc6b768778 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-1.f90 @@ -0,0 +1,137 @@ +! { dg-do compile } + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 +end module + +subroutine bar (a, b, c) + implicit none + integer :: a + integer :: b + integer :: c + c = a + b +end + +subroutine bar2 (a, b, c) + implicit none + integer :: a + integer :: b(15) + integer :: c + c = a + b(1) +end + +subroutine foo(x, y) + use omp_lib_kinds + implicit none + integer :: x + integer :: z + + integer, dimension(15) :: y + integer :: r + integer :: i + integer c1, c2, c3, c4 + integer (kind=omp_allocator_handle_kind) :: h + common /B1/ c1, c2 + common /B2/ c3, c4 + + r = 0 + h = omp_default_mem_alloc; + + + !$omp parallel private(/B1/, c3, c4) allocate(/B1/, /B2/) + !$omp end parallel + + !$omp parallel private(/B1/, /B2/) allocate(h:/B1/, /B2/) + !$omp end parallel + + !$omp parallel private(/B1/, /B2/) allocate(omp_large_cap_mem_alloc:/B1/, c3, c4) + !$omp end parallel + + !$omp parallel allocate (x) allocate (h : y) & + !$omp allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z) + call bar2 (x, y, z); + !$omp end parallel + + !$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z) + call bar (0, x, z); + !$omp end task + + !$omp target teams distribute parallel do private (x) firstprivate (y) & + !$omp allocate ((omp_default_mem_alloc + 0):z) allocate & + !$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r) + do i = 1, 10 + call bar (0, x, z); + call bar2 (1, y, r); + end do + !$omp end target teams distribute parallel do + + !$omp single private (x) allocate (omp_low_lat_mem_alloc:x) + x=1 + !$omp end single + + !$omp single allocate (omp_low_lat_mem_alloc:x) private (x) + !$omp end single + + !$omp parallel + !$omp do allocate (x) private (x) + do i = 1, 64 + x = 1; + end do + !$omp end parallel + + !$omp sections private (x) allocate (omp_low_lat_mem_alloc: x) + x = 1; + !$omp section + x = 2; + !$omp section + x = 3; + !$omp end sections + + !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r) + call bar (r, r, r); + !$omp end taskgroup + + !$omp teams private (x) firstprivate (y) allocate (h : x, y) + call bar2 (x, y, r); + !$omp end teams + + !$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r) + do i = 1, 16 + call bar (0, r, r); + x = i; + end do + !$omp end taskloop + + !$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r) + !$omp taskloop firstprivate (x) in_reduction (+:r) & + !$omp allocate (omp_default_mem_alloc : x, r) + do i = 1, 16 + call bar (x, r, r); + end do + !$omp end taskloop + !$omp end taskgroup + !$omp taskwait +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 new file mode 100644 index 00000000000..88b2d26872d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 @@ -0,0 +1,45 @@ +! { dg-do compile } + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + +end module + +subroutine foo(x) + use omp_lib_kinds + implicit none + integer :: x + + !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=1 + !$omp end task + + !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=2 + !$omp end parallel + + !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + x=3 + !$omp end parallel + + !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } + x=4 + !$omp end parallel + + !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } + x=5 + !$omp end parallel + + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + x=6 + !$omp end parallel + + !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + x=7 + !$omp end parallel + +end subroutine + diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 new file mode 100644 index 00000000000..7b57be980cb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-3.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } + +subroutine foo(x) + implicit none + integer :: x + integer :: i + + !$omp parallel do simd private (x) allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } + do i = 1, 64 + x = i + end do + !$omp end parallel do simd + +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 index 639f5d19bdb..92801852984 100644 --- a/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/clauses-1.f90 @@ -36,8 +36,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -46,8 +46,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -55,8 +55,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute simd & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& order(concurrent) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll +1 end do @@ -81,8 +81,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) copyin(t) - ! FIXME/TODO: allocate (p) + !$omp& lastprivate (l) schedule(static, 4) copyin(t) & + !$omp& allocate (p) do i = 1, 64 ll = ll +1 end do @@ -90,8 +90,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute parallel do & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (p) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (p) do i = 1, 64 ll = ll +1 end do @@ -100,8 +100,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -110,8 +110,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -119,8 +119,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp distribute simd & !$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) & !$omp& safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -140,8 +140,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp do simd & !$omp& private (p) firstprivate (f) lastprivate (l) linear (ll:1) reduction(+:r) schedule(static, 4) collapse(1) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -149,16 +149,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel do & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp parallel do & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -166,16 +166,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel do simd & !$omp& private (p) firstprivate (f) if (i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & !$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp parallel sections & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) & + !$omp& allocate (f) !$omp section block; end block !$omp section @@ -185,16 +185,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target parallel & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & - !$omp& depend(inout: dd(0)) in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& depend(inout: dd(0)) in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) !$omp end target parallel nowait !$omp target parallel do & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) depend(inout: dd(0)) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -204,8 +204,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) depend(inout: dd(0)) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -216,8 +216,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -226,15 +226,15 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte - 1:nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) !$omp end target teams nowait !$omp target teams distribute & !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) order(concurrent) & - !$omp& collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 end do !$omp end target teams distribute nowait @@ -245,8 +245,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) depend(inout: dd(0)) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -259,8 +259,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -271,8 +271,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & !$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do @@ -282,34 +282,34 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& safelen(8) simdlen(4) lastprivate (l) linear(ll: 1) aligned(q: 32) reduction(+:r) & !$omp& depend(inout: dd(0)) nontemporal(ntm) if(simd:i3) order(concurrent) & - !$omp& in_reduction(+:r2) - ! FIXME/TODO: allocate (omp_default_mem_alloc:f) + !$omp& in_reduction(+:r2) & + !$omp& allocate (omp_default_mem_alloc:f) do i = 1, 64 ll = ll + 1 end do !$omp end target simd nowait - !$omp taskgroup task_reduction(+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction(+:r2) & + !$omp& allocate (r2) !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do !$omp end taskgroup - !$omp taskgroup task_reduction(+:r) - ! FIXME/TODO: allocate (r) + !$omp taskgroup task_reduction(+:r) & + !$omp& allocate (r) !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(i1) & !$omp& final(fi) mergeable nogroup priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) in_reduction(+:r) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -319,8 +319,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) if(taskloop: i1) & !$omp& final(fi) priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(+:r) if (simd: i3) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll + 1 end do @@ -328,8 +328,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target depend(inout: dd(0)) in_reduction(+:r2) !$omp teams distribute & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & - !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 end do !$omp end target nowait @@ -339,8 +339,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) order(concurrent) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -352,8 +352,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -363,8 +363,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp teams distribute simd & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) & + !$omp& allocate (omp_default_mem_alloc: f) do i = 1, 64 ll = ll +1 end do @@ -374,8 +374,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& lastprivate (l) schedule(static, 4) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -384,8 +384,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & - !$omp& lastprivate (l) schedule(static, 4) - ! FIXME/TODO: allocate (f) + !$omp& lastprivate (l) schedule(static, 4) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -395,8 +395,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -406,8 +406,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& collapse(1) dist_schedule(static, 16) & !$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) & !$omp& lastprivate (l) schedule(static, 4) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) - ! FIXME/TODO: allocate (f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -415,68 +415,68 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp teams distribute simd & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & !$omp& collapse(1) dist_schedule(static, 16) order(concurrent) & - !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) - ! FIXME/TODO: allocate(f) + !$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) & + !$omp& allocate(f) do i = 1, 64 ll = ll +1 end do !$omp parallel master & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) !$omp end parallel master !$omp parallel masked & !$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d) & + !$omp& allocate (f) !$omp end parallel masked - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) in_reduction(+:r2) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) in_reduction(+:r2) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & - !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) & - !$omp& order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -485,8 +485,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -494,8 +494,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) final(fi) mergeable priority (pp) & - !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -504,8 +504,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -514,14 +514,14 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied & !$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) & !$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) & - !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) & !$omp& untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) @@ -530,8 +530,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) & !$omp& untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) @@ -540,25 +540,25 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) & !$omp& final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do !$omp end taskgroup - !$omp taskgroup task_reduction (+:r2) - ! FIXME/TODO: allocate (r2) + !$omp taskgroup task_reduction (+:r2) & + !$omp& allocate (r2) !$omp masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -566,8 +566,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & - !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t) - ! FIXME/TODO: allocate (f) + !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -575,8 +575,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) & - !$omp& copyin(t) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& copyin(t) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -584,8 +584,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel master taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied & !$omp& if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -593,8 +593,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel masked taskloop simd & !$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) & !$omp& final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) & - !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) - ! FIXME/TODO: allocate (f) + !$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) & + !$omp& allocate (f) do i = 1, 64 ll = ll +1 end do @@ -607,31 +607,31 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp parallel loop & !$omp& private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2) & + !$omp& allocate (f) do l = 1, 64 ll = ll + 1 end do !$omp parallel loop & !$omp& private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) & - !$omp& proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2) - ! FIXME/TODO: allocate (f) + !$omp& proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2) & + !$omp& allocate (f) do l = 1, 64 ll = ll + 1 end do !$omp teams loop & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) & - !$omp& collapse(1) lastprivate (l) bind(teams) - ! FIXME/TODO: allocate (f) + !$omp& collapse(1) lastprivate (l) bind(teams) & + !$omp& allocate (f) do l = 1, 64 end do !$omp teams loop & !$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) & - !$omp& collapse(1) lastprivate (l) order(concurrent) - ! FIXME/TODO: allocate (f) + !$omp& collapse(1) lastprivate (l) order(concurrent) & + !$omp& allocate (f) do l = 1, 64 end do @@ -639,8 +639,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) & !$omp& depend(inout: dd(0)) lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) & - !$omp& if (target: i1) if (parallel: i2) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& if (target: i1) if (parallel: i2) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target parallel loop nowait @@ -648,8 +648,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams loop & !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target teams loop nowait @@ -657,8 +657,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd !$omp target teams loop & !$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) & !$omp& shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) depend(inout: dd(0)) & - !$omp& lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1) - ! FIXME/TODO: allocate (omp_default_mem_alloc: f) + !$omp& lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1) & + !$omp& allocate (omp_default_mem_alloc: f) do l = 1, 64 end do !$omp end target teams loop nowait diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 index 1a06eaba823..01cfc82b760 100644 --- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 @@ -24,7 +24,7 @@ subroutine collapse1 end do !$omp parallel do collapse(2) shared(j) do i = 1, 3 - do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" } + do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } end do end do !$omp parallel do collapse(2) diff --git a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 index 4a17fb9820e..17375e0eff5 100644 --- a/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/openmp-simd-4.f90 @@ -45,17 +45,17 @@ do i = 1, 5 end do !$omp parallel do firstprivate(i) -do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE or LASTPRIVATE" } +do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } x(i) = 42 end do !$omp parallel do simd firstprivate(i) -do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or LINEAR" } +do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE, ALLOCATE or LINEAR" } x(i) = 42 end do !$omp simd linear(i) collapse(2) -do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE or LASTPRIVATE" } +do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" } do j = 1, 2 y(j, i) = 52 end do diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c new file mode 100644 index 00000000000..d33acc6feef --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c @@ -0,0 +1,7 @@ +#include <stdint.h> + +int +is_64bit_aligned_ (uintptr_t a) +{ + return ( (a & 0x3f) == 0); +} diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 new file mode 100644 index 00000000000..35d1750b878 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -0,0 +1,333 @@ +! { dg-do run } +! { dg-additional-sources allocate-1.c } +! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" } + +module m + use omp_lib + use iso_c_binding + implicit none + + interface + integer(c_int) function is_64bit_aligned (a) bind(C) + import :: c_int + integer :: a + end + end interface +end module m + +subroutine foo (x, p, q, px, h, fl) + use omp_lib + use iso_c_binding + integer :: x + integer, dimension(4) :: p + integer, dimension(4) :: q + integer :: px + integer (kind=omp_allocator_handle_kind) :: h + integer :: fl + + integer :: y + integer :: r, i, i1, i2, i3, i4, i5 + integer :: l, l3, l4, l5, l6 + integer :: n, n1, n2, n3, n4 + integer :: j2, j3, j4 + integer, dimension(4) :: l2 + integer, dimension(4) :: r2 + integer, target :: xo + integer, target :: yo + integer, dimension(x) :: v + integer, dimension(x) :: w + + type s_type + integer :: a + integer :: b + end type + + type (s_type) :: s + s%a = 27 + s%b = 29 + y = 0 + r = 0 + n = 8 + n2 = 9 + n3 = 10 + n4 = 11 + xo = x + yo = y + + do i = 1, 4 + r2(i) = 0; + end do + + do i = 1, 4 + p(i) = 0; + end do + + do i = 1, 4 + q(i) = 0; + end do + + do i = 1, x + w(i) = i + end do + + !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) + if (x /= 42) then + stop 1 + end if + v(1) = 7 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(v(1)) == 0))) then + stop 2 + end if + + !$omp barrier + y = 1; + x = x + 1 + v(1) = 7 + v(41) = 8 + !$omp barrier + if (x /= 43 .or. y /= 1) then + stop 3 + end if + if (v(1) /= 7 .or. v(41) /= 8) then + stop 4 + end if + !$omp end parallel + + !$omp teams + !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) + + if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then + stop 5 + end if + !$omp barrier + y = 1; + x = x + 1 + w(19) = w(19) + 1 + !$omp barrier + if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then + stop 6 + end if + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(w(1)) == 0))) then + stop 7 + end if + !$omp end parallel + !$omp end teams + + !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16) + do i = 0, 63 + if (x /= 42) then + stop 8 + end if + y = 1; + l = i; + n = n + y + 15; + r = r + i; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(r) == 0) .or. & + (is_64bit_aligned(l) == 0) .or. & + (is_64bit_aligned(n) == 0))) then + stop 9 + end if + end do + !$omp end parallel do + + !$omp parallel + !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3) + do i1 = 0, 63 + l2(1) = i1 + l2(2) = i1 + 1 + l2(3) = i1 + 2 + l2(4) = i1 + 3 + if (i1 < 37) then + l3 = i1 + end if + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l2(1)) == 0) .or. & + (is_64bit_aligned(l3) == 0) .or. & + (is_64bit_aligned(i1) == 0))) then + stop 10 + end if + end do + + !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2) + do i2 = 3, 4 + do j2 = 17, 22, 2 + n2 = n2 + 17 + l4 = i2 * 31 + j2 + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l4) == 0) .or. & + (is_64bit_aligned(n2) == 0) .or. & + (is_64bit_aligned(i2) == 0) .or. & + (is_64bit_aligned(j2) == 0))) then + stop 11 + end if + end do + end do + + !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3) + do i3 = 3, 4 + do j3 = 17, 22, 2 + n3 = n3 + 17 + l5 = i3 * 31 + j3 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(l5) == 0) .or. & + (is_64bit_aligned(n3) == 0) .or. & + (is_64bit_aligned(i3) == 0) .or. & + (is_64bit_aligned(j3) == 0))) then + stop 12 + end if + end do + end do + + !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4) + do i4 = 3, 4 + do j4 = 17, 22,2 + n4 = n4 + 17; + l6 = i4 * 31 + j4; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l6) == 0) .or. & + (is_64bit_aligned(n4) == 0) .or. & + (is_64bit_aligned(i4) == 0) .or. & + (is_64bit_aligned(j4) == 0))) then + stop 13 + end if + end do + end do + + !$omp do lastprivate (i5) allocate (i5) + do i5 = 1, 17, 3 + if ( (and(fl, 2) /= 0) .and. & + (is_64bit_aligned(i5) == 0)) then + stop 14 + end if + end do + + !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2) + do i = 0, 31 + p(3) = p(3) + i; + p(4) = p(4) + (2 * i) + q(1) = q(1) + (3 * i) + q(3) = q(3) + (4 * i) + r2(1) = r2(1) + (5 * i) + r2(4) = r2(4) + (6 * i) + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(q(1)) == 0) .or. & + (is_64bit_aligned(p(1)) == 0) .or. & + (is_64bit_aligned(r2(1)) == 0) )) then + stop 15 + end if + end do + + !$omp task private(y) firstprivate(x) allocate(x, y) + if (x /= 42) then + stop 16 + end if + + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 17 + end if + !$omp end task + + !$omp task private(y) firstprivate(x) allocate(h: x, y) + if (x /= 42) then + stop 16 + end if + + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 17 + end if + !$omp end task + + !$omp task private(y) firstprivate(s) allocate(s, y) + if (s%a /= 27 .or. s%b /= 29) then + stop 18 + end if + + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(s%a) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 19 + end if + !$omp end task + + !$omp task private(y) firstprivate(s) allocate(h: s, y) + if (s%a /= 27 .or. s%b /= 29) then + stop 18 + end if + + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(s%a) == 0) .or. & + (is_64bit_aligned(y) == 0) )) then + stop 19 + end if + !$omp end task + + !$omp end parallel + + if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then + stop 20 + end if + + if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then + stop 21 + end if + + if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then + stop 22 + end if + + if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then + stop 23 + end if + + if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then + stop 24 + end if + + if (i5 /= 19) then + stop 24 + end if + + if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) & + .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) & + .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then + stop 25 + end if + +end subroutine + +program main + use omp_lib + integer, dimension(4) :: p + integer, dimension(4) :: q + + type (omp_alloctrait) :: traits(3) + integer (omp_allocator_handle_kind) :: a + + traits = [omp_alloctrait (omp_atk_alignment, 64), & + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & + omp_alloctrait (omp_atk_pool_size, 8192)] + a = omp_init_allocator (omp_default_mem_space, 3, traits) + if (a == omp_null_allocator) stop 1 + + call omp_set_default_allocator (omp_default_mem_alloc); + call foo (42, p, q, 2, a, 0); + call foo (42, p, q, 2, omp_default_mem_alloc, 0); + call foo (42, p, q, 2, a, 1); + call omp_set_default_allocator (a); + call foo (42, p, q, 2, omp_null_allocator, 3); + call foo (42, p, q, 2, omp_default_mem_alloc, 2); + call omp_destroy_allocator (a); +end -- 2.25.1 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-11 22:31 ` Hafiz Abid Qadeer @ 2022-01-13 12:50 ` Jakub Jelinek 2022-01-14 9:10 ` Thomas Schwinge 2022-01-21 17:15 ` Thomas Schwinge 2 siblings, 0 replies; 28+ messages in thread From: Jakub Jelinek @ 2022-01-13 12:50 UTC (permalink / raw) To: Hafiz Abid Qadeer; +Cc: Hafiz Abid Qadeer, gcc-patches, tobias On Tue, Jan 11, 2022 at 10:31:54PM +0000, Hafiz Abid Qadeer wrote: > + gfc_omp_namelist *n; > + for (n = *head; n; n = n->next) Better for (gfc_omp_namelist *n = *head; n; n = n->next) as we are in C++ and n isn't used after the loop. > + /* non-composite constructs. */ Capital N Ok for trunk with these nits fixed, no need to repost. Jakub ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-11 22:31 ` Hafiz Abid Qadeer 2022-01-13 12:50 ` Jakub Jelinek @ 2022-01-14 9:10 ` Thomas Schwinge 2022-01-14 11:45 ` Tobias Burnus 2022-01-21 17:15 ` Thomas Schwinge 2 siblings, 1 reply; 28+ messages in thread From: Thomas Schwinge @ 2022-01-14 9:10 UTC (permalink / raw) To: Hafiz Abid Qadeer; +Cc: Jakub Jelinek, Tobias Burnus, gcc-patches, fortran Hi Abid! (Remember to CC <fortran@gcc.gnu.org> for 'gcc/fortran/' etc. changes.) On 2022-01-11T22:31:54+0000, Hafiz Abid Qadeer <abid_qadeer@mentor.com> wrote: > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-2.f90 > @@ -0,0 +1,45 @@ > +! { dg-do compile } > + > +module omp_lib_kinds > + use iso_c_binding, only: c_int, c_intptr_t > + implicit none > + private :: c_int, c_intptr_t > + integer, parameter :: omp_allocator_handle_kind = c_intptr_t > + > +end module > + > +subroutine foo(x) > + use omp_lib_kinds > + implicit none > + integer :: x > + > + !$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } > + x=1 > + !$omp end task > + > + !$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } > + x=2 > + !$omp end parallel > + > + !$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" } > + x=3 > + !$omp end parallel > + > + !$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } > + x=4 > + !$omp end parallel > + > + !$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." } > + x=5 > + !$omp end parallel > + > + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } We do for x86_64 default '-m64', but for '-m32' and '-mx32' compilation, we're not seeing this latter diagnostic: PASS: gfortran.dg/gomp/allocate-1.f90 -O (test for excess errors) PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 16) PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 20) PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 24) FAIL: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 36) PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 40) PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for warnings, line 28) PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for warnings, line 32) PASS: gfortran.dg/gomp/allocate-2.f90 -O (test for excess errors) I suppose the reason is unintended congruence of data types? Would it work to make 'x' a floating-point data type, for example -- or is this meant to explicitly check certain integer data type characteristics? Grüße Thomas > + x=6 > + !$omp end parallel > + > + !$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } > + x=7 > + !$omp end parallel > + > +end subroutine ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-14 9:10 ` Thomas Schwinge @ 2022-01-14 11:45 ` Tobias Burnus 2022-01-14 11:55 ` Jakub Jelinek 0 siblings, 1 reply; 28+ messages in thread From: Tobias Burnus @ 2022-01-14 11:45 UTC (permalink / raw) To: Thomas Schwinge, Hafiz Abid Qadeer Cc: Jakub Jelinek, Tobias Burnus, gcc-patches, fortran Hi all, On 14.01.22 10:10, Thomas Schwinge wrote: >> + integer :: x >> ... >> + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } > We do for x86_64 default '-m64', but for '-m32' and '-mx32' compilation, > we're not seeing this latter diagnostic: > FAIL: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 36) > > I suppose the reason is unintended congruence of data types? Would it > work to make 'x' a floating-point data type, for example -- or is this > meant to explicitly check certain integer data type characteristics? Alternatively, you could use 'integer(kind=1)' (which is a 1-byte/8-bits type.) I assume we do not have any platform which still uses 8-bit pointers and supports libgomp :-) Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-14 11:45 ` Tobias Burnus @ 2022-01-14 11:55 ` Jakub Jelinek 2022-01-14 12:20 ` Tobias Burnus 0 siblings, 1 reply; 28+ messages in thread From: Jakub Jelinek @ 2022-01-14 11:55 UTC (permalink / raw) To: Tobias Burnus; +Cc: Thomas Schwinge, Hafiz Abid Qadeer, gcc-patches, fortran On Fri, Jan 14, 2022 at 12:45:54PM +0100, Tobias Burnus wrote: > On 14.01.22 10:10, Thomas Schwinge wrote: > > > + integer :: x > > > ... > > > + !$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } > > We do for x86_64 default '-m64', but for '-m32' and '-mx32' compilation, > > we're not seeing this latter diagnostic: > > FAIL: gfortran.dg/gomp/allocate-2.f90 -O (test for errors, line 36) > > > > I suppose the reason is unintended congruence of data types? Would it > > work to make 'x' a floating-point data type, for example -- or is this > > meant to explicitly check certain integer data type characteristics? > > Alternatively, you could use 'integer(kind=1)' (which is a 1-byte/8-bits > type.) I assume we do not have any platform which still uses 8-bit > pointers and supports libgomp :-) If we want to check intptr_t, we should guard the dg-error with "" { target { lp64 || llp64 } } or so. Otherwise yes, we can add some other kind and hope it is not the same as omp_allocator_handle_kind. Or we can do both, keep the current one with the target lp64 || llp64 and add another one with some integer(kind=1). Jakub ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-14 11:55 ` Jakub Jelinek @ 2022-01-14 12:20 ` Tobias Burnus 2022-01-17 14:01 ` Hafiz Abid Qadeer 0 siblings, 1 reply; 28+ messages in thread From: Tobias Burnus @ 2022-01-14 12:20 UTC (permalink / raw) To: Jakub Jelinek, Hafiz Abid Qadeer; +Cc: gcc-patches, Thomas Schwinge, fortran On 14.01.22 12:55, Jakub Jelinek via Fortran wrote: > If we want to check intptr_t, we should guard the dg-error with > "" { target { lp64 || llp64 } } > or so. Well, if we want to use intptr_t, we could use be explicitly as with: use iso_c_binding, only: c_intptr_t ! use omp_lib, only: omp_allocator_handle_kind ... ('implicit none' etc.) integer, parameter :: omp_allocator_handle_kind = c_intptr_t ... integer(kind=omp_allocator_handle_kind) (@Abid: The 'use omp_lib' line is commented as in gcc/testsuite/*/gomp/, the OpenMP module/header from libgomp is not available - and then a stub parameter is created.) > Otherwise yes, we can add some other kind and hope it is not the > same as omp_allocator_handle_kind. Or we can do both, > keep the current one with the target lp64 || llp64 and > add another one with some integer(kind=1). For just testing something invalid, I think it makes more sense to just set it to kind=1. For checking the valid value, using c_intptr_t seems to make more sense than restricting it to (l)l64. Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-14 12:20 ` Tobias Burnus @ 2022-01-17 14:01 ` Hafiz Abid Qadeer 0 siblings, 0 replies; 28+ messages in thread From: Hafiz Abid Qadeer @ 2022-01-17 14:01 UTC (permalink / raw) To: Tobias Burnus, Jakub Jelinek, Thomas Schwinge; +Cc: gcc-patches, fortran On 14/01/2022 12:20, Tobias Burnus wrote: > On 14.01.22 12:55, Jakub Jelinek via Fortran wrote: >> If we want to check intptr_t, we should guard the dg-error with >> "" { target { lp64 || llp64 } } >> or so. > > Well, if we want to use intptr_t, we could use be explicitly as with: > > use iso_c_binding, only: c_intptr_t > ! use omp_lib, only: omp_allocator_handle_kind > ... ('implicit none' etc.) > integer, parameter :: omp_allocator_handle_kind = c_intptr_t > ... > integer(kind=omp_allocator_handle_kind) > > (@Abid: The 'use omp_lib' line is commented as in gcc/testsuite/*/gomp/, > the OpenMP module/header from libgomp is not available - and then a > stub parameter is created.) > >> Otherwise yes, we can add some other kind and hope it is not the >> same as omp_allocator_handle_kind. Or we can do both, >> keep the current one with the target lp64 || llp64 and >> add another one with some integer(kind=1). > > For just testing something invalid, I think it makes more sense to just set it to kind=1. > > For checking the valid value, using c_intptr_t seems to make more sense than restricting it to (l)l64. Problem was with the literal 0 having same kind as c_intptr_t for m32. So there was no diagnostic in that case. I am going to change it 0_1 to make the test more robust. Thanks, -- Hafiz Abid Qadeer Mentor, a Siemens Business ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-11 22:31 ` Hafiz Abid Qadeer 2022-01-13 12:50 ` Jakub Jelinek 2022-01-14 9:10 ` Thomas Schwinge @ 2022-01-21 17:15 ` Thomas Schwinge 2022-01-21 17:43 ` Tobias Burnus 2 siblings, 1 reply; 28+ messages in thread From: Thomas Schwinge @ 2022-01-21 17:15 UTC (permalink / raw) To: Hafiz Abid Qadeer; +Cc: Jakub Jelinek, Tobias Burnus, gcc-patches, fortran Hi Abid! On 2022-01-11T22:31:54+0000, Hafiz Abid Qadeer <abid_qadeer@mentor.com> wrote: > From d1fb55bff497a20e6feefa50bd03890e7a903c0e Mon Sep 17 00:00:00 2001 > From: Hafiz Abid Qadeer <abidh@codesourcery.com> > Date: Fri, 24 Sep 2021 10:04:12 +0100 > Subject: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). > > This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not > yet support the allocator-modifier as specified in OpenMP 5.1. The allocate > clause is already supported in C/C++. > libgomp/ChangeLog: > > * testsuite/libgomp.fortran/allocate-1.c: New test. > * testsuite/libgomp.fortran/allocate-1.f90: New test. I'm seeing this test case randomly/non-deterministically FAIL to execute, differently on different systems and runs, for example: libgomp: libgomp: libgomp: Out of memory allocating 4 bytesOut of memory allocating 4 bytes libgomp: libgomp: libgomp: Out of memory allocating 168 bytes libgomp: Out of memory allocating 4 bytes libgomp: Out of memory allocating 4 bytes libgomp: Out of memory allocating 4 bytes I'd assume there's some concurrency issue: the problem disappears if I manually specify a lowerish 'OMP_NUM_THREADS', and conversely, on a system where I don't normally see the FAILs, I can trigger them with a largish 'OMP_NUM_THREADS', such as 'OMP_NUM_THREADS=18' and higher. For example: Thread 10 "a.out" hit Breakpoint 1, omp_aligned_alloc (alignment=4, size=4, allocator=6326576) at [...]/source-gcc/libgomp/allocator.c:318 318 if (allocator_data) (gdb) print *allocator_data $1 = {memspace = omp_default_mem_space, alignment = 64, pool_size = 8192, used_pool_size = 8188, fb_data = omp_null_allocator, sync_hint = 3, access = 7, fallback = 12, pinned = 0, partition = 15} Given the high 'used_pool_size', is that to be expected, and the test case shouldn't be requesting "so much" memory? Or might the problem actually be in 'libgomp/allocator.c' (not touched by your commit)? All but Thread 10 are in 'gomp_team_barrier_wait_end' -- should memory have been released at that point? (gdb) thread apply 10 bt Thread 10 (Thread 0x7ffff32e2700 (LWP 1601318)): #0 omp_aligned_alloc (alignment=4, size=4, allocator=6326576) at [...]/source-gcc/libgomp/allocator.c:320 #1 0x00007ffff790b4db in GOMP_alloc (alignment=4, size=4, allocator=6326576) at [...]/source-gcc/libgomp/allocator.c:364 #2 0x0000000000401f3f in foo_._omp_fn.3 () at source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:136 #3 0x00007ffff78f31e6 in gomp_thread_start (xdata=<optimized out>) at [...]/source-gcc/libgomp/team.c:129 #4 0x00007ffff789e609 in start_thread (arg=<optimized out>) at pthread_create.c:477 #5 0x00007ffff77c5293 in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 (gdb) thread apply 1 bt Thread 1 (Thread 0x7ffff72ec1c0 (LWP 1601309)): #0 futex_wait (val=96, addr=<optimized out>) at [...]/source-gcc/libgomp/config/linux/x86/futex.h:97 #1 do_wait (val=96, addr=<optimized out>) at [...]/source-gcc/libgomp/config/linux/wait.h:67 #2 gomp_team_barrier_wait_end (bar=<optimized out>, state=96) at [...]/source-gcc/libgomp/config/linux/bar.c:112 #3 0x0000000000401f53 in foo_._omp_fn.3 () at source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:136 #4 0x00007ffff78ea4f2 in GOMP_parallel (fn=0x401e6b <foo_._omp_fn.3>, data=0x7fffffffd450, num_threads=18, flags=0) at [...]/source-gcc/libgomp/parallel.c:178 #5 0x00000000004012ab in foo (x=42, p=..., q=..., px=2, h=6326576, fl=0) at source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:122 #6 0x00000000004018e9 in MAIN__ () at source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:326 Manually compiling the test case, I see a lot of '-Wtabs' diagnostics (can be ignored, I suppose), but also: source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:11:47: 11 | integer(c_int) function is_64bit_aligned (a) bind(C) | 1 Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C) procedure ‘is_64bit_aligned’ but may not be C interoperable [-Wc-binding-type] Is that something to worry about? And: source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:31:19: 31 | integer :: n, n1, n2, n3, n4 | 1 Warning: Unused variable ‘n1’ declared at (1) [-Wunused-variable] source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:18:27: 18 | subroutine foo (x, p, q, px, h, fl) | 1 Warning: Unused dummy argument ‘px’ at (1) [-Wunused-dummy-argument] For reference, quoting below the new Fortran test case. Grüße Thomas > --- /dev/null > +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c > @@ -0,0 +1,7 @@ > +#include <stdint.h> > + > +int > +is_64bit_aligned_ (uintptr_t a) > +{ > + return ( (a & 0x3f) == 0); > +} > --- /dev/null > +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > @@ -0,0 +1,333 @@ > +! { dg-do run } > +! { dg-additional-sources allocate-1.c } > +! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" } > + > +module m > + use omp_lib > + use iso_c_binding > + implicit none > + > + interface > + integer(c_int) function is_64bit_aligned (a) bind(C) > + import :: c_int > + integer :: a > + end > + end interface > +end module m > + > +subroutine foo (x, p, q, px, h, fl) > + use omp_lib > + use iso_c_binding > + integer :: x > + integer, dimension(4) :: p > + integer, dimension(4) :: q > + integer :: px > + integer (kind=omp_allocator_handle_kind) :: h > + integer :: fl > + > + integer :: y > + integer :: r, i, i1, i2, i3, i4, i5 > + integer :: l, l3, l4, l5, l6 > + integer :: n, n1, n2, n3, n4 > + integer :: j2, j3, j4 > + integer, dimension(4) :: l2 > + integer, dimension(4) :: r2 > + integer, target :: xo > + integer, target :: yo > + integer, dimension(x) :: v > + integer, dimension(x) :: w > + > + type s_type > + integer :: a > + integer :: b > + end type > + > + type (s_type) :: s > + s%a = 27 > + s%b = 29 > + y = 0 > + r = 0 > + n = 8 > + n2 = 9 > + n3 = 10 > + n4 = 11 > + xo = x > + yo = y > + > + do i = 1, 4 > + r2(i) = 0; > + end do > + > + do i = 1, 4 > + p(i) = 0; > + end do > + > + do i = 1, 4 > + q(i) = 0; > + end do > + > + do i = 1, x > + w(i) = i > + end do > + > + !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) > + if (x /= 42) then > + stop 1 > + end if > + v(1) = 7 > + if ( (and(fl, 2) /= 0) .and. & > + ((is_64bit_aligned(x) == 0) .or. & > + (is_64bit_aligned(y) == 0) .or. & > + (is_64bit_aligned(v(1)) == 0))) then > + stop 2 > + end if > + > + !$omp barrier > + y = 1; > + x = x + 1 > + v(1) = 7 > + v(41) = 8 > + !$omp barrier > + if (x /= 43 .or. y /= 1) then > + stop 3 > + end if > + if (v(1) /= 7 .or. v(41) /= 8) then > + stop 4 > + end if > + !$omp end parallel > + > + !$omp teams > + !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) > + > + if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then > + stop 5 > + end if > + !$omp barrier > + y = 1; > + x = x + 1 > + w(19) = w(19) + 1 > + !$omp barrier > + if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then > + stop 6 > + end if > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(x) == 0) .or. & > + (is_64bit_aligned(y) == 0) .or. & > + (is_64bit_aligned(w(1)) == 0))) then > + stop 7 > + end if > + !$omp end parallel > + !$omp end teams > + > + !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16) > + do i = 0, 63 > + if (x /= 42) then > + stop 8 > + end if > + y = 1; > + l = i; > + n = n + y + 15; > + r = r + i; > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(x) == 0) .or. & > + (is_64bit_aligned(y) == 0) .or. & > + (is_64bit_aligned(r) == 0) .or. & > + (is_64bit_aligned(l) == 0) .or. & > + (is_64bit_aligned(n) == 0))) then > + stop 9 > + end if > + end do > + !$omp end parallel do > + > + !$omp parallel > + !$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3) > + do i1 = 0, 63 > + l2(1) = i1 > + l2(2) = i1 + 1 > + l2(3) = i1 + 2 > + l2(4) = i1 + 3 > + if (i1 < 37) then > + l3 = i1 > + end if > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(l2(1)) == 0) .or. & > + (is_64bit_aligned(l3) == 0) .or. & > + (is_64bit_aligned(i1) == 0))) then > + stop 10 > + end if > + end do > + > + !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2) > + do i2 = 3, 4 > + do j2 = 17, 22, 2 > + n2 = n2 + 17 > + l4 = i2 * 31 + j2 > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(l4) == 0) .or. & > + (is_64bit_aligned(n2) == 0) .or. & > + (is_64bit_aligned(i2) == 0) .or. & > + (is_64bit_aligned(j2) == 0))) then > + stop 11 > + end if > + end do > + end do > + > + !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3) > + do i3 = 3, 4 > + do j3 = 17, 22, 2 > + n3 = n3 + 17 > + l5 = i3 * 31 + j3 > + if ( (and(fl, 2) /= 0) .and. & > + ((is_64bit_aligned(l5) == 0) .or. & > + (is_64bit_aligned(n3) == 0) .or. & > + (is_64bit_aligned(i3) == 0) .or. & > + (is_64bit_aligned(j3) == 0))) then > + stop 12 > + end if > + end do > + end do > + > + !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4) > + do i4 = 3, 4 > + do j4 = 17, 22,2 > + n4 = n4 + 17; > + l6 = i4 * 31 + j4; > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(l6) == 0) .or. & > + (is_64bit_aligned(n4) == 0) .or. & > + (is_64bit_aligned(i4) == 0) .or. & > + (is_64bit_aligned(j4) == 0))) then > + stop 13 > + end if > + end do > + end do > + > + !$omp do lastprivate (i5) allocate (i5) > + do i5 = 1, 17, 3 > + if ( (and(fl, 2) /= 0) .and. & > + (is_64bit_aligned(i5) == 0)) then > + stop 14 > + end if > + end do > + > + !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2) > + do i = 0, 31 > + p(3) = p(3) + i; > + p(4) = p(4) + (2 * i) > + q(1) = q(1) + (3 * i) > + q(3) = q(3) + (4 * i) > + r2(1) = r2(1) + (5 * i) > + r2(4) = r2(4) + (6 * i) > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(q(1)) == 0) .or. & > + (is_64bit_aligned(p(1)) == 0) .or. & > + (is_64bit_aligned(r2(1)) == 0) )) then > + stop 15 > + end if > + end do > + > + !$omp task private(y) firstprivate(x) allocate(x, y) > + if (x /= 42) then > + stop 16 > + end if > + > + if ( (and(fl, 2) /= 0) .and. & > + ((is_64bit_aligned(x) == 0) .or. & > + (is_64bit_aligned(y) == 0) )) then > + stop 17 > + end if > + !$omp end task > + > + !$omp task private(y) firstprivate(x) allocate(h: x, y) > + if (x /= 42) then > + stop 16 > + end if > + > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(x) == 0) .or. & > + (is_64bit_aligned(y) == 0) )) then > + stop 17 > + end if > + !$omp end task > + > + !$omp task private(y) firstprivate(s) allocate(s, y) > + if (s%a /= 27 .or. s%b /= 29) then > + stop 18 > + end if > + > + if ( (and(fl, 2) /= 0) .and. & > + ((is_64bit_aligned(s%a) == 0) .or. & > + (is_64bit_aligned(y) == 0) )) then > + stop 19 > + end if > + !$omp end task > + > + !$omp task private(y) firstprivate(s) allocate(h: s, y) > + if (s%a /= 27 .or. s%b /= 29) then > + stop 18 > + end if > + > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(s%a) == 0) .or. & > + (is_64bit_aligned(y) == 0) )) then > + stop 19 > + end if > + !$omp end task > + > + !$omp end parallel > + > + if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then > + stop 20 > + end if > + > + if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then > + stop 21 > + end if > + > + if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then > + stop 22 > + end if > + > + if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then > + stop 23 > + end if > + > + if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then > + stop 24 > + end if > + > + if (i5 /= 19) then > + stop 24 > + end if > + > + if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) & > + .or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) & > + .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then > + stop 25 > + end if > + > +end subroutine > + > +program main > + use omp_lib > + integer, dimension(4) :: p > + integer, dimension(4) :: q > + > + type (omp_alloctrait) :: traits(3) > + integer (omp_allocator_handle_kind) :: a > + > + traits = [omp_alloctrait (omp_atk_alignment, 64), & > + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & > + omp_alloctrait (omp_atk_pool_size, 8192)] > + a = omp_init_allocator (omp_default_mem_space, 3, traits) > + if (a == omp_null_allocator) stop 1 > + > + call omp_set_default_allocator (omp_default_mem_alloc); > + call foo (42, p, q, 2, a, 0); > + call foo (42, p, q, 2, omp_default_mem_alloc, 0); > + call foo (42, p, q, 2, a, 1); > + call omp_set_default_allocator (a); > + call foo (42, p, q, 2, omp_null_allocator, 3); > + call foo (42, p, q, 2, omp_default_mem_alloc, 2); > + call omp_destroy_allocator (a); > +end ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-21 17:15 ` Thomas Schwinge @ 2022-01-21 17:43 ` Tobias Burnus 2022-01-24 8:45 ` Tobias Burnus 0 siblings, 1 reply; 28+ messages in thread From: Tobias Burnus @ 2022-01-21 17:43 UTC (permalink / raw) To: Thomas Schwinge, Hafiz Abid Qadeer Cc: Jakub Jelinek, Tobias Burnus, gcc-patches, fortran On 21.01.22 18:15, Thomas Schwinge wrote: > source-gcc/libgomp/testsuite/libgomp.fortran/allocate-1.f90:11:47: > > 11 | integer(c_int) function is_64bit_aligned (a) bind(C) > | 1 > Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C) procedure ‘is_64bit_aligned’ but may not be C interoperable [-Wc-binding-type] > > Is that something to worry about? I think it is not very elegant – but should be okay. On the Fortran side: integer(c_int) function is_64bit_aligned (a) bind(C) import :: c_int integer :: a end that matches 'int is_64bit_aligned (int *a);' While 'integer' in principle may not be 'int', the call by reference makes this independent of the actually used integer kind. HOWEVER: That interface it not used! While it defines that interface in 'module m', there is no 'use m' in 'subroutine foo'. (or alternatively: 'foo' being after 'contains' inside the 'module m' - and then 'use m' in the main program) That means that 'is_64bit_aligned(...)' gets implicitly types as 'integer' with unknown arguments, which get passed by value. By gfortran convention, that function has a tailing underscore. That matches the C side, which such an underscore: int is_64bit_aligned_ (uintptr_t a) { return ( (a & 0x3f) == 0); } With pass by reference, a pointer is passed, which should be handled by 'uintptr_t'. * * * Side remark: I really recommend 'implicit none' when writing Fortran code - which disables implicit typing. I personally have started to use implicit none (type, external) which also rejects 'call something()' unless 'something' has been explicitly declared, e.g. by an interface block. * * * Side remark: A Fortran-only variant has been used in libgomp/testsuite/libgomp.fortran/alloc-11.f90: if (mod (TRANSFER (p, iptr), 64) /= 0) As optimization, also 'iand(..., z'3f') == 0' would work ;-) Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-21 17:43 ` Tobias Burnus @ 2022-01-24 8:45 ` Tobias Burnus 2022-01-24 12:54 ` Hafiz Abid Qadeer 2022-02-04 9:37 ` Thomas Schwinge 0 siblings, 2 replies; 28+ messages in thread From: Tobias Burnus @ 2022-01-24 8:45 UTC (permalink / raw) To: Tobias Burnus, Thomas Schwinge, Hafiz Abid Qadeer Cc: Jakub Jelinek, gcc-patches, fortran [-- Attachment #1: Type: text/plain, Size: 2676 bytes --] On 21.01.22 18:43, Tobias Burnus wrote: > On 21.01.22 18:15, Thomas Schwinge wrote: >> 11 | integer(c_int) function is_64bit_aligned (a) bind(C) >> Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C) >> procedure ‘is_64bit_aligned’ but may not be C interoperable >> [-Wc-binding-type] >> >> Is that something to worry about? I have attached a patch (not commited), which silences the three kind of warnings and fixes the interface issue. TODO: commit it. On 21.01.22 18:15, Thomas Schwinge wrote: > I'm seeing this test case randomly/non-deterministically FAIL to execute, > differently on different systems and runs, for example: [...] > I'd assume there's some concurrency issue: the problem disappears if I > manually specify a lowerish 'OMP_NUM_THREADS' If one compiles the program with -fsanitize=thread, it shows tons of errors :-( The first one is: WARNING: ThreadSanitizer: data race (pid=3034413) Read of size 8 at 0x7fff8b5a8340 by thread T1: #0 __m_MOD_foo._omp_fn.2 ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 (a.out+0x402a88) #1 gomp_thread_start ../../../repos/gcc-trunk-commit/libgomp/team.c:129 (libgomp.so.1+0x1e5ed) Previous write of size 8 at 0x7fff8b5a8340 by main thread: #0 __m_MOD_foo._omp_fn.1 ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 (a.out+0x4029c0) #1 GOMP_teams_reg ../../../repos/gcc-trunk-commit/libgomp/teams.c:51 (libgomp.so.1+0x3638c) #2 MAIN__ ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:328 (a.out+0x4024c0) #3 main ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:312 (a.out+0x4025b0) Location is stack of main thread. Location is global '<null>' at 0x000000000000 ([stack]+0x1f340) Thread T1 (tid=3034416, running) created by main thread at: #0 pthread_create ../../../../repos/gcc-trunk-commit/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001 (libtsan.so.2+0x62c76) #1 gomp_team_start ../../../repos/gcc-trunk-commit/libgomp/team.c:858 (libgomp.so.1+0x1ec18) #2 MAIN__ ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:328 (a.out+0x4024c0) #3 main ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:312 (a.out+0x4025b0) SUMMARY: ThreadSanitizer: data race ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 in __m_MOD_foo._omp_fn.2 Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 [-- Attachment #2: patch.diff --] [-- Type: text/x-patch, Size: 6422 bytes --] diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c index d33acc6feef..cb6d355afc6 100644 --- a/libgomp/testsuite/libgomp.fortran/allocate-1.c +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c @@ -1,7 +1,7 @@ #include <stdint.h> int -is_64bit_aligned_ (uintptr_t a) +is_64bit_aligned (uintptr_t a) { return ( (a & 0x3f) == 0); } diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 index 35d1750b878..f31bd533e7f 100644 --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -5,30 +5,30 @@ module m use omp_lib use iso_c_binding - implicit none + implicit none (type, external) interface integer(c_int) function is_64bit_aligned (a) bind(C) import :: c_int - integer :: a + type(*) :: a end end interface -end module m -subroutine foo (x, p, q, px, h, fl) +contains + +subroutine foo (x, p, q, h, fl) use omp_lib use iso_c_binding integer :: x integer, dimension(4) :: p integer, dimension(4) :: q - integer :: px integer (kind=omp_allocator_handle_kind) :: h integer :: fl integer :: y integer :: r, i, i1, i2, i3, i4, i5 integer :: l, l3, l4, l5, l6 - integer :: n, n1, n2, n3, n4 + integer :: n, n2, n3, n4 integer :: j2, j3, j4 integer, dimension(4) :: l2 integer, dimension(4) :: r2 @@ -118,6 +118,7 @@ subroutine foo (x, p, q, px, h, fl) end if !$omp end parallel !$omp end teams +stop !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16) do i = 0, 63 @@ -153,77 +154,77 @@ subroutine foo (x, p, q, px, h, fl) ((is_64bit_aligned(l2(1)) == 0) .or. & (is_64bit_aligned(l3) == 0) .or. & (is_64bit_aligned(i1) == 0))) then - stop 10 + stop 10 end if end do !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2) do i2 = 3, 4 do j2 = 17, 22, 2 - n2 = n2 + 17 - l4 = i2 * 31 + j2 - if ( (and(fl, 1) /= 0) .and. & - ((is_64bit_aligned(l4) == 0) .or. & - (is_64bit_aligned(n2) == 0) .or. & - (is_64bit_aligned(i2) == 0) .or. & - (is_64bit_aligned(j2) == 0))) then - stop 11 - end if + n2 = n2 + 17 + l4 = i2 * 31 + j2 + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l4) == 0) .or. & + (is_64bit_aligned(n2) == 0) .or. & + (is_64bit_aligned(i2) == 0) .or. & + (is_64bit_aligned(j2) == 0))) then + stop 11 + end if end do end do !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3) do i3 = 3, 4 do j3 = 17, 22, 2 - n3 = n3 + 17 - l5 = i3 * 31 + j3 - if ( (and(fl, 2) /= 0) .and. & - ((is_64bit_aligned(l5) == 0) .or. & - (is_64bit_aligned(n3) == 0) .or. & - (is_64bit_aligned(i3) == 0) .or. & - (is_64bit_aligned(j3) == 0))) then - stop 12 - end if + n3 = n3 + 17 + l5 = i3 * 31 + j3 + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(l5) == 0) .or. & + (is_64bit_aligned(n3) == 0) .or. & + (is_64bit_aligned(i3) == 0) .or. & + (is_64bit_aligned(j3) == 0))) then + stop 12 + end if end do end do !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4) do i4 = 3, 4 do j4 = 17, 22,2 - n4 = n4 + 17; - l6 = i4 * 31 + j4; - if ( (and(fl, 1) /= 0) .and. & - ((is_64bit_aligned(l6) == 0) .or. & - (is_64bit_aligned(n4) == 0) .or. & - (is_64bit_aligned(i4) == 0) .or. & - (is_64bit_aligned(j4) == 0))) then - stop 13 - end if + n4 = n4 + 17; + l6 = i4 * 31 + j4; + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(l6) == 0) .or. & + (is_64bit_aligned(n4) == 0) .or. & + (is_64bit_aligned(i4) == 0) .or. & + (is_64bit_aligned(j4) == 0))) then + stop 13 + end if end do end do !$omp do lastprivate (i5) allocate (i5) do i5 = 1, 17, 3 if ( (and(fl, 2) /= 0) .and. & - (is_64bit_aligned(i5) == 0)) then - stop 14 + (is_64bit_aligned(i5) == 0)) then + stop 14 end if end do !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2) do i = 0, 31 - p(3) = p(3) + i; - p(4) = p(4) + (2 * i) - q(1) = q(1) + (3 * i) - q(3) = q(3) + (4 * i) - r2(1) = r2(1) + (5 * i) - r2(4) = r2(4) + (6 * i) - if ( (and(fl, 1) /= 0) .and. & - ((is_64bit_aligned(q(1)) == 0) .or. & - (is_64bit_aligned(p(1)) == 0) .or. & - (is_64bit_aligned(r2(1)) == 0) )) then - stop 15 - end if + p(3) = p(3) + i; + p(4) = p(4) + (2 * i) + q(1) = q(1) + (3 * i) + q(3) = q(3) + (4 * i) + r2(1) = r2(1) + (5 * i) + r2(4) = r2(4) + (6 * i) + if ( (and(fl, 1) /= 0) .and. & + ((is_64bit_aligned(q(1)) == 0) .or. & + (is_64bit_aligned(p(1)) == 0) .or. & + (is_64bit_aligned(r2(1)) == 0) )) then + stop 15 + end if end do !$omp task private(y) firstprivate(x) allocate(x, y) @@ -305,11 +306,13 @@ subroutine foo (x, p, q, px, h, fl) .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then stop 25 end if - end subroutine +end module m program main use omp_lib + use m + implicit none (type, external) integer, dimension(4) :: p integer, dimension(4) :: q @@ -323,11 +326,11 @@ program main if (a == omp_null_allocator) stop 1 call omp_set_default_allocator (omp_default_mem_alloc); - call foo (42, p, q, 2, a, 0); - call foo (42, p, q, 2, omp_default_mem_alloc, 0); - call foo (42, p, q, 2, a, 1); + call foo (42, p, q, a, 0); + call foo (42, p, q, omp_default_mem_alloc, 0); + call foo (42, p, q, a, 1); call omp_set_default_allocator (a); - call foo (42, p, q, 2, omp_null_allocator, 3); - call foo (42, p, q, 2, omp_default_mem_alloc, 2); + call foo (42, p, q, omp_null_allocator, 3); + call foo (42, p, q, omp_default_mem_alloc, 2); call omp_destroy_allocator (a); end ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-24 8:45 ` Tobias Burnus @ 2022-01-24 12:54 ` Hafiz Abid Qadeer 2022-01-25 9:19 ` Thomas Schwinge 2022-02-04 9:37 ` Thomas Schwinge 1 sibling, 1 reply; 28+ messages in thread From: Hafiz Abid Qadeer @ 2022-01-24 12:54 UTC (permalink / raw) To: Tobias Burnus, Thomas Schwinge, Hafiz Abid Qadeer Cc: Jakub Jelinek, gcc-patches, fortran On 24/01/2022 08:45, Tobias Burnus wrote: > On 21.01.22 18:43, Tobias Burnus wrote: >> On 21.01.22 18:15, Thomas Schwinge wrote: >>> 11 | integer(c_int) function is_64bit_aligned (a) bind(C) >>> Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C) procedure ‘is_64bit_aligned’ >>> but may not be C interoperable [-Wc-binding-type] >>> >>> Is that something to worry about? > I have attached a patch (not commited), which silences the three kind of warnings and fixes the > interface issue. > TODO: commit it. > > On 21.01.22 18:15, Thomas Schwinge wrote: >> I'm seeing this test case randomly/non-deterministically FAIL to execute, >> differently on different systems and runs, for example: [...] >> I'd assume there's some concurrency issue: the problem disappears if I >> manually specify a lowerish 'OMP_NUM_THREADS' > > If one compiles the program with -fsanitize=thread, it shows tons of errors :-( > The first one is: > > WARNING: ThreadSanitizer: data race (pid=3034413) > Read of size 8 at 0x7fff8b5a8340 by thread T1: > #0 __m_MOD_foo._omp_fn.2 ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 > (a.out+0x402a88) > #1 gomp_thread_start ../../../repos/gcc-trunk-commit/libgomp/team.c:129 (libgomp.so.1+0x1e5ed) > > Previous write of size 8 at 0x7fff8b5a8340 by main thread: > #0 __m_MOD_foo._omp_fn.1 ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 > (a.out+0x4029c0) > #1 GOMP_teams_reg ../../../repos/gcc-trunk-commit/libgomp/teams.c:51 (libgomp.so.1+0x3638c) > #2 MAIN__ ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:328 (a.out+0x4024c0) > #3 main ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:312 (a.out+0x4025b0) > > Location is stack of main thread. > > Location is global '<null>' at 0x000000000000 ([stack]+0x1f340) > > Thread T1 (tid=3034416, running) created by main thread at: > #0 pthread_create > ../../../../repos/gcc-trunk-commit/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001 > (libtsan.so.2+0x62c76) > #1 gomp_team_start ../../../repos/gcc-trunk-commit/libgomp/team.c:858 (libgomp.so.1+0x1ec18) > #2 MAIN__ ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:328 (a.out+0x4024c0) > #3 main ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:312 (a.out+0x4025b0) > > SUMMARY: ThreadSanitizer: data race ../../libgomp/testsuite/libgomp.fortran/allocate-1.f90:116 in > __m_MOD_foo._omp_fn.2 > > Tobias @Tobias: Thanks for your comments and the patch. @Thomas: Thanks for reporting the problem. Did you notice similar behavior with libgomp/testsuite/libgomp.c-c++-common/allocate-1.c? It was used as base for fortran testcase and it shows similar warnings with -fthread=sanitize. I am trying to figure out if the problem you observed is a general one or just specific to fortran testcase. -- Hafiz Abid Qadeer Mentor, a Siemens Business ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-24 12:54 ` Hafiz Abid Qadeer @ 2022-01-25 9:19 ` Thomas Schwinge 2022-01-25 10:32 ` Tobias Burnus 0 siblings, 1 reply; 28+ messages in thread From: Thomas Schwinge @ 2022-01-25 9:19 UTC (permalink / raw) To: Jakub Jelinek, Tobias Burnus, Hafiz Abid Qadeer; +Cc: gcc-patches, fortran Hi! On 2022-01-24T12:54:27+0000, Hafiz Abid Qadeer <abid_qadeer@mentor.com> wrote: > On 24/01/2022 08:45, Tobias Burnus wrote: >> On 21.01.22 18:15, Thomas Schwinge wrote: >>> I'm seeing this test case randomly/non-deterministically FAIL to execute, >>> differently on different systems and runs, for example: [...] >>> I'd assume there's some concurrency issue: the problem disappears if I >>> manually specify a lowerish 'OMP_NUM_THREADS' >> >> If one compiles the program with -fsanitize=thread, it shows tons of errors :-( Confirmed. > Did you notice similar behavior with > libgomp/testsuite/libgomp.c-c++-common/allocate-1.c? No, this one I always saw PASS. (... which only means so much, of course...) > It was used as base for fortran testcase and it > shows similar warnings with -fthread=sanitize. Confirmed. > I am trying to figure out if the problem you observed > is a general one or just specific to fortran testcase. So, unless the '-fsanitize=thread' issues are bogus -- unlikely ;-) -- it seems a latent issue generally, now fatal with 'libgomp.fortran/allocate-1.f90'. Grüße Thomas ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-25 9:19 ` Thomas Schwinge @ 2022-01-25 10:32 ` Tobias Burnus 2022-01-31 19:13 ` Hafiz Abid Qadeer 0 siblings, 1 reply; 28+ messages in thread From: Tobias Burnus @ 2022-01-25 10:32 UTC (permalink / raw) To: Thomas Schwinge, Jakub Jelinek, Hafiz Abid Qadeer; +Cc: gcc-patches, fortran On 25.01.22 10:19, Thomas Schwinge wrote: >> I am trying to figure out if the problem you observed >> is a general one or just specific to fortran testcase. > So, unless the '-fsanitize=thread' issues are bogus -- unlikely ;-) -- it > seems a latent issue generally, now fatal with > 'libgomp.fortran/allocate-1.f90'. There is one known issue with libgomp and TSAN (-fsanitize=thread) that I tend to forget about :-( That's according to Jakub, who wrote a while ago: "TSAN doesn't understand what libgomp is doing, unless built with --disable-linux-futex" However, I now tried to disable futex and still get the following. (First result for libgomp.c-c++-common/allocate-1.c). On the other hand, I have the feeling that the configure option is a no op for libgomp. This can also be seen in the configure.ac script, which only for libstdc++ uses the result and the others have a no-op call to 'true' (alias ':'): libgomp/configure.ac:GCC_LINUX_FUTEX(:) libitm/configure.ac:GCC_LINUX_FUTEX(:) libstdc++-v3/configure.ac:GCC_LINUX_FUTEX([AC_DEFINE(HAVE_LINUX_FUTEX, 1, [Define if futex syscall is available.])]) (The check is not completely pointless as some checks are still done; e.g. 'SYS_gettid and SYS_futex required'.) (TSAN did find issues in libgomp in the past, however. But those habe been fixed.) Thus, there might or might not be an issue when TSAN reports one. * * * Glancing at the Fortran testcase, I noted the following, which probably does not cause the problems. But still, I want to mention it: !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) if (x /= 42) then stop 1 end if v(1) = 7 if ( (and(fl, 2) /= 0) .and. & ((is_64bit_aligned(x) == 0) .or. & (is_64bit_aligned(y) == 0) .or. & (is_64bit_aligned(v(1)) == 0))) then stop 2 end if If one compares this with the C/C++ testcase, I note that there is a barrier before the alignment check in C/C++ but not in Fortran. Additionally, 'v(1) = 7' is set twice and the alignment check happens earlier than in C/C++. Not that that should really matter, but I just saw it. In C/C++: int v[x], w[x]; ... v[0] = 7; v[41] = 8; In Fortran: integer, dimension(x) :: v ... v(1) = 7 v(41) = 8 where 'x == 42'. The Fortran version is not really wrong, but I think the idea is to set the first and last array element - and that's here v(42) and not v(41). BTW: Fortran permits to specify a different lower bound. When converting C/C++ testcases, it can be useful to use the same lower bound also in Fortran: integer :: v(0:x-1) (or: 'integer, dimension(0:x-1) :: v') uses then 0 ... 41 for the indices instead of 1 ... 42. But one has to be careful as Fortran uses the upper bound and C uses the number of elements. (Same with OpenMP array sections in Fortran vs. C.) Tobias PS: The promised data-race warning: ================== WARNING: ThreadSanitizer: data race (pid=4135381) Read of size 8 at 0x7ffc0888bdc0 by thread T10: #0 foo._omp_fn.2 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402c05) #1 gomp_thread_start ../../../repos/gcc/libgomp/team.c:129 (libgomp.so.1+0x1e5ed) Previous write of size 8 at 0x7ffc0888bdc0 by main thread: #0 foo._omp_fn.1 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402aee) #1 GOMP_teams_reg ../../../repos/gcc/libgomp/teams.c:51 (libgomp.so.1+0x3638c) #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e) Location is stack of main thread. Location is global '<null>' at 0x000000000000 ([stack]+0x1ddc0) Thread T10 (tid=4135398, running) created by main thread at: #0 pthread_create ../../../../repos/gcc/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001 (libtsan.so.2+0x62c76) #1 gomp_team_start ../../../repos/gcc/libgomp/team.c:858 (libgomp.so.1+0x1ec18) #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e) SUMMARY: ThreadSanitizer: data race libgomp.c-c++-common/allocate-1.c:47 in foo._omp_fn.2 ================== ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-25 10:32 ` Tobias Burnus @ 2022-01-31 19:13 ` Hafiz Abid Qadeer 2022-02-04 9:46 ` Thomas Schwinge 0 siblings, 1 reply; 28+ messages in thread From: Hafiz Abid Qadeer @ 2022-01-31 19:13 UTC (permalink / raw) To: Tobias Burnus, Thomas Schwinge, Jakub Jelinek, Hafiz Abid Qadeer Cc: gcc-patches, fortran [-- Attachment #1: Type: text/plain, Size: 4581 bytes --] On 25/01/2022 10:32, Tobias Burnus wrote: > On 25.01.22 10:19, Thomas Schwinge wrote: >>> I am trying to figure out if the problem you observed >>> is a general one or just specific to fortran testcase. >> So, unless the '-fsanitize=thread' issues are bogus -- unlikely ;-) -- it >> seems a latent issue generally, now fatal with >> 'libgomp.fortran/allocate-1.f90'. > > There is one known issue with libgomp and TSAN (-fsanitize=thread) > that I tend to forget about :-( > > That's according to Jakub, who wrote a while ago: > > "TSAN doesn't understand what libgomp is doing, unless built with --disable-linux-futex" > > > > However, I now tried to disable futex and still get the following. > (First result for libgomp.c-c++-common/allocate-1.c). > > On the other hand, I have the feeling that the configure option is > a no op for libgomp. This can also be seen in the configure.ac script, > which only for libstdc++ uses the result and the others have a no-op > call to 'true' (alias ':'): > > libgomp/configure.ac:GCC_LINUX_FUTEX(:) > libitm/configure.ac:GCC_LINUX_FUTEX(:) > libstdc++-v3/configure.ac:GCC_LINUX_FUTEX([AC_DEFINE(HAVE_LINUX_FUTEX, 1, [Define if futex syscall > is available.])]) > > (The check is not completely pointless as some checks are still done; > e.g. 'SYS_gettid and SYS_futex required'.) > > (TSAN did find issues in libgomp in the past, however. But those > habe been fixed.) > > > Thus, there might or might not be an issue when TSAN reports one. > > * * * > > Glancing at the Fortran testcase, I noted the following, > which probably does not cause the problems. But still, > I want to mention it: > > !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) > if (x /= 42) then > stop 1 > end if > > v(1) = 7 > if ( (and(fl, 2) /= 0) .and. & > ((is_64bit_aligned(x) == 0) .or. & > (is_64bit_aligned(y) == 0) .or. & > (is_64bit_aligned(v(1)) == 0))) then > stop 2 > end if > > If one compares this with the C/C++ testcase, I note that there > is a barrier before the alignment check in C/C++ but not in > Fortran. Additionally, 'v(1) = 7' is set twice and the > alignment check happens earlier than in C/C++. Not that that > should really matter, but I just saw it. > > > In C/C++: > int v[x], w[x]; > ... > v[0] = 7; > v[41] = 8; > > In Fortran: > integer, dimension(x) :: v > ... > v(1) = 7 > v(41) = 8 > > where 'x == 42'. The Fortran version is not really wrong, but I think > the idea is to set the first and last array element - and that's here > v(42) and not v(41). > > BTW: Fortran permits to specify a different lower bound. When converting > C/C++ testcases, it can be useful to use the same lower bound also in > Fortran: integer :: v(0:x-1) (or: 'integer, dimension(0:x-1) :: v') > uses then 0 ... 41 for the indices instead of 1 ... 42. > > But one has to be careful as Fortran uses the upper bound and C uses the > number of elements. (Same with OpenMP array sections in Fortran vs. C.) > > > Tobias > > PS: The promised data-race warning: > ================== > WARNING: ThreadSanitizer: data race (pid=4135381) > Read of size 8 at 0x7ffc0888bdc0 by thread T10: > #0 foo._omp_fn.2 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402c05) > #1 gomp_thread_start ../../../repos/gcc/libgomp/team.c:129 (libgomp.so.1+0x1e5ed) > > Previous write of size 8 at 0x7ffc0888bdc0 by main thread: > #0 foo._omp_fn.1 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402aee) > #1 GOMP_teams_reg ../../../repos/gcc/libgomp/teams.c:51 (libgomp.so.1+0x3638c) > #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e) > > Location is stack of main thread. > > Location is global '<null>' at 0x000000000000 ([stack]+0x1ddc0) > > Thread T10 (tid=4135398, running) created by main thread at: > #0 pthread_create ../../../../repos/gcc/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001 > (libtsan.so.2+0x62c76) > #1 gomp_team_start ../../../repos/gcc/libgomp/team.c:858 (libgomp.so.1+0x1ec18) > #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e) > > SUMMARY: ThreadSanitizer: data race libgomp.c-c++-common/allocate-1.c:47 in foo._omp_fn.2 > ================== > Problem was with the pool_size trait. It has limited size which this testcase exceeded. I have removed it now which seems to fix the problem. Ok to commit the attached patch? Thanks, -- Hafiz Abid Qadeer Mentor, a Siemens Business [-- Attachment #2: 0001-libgomp-Fix-testcase-to-remove-out-of-memory-error.patch --] [-- Type: text/x-patch, Size: 1711 bytes --] From 98b5493bd94520dd78b3963d3a4e67cba6bfb6aa Mon Sep 17 00:00:00 2001 From: Hafiz Abid Qadeer <abidh@codesourcery.com> Date: Mon, 31 Jan 2022 19:02:14 +0000 Subject: [PATCH] [libgomp] Fix testcase to remove out of memory error. Thomas reported in https://gcc.gnu.org/pipermail/gcc-patches/2022-January/589039.html that this testcase is randomly failing. The problem was fixed pool size which was exhausted when there were a lot of threads. Fixed it by removing pool_size trait which causes default pool size to be used which should be big enough. libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.f90: Remove pool_size trait. --- libgomp/testsuite/libgomp.fortran/allocate-1.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 index 35d1750b878..04bf2307462 100644 --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -313,13 +313,12 @@ program main integer, dimension(4) :: p integer, dimension(4) :: q - type (omp_alloctrait) :: traits(3) + type (omp_alloctrait) :: traits(2) integer (omp_allocator_handle_kind) :: a traits = [omp_alloctrait (omp_atk_alignment, 64), & - omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & - omp_alloctrait (omp_atk_pool_size, 8192)] - a = omp_init_allocator (omp_default_mem_space, 3, traits) + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)] + a = omp_init_allocator (omp_default_mem_space, 2, traits) if (a == omp_null_allocator) stop 1 call omp_set_default_allocator (omp_default_mem_alloc); -- 2.25.1 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-31 19:13 ` Hafiz Abid Qadeer @ 2022-02-04 9:46 ` Thomas Schwinge 2022-02-04 11:25 ` Hafiz Abid Qadeer 0 siblings, 1 reply; 28+ messages in thread From: Thomas Schwinge @ 2022-02-04 9:46 UTC (permalink / raw) To: Hafiz Abid Qadeer, Tobias Burnus, Jakub Jelinek; +Cc: gcc-patches, fortran Hi! On 2022-01-31T19:13:09+0000, Hafiz Abid Qadeer <abid_qadeer@mentor.com> wrote: > On 25/01/2022 10:32, Tobias Burnus wrote: >> On 25.01.22 10:19, Thomas Schwinge wrote: >>>> I am trying to figure out if the problem you observed >>>> is a general one or just specific to fortran testcase. >>> So, unless the '-fsanitize=thread' issues are bogus -- unlikely ;-) -- it >>> seems a latent issue generally, now fatal with >>> 'libgomp.fortran/allocate-1.f90'. >> >> There is one known issue with libgomp and TSAN (-fsanitize=thread) >> that I tend to forget about :-( >> >> That's according to Jakub, who wrote a while ago: >> >> "TSAN doesn't understand what libgomp is doing, unless built with --disable-linux-futex" Uh. Anything that can reasonably be done to address this? At least, to make this obvious to the user of '-fsanitize=thread'? >> However, I now tried to disable futex and still get the following. >> (First result for libgomp.c-c++-common/allocate-1.c). >> >> On the other hand, I have the feeling that the configure option is >> a no op for libgomp. This can also be seen in the configure.ac script, >> which only for libstdc++ uses the result and the others have a no-op >> call to 'true' (alias ':'): >> >> libgomp/configure.ac:GCC_LINUX_FUTEX(:) >> libitm/configure.ac:GCC_LINUX_FUTEX(:) >> libstdc++-v3/configure.ac:GCC_LINUX_FUTEX([AC_DEFINE(HAVE_LINUX_FUTEX, 1, [Define if futex syscall >> is available.])]) >> >> (The check is not completely pointless as some checks are still done; >> e.g. 'SYS_gettid and SYS_futex required'.) Uh. That (make '--disable-linux-futex' work) should be fixed, I suppose? >> (TSAN did find issues in libgomp in the past, however. But those >> habe been fixed.) >> >> >> Thus, there might or might not be an issue when TSAN reports one. >> >> * * * >> >> Glancing at the Fortran testcase, I noted the following, >> which probably does not cause the problems. But still, >> I want to mention it: >> >> !$omp parallel private (y, v) firstprivate (x) allocate (x, y, v) >> if (x /= 42) then >> stop 1 >> end if >> >> v(1) = 7 >> if ( (and(fl, 2) /= 0) .and. & >> ((is_64bit_aligned(x) == 0) .or. & >> (is_64bit_aligned(y) == 0) .or. & >> (is_64bit_aligned(v(1)) == 0))) then >> stop 2 >> end if >> >> If one compares this with the C/C++ testcase, I note that there >> is a barrier before the alignment check in C/C++ but not in >> Fortran. Additionally, 'v(1) = 7' is set twice and the >> alignment check happens earlier than in C/C++. Not that that >> should really matter, but I just saw it. >> >> >> In C/C++: >> int v[x], w[x]; >> ... >> v[0] = 7; >> v[41] = 8; >> >> In Fortran: >> integer, dimension(x) :: v >> ... >> v(1) = 7 >> v(41) = 8 >> >> where 'x == 42'. The Fortran version is not really wrong, but I think >> the idea is to set the first and last array element - and that's here >> v(42) and not v(41). >> >> BTW: Fortran permits to specify a different lower bound. When converting >> C/C++ testcases, it can be useful to use the same lower bound also in >> Fortran: integer :: v(0:x-1) (or: 'integer, dimension(0:x-1) :: v') >> uses then 0 ... 41 for the indices instead of 1 ... 42. >> >> But one has to be careful as Fortran uses the upper bound and C uses the >> number of elements. (Same with OpenMP array sections in Fortran vs. C.) Abid, are you going to address these? I think it does make sense if the C/C++ and Fortran test cases match as much as feasible. >> PS: The promised data-race warning: >> ================== >> WARNING: ThreadSanitizer: data race (pid=4135381) >> Read of size 8 at 0x7ffc0888bdc0 by thread T10: >> #0 foo._omp_fn.2 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402c05) >> #1 gomp_thread_start ../../../repos/gcc/libgomp/team.c:129 (libgomp.so.1+0x1e5ed) >> >> Previous write of size 8 at 0x7ffc0888bdc0 by main thread: >> #0 foo._omp_fn.1 libgomp.c-c++-common/allocate-1.c:47 (a.out+0x402aee) >> #1 GOMP_teams_reg ../../../repos/gcc/libgomp/teams.c:51 (libgomp.so.1+0x3638c) >> #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e) >> >> Location is stack of main thread. >> >> Location is global '<null>' at 0x000000000000 ([stack]+0x1ddc0) >> >> Thread T10 (tid=4135398, running) created by main thread at: >> #0 pthread_create ../../../../repos/gcc/libsanitizer/tsan/tsan_interceptors_posix.cpp:1001 >> (libtsan.so.2+0x62c76) >> #1 gomp_team_start ../../../repos/gcc/libgomp/team.c:858 (libgomp.so.1+0x1ec18) >> #2 main libgomp.c-c++-common/allocate-1.c:366 (a.out+0x40273e) >> >> SUMMARY: ThreadSanitizer: data race libgomp.c-c++-common/allocate-1.c:47 in foo._omp_fn.2 >> ================== >> > > Problem was with the pool_size trait. It has limited size which this testcase exceeded. I have > removed it now which seems to fix the problem. Ok to commit the attached patch? First, I do confirm that this (testing together with Tobias' patch "which silences the three kind of warnings and fixes the interface issue" plus my suggestion that the "early 'stop' [...] be backed out") does resolve the execution FAILs, thanks. However: really (a) remove 'omp_alloctrait (omp_atk_pool_size, 8192)' altogether, or instead: (b) increase its size (if that can be computed) -- and/or (c) limit the number of OpenMP threads executing in parallel? Due to unfamiliarity with all that, I don't know what's best here. Grüße Thomas > From 98b5493bd94520dd78b3963d3a4e67cba6bfb6aa Mon Sep 17 00:00:00 2001 > From: Hafiz Abid Qadeer <abidh@codesourcery.com> > Date: Mon, 31 Jan 2022 19:02:14 +0000 > Subject: [PATCH] [libgomp] Fix testcase to remove out of memory error. > > Thomas reported in > https://gcc.gnu.org/pipermail/gcc-patches/2022-January/589039.html > that this testcase is randomly failing. The problem was fixed pool > size which was exhausted when there were a lot of threads. Fixed it > by removing pool_size trait which causes default pool size to be used > which should be big enough. > > libgomp/ChangeLog: > > * testsuite/libgomp.fortran/allocate-1.f90: Remove pool_size trait. > --- > libgomp/testsuite/libgomp.fortran/allocate-1.f90 | 7 +++---- > 1 file changed, 3 insertions(+), 4 deletions(-) > > diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > index 35d1750b878..04bf2307462 100644 > --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > @@ -313,13 +313,12 @@ program main > integer, dimension(4) :: p > integer, dimension(4) :: q > > - type (omp_alloctrait) :: traits(3) > + type (omp_alloctrait) :: traits(2) > integer (omp_allocator_handle_kind) :: a > > traits = [omp_alloctrait (omp_atk_alignment, 64), & > - omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & > - omp_alloctrait (omp_atk_pool_size, 8192)] > - a = omp_init_allocator (omp_default_mem_space, 3, traits) > + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)] > + a = omp_init_allocator (omp_default_mem_space, 2, traits) > if (a == omp_null_allocator) stop 1 > > call omp_set_default_allocator (omp_default_mem_alloc); > -- > 2.25.1 ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-02-04 9:46 ` Thomas Schwinge @ 2022-02-04 11:25 ` Hafiz Abid Qadeer 2022-02-05 19:09 ` Hafiz Abid Qadeer 0 siblings, 1 reply; 28+ messages in thread From: Hafiz Abid Qadeer @ 2022-02-04 11:25 UTC (permalink / raw) To: Thomas Schwinge, Hafiz Abid Qadeer, Tobias Burnus, Jakub Jelinek Cc: gcc-patches, fortran On 04/02/2022 09:46, Thomas Schwinge wrote: > > Abid, are you going to address these? I think it does make sense if the > C/C++ and Fortran test cases match as much as feasible. > Sure. I will do that. > However: really (a) remove 'omp_alloctrait (omp_atk_pool_size, 8192)' > altogether, or instead: (b) increase its size (if that can be computed) > -- and/or (c) limit the number of OpenMP threads executing in parallel? > Due to unfamiliarity with all that, I don't know what's best here. > C testcase also does not have the pool_size trait. So it makes sense to me to not have it in fortran testcase too. It also seems more cleaner than putting some limits on number of threads or increasing the size which will be a bit fragile. Thanks, -- Hafiz Abid Qadeer ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-02-04 11:25 ` Hafiz Abid Qadeer @ 2022-02-05 19:09 ` Hafiz Abid Qadeer 2022-02-16 10:29 ` Hafiz Abid Qadeer 0 siblings, 1 reply; 28+ messages in thread From: Hafiz Abid Qadeer @ 2022-02-05 19:09 UTC (permalink / raw) To: Thomas Schwinge, Tobias Burnus, Jakub Jelinek; +Cc: gcc-patches, fortran [-- Attachment #1: Type: text/plain, Size: 367 bytes --] On 04/02/2022 11:25, Hafiz Abid Qadeer wrote: > On 04/02/2022 09:46, Thomas Schwinge wrote: > >> >> Abid, are you going to address these? I think it does make sense if the >> C/C++ and Fortran test cases match as much as feasible. >> > Sure. I will do that. The attached patch address those issues apart from removing pool_size trait. Thanks -- Hafiz Abid Qadeer [-- Attachment #2: 0001-libgomp-Fix-multiple-issue-in-the-testcase-allocate-.patch --] [-- Type: text/x-patch, Size: 3027 bytes --] From 7b4dbd5b7c853f0165436ef58339663edce802d5 Mon Sep 17 00:00:00 2001 From: Hafiz Abid Qadeer <abidh@codesourcery.com> Date: Mon, 31 Jan 2022 19:02:14 +0000 Subject: [PATCH] [libgomp] Fix multiple issue in the testcase allocate-1.f90. 1. Thomas reported in https://gcc.gnu.org/pipermail/gcc-patches/2022-January/589039.html that this testcase is randomly failing. The problem was fixed pool size which was exhausted when there were a lot of threads. Fixed it by removing pool_size trait which causes default pool size to be used which should be big enough. 2. Array indices have been changed to check the last element in the array. 3. Remove a redundant assignment and move some code to better match C testcase. libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.f90: Remove pool_size trait. Test last index in w and v array. Remove redundant assignment to V(1). Move alignment checks at the end of parallel region. --- .../testsuite/libgomp.fortran/allocate-1.f90 | 26 +++++++++---------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 index 0a31d35d5ac..1547d2baeef 100644 --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -74,31 +74,30 @@ subroutine foo (x, p, q, h, fl) if (x /= 42) then stop 1 end if - v(1) = 7 - if ( (and(fl, 2) /= 0) .and. & - ((is_64bit_aligned(x) == 0) .or. & - (is_64bit_aligned(y) == 0) .or. & - (is_64bit_aligned(v(1)) == 0))) then - stop 2 - end if !$omp barrier y = 1; x = x + 1 v(1) = 7 - v(41) = 8 + v(42) = 8 !$omp barrier if (x /= 43 .or. y /= 1) then stop 3 end if - if (v(1) /= 7 .or. v(41) /= 8) then + if (v(1) /= 7 .or. v(42) /= 8) then stop 4 end if + if ( (and(fl, 2) /= 0) .and. & + ((is_64bit_aligned(x) == 0) .or. & + (is_64bit_aligned(y) == 0) .or. & + (is_64bit_aligned(v(1)) == 0))) then + stop 2 + end if !$omp end parallel !$omp teams !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) - if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then + if (x /= 42 .or. w(17) /= 17 .or. w(42) /= 42) then stop 5 end if !$omp barrier @@ -314,13 +313,12 @@ program main integer, dimension(4) :: p integer, dimension(4) :: q - type (omp_alloctrait) :: traits(3) + type (omp_alloctrait) :: traits(2) integer (omp_allocator_handle_kind) :: a traits = [omp_alloctrait (omp_atk_alignment, 64), & - omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & - omp_alloctrait (omp_atk_pool_size, 8192)] - a = omp_init_allocator (omp_default_mem_space, 3, traits) + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)] + a = omp_init_allocator (omp_default_mem_space, 2, traits) if (a == omp_null_allocator) stop 1 call omp_set_default_allocator (omp_default_mem_alloc); -- 2.25.1 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-02-05 19:09 ` Hafiz Abid Qadeer @ 2022-02-16 10:29 ` Hafiz Abid Qadeer 0 siblings, 0 replies; 28+ messages in thread From: Hafiz Abid Qadeer @ 2022-02-16 10:29 UTC (permalink / raw) To: Thomas Schwinge, Tobias Burnus, Jakub Jelinek; +Cc: gcc-patches, fortran On 05/02/2022 19:09, Hafiz Abid Qadeer wrote: > On 04/02/2022 11:25, Hafiz Abid Qadeer wrote: >> On 04/02/2022 09:46, Thomas Schwinge wrote: >> >>> >>> Abid, are you going to address these? I think it does make sense if the >>> C/C++ and Fortran test cases match as much as feasible. >>> >> Sure. I will do that. > > The attached patch address those issues apart from removing pool_size trait. Is this change ok to commit? Thanks, -- Hafiz Abid Qadeer ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0). 2022-01-24 8:45 ` Tobias Burnus 2022-01-24 12:54 ` Hafiz Abid Qadeer @ 2022-02-04 9:37 ` Thomas Schwinge 2022-02-04 13:57 ` [committed] libgomp.fortran/allocate-1.f90: Minor cleanup (was: Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0).) Tobias Burnus 1 sibling, 1 reply; 28+ messages in thread From: Thomas Schwinge @ 2022-02-04 9:37 UTC (permalink / raw) To: Tobias Burnus; +Cc: Hafiz Abid Qadeer, Jakub Jelinek, gcc-patches, fortran Hi Tobias! On 2022-01-24T09:45:48+0100, Tobias Burnus <tobias@codesourcery.com> wrote: > On 21.01.22 18:43, Tobias Burnus wrote: >> On 21.01.22 18:15, Thomas Schwinge wrote: >>> 11 | integer(c_int) function is_64bit_aligned (a) bind(C) >>> Warning: Variable ‘a’ at (1) is a dummy argument of the BIND(C) >>> procedure ‘is_64bit_aligned’ but may not be C interoperable >>> [-Wc-binding-type] >>> >>> Is that something to worry about? > I have attached a patch (not commited), which silences the three kind of > warnings and fixes the interface issue. > TODO: commit it. Still "TODO: commit it" ;-) -- and while I haven't reviewed the changes in detail, I did spot one item that should be addressed, I suppose: > --- a/libgomp/testsuite/libgomp.fortran/allocate-1.c > +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c > @@ -1,7 +1,7 @@ > #include <stdint.h> > > int > -is_64bit_aligned_ (uintptr_t a) > +is_64bit_aligned (uintptr_t a) > { > return ( (a & 0x3f) == 0); > } > --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > @@ -5,30 +5,30 @@ > module m > use omp_lib > use iso_c_binding > - implicit none > + implicit none (type, external) > > interface > integer(c_int) function is_64bit_aligned (a) bind(C) > import :: c_int > - integer :: a > + type(*) :: a > end > end interface > -end module m > > -subroutine foo (x, p, q, px, h, fl) > +contains > + > +subroutine foo (x, p, q, h, fl) > use omp_lib > use iso_c_binding > integer :: x > integer, dimension(4) :: p > integer, dimension(4) :: q > - integer :: px > integer (kind=omp_allocator_handle_kind) :: h > integer :: fl > > integer :: y > integer :: r, i, i1, i2, i3, i4, i5 > integer :: l, l3, l4, l5, l6 > - integer :: n, n1, n2, n3, n4 > + integer :: n, n2, n3, n4 > integer :: j2, j3, j4 > integer, dimension(4) :: l2 > integer, dimension(4) :: r2 > @@ -118,6 +118,7 @@ subroutine foo (x, p, q, px, h, fl) > end if > !$omp end parallel > !$omp end teams > +stop > > !$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16) > do i = 0, 63 That early 'stop' should probably be backed out? ;-) Grüße Thomas > @@ -153,77 +154,77 @@ subroutine foo (x, p, q, px, h, fl) > ((is_64bit_aligned(l2(1)) == 0) .or. & > (is_64bit_aligned(l3) == 0) .or. & > (is_64bit_aligned(i1) == 0))) then > - stop 10 > + stop 10 > end if > end do > > !$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2) > do i2 = 3, 4 > do j2 = 17, 22, 2 > - n2 = n2 + 17 > - l4 = i2 * 31 + j2 > - if ( (and(fl, 1) /= 0) .and. & > - ((is_64bit_aligned(l4) == 0) .or. & > - (is_64bit_aligned(n2) == 0) .or. & > - (is_64bit_aligned(i2) == 0) .or. & > - (is_64bit_aligned(j2) == 0))) then > - stop 11 > - end if > + n2 = n2 + 17 > + l4 = i2 * 31 + j2 > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(l4) == 0) .or. & > + (is_64bit_aligned(n2) == 0) .or. & > + (is_64bit_aligned(i2) == 0) .or. & > + (is_64bit_aligned(j2) == 0))) then > + stop 11 > + end if > end do > end do > > !$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3) > do i3 = 3, 4 > do j3 = 17, 22, 2 > - n3 = n3 + 17 > - l5 = i3 * 31 + j3 > - if ( (and(fl, 2) /= 0) .and. & > - ((is_64bit_aligned(l5) == 0) .or. & > - (is_64bit_aligned(n3) == 0) .or. & > - (is_64bit_aligned(i3) == 0) .or. & > - (is_64bit_aligned(j3) == 0))) then > - stop 12 > - end if > + n3 = n3 + 17 > + l5 = i3 * 31 + j3 > + if ( (and(fl, 2) /= 0) .and. & > + ((is_64bit_aligned(l5) == 0) .or. & > + (is_64bit_aligned(n3) == 0) .or. & > + (is_64bit_aligned(i3) == 0) .or. & > + (is_64bit_aligned(j3) == 0))) then > + stop 12 > + end if > end do > end do > > !$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4) > do i4 = 3, 4 > do j4 = 17, 22,2 > - n4 = n4 + 17; > - l6 = i4 * 31 + j4; > - if ( (and(fl, 1) /= 0) .and. & > - ((is_64bit_aligned(l6) == 0) .or. & > - (is_64bit_aligned(n4) == 0) .or. & > - (is_64bit_aligned(i4) == 0) .or. & > - (is_64bit_aligned(j4) == 0))) then > - stop 13 > - end if > + n4 = n4 + 17; > + l6 = i4 * 31 + j4; > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(l6) == 0) .or. & > + (is_64bit_aligned(n4) == 0) .or. & > + (is_64bit_aligned(i4) == 0) .or. & > + (is_64bit_aligned(j4) == 0))) then > + stop 13 > + end if > end do > end do > > !$omp do lastprivate (i5) allocate (i5) > do i5 = 1, 17, 3 > if ( (and(fl, 2) /= 0) .and. & > - (is_64bit_aligned(i5) == 0)) then > - stop 14 > + (is_64bit_aligned(i5) == 0)) then > + stop 14 > end if > end do > > !$omp do reduction(+:p, q, r2) allocate(h: p, q, r2) > do i = 0, 31 > - p(3) = p(3) + i; > - p(4) = p(4) + (2 * i) > - q(1) = q(1) + (3 * i) > - q(3) = q(3) + (4 * i) > - r2(1) = r2(1) + (5 * i) > - r2(4) = r2(4) + (6 * i) > - if ( (and(fl, 1) /= 0) .and. & > - ((is_64bit_aligned(q(1)) == 0) .or. & > - (is_64bit_aligned(p(1)) == 0) .or. & > - (is_64bit_aligned(r2(1)) == 0) )) then > - stop 15 > - end if > + p(3) = p(3) + i; > + p(4) = p(4) + (2 * i) > + q(1) = q(1) + (3 * i) > + q(3) = q(3) + (4 * i) > + r2(1) = r2(1) + (5 * i) > + r2(4) = r2(4) + (6 * i) > + if ( (and(fl, 1) /= 0) .and. & > + ((is_64bit_aligned(q(1)) == 0) .or. & > + (is_64bit_aligned(p(1)) == 0) .or. & > + (is_64bit_aligned(r2(1)) == 0) )) then > + stop 15 > + end if > end do > > !$omp task private(y) firstprivate(x) allocate(x, y) > @@ -305,11 +306,13 @@ subroutine foo (x, p, q, px, h, fl) > .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then > stop 25 > end if > - > end subroutine > +end module m > > program main > use omp_lib > + use m > + implicit none (type, external) > integer, dimension(4) :: p > integer, dimension(4) :: q > > @@ -323,11 +326,11 @@ program main > if (a == omp_null_allocator) stop 1 > > call omp_set_default_allocator (omp_default_mem_alloc); > - call foo (42, p, q, 2, a, 0); > - call foo (42, p, q, 2, omp_default_mem_alloc, 0); > - call foo (42, p, q, 2, a, 1); > + call foo (42, p, q, a, 0); > + call foo (42, p, q, omp_default_mem_alloc, 0); > + call foo (42, p, q, a, 1); > call omp_set_default_allocator (a); > - call foo (42, p, q, 2, omp_null_allocator, 3); > - call foo (42, p, q, 2, omp_default_mem_alloc, 2); > + call foo (42, p, q, omp_null_allocator, 3); > + call foo (42, p, q, omp_default_mem_alloc, 2); > call omp_destroy_allocator (a); > end ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* [committed] libgomp.fortran/allocate-1.f90: Minor cleanup (was: Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0).) 2022-02-04 9:37 ` Thomas Schwinge @ 2022-02-04 13:57 ` Tobias Burnus 2022-02-04 15:33 ` Thomas Schwinge 0 siblings, 1 reply; 28+ messages in thread From: Tobias Burnus @ 2022-02-04 13:57 UTC (permalink / raw) To: Thomas Schwinge, Tobias Burnus Cc: Hafiz Abid Qadeer, Jakub Jelinek, gcc-patches, fortran [-- Attachment #1: Type: text/plain, Size: 1025 bytes --] Hi Thomas, On 04.02.22 10:37, Thomas Schwinge wrote: >> I have attached a patch (not commited), which silences the three kind of >> warnings and fixes the interface issue. >> TODO: commit it. > Still "TODO: commit it" ;-) -- and while I haven't reviewed the changes > in detail, I did spot one item that should be addressed, I suppose: I had also spotted the 'stop' which was a left over from -fsanitized=... checking and had removed it locally. But good that you also keep checking patches :-) In any case, I have now _finally_ committed the patch. Attached is the simplified (-w) diff, where I did exclude the indentation changes to make the diff more readable. For the full diff, see e.g. https://gcc.gnu.org/r12-7053 Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 [-- Attachment #2: committed.diff --] [-- Type: text/x-patch, Size: 3315 bytes --] commit 6d4981350168f1eb3f72149bd7e05b9ba6bec1fd Author: Tobias Burnus <tobias@codesourcery.com> Date: Fri Feb 4 14:51:01 2022 +0100 libgomp.fortran/allocate-1.f90: Minor cleanup libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.c (is_64bit_aligned): Renamed from is_64bit_aligned_. * testsuite/libgomp.fortran/allocate-1.f90: Fix interface decl and use it, more implicit none, remove unused argument. diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c index d33acc6feef..cb6d355afc6 100644 --- a/libgomp/testsuite/libgomp.fortran/allocate-1.c +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c @@ -1,7 +1,7 @@ #include <stdint.h> int -is_64bit_aligned_ (uintptr_t a) +is_64bit_aligned (uintptr_t a) { return ( (a & 0x3f) == 0); } diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 index 35d1750b878..062278f9908 100644 --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -5,30 +5,30 @@ module m use omp_lib use iso_c_binding - implicit none + implicit none (type, external) interface integer(c_int) function is_64bit_aligned (a) bind(C) import :: c_int - integer :: a + type(*) :: a end end interface -end module m -subroutine foo (x, p, q, px, h, fl) +contains + +subroutine foo (x, p, q, h, fl) use omp_lib use iso_c_binding integer :: x integer, dimension(4) :: p integer, dimension(4) :: q - integer :: px integer (kind=omp_allocator_handle_kind) :: h integer :: fl integer :: y integer :: r, i, i1, i2, i3, i4, i5 integer :: l, l3, l4, l5, l6 - integer :: n, n1, n2, n3, n4 + integer :: n, n2, n3, n4 integer :: j2, j3, j4 integer, dimension(4) :: l2 integer, dimension(4) :: r2 @@ -74,6 +74,8 @@ subroutine foo (x, p, q, px, h, fl) if (x /= 42) then stop 1 end if + + !!$omp barrier v(1) = 7 if ( (and(fl, 2) /= 0) .and. & ((is_64bit_aligned(x) == 0) .or. & @@ -95,7 +97,7 @@ subroutine foo (x, p, q, px, h, fl) stop 4 end if !$omp end parallel - +stop !$omp teams !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) @@ -305,11 +307,13 @@ subroutine foo (x, p, q, px, h, fl) .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then stop 25 end if - end subroutine +end module m program main use omp_lib + use m + implicit none (type, external) integer, dimension(4) :: p integer, dimension(4) :: q @@ -323,11 +327,11 @@ program main if (a == omp_null_allocator) stop 1 call omp_set_default_allocator (omp_default_mem_alloc); - call foo (42, p, q, 2, a, 0); - call foo (42, p, q, 2, omp_default_mem_alloc, 0); - call foo (42, p, q, 2, a, 1); + call foo (42, p, q, a, 0); + call foo (42, p, q, omp_default_mem_alloc, 0); + call foo (42, p, q, a, 1); call omp_set_default_allocator (a); - call foo (42, p, q, 2, omp_null_allocator, 3); - call foo (42, p, q, 2, omp_default_mem_alloc, 2); + call foo (42, p, q, omp_null_allocator, 3); + call foo (42, p, q, omp_default_mem_alloc, 2); call omp_destroy_allocator (a); end ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [committed] libgomp.fortran/allocate-1.f90: Minor cleanup (was: Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0).) 2022-02-04 13:57 ` [committed] libgomp.fortran/allocate-1.f90: Minor cleanup (was: Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0).) Tobias Burnus @ 2022-02-04 15:33 ` Thomas Schwinge 2022-02-04 16:34 ` Tobias Burnus 0 siblings, 1 reply; 28+ messages in thread From: Thomas Schwinge @ 2022-02-04 15:33 UTC (permalink / raw) To: Tobias Burnus; +Cc: Hafiz Abid Qadeer, Jakub Jelinek, gcc-patches, fortran Hi Tobias! On 2022-02-04T14:57:07+0100, Tobias Burnus <tobias@codesourcery.com> wrote: > On 04.02.22 10:37, Thomas Schwinge wrote: >>> I have attached a patch (not commited), which silences the three kind of >>> warnings and fixes the interface issue. >>> TODO: commit it. >> Still "TODO: commit it" ;-) -- and while I haven't reviewed the changes >> in detail, I did spot one item that should be addressed, I suppose: > > I had also spotted the 'stop' which was a left over from -fsanitized=... > checking and had removed it locally. Maybe removed locally, I can't tell ;-) -- but it's still in the commit that you pushed. See below. Also, a commented-out '!$omp barrier'; not sure what that one is about. > But good that you also keep > checking patches :-) I try! :-) Grüße Thomas > In any case, I have now _finally_ committed the patch. > > Attached is the simplified (-w) diff, where I did exclude the > indentation changes to make the diff more readable. > > For the full diff, see e.g. https://gcc.gnu.org/r12-7053 > > Tobias > commit 6d4981350168f1eb3f72149bd7e05b9ba6bec1fd > Author: Tobias Burnus <tobias@codesourcery.com> > Date: Fri Feb 4 14:51:01 2022 +0100 > > libgomp.fortran/allocate-1.f90: Minor cleanup > > libgomp/ChangeLog: > * testsuite/libgomp.fortran/allocate-1.c (is_64bit_aligned): Renamed > from is_64bit_aligned_. > * testsuite/libgomp.fortran/allocate-1.f90: Fix interface decl > and use it, more implicit none, remove unused argument. > > diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c b/libgomp/testsuite/libgomp.fortran/allocate-1.c > index d33acc6feef..cb6d355afc6 100644 > --- a/libgomp/testsuite/libgomp.fortran/allocate-1.c > +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c > @@ -1,7 +1,7 @@ > #include <stdint.h> > > int > -is_64bit_aligned_ (uintptr_t a) > +is_64bit_aligned (uintptr_t a) > { > return ( (a & 0x3f) == 0); > } > diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > index 35d1750b878..062278f9908 100644 > --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 > @@ -5,30 +5,30 @@ > module m > use omp_lib > use iso_c_binding > - implicit none > + implicit none (type, external) > > interface > integer(c_int) function is_64bit_aligned (a) bind(C) > import :: c_int > - integer :: a > + type(*) :: a > end > end interface > -end module m > > -subroutine foo (x, p, q, px, h, fl) > +contains > + > +subroutine foo (x, p, q, h, fl) > use omp_lib > use iso_c_binding > integer :: x > integer, dimension(4) :: p > integer, dimension(4) :: q > - integer :: px > integer (kind=omp_allocator_handle_kind) :: h > integer :: fl > > integer :: y > integer :: r, i, i1, i2, i3, i4, i5 > integer :: l, l3, l4, l5, l6 > - integer :: n, n1, n2, n3, n4 > + integer :: n, n2, n3, n4 > integer :: j2, j3, j4 > integer, dimension(4) :: l2 > integer, dimension(4) :: r2 > @@ -74,6 +74,8 @@ subroutine foo (x, p, q, px, h, fl) > if (x /= 42) then > stop 1 > end if > + > + !!$omp barrier > v(1) = 7 > if ( (and(fl, 2) /= 0) .and. & > ((is_64bit_aligned(x) == 0) .or. & > @@ -95,7 +97,7 @@ subroutine foo (x, p, q, px, h, fl) > stop 4 > end if > !$omp end parallel > - > +stop > !$omp teams > !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) > > @@ -305,11 +307,13 @@ subroutine foo (x, p, q, px, h, fl) > .or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then > stop 25 > end if > - > end subroutine > +end module m > > program main > use omp_lib > + use m > + implicit none (type, external) > integer, dimension(4) :: p > integer, dimension(4) :: q > > @@ -323,11 +327,11 @@ program main > if (a == omp_null_allocator) stop 1 > > call omp_set_default_allocator (omp_default_mem_alloc); > - call foo (42, p, q, 2, a, 0); > - call foo (42, p, q, 2, omp_default_mem_alloc, 0); > - call foo (42, p, q, 2, a, 1); > + call foo (42, p, q, a, 0); > + call foo (42, p, q, omp_default_mem_alloc, 0); > + call foo (42, p, q, a, 1); > call omp_set_default_allocator (a); > - call foo (42, p, q, 2, omp_null_allocator, 3); > - call foo (42, p, q, 2, omp_default_mem_alloc, 2); > + call foo (42, p, q, omp_null_allocator, 3); > + call foo (42, p, q, omp_default_mem_alloc, 2); > call omp_destroy_allocator (a); > end ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 ^ permalink raw reply [flat|nested] 28+ messages in thread
* Re: [committed] libgomp.fortran/allocate-1.f90: Minor cleanup (was: Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0).) 2022-02-04 15:33 ` Thomas Schwinge @ 2022-02-04 16:34 ` Tobias Burnus 0 siblings, 0 replies; 28+ messages in thread From: Tobias Burnus @ 2022-02-04 16:34 UTC (permalink / raw) To: Thomas Schwinge, Tobias Burnus Cc: Hafiz Abid Qadeer, Jakub Jelinek, gcc-patches, fortran [-- Attachment #1: Type: text/plain, Size: 644 bytes --] On 04.02.22 16:33, Thomas Schwinge wrote: > Maybe removed locally, I can't tell ;-) -- but it's still in the > commit that you pushed. See below. > Also, a commented-out '!$omp barrier'; not sure what that one is about. I shall not do commits after one week of 6h+/day virtual OpenMP Face2Face meeting. Corrected with commit as shown in the attachment. Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 [-- Attachment #2: committed.diff --] [-- Type: text/x-patch, Size: 988 bytes --] commit f62156eab7b757d1ee03a11d5c96c72bd3de079c Author: Tobias Burnus <tobias@codesourcery.com> Date: Fri Feb 4 17:31:21 2022 +0100 libgomp.fortran/allocate-1.f90: Fix minor cleanup libgomp/ChangeLog: * testsuite/libgomp.fortran/allocate-1.f90: Remove spurious STOP of previous commit. diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 index 062278f9908..0a31d35d5ac 100644 --- a/libgomp/testsuite/libgomp.fortran/allocate-1.f90 +++ b/libgomp/testsuite/libgomp.fortran/allocate-1.f90 @@ -74,8 +74,6 @@ subroutine foo (x, p, q, h, fl) if (x /= 42) then stop 1 end if - - !!$omp barrier v(1) = 7 if ( (and(fl, 2) /= 0) .and. & ((is_64bit_aligned(x) == 0) .or. & @@ -97,7 +95,6 @@ subroutine foo (x, p, q, h, fl) stop 4 end if !$omp end parallel -stop !$omp teams !$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w) ^ permalink raw reply [flat|nested] 28+ messages in thread
end of thread, other threads:[~2022-02-16 10:29 UTC | newest] Thread overview: 28+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2021-10-22 13:05 [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0) Hafiz Abid Qadeer 2021-10-22 13:28 ` Tobias Burnus 2021-11-02 16:27 ` Jakub Jelinek 2021-11-02 17:54 ` Jakub Jelinek 2021-11-18 19:30 ` Hafiz Abid Qadeer 2021-12-20 20:06 ` Jakub Jelinek 2022-01-11 22:31 ` Hafiz Abid Qadeer 2022-01-13 12:50 ` Jakub Jelinek 2022-01-14 9:10 ` Thomas Schwinge 2022-01-14 11:45 ` Tobias Burnus 2022-01-14 11:55 ` Jakub Jelinek 2022-01-14 12:20 ` Tobias Burnus 2022-01-17 14:01 ` Hafiz Abid Qadeer 2022-01-21 17:15 ` Thomas Schwinge 2022-01-21 17:43 ` Tobias Burnus 2022-01-24 8:45 ` Tobias Burnus 2022-01-24 12:54 ` Hafiz Abid Qadeer 2022-01-25 9:19 ` Thomas Schwinge 2022-01-25 10:32 ` Tobias Burnus 2022-01-31 19:13 ` Hafiz Abid Qadeer 2022-02-04 9:46 ` Thomas Schwinge 2022-02-04 11:25 ` Hafiz Abid Qadeer 2022-02-05 19:09 ` Hafiz Abid Qadeer 2022-02-16 10:29 ` Hafiz Abid Qadeer 2022-02-04 9:37 ` Thomas Schwinge 2022-02-04 13:57 ` [committed] libgomp.fortran/allocate-1.f90: Minor cleanup (was: Re: [PATCH] [gfortran] Add support for allocate clause (OpenMP 5.0).) Tobias Burnus 2022-02-04 15:33 ` Thomas Schwinge 2022-02-04 16:34 ` Tobias Burnus
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).