This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[accaf, fortran, 4/4] Allocatable components support in derived typed coarrays
- From: Andre Vehreschild <vehre at gmx dot de>
- To: GCC-Fortran-ML <fortran at gcc dot gnu dot org>
- Cc: Damian Rouson <damian at sourceryinstitute dot org>, Tobias Burnus <burnus at net-b dot de>
- Date: Tue, 30 Aug 2016 17:50:29 +0200
- Subject: [accaf, fortran, 4/4] Allocatable components support in derived typed coarrays
- Authentication-results: sourceware.org; auth=none
Hi all,
this is the last part of the allocatable components for derived typed
coarrays patchset. It adds test cases for the new functions implemented.
It changes many coarray testcases that failed, because the
caf_register() function has changed its signature. Because at the moment
the patch set is configured to always make use of the new get_by_ref()
function another set of testcases which checked the original-dump for
certain identifiers had to be adapted, too. The latter might not be
necessary in the general case, but allowed for better testing.
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90
new file mode 100644
index 0000000..e3514e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+
+! Contributed by Damian Rouson
+
+program main
+
+ implicit none
+
+ type mytype
+ integer, allocatable :: indices(:)
+ end type
+
+ type(mytype), save :: object[*]
+ integer :: me
+
+ me=this_image()
+ allocate(object%indices(me))
+ object%indices = 42
+
+ if ( any( object[me]%indices(:) /= 42 ) ) call abort()
+end program
diff --git a/gcc/testsuite/gfortran.dg/coarray_38.f90 b/gcc/testsuite/gfortran.dg/coarray_38.f90
index 6fa0a65..31155c5 100644
--- a/gcc/testsuite/gfortran.dg/coarray_38.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_38.f90
@@ -15,11 +15,11 @@ end type t2
type(t), save :: caf[*],x
type(t2) :: y
-x = caf[4] ! { dg-error "Sorry, coindexed coarray at \\(1\\) with allocatable component is not yet supported" }
-x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x = caf[4] ! OK, now
+x%a = caf[4]%a ! OK, now
x%b = caf[4]%b ! OK
-x = y%caf2[5] ! { dg-error "Sorry, coindexed coarray at \\(1\\) with allocatable component is not yet supported" }
-x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x = y%caf2[5] ! OK, now
+x%a = y%caf2[4]%a ! OK, now
x%b = y%caf2[4]%b ! OK
end subroutine one
@@ -36,10 +36,10 @@ type(t), save :: caf[*],x
type(t2) :: y
x = caf[4] ! OK
-x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%a = caf[4]%a ! OK, now
x%b = caf[4]%b ! OK
x = y%caf2[5] ! OK
-x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%a = y%caf2[4]%a ! OK, now
x%b = y%caf2[4]%b ! OK
end subroutine two
@@ -56,10 +56,10 @@ integer :: x(10)
type(t2) :: y
x(1) = caf(2)[4]%b ! OK
-x(:) = caf(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+x(:) = caf(:)[4]%b ! OK now
x(1) = y%caf2(2)[4]%b ! OK
-x(:) = y%caf2(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+x(:) = y%caf2(:)[4]%b ! OK now
end subroutine three
subroutine four
@@ -76,10 +76,10 @@ type(t) :: x
type(t2) :: y
!x = caf[4] ! Unsupported - and ICEs in resolve_ordinary_assign, cf. PR fortran/65397
-x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%a = caf[4]%a ! OK, now
x%b = caf[4]%b ! OK
!x = y%caf2[5] ! Unsupported - and ICEs in resolve_ordinary_assign, cf. PR fortran/65397
-x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%a = y%caf2[4]%a ! Ok, now
x%b = y%caf2[4]%b ! OK
end subroutine four
@@ -97,10 +97,10 @@ type(t) :: x
type(t2) :: y
!x = caf[4] ! OK - but ICEs in resolve_ordinary_assign, cf. PR fortran/65397
-x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%a = caf[4]%a ! OK, now
x%b = caf[4]%b ! OK
!x = y%caf2[5] ! OK - but ICEs in resolve_ordinary_assign, cf. PR fortran/65397
-x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%a = y%caf2[4]%a ! OK, now
x%b = y%caf2[4]%b ! OK
end subroutine five
@@ -117,8 +117,16 @@ integer :: x(10)
type(t2) :: y
x(1) = caf(2)[4]%b ! OK
-x(:) = caf(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+x(:) = caf(:)[4]%b ! OK now
x(1) = y%caf2(2)[4]%b ! OK
-x(:) = y%caf2(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+x(:) = y%caf2(:)[4]%b ! OK now
end subroutine six
+
+call one()
+call two()
+call three()
+call four()
+call five()
+call six()
+end
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_1.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_1.f08
new file mode 100644
index 0000000..78da297
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_1.f08
@@ -0,0 +1,92 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+
+! Contributed by Damian Rouson
+! Check the new _caf_get_by_ref()-routine.
+
+program main
+
+implicit none
+
+type :: mytype
+ integer :: i
+ integer, allocatable :: indices(:)
+ real, dimension(2,5,3) :: volume
+ integer, allocatable :: scalar
+ integer :: j
+ integer, allocatable :: matrix(:,:)
+ real, allocatable :: dynvol(:,:,:)
+end type
+
+type arrtype
+ type(mytype), allocatable :: vec(:)
+ type(mytype), allocatable :: mat(:,:)
+end type arrtype
+
+type(mytype), save :: object[*]
+type(arrtype), save :: bar[*]
+integer :: i,j,me,neighbor
+integer :: idx(5)
+real, allocatable :: volume(:,:,:), vol2(:,:,:)
+real :: vol_static(2,5,3)
+
+idx = (/ 1,2,1,7,5 /)
+
+me=this_image()
+object%indices=[(i,i=1,5)]
+allocate(object%scalar, object%matrix(10,7))
+object%i = 37
+object%scalar = 42
+vol_static = reshape([(i, i=1, 2*5*3)], [2, 5, 3])
+object%volume = vol_static
+object%matrix = reshape([(i, i=1, 70)], [10, 7])
+object%dynvol = vol_static
+sync all
+neighbor = merge(1,neighbor,me==num_images())
+if (object[neighbor]%scalar /= 42) call abort()
+if (object[neighbor]%indices(4) /= 4) call abort()
+if (object[neighbor]%matrix(3,6) /= 53) call abort()
+if (any( object[neighbor]%indices(:) /= [1,2,3,4,5] )) call abort()
+if (any( object[neighbor]%matrix(:,:) /= reshape([(i, i=1, 70)], [10, 7]))) call abort()
+if (any( object[neighbor]%matrix(3,:) /= [(i * 10 + 3, i=0, 6)])) call abort()
+if (any( object[neighbor]%matrix(:,2) /= [(i + 10, i=1, 10)])) call abort()
+if (any( object[neighbor]%matrix(idx,2) /= [11, 12, 11, 17, 15])) call abort()
+if (any( object[neighbor]%matrix(3,idx) /= [3, 13, 3, 63, 43])) call abort()
+if (any( object[neighbor]%matrix(2:8:4, 5:1:-1) /= reshape([42, 46, 32, 36, 22, 26, 12, 16, 2, 6], [2,5]))) call abort()
+if (any( object[neighbor]%matrix(:8:4, 2::2) /= reshape([11, 15, 31, 35, 51, 55], [2,3]))) call abort()
+if (any( object[neighbor]%volume /= vol_static)) call abort()
+if (any( object[neighbor]%dynvol /= vol_static)) call abort()
+if (any( object[neighbor]%volume(:, 2:4, :) /= vol_static(:, 2:4, :))) call abort()
+if (any( object[neighbor]%dynvol(:, 2:4, :) /= vol_static(:, 2:4, :))) call abort()
+
+vol2 = vol_static(:, ::2, :)
+if (any( object[neighbor]%volume(:, ::2, :) /= vol2)) call abort()
+if (any( object[neighbor]%dynvol(:, ::2, :) /= vol2)) call abort()
+
+allocate(bar%vec(-2:2))
+
+bar%vec(1)%volume = vol_static
+if (any(bar[neighbor]%vec(1)%volume /= vol_static)) call abort()
+
+i = 15
+bar%vec(1)%scalar = i
+if (.not. allocated(bar%vec(1)%scalar)) call abort()
+if (bar[neighbor]%vec(1)%scalar /= 15) call abort()
+
+bar%vec(0)%scalar = 27
+if (.not. allocated(bar%vec(0)%scalar)) call abort()
+if (bar[neighbor]%vec(0)%scalar /= 27) call abort()
+
+bar%vec(1)%indices = [ 3, 4, 15 ]
+allocate(bar%vec(2)%indices(5))
+bar%vec(2)%indices = 89
+
+if (.not. allocated(bar%vec(1)%indices)) call abort()
+if (allocated(bar%vec(-2)%indices)) call abort()
+if (allocated(bar%vec(-1)%indices)) call abort()
+if (allocated(bar%vec( 0)%indices)) call abort()
+if (.not. allocated(bar%vec( 2)%indices)) call abort()
+if (any(bar[me]%vec(2)%indices /= 89)) call abort()
+
+if (any (bar[neighbor]%vec(1)%indices /= [ 3,4,15])) call abort()
+end program
diff --git a/gcc/testsuite/gfortran.dg/coarray_alloc_comp_2.f08 b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_2.f08
new file mode 100644
index 0000000..b36ec2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_alloc_comp_2.f08
@@ -0,0 +1,84 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+
+! Contributed by Damian Rouson
+! Check the new _caf_send_by_ref()-routine.
+
+program main
+
+implicit none
+
+type :: mytype
+ integer :: i
+ integer, allocatable :: indices(:)
+ real, dimension(2,5,3) :: volume
+ integer, allocatable :: scalar
+ integer :: j
+ integer, allocatable :: matrix(:,:)
+ real, allocatable :: dynvol(:,:,:)
+end type
+
+type arrtype
+ type(mytype), allocatable :: vec(:)
+ type(mytype), allocatable :: mat(:,:)
+end type arrtype
+
+type(mytype), save :: object[*]
+type(arrtype), save :: bar[*]
+integer :: i,j,me,neighbor
+integer :: idx(5)
+real, allocatable :: volume(:,:,:), vol2(:,:,:)
+real :: vol_static(2,5,3)
+
+idx = (/ 1,2,1,7,5 /)
+
+me=this_image()
+neighbor = merge(1,me+1,me==num_images())
+object[neighbor]%indices=[(i,i=1,5)]
+object[neighbor]%i = 37
+object[neighbor]%scalar = 42
+vol_static = reshape([(i, i=1, 2*5*3)], [2, 5, 3])
+object[neighbor]%volume = vol_static
+object[neighbor]%matrix = reshape([(i, i=1, 70)], [10, 7])
+object[neighbor]%dynvol = vol_static
+sync all
+if (object%scalar /= 42) call abort()
+if (any( object%indices /= [1,2,3,4,5] )) call abort()
+if (any( object%matrix /= reshape([(i, i=1, 70)], [10, 7]))) call abort()
+if (any( object%volume /= vol_static)) call abort()
+if (any( object%dynvol /= vol_static)) call abort()
+
+vol2 = vol_static
+vol2(:, ::2, :) = 42
+object[neighbor]%volume(:, ::2, :) = 42
+object[neighbor]%dynvol(:, ::2, :) = 42
+if (any( object%volume /= vol2)) call abort()
+if (any( object%dynvol /= vol2)) call abort()
+
+allocate(bar%vec(-2:2))
+
+bar[neighbor]%vec(1)%volume = vol_static
+if (any(bar%vec(1)%volume /= vol_static)) call abort()
+
+i = 15
+bar[neighbor]%vec(1)%scalar = i
+if (.not. allocated(bar%vec(1)%scalar)) call abort()
+if (bar%vec(1)%scalar /= 15) call abort()
+
+bar[neighbor]%vec(0)%scalar = 27
+if (.not. allocated(bar%vec(0)%scalar)) call abort()
+if (bar%vec(0)%scalar /= 27) call abort()
+
+bar[neighbor]%vec(1)%indices = [ 3, 4, 15 ]
+allocate(bar%vec(2)%indices(5))
+bar[neighbor]%vec(2)%indices = 89
+
+if (.not. allocated(bar%vec(1)%indices)) call abort()
+if (allocated(bar%vec(-2)%indices)) call abort()
+if (allocated(bar%vec(-1)%indices)) call abort()
+if (allocated(bar%vec( 0)%indices)) call abort()
+if (.not. allocated(bar%vec( 2)%indices)) call abort()
+if (any(bar%vec(2)%indices /= 89)) call abort()
+
+if (any (bar%vec(1)%indices /= [ 3,4,15])) call abort()
+end program
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_7.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_7.f08
new file mode 100644
index 0000000..cd9d8f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_allocate_7.f08
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single -fdump-tree-original" }
+
+! Contributed by Damian Rouson
+! Checking whether (de-)registering of coarrays works.
+
+program main
+
+ implicit none
+
+ type mytype
+ integer, allocatable :: indices(:)
+ end type
+
+ type(mytype), save :: object[*]
+ integer :: i,me
+
+ me=this_image() ! me is always 1 here
+ object%indices=[(i,i=1,me)]
+ if ( size(object%indices) /= 1 ) call abort()
+ ! therefore no array is present here and no array test needed.
+ if ( object%indices(1) /= 1 ) call abort()
+end program
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(D.\[0-9\]{4}, 1, &\\(\\(struct mytype\\) \\*object\\).indices.token, &\\(\\(struct mytype\\) \\*object\\).indices, 0B, 0B, 0\\);" 2 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister \\(&\\(\\(struct mytype\\) \\*object\\).indices.token, 0B, 0B, 0\\);" 1 "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_8.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_8.f08
new file mode 100644
index 0000000..4710049
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_allocate_8.f08
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single -fdump-tree-original" }
+
+program alloc_comp
+ implicit none
+
+ type coords
+ real,allocatable :: x(:)
+ real,allocatable :: y(:)
+ real,allocatable :: z(:)
+ end type
+
+ integer :: me,np,n,i
+ type(coords) :: coo[*]
+
+ ! with caf_single num_images is always == 1
+ me = this_image(); np = num_images()
+ n = 100
+
+ allocate(coo%x(n),coo%y(n),coo%z(n))
+
+ coo%y = me
+
+ do i=1, n
+ coo%y(i) = coo%y(i) + i
+ end do
+
+ sync all
+
+ ! Check the caf_get()-offset is computed correctly.
+ if(me == 1 .and. coo[np]%y(10) /= 11 ) call abort()
+
+ ! Check the whole array is correct.
+ if (me == 1 .and. any( coo[np]%y /= [(i, i=2, 101)] ) ) call abort()
+
+ deallocate(coo%x)
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_9.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_9.f08
new file mode 100644
index 0000000..3b4e4ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_allocate_9.f08
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+
+! Contributed by Damian Rouson
+
+program main
+ implicit none
+
+ type particles
+ real x(2)
+ end type
+
+ type vector
+ type(particles), allocatable :: v(:)
+ end type
+
+ type(vector) :: outbox[*]
+ type(particles), allocatable :: object(:)[:]
+
+ allocate(outbox%v(1), source=particles(this_image()))
+
+ if (any( outbox[1]%v(1)%x(1:2) /= [ 1.0, 1.0] )) call abort()
+ if (any( outbox[1]%v(1)%x(:) /= [ 1.0, 1.0] )) call abort()
+ if (any( outbox[1]%v(1)%x /= [ 1.0, 1.0] )) call abort()
+
+ allocate(object(1)[*], source=particles(this_image()))
+
+ if (any( object(1)[1]%x(1:2) /= [ 1.0, 1.0] )) call abort()
+ if (any( object(1)[1]%x(:) /= [ 1.0, 1.0] )) call abort()
+ if (any( object(1)[1]%x /= [ 1.0, 1.0] )) call abort()
+end program
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90
index f3c2948..31e4cf5 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_1.f90
@@ -13,8 +13,8 @@
deallocate(xx,yy,stat=stat, errmsg=errmsg)
end
-! { dg-final { scan-tree-dump-times "_gfortran_caf_register .4, 1, &xx.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_register .8, 1, &yy.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(4, 1, &xx.token, \\(void \\*\\) &xx, &stat.., &errmsg, 200\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(8, 1, &yy.token, \\(void \\*\\) &yy, &stat.., &errmsg, 200\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx.token, &stat.., &errmsg, 200.;" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, &stat.., &errmsg, 200.;" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy.token, 0B, 0B, 0.;" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
index 19c60a0..a83963c 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
@@ -15,8 +15,8 @@
deallocate(xx,yy,stat=stat, errmsg=errmsg)
end
-! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 1, &xx._data.token, \\(void \\*\\) &xx._data, &stat.., &errmsg, 200\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 1, &yy._data.token, \\(void \\*\\) &yy._data, &stat.., &errmsg, 200\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90
index 696c937..33cda92 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_3.f90
@@ -16,8 +16,8 @@ subroutine test
deallocate(xx,yy,stat=stat, errmsg=errmsg)
end
-! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 1, &xx._data.token, \\(void \\*\\) &xx._data, &stat.., &errmsg, 200\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 1, &yy._data.token, \\(void \\*\\) &yy._data, &stat.., &errmsg, 200\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
index 7b4d937..7ab5ab4 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_comm_1.f90
@@ -38,8 +38,9 @@ B(1:5) = B(3:7)
if (any (A-B /= 0)) call abort
end
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0, 0B\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1, 0B\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1, 0B\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0, 0B\\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, _gfortran_caf_this_image \\\(0\\\), &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, _gfortran_caf_this_image \\\(0\\\), &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 1, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get_by_ref \\\(caf_token.0, 1, &p, &caf_ref.\[0-9\]+, 4, 4, 1, 0, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get_by_ref \\\(caf_token.1, 1, &p, &caf_ref.\[0-9\]+, 4, 4, 0, 0, 0B\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0, 0B\\\);" 1 "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90
index 1a92f02..bedb091 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_3.f90
@@ -8,5 +8,5 @@ allocate(CAF(1)[*])
allocate(CAF_SCALAR[*])
end
-! { dg-final { scan-tree-dump-times "caf.data = \\(void . restrict\\) _gfortran_caf_register \\(4, 1, &caf.token, 0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "caf_scalar.data = \\(void . restrict\\) _gfortran_caf_register \\(4, 1, &caf_scalar.token, 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(4, 1, &caf.token, \\(void \\*\\) &caf, 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(4, 1, &caf_scalar.token, \\(void \\*\\) &caf_scalar, 0B, 0B, 0\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lock_7.f90 b/gcc/testsuite/gfortran.dg/coarray_lock_7.f90
index b8920f1..10c390f 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lock_7.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lock_7.f90
@@ -27,10 +27,10 @@ lock(four(1)[6], acquired_lock=ll, stat=ii)
unlock(four(2)[7])
end
-! { dg-final { scan-tree-dump-times "one = \\(void \\* \\* restrict\\) _gfortran_caf_register \\(1, 2, \\(void \\* \\*\\) &caf_token.., 0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "two = \\(void \\*\\\[25\\\] \\* restrict\\) _gfortran_caf_register \\(25, 2, \\(void \\* \\*\\) &caf_token.., 0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "three.data = \\(void \\* restrict\\) _gfortran_caf_register \\(1, 3, &three.token, &stat.., 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "four.data = \\(void \\* restrict\\) _gfortran_caf_register \\(7, 3, &four.token, &stat.., 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 2, \\(void \\* \\*\\) &caf_token.., \\(void \\*\\) &desc.., 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(25, 2, \\(void \\* \\*\\) &caf_token.., \\(void \\*\\) &desc.., 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(1, 3, &three.token, \\(void \\*\\) &three, &stat.., 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(7, 3, &four.token, \\(void \\*\\) &four, &stat.., 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(caf_token.., 0, 0, 0B, 0B, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(caf_token.., 0, 0, 0B, 0B, 0\\);" 1 "original" } }
@@ -38,9 +38,9 @@ end
! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(caf_token.., \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lbound\\) \\+ \\(integer\\(kind=4\\)\\) MAX_EXPR <\\(parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound\\) \\+ 1, 0> \\* \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[1\\\].lbound\\), 0, 0B, &ii, 0B, 0\\);|_gfortran_caf_lock \\(caf_token.1, \\(3 - parm...dim\\\[0\\\].lbound\\) \\+ MAX_EXPR <\\(parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound\\) \\+ 1, 0> \\* \\(3 - parm...dim\\\[1\\\].lbound\\), 0, 0B, &ii, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(caf_token.., \\(2 - \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lbound\\) \\+ \\(integer\\(kind=4\\)\\) MAX_EXPR <\\(parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound\\) \\+ 1, 0> \\* \\(3 - \\(integer\\(kind=4\\)\\) parm...dim\\\[1\\\].lbound\\), 0, &ii, 0B, 0\\);|_gfortran_caf_unlock \\(caf_token.., \\(2 - parm...dim\\\[0\\\].lbound\\) \\+ MAX_EXPR <\\(parm...dim\\\[0\\\].ubound - parm...dim\\\[0\\\].lbound\\) \\+ 1, 0> \\* \\(3 - parm...dim\\\[1\\\].lbound\\), 0, &ii, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(three.token, 0, 5 - \\(integer\\(kind=4\\)\\) three.dim\\\[0\\\].lbound, &acquired.8, 0B, 0B, 0\\);|_gfortran_caf_lock \\(three.token, 0, 5 - three.dim\\\[0\\\].lbound, &acquired.., 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(three.token, 0, 5 - \\(integer\\(kind=4\\)\\) three.dim\\\[0\\\].lbound, &acquired.\[0-9\]+, 0B, 0B, 0\\);|_gfortran_caf_lock \\(three.token, 0, 5 - three.dim\\\[0\\\].lbound, &acquired.\[0-9\]+, 0B, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(three.token, 0, 8 - \\(integer\\(kind=4\\)\\) three.dim\\\[0\\\].lbound, &ii, 0B, 0\\);|_gfortran_caf_unlock \\(three.token, 0, 8 - three.dim\\\[0\\\].lbound, &ii, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(four.token, 1 - \\(integer\\(kind=4\\)\\) four.dim\\\[0\\\].lbound, 7 - \\(integer\\(kind=4\\)\\) four.dim\\\[1\\\].lbound, &acquired.., &ii, 0B, 0\\);|_gfortran_caf_lock \\(four.token, 1 - four.dim\\\[0\\\].lbound, 7 - four.dim\\\[1\\\].lbound, &acquired.., &ii, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_lock \\(four.token, 1 - \\(integer\\(kind=4\\)\\) four.dim\\\[0\\\].lbound, 7 - \\(integer\\(kind=4\\)\\) four.dim\\\[1\\\].lbound, &acquired.\[0-9\]+, &ii, 0B, 0\\);|_gfortran_caf_lock \\(four.token, 1 - four.dim\\\[0\\\].lbound, 7 - four.dim\\\[1\\\].lbound, &acquired.\[0-9\]+, &ii, 0B, 0\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "_gfortran_caf_unlock \\(four.token, 2 - \\(integer\\(kind=4\\)\\) four.dim\\\[0\\\].lbound, 8 - \\(integer\\(kind=4\\)\\) four.dim\\\[1\\\].lbound, 0B, 0B, 0\\);|_gfortran_caf_unlock \\(four.token, 2 - four.dim\\\[0\\\].lbound, 8 - four.dim\\\[1\\\].lbound, 0B, 0B, 0\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_5.f90
index f406da8..8e6142f 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_5.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_5.f90
@@ -10,4 +10,4 @@ class(t) :: x
allocate(x%x[*])
end subroutine test
-! { dg-final { scan-tree-dump-times "x->_data->x.data = _gfortran_caf_register \\(4, 1, &x->_data->x.token, 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(4, 1, &x->_data->x.token, \\(void \\*\\) &x->_data->x, 0B, 0B, 0\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90
index 06c0743..53b80e4 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_6.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_6.f90
@@ -18,4 +18,4 @@ end
! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_0_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_0_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data._data.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
index 65d1c93..44f98e1 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_7.f90
@@ -18,4 +18,4 @@ end
! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data._data.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
index bfca8a4..cac305f 100644
--- a/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_8.f90
@@ -18,4 +18,4 @@ end
! { dg-final { scan-tree-dump-times "foo \\(struct __class_MAIN___T_1_1t & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(struct __class_MAIN___T_1_1t \\* x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "bar \\(0B, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data._data.data\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(&class.., y._data.token, \\(integer\\(kind=\[48\]\\)\\) class..._data.data - \\(integer\\(kind=\[48\]\\)\\) y._data.data\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coindexed_1.f90 b/gcc/testsuite/gfortran.dg/coindexed_1.f90
index 878c46f..b25f2f8 100644
--- a/gcc/testsuite/gfortran.dg/coindexed_1.f90
+++ b/gcc/testsuite/gfortran.dg/coindexed_1.f90
@@ -14,7 +14,7 @@ program pmup
integer :: ii
!! --- ONE ---
- allocate(real :: a(3)[*])
+ allocate(real :: a(3)[*]) ! { dg-error "Sorry, coindexed access to an unlimited polymorphic object at" }
IF (this_image() == num_images()) THEN
SELECT TYPE (a)
TYPE IS (real)
@@ -43,11 +43,11 @@ program pmup
!! --- TWO ---
deallocate(a)
- allocate(t :: a(3)[*])
+ allocate(t :: a(3)[*]) ! { dg-error "Sorry, coindexed access to an unlimited polymorphic object at" }
IF (this_image() == num_images()) THEN
SELECT TYPE (a)
- TYPE IS (t) ! FIXME: When implemented, turn into "do-do run"
- a(:)[1]%a = 4.0 ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+ TYPE IS (t)
+ a(:)[1]%a = 4.0
END SELECT
END IF
SYNC ALL
@@ -57,8 +57,8 @@ program pmup
TYPE IS (real)
ii = a(1)[1]
call abort()
- TYPE IS (t) ! FIXME: When implemented, turn into "do-do run"
- IF (ALL(A(:)[1]%a == 4.0)) THEN ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+ TYPE IS (t)
+ IF (ALL(A(:)[1]%a == 4.0)) THEN
!WRITE(*,*) 'OK'
ELSE
WRITE(*,*) 'FAIL'