[patch, libfortran] Fix PR 36302

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

this fixes RP 36302, which I just stumbled across when reading through
some intrinsics source code.

This looks pretty obvious and compiles on i686-pc-linux-gnu, and the
tests are properly ignored.  Could somebody test it on a 64-bit-integer
capable system?

OK for trunk if that's been done?

	Thomas

2008-05-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libgfortran/36302
	* gfortran.map:  Add _gfortran_eoshift0_16,
	_gfortran_eoshift0_16_char, _gfortran_eoshift2_16,
	_gfortran_eoshift2_16_char,_gfortran_cshift0_16,
	_gfortran_cshift0_16_char.
	* intrinsics/eoshift0.c:  Add function for kind=16 integer.
	* intrinsics/eoshift2.c:  Likewise.
	* intrinsics/cshift0.c:  Likewise.

2008-05-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libgfortran/36302
	* gfortran.dg/cshift_large_1.f90:  New test.
	* gfortran.dg/eoshift_large_1.f90:  New test.

! { dg-do run }
! { dg-require-effective-target fortran_large_int }
! Program to test the cshift intrinsic for kind=16 integers
program intrinsic_cshift
   integer, parameter :: k=16
   integer(kind=k), dimension(3_k, 3_k) :: a
   integer(kind=k), dimension(3_k, 3_k, 2_k) :: b

   ! Scalar shift
   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = cshift (a, 1_k, 1_k)
   if (any (a .ne. reshape ((/2_k, 3_k, 1_k, 5_k, 6_k, 4_k, 8_k, 9_k, 7_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = cshift (a, -2_k, dim = 2_k)
   if (any (a .ne. reshape ((/4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
      call abort

   ! Array shift
   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = cshift (a, (/1_k, 0_k, -1_k/))
   if (any (a .ne. reshape ((/2_k, 3_k, 1_k, 4_k, 5_k, 6_k, 9_k, 7_k, 8_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = cshift (a, (/2_k, -2_k, 0_k/), dim = 2_k)
   if (any (a .ne. reshape ((/7_k, 5_k, 3_k, 1_k, 8_k, 6_k, 4_k, 2_k, 9_k/), (/3_k, 3_k/)))) &
      call abort

   ! Test arrays > rank 2
   b = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 11_k, 12_k, 13_k, 14_k, 15_k, 16_k, 17_k,&
         18_k, 19_k/), (/3_k, 3_k, 2_k/))
   b = cshift (b, 1_k)
   if (any (b .ne. reshape ((/2_k, 3_k, 1_k, 5_k, 6_k, 4_k, 8_k, 9_k, 7_k, 12_k, 13_k, 11_k, 15_k,&
     16_k, 14_k, 18_k, 19_k, 17_k/), (/3_k, 3_k, 2_k/)))) &
      call abort

   b = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k, 11_k, 12_k, 13_k, 14_k, 15_k, 16_k, 17_k,&
         18_k, 19_k/), (/3_k, 3_k, 2_k/))
   b = cshift (b, reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/)), 3_k)
   if (any (b .ne. reshape ((/11_k, 2_k, 13_k, 4_k, 15_k, 6_k, 17_k, 8_k, 19_k, 1_k, 12_k, 3_k,&
     14_k, 5_k, 16_k, 7_k, 18_k, 9_k/), (/3_k, 3_k, 2_k/)))) &
      call abort

end program

! { dg-do run }
! { dg-require-effective-target fortran_large_int }
! Program to test the eoshift intrinsic for kind=16_k integers
! 
program intrinsic_eoshift
  integer, parameter :: k=16
  integer(kind=k), dimension(3_k, 3_k) :: a
   integer(kind=k), dimension(3_k, 3_k, 2_k) :: b
   integer(kind=k), dimension(3_k) :: bo, sh

   ! Scalar shift and scalar bound.
   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, 1_k, 99_k, 1_k)
   if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, 99_k, 8_k, 9_k, 99_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, 9999_k, 99_k, 1_k)
   if (any (a .ne. 99_k)) call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, -2_k, dim = 2_k)
   if (any (a .ne. reshape ((/0_k, 0_k, 0_k, 0_k, 0_k, 0_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, -9999_k, 99_k, 1_k)
   if (any (a .ne. 99_k)) call abort

   ! Array shift and scalar bound.
   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, (/1_k, 0_k, -1_k/), 99_k, 1_k)
   if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 4_k, 5_k, 6_k, 99_k, 7_k, 8_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, (/9999_k, 0_k, -9999_k/), 99_k, 1_k)
   if (any (a .ne. reshape ((/99_k, 99_k, 99_k, 4_k, 5_k, 6_k, 99_k, 99_k, 99_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, (/2_k, -2_k, 0_k/), dim = 2_k)
   if (any (a .ne. reshape ((/7_k, 0_k, 3_k, 0_k, 0_k, 6_k, 0_k, 2_k, 9_k/), (/3_k, 3_k/)))) &
      call abort

   ! Scalar shift and array bound.
   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, 1_k, (/99_k, -1_k, 42_k/), 1_k)
   if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, -1_k, 8_k, 9_k, 42_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, 9999_k, (/99_k, -1_k, 42_k/), 1_k)
   if (any (a .ne. reshape ((/99_k, 99_k, 99_k, -1_k, -1_k, -1_k, 42_k, 42_k, 42_k/), &
	(/3_k, 3_k/)))) call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, -9999_k, (/99_k, -1_k, 42_k/), 1_k)
   if (any (a .ne. reshape ((/99_k, 99_k, 99_k, -1_k, -1_k, -1_k, 42_k, 42_k, 42_k/), &
	(/3_k, 3_k/)))) call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, -2_k, (/99_k, -1_k, 42_k/), 2_k)
   if (any (a .ne. reshape ((/99_k, -1_k, 42_k, 99_k, -1_k, 42_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   bo = (/99_k, -1_k, 42_k/)
   a = eoshift (a, -2_k, bo, 2_k)
   if (any (a .ne. reshape ((/99_k, -1_k, 42_k, 99_k, -1_k, 42_k, 1_k, 2_k, 3_k/), (/3_k, 3_k/)))) &
      call abort

   ! Array shift and array bound.
   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, (/1_k, 0_k, -1_k/), (/99_k, -1_k, 42_k/), 1_k)
   if (any (a .ne. reshape ((/2_k, 3_k, 99_k, 4_k, 5_k, 6_k, 42_k, 7_k, 8_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, (/2_k, -2_k, 0_k/), (/99_k, -1_k, 42_k/), 2_k)
   if (any (a .ne. reshape ((/7_k, -1_k, 3_k, 99_k, -1_k, 6_k, 99_k, 2_k, 9_k/), (/3_k, 3_k/)))) &
      call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   sh = (/ 3_k, -1_k, -3_k /)
   bo = (/-999_k, -99_k, -9_k /)
   a = eoshift(a, shift=sh, boundary=bo)
   if (any (a .ne. reshape ((/ -999_k, -999_k, -999_k, -99_k, 4_k, 5_k, -9_k, -9_k, -9_k /), &
        shape(a)))) call abort

   a = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   a = eoshift (a, (/9999_k, -9999_k, 0_k/), (/99_k, -1_k, 42_k/), 2_k)
   if (any (a .ne. reshape ((/99_k, -1_k, 3_k, 99_k, -1_k, 6_k, 99_k, -1_k, 9_k/), (/3_k, 3_k/)))) &
      call abort

   ! Test arrays > rank 2
   b(:, :, 1_k) = reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   b(:, :, 2_k) = 10_k + reshape ((/1_k, 2_k, 3_k, 4_k, 5_k, 6_k, 7_k, 8_k, 9_k/), (/3_k, 3_k/))
   b = eoshift (b, 1_k, 99_k, 1_k)
   if (any (b(:, :, 1_k) .ne. reshape ((/2_k, 3_k, 99_k, 5_k, 6_k, 99_k, 8_k, 9_k, 99_k/), (/3_k, 3_k/)))) &
      call abort
   if (any (b(:, :, 2_k) .ne. reshape ((/12_k, 13_k, 99_k, 15_k, 16_k, 99_k, 18_k, 19_k, 99_k/), (/3_k, 3_k/)))) &
      call abort

   ! TODO: Test array sections
end program

Index: intrinsics/cshift0.c
===================================================================
--- intrinsics/cshift0.c	(revision 135512)
+++ intrinsics/cshift0.c	(working copy)
@@ -340,3 +340,6 @@ DEFINE_CSHIFT (1);
 DEFINE_CSHIFT (2);
 DEFINE_CSHIFT (4);
 DEFINE_CSHIFT (8);
+#ifdef HAVE_GFC_INTEGER_16
+DEFINE_CSHIFT (16);
+#endif
Index: intrinsics/eoshift0.c
===================================================================
--- intrinsics/eoshift0.c	(revision 135512)
+++ intrinsics/eoshift0.c	(working copy)
@@ -251,3 +251,6 @@ DEFINE_EOSHIFT (1);
 DEFINE_EOSHIFT (2);
 DEFINE_EOSHIFT (4);
 DEFINE_EOSHIFT (8);
+#ifdef HAVE_GFC_INTEGER_16
+DEFINE_EOSHIFT (16);
+#endif
Index: intrinsics/eoshift2.c
===================================================================
--- intrinsics/eoshift2.c	(revision 135512)
+++ intrinsics/eoshift2.c	(working copy)
@@ -272,3 +272,6 @@ DEFINE_EOSHIFT (1);
 DEFINE_EOSHIFT (2);
 DEFINE_EOSHIFT (4);
 DEFINE_EOSHIFT (8);
+#ifdef HAVE_GFC_INTEGER_16
+DEFINE_EOSHIFT (16);
+#endif
Index: gfortran.map
===================================================================
--- gfortran.map	(revision 135512)
+++ gfortran.map	(working copy)
@@ -1060,6 +1060,12 @@ GFORTRAN_1.1 {
     _gfortran_pack_s_char4;
     _gfortran_unpack0_char4;
     _gfortran_unpack1_char4;
+    _gfortran_eoshift0_16;
+    _gfortran_eoshift0_16_char;
+    _gfortran_eoshift2_16;
+    _gfortran_eoshift2_16_char;
+    _gfortran_cshift0_16;
+    _gfortran_cshift0_16_char;
 } GFORTRAN_1.0; 
 
 F2C_1.0 {