re PR libfortran/32972 (performance of pack/unpack)

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

	PR libfortran/32972
	PR libfortran/32512
	* Makefile.am:  Add new variable, i_spread_c, containing
	pack_i1.c, pack_i2.c, pack_i4.c, pack_i8.c, spread_i16.c,
	spread_r4.c, spread_r8.c, spread_r10.c, spread_r16.c,
	spread_c4.c, spread_c8.c, spread_c10.c, spread_c16.c.
	* Makefile.in:  Regenerated.
	* libgfortran.h:  Add prototypes for spread_i1, spread_i2,
	spread_i4, spread_i8, spread_i16, spread_r4, spread_r8,
	spread_c4, spread_c8, spread_c10, spread_c16,
	spread_scalar_i1, spread_scalar_i2, spread_scalar_i4,
	spread_scalar_i8, spread_scalar_i16, spread_scalar_r4
	spread_scalar_r8, spread_scalar_c4, spread_scalar_c8,
	spread_scalar_c10 and spread_scalar_c16.
	Add macros to isolate both type and size information
	from array descriptors with a single mask operation.
	* intrinsics/spread_generic.c:  Add calls to specific
	spread functions.
	* m4/spread.m4:  New file.
	* generated/spread_i1.c:  New file.
	* generated/spread_i2.c:  New file.
	* generated/spread_i4.c:  New file.
	* generated/spread_i8.c:  New file.
	* generated/spread_i16.c:  New file.
	* generated/spread_r4.c:  New file.
	* generated/spread_r8.c:  New file.
	* generated/spread_r10.c:  New file.
	* generated/spread_r16.c:  New file.
	* generated/spread_c4.c:  New file.
	* generated/spread_c8.c:  New file.
	* generated/spread_c10.c:  New file.
	* generated/spread_c16.c:  New file.

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

	PR libfortran/32972
	PR libfortran/32512
	* intrinsic_spread_1.f90:  New file.
	* intrinsic_spread_2.f90:  New file.
	* intrinsic_spread_3.f90:  New file.

From-SVN: r133702

