This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
gfortran.dg patch, committed
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Sun, 30 Mar 2008 18:23:32 +0200
- Subject: gfortran.dg patch, committed
Hello world,
I have just committed the patch below as obvious, after verifying that
the test cases do pass.
This simply extends test coverage to complex versions of the functions.
2008-03-30 Thomas Koenig <tkoenig@gcc.gnu.org>
* gfortran.dg/internal_pack_1.f90: Added complex to test case.
* gfortran.dg/internal_pack_2.f90: Likewise.
* gfortran.dg/intrinsic_spread_1.f90: Likewise.
* gfortran.dg/intrinsic_spread_2.f90: Likewise.
* gfortran.dg/intrinsic_pack_1.f90: Likewise.
* gfortran.dg/intrinsic_pack_2.f90: Likewise.
* gfortran.dg/intrinsic_unpack_1.f90: Likewise.
* gfortran.dg/intrinsic_unpack_2.f90: Likewise.
Index: gfortran.dg/internal_pack_1.f90
===================================================================
--- gfortran.dg/internal_pack_1.f90 (revision 133732)
+++ gfortran.dg/internal_pack_1.f90 (working copy)
@@ -9,6 +9,8 @@ program main
integer(kind=8), dimension(3) :: i8
real(kind=4), dimension(3) :: r4
real(kind=8), dimension(3) :: r8
+ complex(kind=4), dimension(3) :: c4
+ complex(kind=8), dimension(3) :: c8
i1 = (/ -1, 1, -3 /)
call sub_i1(i1(1:3:2))
@@ -34,6 +36,16 @@ program main
call sub_r8(r8(1:3:2))
if (any(r8 /= (/ 3.0_8, 1.0_8, 2.0_8/))) call abort
+ c4 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
+ call sub_c4(c4(1:3:2))
+ if (any(real(c4) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort
+ if (any(aimag(c4) /= 0._4)) call abort
+
+ c8 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /)
+ call sub_c8(c8(1:3:2))
+ if (any(real(c8) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort
+ if (any(aimag(c8) /= 0._4)) call abort
+
end program main
subroutine sub_i1(i)
@@ -83,3 +95,21 @@ subroutine sub_r8(r)
r(1) = 3._8
r(2) = 2._8
end subroutine sub_r8
+
+subroutine sub_c8(r)
+ implicit none
+ complex(kind=8), dimension(2) :: r
+ if (r(1) /= (-1._8,0._8)) call abort
+ if (r(2) /= (-3._8,0._8)) call abort
+ r(1) = 3._8
+ r(2) = 2._8
+end subroutine sub_c8
+
+subroutine sub_c4(r)
+ implicit none
+ complex(kind=4), dimension(2) :: r
+ if (r(1) /= (-1._4,0._4)) call abort
+ if (r(2) /= (-3._4,0._4)) call abort
+ r(1) = 3._4
+ r(2) = 2._4
+end subroutine sub_c4
Index: gfortran.dg/internal_pack_2.f90
===================================================================
--- gfortran.dg/internal_pack_2.f90 (revision 133732)
+++ gfortran.dg/internal_pack_2.f90 (working copy)
@@ -7,11 +7,17 @@ program main
implicit none
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
real(kind=k), dimension(3) :: rk
+ complex(kind=k), dimension(3) :: ck
rk = (/ -1.0_k, 1.0_k, -3.0_k /)
call sub_rk(rk(1:3:2))
if (any(rk /= (/ 3.0_k, 1.0_k, 2.0_k/))) call abort
+ ck = (/ (-1.0_k, 0._k), (1.0_k, 0._k), (-3.0_k, 0._k) /)
+ call sub_ck(ck(1:3:2))
+ if (any(real(ck) /= (/ 3.0_k, 1.0_k, 2.0_k/))) call abort
+ if (any(aimag(ck) /= 0._k)) call abort
+
end program main
subroutine sub_rk(r)
@@ -23,3 +29,13 @@ subroutine sub_rk(r)
r(1) = 3._k
r(2) = 2._k
end subroutine sub_rk
+
+subroutine sub_ck(r)
+ implicit none
+ integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+ complex(kind=k), dimension(2) :: r
+ if (r(1) /= (-1._k,0._k)) call abort
+ if (r(2) /= (-3._k,0._k)) call abort
+ r(1) = 3._k
+ r(2) = 2._k
+end subroutine sub_ck
Index: gfortran.dg/intrinsic_spread_1.f90
===================================================================
--- gfortran.dg/intrinsic_spread_1.f90 (revision 133732)
+++ gfortran.dg/intrinsic_spread_1.f90 (working copy)
@@ -19,6 +19,12 @@ program foo
real(kind=8), dimension (10) :: r_8
real(kind=8), dimension (2, 3) :: ar_8
real(kind=8), dimension (2, 2, 3) :: br_8
+ complex(kind=4), dimension (10) :: c_4
+ complex(kind=4), dimension (2, 3) :: ac_4
+ complex(kind=4), dimension (2, 2, 3) :: bc_4
+ complex(kind=8), dimension (10) :: c_8
+ complex(kind=8), dimension (2, 3) :: ac_8
+ complex(kind=8), dimension (2, 2, 3) :: bc_8
character (len=200) line1, line2, line3
a_1 = reshape ((/1_1, 2_1, 3_1, 4_1, 5_1, 6_1/), (/2, 3/))
@@ -117,7 +123,44 @@ program foo
r_8 = spread(1._8,1,10)
if (any(r_8 /= 1._8)) call abort
+ ac_4 = reshape ((/(1._4,-1._4), (2._4,-2._4), (3._4, -3._4), (4._4, -4._4), &
+ & (5._4,-5._4), (6._4,-6._4)/), (/2, 3/))
+ bc_4 = spread (ac_4, 1, 2)
+ if (any (real(bc_4) .ne. reshape ((/1._4, 1._4, 2._4, 2._4, 3._4, 3._4, &
+ & 4._4, 4._4, 5._4, 5._4, 6._4, 6._4/), (/2, 2, 3/)))) call abort
+ if (any (-aimag(bc_4) .ne. reshape ((/1._4, 1._4, 2._4, 2._4, 3._4, 3._4, &
+ & 4._4, 4._4, 5._4, 5._4, 6._4, 6._4/), (/2, 2, 3/)))) call abort
+ line1 = ' '
+ write(line1, 9020) bc_4
+ line2 = ' '
+ write(line2, 9020) spread (ac_4, 1, 2)
+ if (line1 /= line2) call abort
+ line3 = ' '
+ write(line3, 9020) spread (ac_4, 1, 2) + 0._4
+ if (line1 /= line3) call abort
+ c_4 = spread((1._4,-1._4),1,10)
+ if (any(c_4 /= (1._4,-1._4))) call abort
+
+ ac_8 = reshape ((/(1._8,-1._8), (2._8,-2._8), (3._8, -3._8), (4._8, -4._8), &
+ & (5._8,-5._8), (6._8,-6._8)/), (/2, 3/))
+ bc_8 = spread (ac_8, 1, 2)
+ if (any (real(bc_8) .ne. reshape ((/1._8, 1._8, 2._8, 2._8, 3._8, 3._8, &
+ & 4._8, 4._8, 5._8, 5._8, 6._8, 6._8/), (/2, 2, 3/)))) call abort
+ if (any (-aimag(bc_8) .ne. reshape ((/1._8, 1._8, 2._8, 2._8, 3._8, 3._8, &
+ & 4._8, 4._8, 5._8, 5._8, 6._8, 6._8/), (/2, 2, 3/)))) call abort
+ line1 = ' '
+ write(line1, 9020) bc_8
+ line2 = ' '
+ write(line2, 9020) spread (ac_8, 1, 2)
+ if (line1 /= line2) call abort
+ line3 = ' '
+ write(line3, 9020) spread (ac_8, 1, 2) + 0._8
+ if (line1 /= line3) call abort
+ c_8 = spread((1._8,-1._8),1,10)
+ if (any(c_8 /= (1._8,-1._8))) call abort
+
9000 format(12I3)
9010 format(12F7.3)
+9020 format(25F7.3)
end program
Index: gfortran.dg/intrinsic_spread_2.f90
===================================================================
--- gfortran.dg/intrinsic_spread_2.f90 (revision 133732)
+++ gfortran.dg/intrinsic_spread_2.f90 (working copy)
@@ -7,6 +7,9 @@ program foo
real(kind=k), dimension(10) :: r_k
real(kind=k), dimension (2, 3) :: ar_k
real(kind=k), dimension (2, 2, 3) :: br_k
+ complex(kind=k), dimension(10) :: c_k
+ complex(kind=k), dimension (2, 3) :: ac_k
+ complex(kind=k), dimension (2, 2, 3) :: bc_k
character (len=200) line1, line2, line3
ar_k = reshape ((/1._k, 2._k, 3._k, 4._k, 5._k, 6._k/), (/2, 3/))
@@ -24,6 +27,25 @@ program foo
r_k = spread(1._k,1,10)
if (any(r_k /= 1._k)) call abort
+ ac_k = reshape ((/(1._k,-1._k), (2._k,-2._k), (3._k, -3._k), (4._k, -4._k), &
+ & (5._k,-5._k), (6._k,-6._k)/), (/2, 3/))
+ bc_k = spread (ac_k, 1, 2)
+ if (any (real(bc_k) .ne. reshape ((/1._k, 1._k, 2._k, 2._k, 3._k, 3._k, &
+ & 4._k, 4._k, 5._k, 5._k, 6._k, 6._k/), (/2, 2, 3/)))) call abort
+ if (any (-aimag(bc_k) .ne. reshape ((/1._k, 1._k, 2._k, 2._k, 3._k, 3._k, &
+ & 4._k, 4._k, 5._k, 5._k, 6._k, 6._k/), (/2, 2, 3/)))) call abort
+ line1 = ' '
+ write(line1, 9020) bc_k
+ line2 = ' '
+ write(line2, 9020) spread (ac_k, 1, 2)
+ if (line1 /= line2) call abort
+ line3 = ' '
+ write(line3, 9020) spread (ac_k, 1, 2) + 0._k
+ if (line1 /= line3) call abort
+ c_k = spread((1._k,-1._k),1,10)
+ if (any(c_k /= (1._k,-1._k))) call abort
+
9010 format(12F7.3)
+9020 format(25F7.3)
end program
Index: gfortran.dg/intrinsic_pack_1.f90
===================================================================
--- gfortran.dg/intrinsic_pack_1.f90 (revision 133732)
+++ gfortran.dg/intrinsic_pack_1.f90 (working copy)
@@ -10,6 +10,12 @@ program main
real(kind=8), dimension(3,3) :: r8
real(kind=8), dimension(9) :: vr8
real(kind=8), dimension(9) :: rr8
+ complex(kind=4), dimension(3,3) :: c4
+ complex(kind=4), dimension(9) :: vc4
+ complex(kind=4), dimension(9) :: rc4
+ complex(kind=8), dimension(3,3) :: c8
+ complex(kind=8), dimension(9) :: vc8
+ complex(kind=8), dimension(9) :: rc8
integer(kind=1), dimension(3,3) :: i1
integer(kind=1), dimension(9) :: vi1
integer(kind=1), dimension(9) :: ri1
@@ -37,6 +43,22 @@ program main
if (any(rr8 /= (/ 1.0_8, 2.1_8, 1.2_8, 0.98_8, 15._8, 16._8, 17._8, &
& 18._8, 19._8 /))) call abort
+ vc4 = (/(i+10,i=1,9)/)
+ c4 = reshape((/1.0_4, -3.0_4, 2.1_4, -4.21_4, 1.2_4, 0.98_4, -1.2_4, &
+ & -7.1_4, -9.9_4, 0.3_4 /), shape(c4))
+ rc4 = pack(c4,real(c4)>0,vc4)
+ if (any(real(rc4) /= (/ 1.0_4, 2.1_4, 1.2_4, 0.98_4, 15._4, 16._4, 17._4, &
+ & 18._4, 19._4 /))) call abort
+ if (any(aimag(rc4) /= 0)) call abort
+
+ vc8 = (/(i+10,i=1,9)/)
+ c8 = reshape((/1.0_4, -3.0_4, 2.1_4, -4.21_4, 1.2_4, 0.98_4, -1.2_4, &
+ & -7.1_4, -9.9_4, 0.3_4 /), shape(c8))
+ rc8 = pack(c8,real(c8)>0,vc8)
+ if (any(real(rc8) /= (/ 1.0_4, 2.1_4, 1.2_4, 0.98_4, 15._4, 16._4, 17._4, &
+ & 18._4, 19._4 /))) call abort
+ if (any(aimag(rc8) /= 0)) call abort
+
vi1 = (/(i+10,i=1,9)/)
i1 = reshape((/1_1, -1_1, 2_1, -2_1, 3_1, -3_1, 4_1, -4_1, 5_1/), shape(i1))
ri1 = pack(i1,i1>0,vi1)
Index: gfortran.dg/intrinsic_pack_2.f90
===================================================================
--- gfortran.dg/intrinsic_pack_2.f90 (revision 133732)
+++ gfortran.dg/intrinsic_pack_2.f90 (working copy)
@@ -9,6 +9,9 @@ program main
real(kind=k), dimension(3,3) :: rk
real(kind=k), dimension(9) :: vrk
real(kind=k), dimension(9) :: rrk
+ complex(kind=k), dimension(3,3) :: ck
+ complex(kind=k), dimension(9) :: vck
+ complex(kind=k), dimension(9) :: rck
vrk = (/(i+10,i=1,9)/)
rk = reshape((/1.0_k, -3.0_k, 2.1_k, -4.21_k, 1.2_k, 0.98_k, -1.2_k, &
@@ -17,4 +20,12 @@ program main
if (any(rrk /= (/ 1.0_k, 2.1_k, 1.2_k, 0.98_k, 15._k, 16._k, 17._k, &
& 18._k, 19._k /))) call abort
+ vck = (/(i+10,i=1,9)/)
+ ck = reshape((/1.0_k, -3.0_k, 2.1_k, -4.21_k, 1.2_k, 0.98_k, -1.2_k, &
+ & -7.1_k, -9.9_k, 0.3_k /), shape(ck))
+ rck = pack(ck,real(ck)>0,vck)
+ if (any(real(rck) /= (/ 1.0_k, 2.1_k, 1.2_k, 0.98_k, 15._k, 16._k, 17._k, &
+ & 18._k, 19._k /))) call abort
+ if (any(aimag(rck) /= 0)) call abort
+
end program main
Index: gfortran.dg/intrinsic_unpack_1.f90
===================================================================
--- gfortran.dg/intrinsic_unpack_1.f90 (revision 133732)
+++ gfortran.dg/intrinsic_unpack_1.f90 (working copy)
@@ -8,8 +8,10 @@ program intrinsic_unpack
integer(kind=8), dimension(3, 3) :: a8, b8
real(kind=4), dimension(3,3) :: ar4, br4
real(kind=8), dimension(3,3) :: ar8, br8
+ complex(kind=4), dimension(3,3) :: ac4, bc4
+ complex(kind=8), dimension(3,3) :: ac8, bc8
logical, dimension(3, 3) :: mask
- character(len=100) line1, line2
+ character(len=500) line1, line2
integer i
mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
@@ -92,4 +94,26 @@ program intrinsic_unpack
0._8, 0._8, 4._8/), (/3, 3/)))) &
call abort
+ ac4 = reshape ((/1._4, 0._4, 0._4, 0._4, 1._4, 0._4, 0._4, 0._4, 1._4/), &
+ (/3, 3/));
+ bc4 = unpack ((/(2._4, 0._4), (3._4, 0._4), (4._4, 0._4)/), mask, ac4)
+ if (any (real(bc4) .ne. reshape ((/1._4, 2._4, 0._4, 3._4, 1._4, 0._4, &
+ 0._4, 0._4, 4._4/), (/3, 3/)))) &
+ call abort
+ write (line1,'(18F9.5)') bc4
+ write (line2,'(18F9.5)') unpack((/(2._4, 0._4), (3._4, 0._4), (4._4,0._4)/), &
+ mask, ac4)
+ if (line1 .ne. line2) call abort
+
+ ac8 = reshape ((/1._8, 0._8, 0._8, 0._8, 1._8, 0._8, 0._8, 0._8, 1._8/), &
+ (/3, 3/));
+ bc8 = unpack ((/(2._8, 0._8), (3._8, 0._8), (4._8, 0._8)/), mask, ac8)
+ if (any (real(bc8) .ne. reshape ((/1._8, 2._8, 0._8, 3._8, 1._8, 0._8, &
+ 0._8, 0._8, 4._8/), (/3, 3/)))) &
+ call abort
+ write (line1,'(18F9.5)') bc8
+ write (line2,'(18F9.5)') unpack((/(2._8, 0._8), (3._8, 0._8), (4._8,0._8)/), &
+ mask, ac8)
+ if (line1 .ne. line2) call abort
+
end program
Index: gfortran.dg/intrinsic_unpack_2.f90
===================================================================
--- gfortran.dg/intrinsic_unpack_2.f90 (revision 133732)
+++ gfortran.dg/intrinsic_unpack_2.f90 (working copy)
@@ -6,8 +6,10 @@ program intrinsic_unpack
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
real(kind=k), dimension(3,3) :: ark, brk
+ complex(kind=k), dimension(3,3) :: ack, bck
+
logical, dimension(3, 3) :: mask
- character(len=100) line1, line2
+ character(len=500) line1, line2
integer i
mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
@@ -28,4 +30,15 @@ program intrinsic_unpack
0._k, 0._k, 4._k/), (/3, 3/)))) &
call abort
+ ack = reshape ((/1._k, 0._k, 0._k, 0._k, 1._k, 0._k, 0._k, 0._k, 1._k/), &
+ (/3, 3/));
+ bck = unpack ((/(2._k, 0._k), (3._k, 0._k), (4._k, 0._k)/), mask, ack)
+ if (any (real(bck) .ne. reshape ((/1._k, 2._k, 0._k, 3._k, 1._k, 0._k, &
+ 0._k, 0._k, 4._k/), (/3, 3/)))) &
+ call abort
+ write (line1,'(18F9.5)') bck
+ write (line2,'(18F9.5)') unpack((/(2._k, 0._k), (3._k, 0._k), (4._k,0._k)/), &
+ mask, ack)
+ if (line1 .ne. line2) call abort
+
end program