From 8ae6e4a4dd741b4d5ebc07a0442e9714d4667aaf Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 30 Mar 2008 16:16:24 +0000 Subject: [PATCH] internal_pack_1.f90: Added complex to test case. 2008-03-30 Thomas Koenig * 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 --- gcc/testsuite/ChangeLog | 17 ++++++-- gcc/testsuite/gfortran.dg/internal_pack_1.f90 | 30 +++++++++++++ gcc/testsuite/gfortran.dg/internal_pack_2.f90 | 16 +++++++ .../gfortran.dg/intrinsic_pack_1.f90 | 22 ++++++++++ .../gfortran.dg/intrinsic_pack_2.f90 | 11 +++++ .../gfortran.dg/intrinsic_spread_1.f90 | 43 +++++++++++++++++++ .../gfortran.dg/intrinsic_spread_2.f90 | 22 ++++++++++ .../gfortran.dg/intrinsic_unpack_1.f90 | 26 ++++++++++- .../gfortran.dg/intrinsic_unpack_2.f90 | 15 ++++++- 9 files changed, 197 insertions(+), 5 deletions(-) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3124811858d..c6a8b3c3abd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2008-03-30 Thomas Koenig + + * 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 * 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 diff --git a/gcc/testsuite/gfortran.dg/internal_pack_1.f90 b/gcc/testsuite/gfortran.dg/internal_pack_1.f90 index 87565bee322..6c3781ba9b2 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_1.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/internal_pack_2.f90 b/gcc/testsuite/gfortran.dg/internal_pack_2.f90 index 1966e7d05d2..1f0473e2455 100644 --- a/gcc/testsuite/gfortran.dg/internal_pack_2.f90 +++ b/gcc/testsuite/gfortran.dg/internal_pack_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 index 580d776e58f..e464503c963 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 @@ -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) diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90 index aba93d232cb..642cd5c1f82 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 index e2a0e169bea..1fe09d478bb 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90 index ab0152182c1..0a91be7b599 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 index f73fcc1def9..71cce798ca5 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90 index 613f70a1f07..d993f234065 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90 @@ -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 -- 2.30.2