2008-03-21 Thomas Koenig <tkoenig@gcc.gnu.org>

	PR libfortran/32972
	* Makefile.am:  Add new variable, i_pack_c, containing
	pack_i1.c, pack_i2.c, pack_i4.c, pack_i8.c, pack_i16.c,
	pack_r4.c, pack_r8.c, pack_r10.c, pack_r16.c, pack_c4.c,
	pack_c8.c, pack_c10.c, pack_c16.c.
	Add m4/pack.m4 to m4_files.
	Add i_pack_c to gfor_built_src.
	Add rule to generate i_pack_c from m4/pack.m4.
	* Makefile.in:  Regenerated.
	* libgfortran.h: Add prototypes for pack_i1, pack_i2, pack_i4,
	pack_i8, pack_i16, pack_r4, pack_r8, pack_c4, pack_c8,
	pack_c10, pack_c16.
	* intrinsics/pack_generic.c:  Add calls to specific
	pack functions.
	* m4/pack.m4:  New file.
	* generated/pack_i1.c:  New file.
	* generated/pack_i2.c:  New file.
	* generated/pack_i4.c:  New file.
	* generated/pack_i8.c:  New file.
	* generated/pack_i16.c:  New file.
	* generated/pack_r4.c:  New file.
	* generated/pack_r8.c:  New file.
	* generated/pack_r10.c:  New file.
	* generated/pack_r16.c:  New file.
	* generated/pack_c4.c:  New file.
	* generated/pack_c8.c:  New file.
	* generated/pack_c10.c:  New file.
	* generated/pack_c16.c:  New file.

2008-03-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/32972
	* internal_pack_1.f90:  New test case.
	* internal_pack_2.f90:  New test case.
	* internal_pack_3.f90:  New test case.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@133427 138bc75d-0d04-0410-961f-82ee72b054a4

3 files changed, 105 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90
new file mode 100644
index 00000000000..580d776e58f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_1.f90
@@ -0,0 +1,65 @@
+! { dg-do run }
+! Take the pack intrinsic through its paces, with all types that are
+! normally accessible.
+program main
+  implicit none
+  integer :: i
+  real(kind=4), dimension(3,3) :: r4
+  real(kind=4), dimension(9) :: vr4
+  real(kind=4), dimension(9) :: rr4
+  real(kind=8), dimension(3,3) :: r8
+  real(kind=8), dimension(9) :: vr8
+  real(kind=8), dimension(9) :: rr8
+  integer(kind=1), dimension(3,3) :: i1
+  integer(kind=1), dimension(9) :: vi1
+  integer(kind=1), dimension(9) :: ri1
+  integer(kind=2), dimension(3,3) :: i2
+  integer(kind=2), dimension(9) :: vi2
+  integer(kind=2), dimension(9) :: ri2
+  integer(kind=4), dimension(3,3) :: i4
+  integer(kind=4), dimension(9) :: vi4
+  integer(kind=4), dimension(9) :: ri4
+  integer(kind=8), dimension(3,3) :: i8
+  integer(kind=8), dimension(9) :: vi8
+  integer(kind=8), dimension(9) :: ri8
+
+  vr4 = (/(i+10,i=1,9)/)
+  r4 = 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(r4))
+  rr4 = pack(r4,r4>0,vr4)
+  if (any(rr4 /= (/ 1.0_4, 2.1_4, 1.2_4, 0.98_4,  15._4, 16._4, 17._4, &
+  &                  18._4, 19._4 /))) call abort
+
+  vr8 = (/(i+10,i=1,9)/)
+  r8 = reshape((/1.0_8, -3.0_8, 2.1_8, -4.21_8, 1.2_8, 0.98_8, -1.2_8, &
+  &              -7.1_8, -9.9_8, 0.3_8 /), shape(r8))
+  rr8 = pack(r8,r8>0,vr8)
+  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
+
+  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)
+  if (any(ri1 /= (/1_1, 2_1, 3_1, 4_1, 5_1, 16_1, 17_1, 18_1, 19_1/))) &
+       & call abort
+
+  vi2 = (/(i+10,i=1,9)/)
+  i2 = reshape((/1_2, -1_2, 2_2, -2_2, 3_2, -3_2, 4_2, -4_2, 5_2/), shape(i2))
+  ri2 = pack(i2,i2>0,vi2)
+  if (any(ri2 /= (/1_2, 2_2, 3_2, 4_2, 5_2, 16_2, 17_2, 18_2, 19_2/))) &
+       & call abort
+
+  vi4 = (/(i+10,i=1,9)/)
+  i4 = reshape((/1_4, -1_4, 2_4, -2_4, 3_4, -3_4, 4_4, -4_4, 5_4/), shape(i4))
+  ri4 = pack(i4,i4>0,vi4)
+  if (any(ri4 /= (/1_4, 2_4, 3_4, 4_4, 5_4, 16_4, 17_4, 18_4, 19_4/))) &
+       & call abort
+
+  vi8 = (/(i+10,i=1,9)/)
+  i8 = reshape((/1_8, -1_8, 2_8, -2_8, 3_8, -3_8, 4_8, -4_8, 5_8/), shape(i8))
+  ri8 = pack(i8,i8>0,vi8)
+  if (any(ri8 /= (/1_8, 2_8, 3_8, 4_8, 5_8, 16_8, 17_8, 18_8, 19_8/))) &
+       & call abort
+
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90
new file mode 100644
index 00000000000..aba93d232cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_2.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Take the pack intrinsic through its paces, with all types that are
+! normally accessible.
+program main
+  implicit none
+  integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+  integer :: i
+  real(kind=k), dimension(3,3) :: rk
+  real(kind=k), dimension(9) :: vrk
+  real(kind=k), dimension(9) :: rrk
+
+  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, &
+  &              -7.1_k, -9.9_k, 0.3_k /), shape(rk))
+  rrk = pack(rk,rk>0,vrk)
+  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
+
+end program main
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_3.f90
new file mode 100644
index 00000000000..d559e911207
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_3.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+! Take the pack intrinsic through its paces, with all types that are
+! normally accessible.
+program main
+  implicit none
+  integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+  integer :: i
+  integer(kind=k), dimension(3,3) :: ik
+  integer(kind=k), dimension(9) :: vik
+  integer(kind=k), dimension(9) :: rik
+
+  vik = (/(i+10,i=1,9)/)
+  ik = reshape((/1_k, -1_k, 2_k, -2_k, 3_k, -3_k, 4_k, -4_k, 5_k/), shape(ik))
+  rik = pack(ik,ik>0,vik)
+  if (any(rik /= (/1_k, 2_k, 3_k, 4_k, 5_k, 16_k, 17_k, 18_k, 19_k/))) &
+       & call abort
+
+
+end program main