internal_pack_1.f90: Added complex to test case.

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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3124811858d5844d7ea597700f2764040fca1aa0..c6a8b3c3abdbcb7c91340afe8cb6f3c22e952984 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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>
 

diff --git a/gcc/testsuite/gfortran.dg/internal_pack_1.f90 b/gcc/testsuite/gfortran.dg/internal_pack_1.f90
index 87565bee322803e0f14ade684bfe0b0fbcf76828..6c3781ba9b2163d268490f05605616bf8c16d029 100644 (file)
--- 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 1966e7d05d2f0c86f648b58101e8c7b73271cb68..1f0473e2455f1b453907293e4cebd88bb43294b1 100644 (file)
--- 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 580d776e58f6cad1d5e936fac6e8d3b8682eaa1c..e464503c96360eef75c7a9f4be99c2d12f138472 100644 (file)
--- 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 aba93d232cb2ed2c516860e205965a600bb09716..642cd5c1f825a9232a9f0e97fe698dc3701507cc 100644 (file)
--- 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 e2a0e169bea11f00aea1a79dd0b126ab0d4e191f..1fe09d478bb5f75416d8ebde240cb5ebb58b866a 100644 (file)
--- 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 ab0152182c153291e1ffd3cff42ad00a83758d0d..0a91be7b599aeced6d06d8edc4aba5472d1b8844 100644 (file)
--- 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 f73fcc1def9cd05e26d5709d9dc8afc3ff6f994b..71cce798ca594a3edb142e61de11363aac763a57 100644 (file)
--- 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 613f70a1f077464a46edc5b8cc86673a1dae0a2d..d993f234065baa49758576fb7f5f94bcd18882ee 100644 (file)
--- 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