OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

internal_pack_1.f90: Added complex to test case.

Browse Source 
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.

From-SVN: r133733
This commit is contained in:
Thomas Koenig 2008-03-30 16:16:24 +00:00
parent 8f0e26718e
commit 8ae6e4a4dd
9 changed files with 197 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,14 @@
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.
2008-03-30 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/bit_packed_array2.adb: New test.
@ -23,9 +34,9 @@
PR libfortran/32972
PR libfortran/32512
* intrinsic_spread_1.f90: New file.
* intrinsic_spread_2.f90: New file.
* intrinsic_spread_3.f90: New file.
* gfortran.dg/intrinsic_spread_1.f90: New file.
* gfortran.dg/intrinsic_spread_2.f90: New file.
* gfortran.dg/intrinsic_spread_3.f90: New file.
2008-03-28 Daniel Franke <franke.daniel@gmail.com>

30
gcc/testsuite/gfortran.dg/internal_pack_1.f90
View File

@ -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

16
gcc/testsuite/gfortran.dg/internal_pack_2.f90
View File

@ -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

22
gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90
View File

@ -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)

11
gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90
View File

@ -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

43
gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90
View File

@ -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

22
gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90
View File

@ -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

26
gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90
View File

@ -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

15
gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90
View File

@ -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