2007-03-23 Thomas Koenig <tkoenig@gcc.gnu.org

	PR libfortran/32972
	* Makefile.am:  Add new variable, i_unpack_c, containing
	unpack_i1.c, unpack_i2.c, unpack_i4.c, unpack_i8.c,
	unpack_i16.c, unpack_r4.c, unpack_r8.c, unpack_r10.c,
	unpack_r16.c, unpack_c4.c, unpack_c8.c, unpack_c10.c
	and unpack_c16.c
	Add i_unpack_c to gfor_built_src.
	Add rule to generate i_unpack_c from m4/unpack.m4.
	* Makefile.in:  Regenerated.
	* libgfortran.h: Add prototypes for unpack0_i1, unpack0_i2,
	unpack0_i4, unpack0_i8, unpack0_i16, unpack0_r4, unpack0_r8,
	unpack0_r10, unpack0_r16, unpack0_c4, unpack0_c8, unpack0_c10,
	unpack0_c16, unpack1_i1, unpack1_i2, unpack1_i4, unpack1_i8,
	unpack1_i16, unpack1_r4, unpack1_r8, unpack1_r10, unpack1_r16,
	unpack1_c4, unpack1_c8, unpack1_c10 and unpack1_c16.
	* intrinsics/pack_generic.c (unpack1):  Add calls to specific
	unpack1 functions.
	(unpack0):  Add calls to specific unpack0 functions.
	* m4/unpack.m4:  New file.
	* generated/unpack_i1.c:  New file.
	* generated/unpack_i2.c:  New file.
	* generated/unpack_i4.c:  New file.
	* generated/unpack_i8.c:  New file.
	* generated/unpack_i16.c:  New file.
	* generated/unpack_r4.c:  New file.
	* generated/unpack_r8.c:  New file.
	* generated/unpack_r10.c:  New file.
	* generated/unpack_r16.c:  New file.
	* generated/unpack_c4.c:  New file.
	* generated/unpack_c8.c:  New file.
	* generated/unpack_c10.c:  New file.
	* generated/unpack_c16.c:  New file.

2007-03-23  Thomas Koenig  <tkoenig@gcc.gnu.org

	PR libfortran/32972
	* gfortran.dg/intrinsic_unpack_1.f90:  New test case.
	* gfortran.dg/intrinsic_unpack_2.f90:  New test case.
	* gfortran.dg/intrinsic_unpack_3.f90:  New test case.



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

