[multiple changes]

2007-11-23  Tobias Burnus  <burnus@net-b.de>

	PR fortran/34209
	* gfortran.dg/nearest_3.f90: New test.

2007-11-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/33317
	* gfortran.dg/optional_dim_2.f90: New test.

From-SVN: r130392

3 files changed, 371 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ee015a2..6c191d6 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,15 @@
 2007-11-23  Tobias Burnus  <burnus@net-b.de>
 
+	PR fortran/34209
+	* gfortran.dg/nearest_3.f90: New test.
+
+2007-11-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33317
+	* gfortran.dg/optional_dim_2.f90: New test.
+
+2007-11-23  Tobias Burnus  <burnus@net-b.de>
+
 	PR fortran/34187
 	* gfortran.dg/bind_c_usage_15.f90: New.
 
diff --git a/gcc/testsuite/gfortran.dg/nearest_3.f90 b/gcc/testsuite/gfortran.dg/nearest_3.f90
new file mode 100644
index 0000000..0bf241a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nearest_3.f90
@@ -0,0 +1,337 @@
+! { dg-do run }
+!
+! PR fortran/34209
+!
+! Test run-time implementation of NEAREST
+!
+program test
+  implicit none
+  real(4), volatile :: r4
+  real(8), volatile :: r8
+
+! Single precision with single-precision sign
+
+  r4 = 0.0_4
+  ! 0+ > 0
+  if (nearest(r4, 1.0) &
+      <= r4) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(r4, 1.0), 1.0) &
+      <= nearest(r4, 1.0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(r4, 1.0), 1.0), 1.0) &
+      <= nearest(nearest(r4, 1.0), 1.0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(r4, 1.0), -1.0) &
+      /= r4) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(r4, 1.0), 1.0), -1.0) &
+      /= nearest(r4, 1.0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(r4, 1.0), 1.0), -1.0), -1.0) &
+      /= r4) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(r4, -1.0) &
+      >= r4) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(r4, -1.0), -1.0) &
+      >= nearest(r4, -1.0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(r4, -1.0), -1.0), -1.0) &
+      >= nearest(nearest(r4, -1.0), -1.0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(r4, -1.0), 1.0) &
+      /= r4) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(r4, -1.0), -1.0), 1.0) &
+      /= nearest(r4, -1.0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(r4, -1.0), -1.0), 1.0), 1.0) &
+      /= r4) &
+    call abort()
+
+  r4 = 42.0_4
+  ! 42++ > 42+
+  if (nearest(nearest(r4, 1.0), 1.0) &
+      <= nearest(r4, 1.0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(r4, -1.0), -1.0) &
+      >= nearest(r4, -1.0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(r4, -1.0), 1.0) &
+      /= r4) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(r4, 1.0), -1.0) &
+      /= r4) &
+    call abort()
+
+  r4 = 0.0
+  ! INF+ = INF
+  if (nearest(1.0/r4, 1.0) /= 1.0/r4) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0/r4, -1.0) /= -1.0/r4) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0/r4,  1.0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0/r4, -1.0))) call abort()
+
+! Double precision with single-precision sign
+
+  r8 = 0.0_8
+  ! 0+ > 0
+  if (nearest(r8, 1.0) &
+      <= r8) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(r8, 1.0), 1.0) &
+      <= nearest(r8, 1.0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(r8, 1.0), 1.0), 1.0) &
+      <= nearest(nearest(r8, 1.0), 1.0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(r8, 1.0), -1.0) &
+      /= r8) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(r8, 1.0), 1.0), -1.0) &
+      /= nearest(r8, 1.0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(r8, 1.0), 1.0), -1.0), -1.0) &
+      /= r8) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(r8, -1.0) &
+      >= r8) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(r8, -1.0), -1.0) &
+      >= nearest(r8, -1.0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(r8, -1.0), -1.0), -1.0) &
+      >= nearest(nearest(r8, -1.0), -1.0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(r8, -1.0), 1.0) &
+      /= r8) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(r8, -1.0), -1.0), 1.0) &
+      /= nearest(r8, -1.0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(r8, -1.0), -1.0), 1.0), 1.0) &
+      /= r8) &
+    call abort()
+
+  r8 = 42.0_8
+  ! 42++ > 42+
+  if (nearest(nearest(r8, 1.0), 1.0) &
+      <= nearest(r8, 1.0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(r8, -1.0), -1.0) &
+      >= nearest(r8, -1.0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(r8, -1.0), 1.0) &
+      /= r8) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(r8, 1.0), -1.0) &
+      /= r8) &
+    call abort()
+
+  r4 = 0.0
+  ! INF+ = INF
+  if (nearest(1.0/r4, 1.0) /= 1.0/r4) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0/r4, -1.0) /= -1.0/r4) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0/r4,  1.0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0/r4, -1.0))) call abort()
+
+
+! Single precision with double-precision sign
+
+  r4 = 0.0_4
+  ! 0+ > 0
+  if (nearest(r4, 1.0d0) &
+      <= r4) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(r4, 1.0d0), 1.0d0) &
+      <= nearest(r4, 1.0d0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(r4, 1.0d0), 1.0d0), 1.0d0) &
+      <= nearest(nearest(r4, 1.0d0), 1.0d0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(r4, 1.0d0), -1.0d0) &
+      /= r4) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(r4, 1.0d0), 1.0d0), -1.0d0) &
+      /= nearest(r4, 1.0d0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(r4, 1.0d0), 1.0d0), -1.0d0), -1.0d0) &
+      /= r4) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(r4, -1.0d0) &
+      >= r4) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(r4, -1.0d0), -1.0d0) &
+      >= nearest(r4, -1.0d0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(r4, -1.0d0), -1.0d0), -1.0d0) &
+      >= nearest(nearest(r4, -1.0d0), -1.0d0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(r4, -1.0d0), 1.0d0) &
+      /= r4) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(r4, -1.0d0), -1.0d0), 1.0d0) &
+      /= nearest(r4, -1.0d0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(r4, -1.0d0), -1.0d0), 1.0d0), 1.0d0) &
+      /= r4) &
+    call abort()
+
+  r4 = 42.0_4
+  ! 42++ > 42+
+  if (nearest(nearest(r4, 1.0d0), 1.0d0) &
+      <= nearest(r4, 1.0d0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(r4, -1.0d0), -1.0d0) &
+      >= nearest(r4, -1.0d0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(r4, -1.0d0), 1.0d0) &
+      /= r4) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(r4, 1.0d0), -1.0d0) &
+      /= r4) &
+    call abort()
+
+  r4 = 0.0
+  ! INF+ = INF
+  if (nearest(1.0d0/r4, 1.0d0) /= 1.0d0/r4) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0d0/r4, -1.0d0) /= -1.0d0/r4) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0/r4,  1.0d0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0/r4, -1.0d0))) call abort()
+
+! Double precision with double-precision sign
+
+  r8 = 0.0_8
+  ! 0+ > 0
+  if (nearest(r8, 1.0d0) &
+      <= r8) &
+    call abort()
+  ! 0++ > 0+
+  if (nearest(nearest(r8, 1.0d0), 1.0d0) &
+      <= nearest(r8, 1.0d0)) &
+    call abort()
+  ! 0+++ > 0++
+  if (nearest(nearest(nearest(r8, 1.0d0), 1.0d0), 1.0d0) &
+      <= nearest(nearest(r8, 1.0d0), 1.0d0)) &
+    call abort()
+  ! 0+- = 0
+  if (nearest(nearest(r8, 1.0d0), -1.0d0) &
+      /= r8) &
+    call abort()
+  ! 0++- = 0+
+  if (nearest(nearest(nearest(r8, 1.0d0), 1.0d0), -1.0d0) &
+      /= nearest(r8, 1.0d0)) &
+    call abort()
+  ! 0++-- = 0
+  if (nearest(nearest(nearest(nearest(r8, 1.0d0), 1.0d0), -1.0d0), -1.0d0) &
+      /= r8) &
+    call abort()
+
+  ! 0- < 0
+  if (nearest(r8, -1.0d0) &
+      >= r8) &
+    call abort()
+  ! 0-- < 0+
+  if (nearest(nearest(r8, -1.0d0), -1.0d0) &
+      >= nearest(r8, -1.0d0)) &
+    call abort()
+  ! 0--- < 0--
+  if (nearest(nearest(nearest(r8, -1.0d0), -1.0d0), -1.0d0) &
+      >= nearest(nearest(r8, -1.0d0), -1.0d0)) &
+    call abort()
+  ! 0-+ = 0
+  if (nearest(nearest(r8, -1.0d0), 1.0d0) &
+      /= r8) &
+    call abort()
+  ! 0--+ = 0-
+  if (nearest(nearest(nearest(r8, -1.0d0), -1.0d0), 1.0d0) &
+      /= nearest(r8, -1.0d0)) &
+    call abort()
+  ! 0--++ = 0
+  if (nearest(nearest(nearest(nearest(r8, -1.0d0), -1.0d0), 1.0d0), 1.0d0) &
+      /= r8) &
+    call abort()
+
+  r8 = 42.0_8
+  ! 42++ > 42+
+  if (nearest(nearest(r8, 1.0d0), 1.0d0) &
+      <= nearest(r8, 1.0d0)) &
+    call abort()
+  ! 42-- < 42-
+  if (nearest(nearest(r8, -1.0d0), -1.0d0) &
+      >= nearest(r8, -1.0d0)) &
+    call abort()
+  ! 42-+ = 42
+  if (nearest(nearest(r8, -1.0d0), 1.0d0) &
+      /= r8) &
+    call abort()
+  ! 42+- = 42
+  if (nearest(nearest(r8, 1.0d0), -1.0d0) &
+      /= r8) &
+    call abort()
+
+  r4 = 0.0
+  ! INF+ = INF
+  if (nearest(1.0d0/r4, 1.0d0) /= 1.0d0/r4) call abort()
+  ! -INF- = -INF
+  if (nearest(-1.0d0/r4, -1.0d0) /= -1.0d0/r4) call abort()
+  ! NAN- = NAN
+  if (.not.isnan(nearest(0.0/r4,  1.0d0))) call abort()
+  ! NAN+ = NAN
+  if (.not.isnan(nearest(0.0/r4, -1.0d0))) call abort()
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/optional_dim_2.f90 b/gcc/testsuite/gfortran.dg/optional_dim_2.f90
new file mode 100644
index 0000000..bb25201
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_dim_2.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! PR33317 CSHIFT/EOSHIFT: Rejects optional dummy for DIM=
+! Test case submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+program test
+ implicit none
+ call sub(bound=.false., dimmy=1_8)
+ call sub()
+contains
+ subroutine sub(bound, dimmy)
+   integer(kind=8), optional :: dimmy
+   logical, optional :: bound
+   logical :: lotto(4)
+   character(20) :: testbuf
+   lotto = .false.
+   lotto = cshift((/.true.,.false.,.true.,.false./),1,dim=dimmy)
+   write(testbuf,*) lotto
+   if (trim(testbuf).ne." F T F T") call abort
+   lotto = .false.
+   lotto = eoshift((/.true.,.true.,.true.,.true./),1,boundary=bound,dim=dimmy)
+   lotto = eoshift(lotto,1,dim=dimmy)
+   write(testbuf,*) lotto
+   if (trim(testbuf).ne." T T F F") print *, testbuf
+ end subroutine
+end program test
\ No newline at end of file