2017-10-11 Cesar Philippidis <cesar@codesourcery.com>
gcc/fortran/
* openmp.c (match_acc): Add new argument derived_types. Propagate
it to gfc_match_omp_clauses.
(gfc_match_oacc_enter_data): Update call to match_acc.
(gfc_match_oacc_exit_data): Likewise.
gcc/testsuite/
* gfortran.dg/goacc/derived-types.f90: Adjust test case.
libgomp/
* testsuite/libgomp.oacc-fortran/derived-type-2.f90: New test.
@@ -2141,10 +2141,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, omp_mask mask,
static match
-match_acc (gfc_exec_op op, const omp_mask mask, const omp_mask dtype_mask)
+match_acc (gfc_exec_op op, const omp_mask mask, const omp_mask dtype_mask,
+ bool derived_types=false)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, mask, dtype_mask, false, false, true)
+ if (gfc_match_omp_clauses (&c, mask, dtype_mask, false, false, true,
+ derived_types)
!= MATCH_YES)
return MATCH_ERROR;
new_st.op = op;
@@ -2329,7 +2331,7 @@ match
gfc_match_oacc_enter_data (void)
{
return match_acc (EXEC_OACC_ENTER_DATA, OACC_ENTER_DATA_CLAUSES,
- OMP_MASK2_LAST);
+ OMP_MASK2_LAST, true);
}
@@ -2337,7 +2339,7 @@ match
gfc_match_oacc_exit_data (void)
{
return match_acc (EXEC_OACC_EXIT_DATA, OACC_EXIT_DATA_CLAUSES,
- OMP_MASK2_LAST);
+ OMP_MASK2_LAST, true);
}
@@ -28,11 +28,14 @@ program derived_acc
!$acc update self(var%a)
!$acc enter data copyin(var)
- !$acc enter data copyin(var%a) ! { dg-error "Syntax error in OpenMP" }
+ !$acc enter data copyin(var%a)
!$acc exit data copyout(var)
- !$acc exit data copyout(var%a) ! { dg-error "Syntax error in OpenMP" }
+ !$acc exit data copyout(var%a)
+ !$acc data copy(var%a) ! { dg-error "Syntax error in OpenMP" }
+ !$acc end data ! { dg-error "Unexpected ..ACC END DATA" }
+
!$acc data copy(var)
!$acc end data
new file mode 100644
@@ -0,0 +1,67 @@
+! Test derived types in data clauses.
+
+! { dg-do run }
+
+module newtype
+ type dtype
+ integer :: a, b, c
+ integer, allocatable :: ary(:)
+ end type dtype
+end module newtype
+
+program main
+ use newtype
+ implicit none
+ integer, parameter :: n = 100
+ integer i
+ type (dtype), dimension(n) :: d1
+ type (dtype) :: d2
+ external process
+
+ allocate (d2%ary(n))
+
+ !$acc enter data create (d2%ary)
+
+ do i = 1, n
+ d2%ary(i) = 1
+ end do
+
+ !$acc update device (d2%ary)
+
+ call process (n, d2%ary)
+
+ !$acc exit data copyout (d2%ary)
+
+ do i = 1, n
+ if (d2%ary(i) /= i + 1) call abort
+ end do
+
+ !$acc data copy(d1(1:n))
+ !$acc parallel loop
+ do i = 1, n
+ d1(i)%a = i
+ d1(i)%b = i-1
+ d1(i)%c = i+1
+ end do
+ !$acc end data
+
+ do i = 1, n
+ if (d1(i)%a /= i) call abort
+ if (d1(i)%b /= i-1) call abort
+ if (d1(i)%c /= i+1) call abort
+ end do
+
+ deallocate (d2%ary)
+end program main
+
+subroutine process (a, b)
+ use newtype
+ implicit none
+ integer :: a, i
+ integer :: b(a)
+
+ !$acc parallel loop present (b(1:a))
+ do i = 1, a
+ b(i) = b(i) + i
+ end do
+end subroutine process