4 files changed, 160 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e952bef7e2a..50d7ded78c8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2007-03-23  Thomas Koenig  <tkoenig@gcc.gnu.org
+
+	PR libfortran/32972
+	* gfortran.dg/intrinsic_unpack_1.f90:  New test case.
+	* gfortran.dg/intrinsic_unpack_2.f90:  New test case.
+	* gfortran.dg/intrinsic_unpack_3.f90:  New test case.
+
 2008-03-22  Richard Sandiford  <rsandifo@nildram.co.uk>
 
 	* gcc.target/mips/dse-1.c: Add checks for zeros.
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90
new file mode 100644
index 00000000000..f73fcc1def9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_1.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+! Program to test the UNPACK intrinsic for the types usually present.
+program intrinsic_unpack
+   implicit none
+   integer(kind=1), dimension(3, 3) :: a1, b1
+   integer(kind=2), dimension(3, 3) :: a2, b2
+   integer(kind=4), dimension(3, 3) :: a4, b4
+   integer(kind=8), dimension(3, 3) :: a8, b8
+   real(kind=4), dimension(3,3) :: ar4, br4
+   real(kind=8), dimension(3,3) :: ar8, br8
+   logical, dimension(3, 3) :: mask
+   character(len=100) line1, line2
+   integer i
+
+   mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
+                    &.false.,.false.,.true./), (/3, 3/));
+   a1 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   b1 = unpack ((/2_1, 3_1, 4_1/), mask, a1)
+   if (any (b1 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') b1
+   write (line2,'(10I4)') unpack((/2_1, 3_1, 4_1/), mask, a1)
+   if (line1 .ne. line2) call abort
+   b1 = -1
+   b1 = unpack ((/2_1, 3_1, 4_1/), mask, 0_1)
+   if (any (b1 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+   a2 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   b2 = unpack ((/2_2, 3_2, 4_2/), mask, a2)
+   if (any (b2 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') b2
+   write (line2,'(10I4)') unpack((/2_2, 3_2, 4_2/), mask, a2)
+   if (line1 .ne. line2) call abort
+   b2 = -1
+   b2 = unpack ((/2_2, 3_2, 4_2/), mask, 0_2)
+   if (any (b2 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+   a4 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   b4 = unpack ((/2_4, 3_4, 4_4/), mask, a4)
+   if (any (b4 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') b4
+   write (line2,'(10I4)') unpack((/2_4, 3_4, 4_4/), mask, a4)
+   if (line1 .ne. line2) call abort
+   b4 = -1
+   b4 = unpack ((/2_4, 3_4, 4_4/), mask, 0_4)
+   if (any (b4 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+   a8 = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   b8 = unpack ((/2_8, 3_8, 4_8/), mask, a8)
+   if (any (b8 .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') b8
+   write (line2,'(10I4)') unpack((/2_8, 3_8, 4_8/), mask, a8)
+   if (line1 .ne. line2) call abort
+   b8 = -1
+   b8 = unpack ((/2_8, 3_8, 4_8/), mask, 0_8)
+   if (any (b8 .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+   ar4 = reshape ((/1._4, 0._4, 0._4, 0._4, 1._4, 0._4, 0._4, 0._4, 1._4/), &
+         (/3, 3/));
+   br4 = unpack ((/2._4, 3._4, 4._4/), mask, ar4)
+   if (any (br4 .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,'(9F9.5)') br4
+   write (line2,'(9F9.5)') unpack((/2._4, 3._4, 4._4/), mask, ar4)
+   if (line1 .ne. line2) call abort
+   br4 = -1._4
+   br4 = unpack ((/2._4, 3._4, 4._4/), mask, 0._4)
+   if (any (br4 .ne. reshape ((/0._4, 2._4, 0._4, 3._4, 0._4, 0._4, &
+      0._4, 0._4, 4._4/), (/3, 3/)))) &
+      call abort
+
+   ar8 = reshape ((/1._8, 0._8, 0._8, 0._8, 1._8, 0._8, 0._8, 0._8, 1._8/), &
+         (/3, 3/));
+   br8 = unpack ((/2._8, 3._8, 4._8/), mask, ar8)
+   if (any (br8 .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,'(9F9.5)') br8
+   write (line2,'(9F9.5)') unpack((/2._8, 3._8, 4._8/), mask, ar8)
+   if (line1 .ne. line2) call abort
+   br8 = -1._8
+   br8 = unpack ((/2._8, 3._8, 4._8/), mask, 0._8)
+   if (any (br8 .ne. reshape ((/0._8, 2._8, 0._8, 3._8, 0._8, 0._8, &
+      0._8, 0._8, 4._8/), (/3, 3/)))) &
+      call abort
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90
new file mode 100644
index 00000000000..613f70a1f07
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_2.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+! Program to test the UNPACK intrinsic for large real type
+program intrinsic_unpack
+   implicit none
+   integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+
+   real(kind=k), dimension(3,3) :: ark, brk
+   logical, dimension(3, 3) :: mask
+   character(len=100) line1, line2
+   integer i
+
+   mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
+                    &.false.,.false.,.true./), (/3, 3/));
+
+   ark = reshape ((/1._k, 0._k, 0._k, 0._k, 1._k, 0._k, 0._k, 0._k, 1._k/), &
+         (/3, 3/));
+   brk = unpack ((/2._k, 3._k, 4._k/), mask, ark)
+   if (any (brk .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,'(9F9.5)') brk
+   write (line2,'(9F9.5)') unpack((/2._k, 3._k, 4._k/), mask, ark)
+   if (line1 .ne. line2) call abort
+   brk = -1._k
+   brk = unpack ((/2._k, 3._k, 4._k/), mask, 0._k)
+   if (any (brk .ne. reshape ((/0._k, 2._k, 0._k, 3._k, 0._k, 0._k, &
+      0._k, 0._k, 4._k/), (/3, 3/)))) &
+      call abort
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_unpack_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_unpack_3.f90
new file mode 100644
index 00000000000..4a4443facf5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_unpack_3.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+! Program to test the UNPACK intrinsic for a long integer type
+program intrinsic_unpack
+   implicit none
+   integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+   integer(kind=k), dimension(3, 3) :: ak, bk
+   logical, dimension(3, 3) :: mask
+   character(len=100) line1, line2
+   integer i
+
+   mask = reshape ((/.false.,.true.,.false.,.true.,.false.,.false.,&
+                    &.false.,.false.,.true./), (/3, 3/));
+
+   ak = reshape ((/1, 0, 0, 0, 1, 0, 0, 0, 1/), (/3, 3/));
+   bk = unpack ((/2_k, 3_k, 4_k/), mask, ak)
+   if (any (bk .ne. reshape ((/1, 2, 0, 3, 1, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+   write (line1,'(10I4)') bk
+   write (line2,'(10I4)') unpack((/2_k, 3_k, 4_k/), mask, ak)
+   if (line1 .ne. line2) call abort
+   bk = -1
+   bk = unpack ((/2_k, 3_k, 4_k/), mask, 0_k)
+   if (any (bk .ne. reshape ((/0, 2, 0, 3, 0, 0, 0, 0, 4/), (/3, 3/)))) &
+      call abort
+
+end program