OpenMP: Handle order(concurrent) clause in gfortran
gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle order(concurrent). * gfortran.h (struct gfc_omp_clauses): Add order_concurrent. * openmp.c (enum omp_mask1, OMP_DO_CLAUSES, OMP_SIMD_CLAUSES): Add OMP_CLAUSE_ORDER. * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): Handle order(concurrent) clause. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/order-3.f90: New test. * gfortran.dg/gomp/order-4.f90: New test.
This commit is contained in:
Tobias Burnus
parent
f6fe3bbf9f
commit
d8140b9ed3
|
|
@ -1552,6 +1552,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
|
|||
fputs (" SEQ", dumpfile);
|
||||
if (omp_clauses->independent)
|
||||
fputs (" INDEPENDENT", dumpfile);
|
||||
if (omp_clauses->order_concurrent)
|
||||
fputs (" ORDER(CONCURRENT)", dumpfile);
|
||||
if (omp_clauses->ordered)
|
||||
{
|
||||
if (omp_clauses->orderedc)
|
||||
|
|
|
|||
|
|
@ -1365,7 +1365,7 @@ typedef struct gfc_omp_clauses
|
|||
bool nowait, ordered, untied, mergeable;
|
||||
bool inbranch, notinbranch, defaultmap, nogroup;
|
||||
bool sched_simd, sched_monotonic, sched_nonmonotonic;
|
||||
bool simd, threads, depend_source;
|
||||
bool simd, threads, depend_source, order_concurrent;
|
||||
enum gfc_omp_cancel_kind cancel;
|
||||
enum gfc_omp_proc_bind_kind proc_bind;
|
||||
struct gfc_expr *safelen_expr;
|
||||
|
|
|
|||
|
|
@ -766,6 +766,7 @@ enum omp_mask1
|
|||
OMP_CLAUSE_NUM_THREADS,
|
||||
OMP_CLAUSE_SCHEDULE,
|
||||
OMP_CLAUSE_DEFAULT,
|
||||
OMP_CLAUSE_ORDER,
|
||||
OMP_CLAUSE_ORDERED,
|
||||
OMP_CLAUSE_COLLAPSE,
|
||||
OMP_CLAUSE_UNTIED,
|
||||
|
|
@ -1549,6 +1550,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
|
|||
continue;
|
||||
break;
|
||||
case 'o':
|
||||
if ((mask & OMP_CLAUSE_ORDER)
|
||||
&& !c->order_concurrent
|
||||
&& gfc_match ("order ( concurrent )") == MATCH_YES)
|
||||
{
|
||||
c->order_concurrent = true;
|
||||
continue;
|
||||
}
|
||||
if ((mask & OMP_CLAUSE_ORDERED)
|
||||
&& !c->ordered
|
||||
&& gfc_match ("ordered") == MATCH_YES)
|
||||
|
|
@ -2575,7 +2583,7 @@ 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_LINEAR | OMP_CLAUSE_ORDER)
|
||||
#define OMP_SECTIONS_CLAUSES \
|
||||
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
|
||||
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
|
||||
|
|
@ -2583,7 +2591,7 @@ cleanup:
|
|||
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \
|
||||
| OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \
|
||||
| OMP_CLAUSE_LINEAR | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_SIMDLEN \
|
||||
| OMP_CLAUSE_IF)
|
||||
| OMP_CLAUSE_IF | OMP_CLAUSE_ORDER)
|
||||
#define OMP_TASK_CLAUSES \
|
||||
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
|
||||
| OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \
|
||||
|
|
|
|||
|
|
@ -3371,6 +3371,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
|
|||
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
|
||||
}
|
||||
|
||||
if (clauses->order_concurrent)
|
||||
{
|
||||
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDER);
|
||||
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
|
||||
}
|
||||
|
||||
if (clauses->untied)
|
||||
{
|
||||
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED);
|
||||
|
|
@ -4970,6 +4976,8 @@ gfc_split_omp_clauses (gfc_code *code,
|
|||
/* Duplicate collapse. */
|
||||
clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse
|
||||
= code->ext.omp_clauses->collapse;
|
||||
clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_concurrent
|
||||
= code->ext.omp_clauses->order_concurrent;
|
||||
}
|
||||
if (mask & GFC_OMP_MASK_PARALLEL)
|
||||
{
|
||||
|
|
@ -5015,6 +5023,8 @@ gfc_split_omp_clauses (gfc_code *code,
|
|||
/* Duplicate collapse. */
|
||||
clausesa[GFC_OMP_SPLIT_DO].collapse
|
||||
= code->ext.omp_clauses->collapse;
|
||||
clausesa[GFC_OMP_SPLIT_DO].order_concurrent
|
||||
= code->ext.omp_clauses->order_concurrent;
|
||||
}
|
||||
if (mask & GFC_OMP_MASK_SIMD)
|
||||
{
|
||||
|
|
@ -5029,6 +5039,8 @@ gfc_split_omp_clauses (gfc_code *code,
|
|||
= code->ext.omp_clauses->collapse;
|
||||
clausesa[GFC_OMP_SPLIT_SIMD].if_exprs[OMP_IF_SIMD]
|
||||
= code->ext.omp_clauses->if_exprs[OMP_IF_SIMD];
|
||||
clausesa[GFC_OMP_SPLIT_SIMD].order_concurrent
|
||||
= code->ext.omp_clauses->order_concurrent;
|
||||
/* And this is copied to all. */
|
||||
clausesa[GFC_OMP_SPLIT_SIMD].if_expr
|
||||
= code->ext.omp_clauses->if_expr;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,227 @@
|
|||
module my_omp_mod
|
||||
use iso_c_binding, only: c_loc
|
||||
implicit none
|
||||
integer :: v
|
||||
interface
|
||||
integer function omp_get_thread_num () bind(C)
|
||||
end
|
||||
integer function omp_get_num_threads () bind(C)
|
||||
end
|
||||
integer function omp_get_cancellation () bind(C)
|
||||
end
|
||||
integer function omp_target_is_present (ptr, device_num) bind(C)
|
||||
use iso_c_binding, only: c_ptr
|
||||
type(c_ptr), value :: ptr
|
||||
integer :: device_num
|
||||
end
|
||||
end interface
|
||||
contains
|
||||
subroutine foo ()
|
||||
end
|
||||
end
|
||||
|
||||
subroutine f1 (a, b)
|
||||
use my_omp_mod
|
||||
implicit none
|
||||
integer :: a(:), b(:,:)
|
||||
target :: a
|
||||
integer i, j
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp parallel ! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
|
||||
call foo ()
|
||||
!$omp end parallel
|
||||
end do
|
||||
!$omp end simd
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp simd
|
||||
do j = 1, 64
|
||||
b(j, i) = i + j
|
||||
end do
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp critical ! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
|
||||
call foo ()
|
||||
!$omp end critical
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
call foo ()
|
||||
!$omp end ordered
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
v = v + 1
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
a(i) = v
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
v = a(i)
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp simd order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
end
|
||||
|
||||
subroutine f2 (a, b)
|
||||
use my_omp_mod
|
||||
implicit none
|
||||
integer a(:), b(:,:)
|
||||
target :: a
|
||||
integer i, j
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp parallel ! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
|
||||
call foo ()
|
||||
!$omp end parallel
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp simd
|
||||
do j = 1, 64
|
||||
b (j, i) = i + j
|
||||
end do
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp critical ! { dg-error "OpenMP constructs other than 'ordered simd', 'simd', 'loop' or 'atomic' may not be nested inside 'simd' region" }
|
||||
call foo ()
|
||||
!$omp end critical
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
call foo ()
|
||||
!$omp end ordered
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
v = v + 1
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
a(i) = v
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
v = a(i)
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp do simd order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
end
|
||||
|
||||
subroutine f3 (a, b)
|
||||
use my_omp_mod
|
||||
implicit none
|
||||
integer :: a(:), b(:,:)
|
||||
target :: a
|
||||
integer i, j
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp parallel
|
||||
call foo ()
|
||||
!$omp end parallel
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp simd
|
||||
do j = 1, 64
|
||||
b(j, i) = i + j
|
||||
end do
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp critical ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
call foo ()
|
||||
!$omp end critical
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp ordered simd ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
call foo ()
|
||||
!$omp end ordered
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
v = v + 1
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic read ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
a(i) = v
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp atomic write ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
v = a(i)
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp task ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
a(i) = a(i) + 1
|
||||
!$omp end task
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
!$omp taskloop ! { dg-error "OpenMP constructs other than 'parallel', 'loop' or 'simd' may not be nested inside a region with the 'order\\(concurrent\\)' clause" }
|
||||
do j = 1, 64
|
||||
b(j, i) = i + j
|
||||
end do
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_thread_num () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_thread_num\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_num_threads () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_num_threads\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_target_is_present (c_loc(a(i)), 0) ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_target_is_present\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
!$omp do order(concurrent)
|
||||
do i = 1, 64
|
||||
a(i) = a(i) + omp_get_cancellation () ! { dg-error "OpenMP runtime API call '\[^\n\r]*omp_get_cancellation\[^\n\r]*' in a region with 'order\\(concurrent\\)' clause" }
|
||||
end do
|
||||
end
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
module m
|
||||
integer t;
|
||||
!$omp threadprivate(t)
|
||||
end
|
||||
|
||||
subroutine f1
|
||||
use m
|
||||
implicit none
|
||||
integer :: i
|
||||
!$omp simd order(concurrent) ! { dg-message "note: enclosing region" } */
|
||||
do i = 1, 64
|
||||
t = t + 1 ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
|
||||
end do
|
||||
end
|
||||
|
||||
subroutine f2
|
||||
use m
|
||||
implicit none
|
||||
integer :: i
|
||||
!$omp do simd order(concurrent) ! { dg-message "note: enclosing region" } */
|
||||
do i = 1, 64
|
||||
t = t + 1 ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
|
||||
end do
|
||||
end
|
||||
|
||||
subroutine f3
|
||||
use m
|
||||
implicit none
|
||||
integer :: i
|
||||
!$omp do order(concurrent) ! { dg-message "note: enclosing region" } */
|
||||
do i = 1, 64
|
||||
t = t + 1 ! { dg-error "threadprivate variable 't' used in a region with 'order\\(concurrent\\)' clause" } */
|
||||
end do
|
||||
end
|
||||
Loading…
Reference in New Issue