3 files changed, 183 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90
new file mode 100644
index 0000000..e2a0e16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_1.f90
@@ -0,0 +1,123 @@
+! { dg-do run }
+program foo
+   implicit none
+   integer(kind=1), dimension (10) :: i_1
+   integer(kind=1), dimension (2, 3) :: a_1
+   integer(kind=1), dimension (2, 2, 3) :: b_1
+   integer(kind=2), dimension (10) :: i_2
+   integer(kind=2), dimension (2, 3) :: a_2
+   integer(kind=2), dimension (2, 2, 3) :: b_2
+   integer(kind=4), dimension (10) :: i_4
+   integer(kind=4), dimension (2, 3) :: a_4
+   integer(kind=4), dimension (2, 2, 3) :: b_4
+   integer(kind=8), dimension (10) :: i_8
+   integer(kind=8), dimension (2, 3) :: a_8
+   integer(kind=8), dimension (2, 2, 3) :: b_8
+   real(kind=4), dimension (10) :: r_4
+   real(kind=4), dimension (2, 3) :: ar_4
+   real(kind=4), dimension (2, 2, 3) :: br_4
+   real(kind=8), dimension (10) :: r_8
+   real(kind=8), dimension (2, 3) :: ar_8
+   real(kind=8), dimension (2, 2, 3) :: br_8
+   character (len=200) line1, line2, line3
+
+   a_1 = reshape ((/1_1, 2_1, 3_1, 4_1, 5_1, 6_1/), (/2, 3/))
+   b_1 = spread (a_1, 1, 2)
+   if (any (b_1 .ne. reshape ((/1_1, 1_1, 2_1, 2_1, 3_1, 3_1, 4_1, 4_1, 5_1, 5_1, 6_1, 6_1/), &
+                            (/2, 2, 3/)))) &
+      call abort
+   line1 = ' '
+   write(line1, 9000) b_1
+   line2 = ' '
+   write(line2, 9000) spread (a_1, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_1, 1, 2) + 0_1
+   if (line1 /= line3) call abort
+   i_1 = spread(1_1,1,10)
+   if (any(i_1 /= 1_1)) call abort
+
+   a_2 = reshape ((/1_2, 2_2, 3_2, 4_2, 5_2, 6_2/), (/2, 3/))
+   b_2 = spread (a_2, 1, 2)
+   if (any (b_2 .ne. reshape ((/1_2, 1_2, 2_2, 2_2, 3_2, 3_2, 4_2, 4_2, 5_2, 5_2, 6_2, 6_2/), &
+                            (/2, 2, 3/)))) &
+      call abort
+   line1 = ' '
+   write(line1, 9000) b_2
+   line2 = ' '
+   write(line2, 9000) spread (a_2, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_2, 1, 2) + 0_2
+   if (line1 /= line3) call abort
+   i_2 = spread(1_2,1,10)
+   if (any(i_2 /= 1_2)) call abort
+
+   a_4 = reshape ((/1_4, 2_4, 3_4, 4_4, 5_4, 6_4/), (/2, 3/))
+   b_4 = spread (a_4, 1, 2)
+   if (any (b_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, 9000) b_4
+   line2 = ' '
+   write(line2, 9000) spread (a_4, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_4, 1, 2) + 0_4
+   if (line1 /= line3) call abort
+   i_4 = spread(1_4,1,10)
+   if (any(i_4 /= 1_4)) call abort
+
+   a_8 = reshape ((/1_8, 2_8, 3_8, 4_8, 5_8, 6_8/), (/2, 3/))
+   b_8 = spread (a_8, 1, 2)
+   if (any (b_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, 9000) b_8
+   line2 = ' '
+   write(line2, 9000) spread (a_8, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_8, 1, 2) + 0_8
+   if (line1 /= line3) call abort
+   i_8 = spread(1_8,1,10)
+   if (any(i_8 /= 1_8)) call abort
+
+
+   ar_4 = reshape ((/1._4, 2._4, 3._4, 4._4, 5._4, 6._4/), (/2, 3/))
+   br_4 = spread (ar_4, 1, 2)
+   if (any (br_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, 9010) br_4
+   line2 = ' '
+   write(line2, 9010) spread (ar_4, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9010) spread (ar_4, 1, 2) + 0._4
+   if (line1 /= line3) call abort
+   r_4 = spread(1._4,1,10)
+   if (any(r_4 /= 1._4)) call abort
+
+
+   ar_8 = reshape ((/1._8, 2._8, 3._8, 4._8, 5._8, 6._8/), (/2, 3/))
+   br_8 = spread (ar_8, 1, 2)
+   if (any (br_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, 9010) br_8
+   line2 = ' '
+   write(line2, 9010) spread (ar_8, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9010) spread (ar_8, 1, 2) + 0._8
+   if (line1 /= line3) call abort
+   r_8 = spread(1._8,1,10)
+   if (any(r_8 /= 1._8)) call abort
+
+9000 format(12I3)
+9010 format(12F7.3)
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90
new file mode 100644
index 0000000..ab01521
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_2.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_real }
+program foo
+   implicit none
+   integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
+
+   real(kind=k), dimension(10) :: r_k
+   real(kind=k), dimension (2, 3) :: ar_k
+   real(kind=k), dimension (2, 2, 3) :: br_k
+   character (len=200) line1, line2, line3
+
+   ar_k = reshape ((/1._k, 2._k, 3._k, 4._k, 5._k, 6._k/), (/2, 3/))
+   br_k = spread (ar_k, 1, 2)
+   if (any (br_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, 9010) br_k
+   line2 = ' '
+   write(line2, 9010) spread (ar_k, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9010) spread (ar_k, 1, 2) + 0._k
+   if (line1 /= line3) call abort
+   r_k = spread(1._k,1,10)
+   if (any(r_k /= 1._k)) call abort
+
+9010 format(12F7.3)
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_spread_3.f90 b/gcc/testsuite/gfortran.dg/intrinsic_spread_3.f90
new file mode 100644
index 0000000..1dd2feb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intrinsic_spread_3.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_large_int }
+
+program foo
+   implicit none
+   integer,parameter :: k = selected_int_kind (range (0_8) + 1)
+
+   integer(kind=k), dimension(10) :: i_k
+   integer(kind=k), dimension (2, 3) :: a_k
+   integer(kind=k), dimension (2, 2, 3) :: b_k
+   character (len=200) line1, line2, line3
+
+   a_k = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k/), (/2, 3/))
+   b_k = spread (a_k, 1, 2)
+   if (any (b_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, 9000) b_k
+   line2 = ' '
+   write(line2, 9000) spread (a_k, 1, 2)
+   if (line1 /= line2) call abort
+   line3 = ' '
+   write(line3, 9000) spread (a_k, 1, 2) + 0_k
+   if (line1 /= line3) call abort
+   i_k = spread(1_k,1,10)
+   if (any(i_k /= 1_k)) call abort
+
+9000 format(12I3)
+
+end program