Commit b769ac9c by Jerry DeLisle

[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
parent be9c3c6e
2007-11-23 Tobias Burnus <burnus@net-b.de> 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 PR fortran/34187
* gfortran.dg/bind_c_usage_15.f90: New. * gfortran.dg/bind_c_usage_15.f90: New.
! { 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
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment