OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [nan_1.f90] - Blame information for rev 308

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn 
! Test if MIN and MAX intrinsics behave correctly when passed NaNs
2 
! as arguments
3 
!
4 
! { dg-do run }
5 
! { dg-add-options ieee }
6 
! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
7 
!
8 
module aux2
9 
  interface isnan
10 
    module procedure isnan_r
11 
    module procedure isnan_d
12 
  end interface isnan
13 
 
14 
  interface isinf
15 
    module procedure isinf_r
16 
    module procedure isinf_d
17 
  end interface isinf
18 
contains
19 
 
20 
  pure function isnan_r(x) result (isnan)
21 
    logical :: isnan
22 
    real, intent(in) :: x
23 
 
24 
    isnan = (.not.(x == x))
25 
  end function isnan_r
26 
 
27 
  pure function isnan_d(x) result (isnan)
28 
    logical :: isnan
29 
    double precision, intent(in) :: x
30 
 
31 
    isnan = (.not.(x == x))
32 
  end function isnan_d
33 
 
34 
  pure function isinf_r(x) result (isinf)
35 
    logical :: isinf
36 
    real, intent(in) :: x
37 
 
38 
    isinf = (x > huge(x)) .or. (x < -huge(x))
39 
  end function isinf_r
40 
 
41 
  pure function isinf_d(x) result (isinf)
42 
    logical :: isinf
43 
    double precision, intent(in) :: x
44 
 
45 
    isinf = (x > huge(x)) .or. (x < -huge(x))
46 
  end function isinf_d
47 
end module aux2
48 
 
49 
program test
50 
  use aux2
51 
  implicit none
52 
  real :: nan, large, inf
53 
 
54 
  ! Create a NaN and check it
55 
  nan = 0
56 
  nan = nan / nan
57 
  if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
58 
      .or. nan <= nan) call abort
59 
  if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
60 
      (.not. isnan(real(nan,kind=kind(2.d0))))) call abort
61 
 
62 
  ! Create an INF and check it
63 
  large = huge(large)
64 
  inf = 2 * large
65 
  if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) call abort
66 
  if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) call abort
67 
 
68 
  ! Check that MIN and MAX behave correctly
69 
  if (max(2.0, nan) /= 2.0) call abort
70 
  if (min(2.0, nan) /= 2.0) call abort
71 
  if (max(nan, 2.0) /= 2.0) call abort
72 
  if (min(nan, 2.0) /= 2.0) call abort
73 
 
74 
  if (max(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
75 
  if (min(2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
76 
  if (max(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
77 
  if (min(nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
78 
 
79 
  if (.not. isnan(min(nan,nan))) call abort
80 
  if (.not. isnan(max(nan,nan))) call abort
81 
 
82 
  ! Same thing, with more arguments
83 
 
84 
  if (max(3.0, 2.0, nan) /= 3.0) call abort
85 
  if (min(3.0, 2.0, nan) /= 2.0) call abort
86 
  if (max(3.0, nan, 2.0) /= 3.0) call abort
87 
  if (min(3.0, nan, 2.0) /= 2.0) call abort
88 
  if (max(nan, 3.0, 2.0) /= 3.0) call abort
89 
  if (min(nan, 3.0, 2.0) /= 2.0) call abort
90 
 
91 
  if (max(3.d0, 2.d0, nan) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
92 
  if (min(3.d0, 2.d0, nan) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
93 
  if (max(3.d0, nan, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
94 
  if (min(3.d0, nan, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
95 
  if (max(nan, 3.d0, 2.d0) /= 3.d0) call abort ! { dg-warning "Extension: Different type kinds" }
96 
  if (min(nan, 3.d0, 2.d0) /= 2.d0) call abort ! { dg-warning "Extension: Different type kinds" }
97 
 
98 
  if (.not. isnan(min(nan,nan,nan))) call abort
99 
  if (.not. isnan(max(nan,nan,nan))) call abort
100 
  if (.not. isnan(min(nan,nan,nan,nan))) call abort
101 
  if (.not. isnan(max(nan,nan,nan,nan))) call abort
102 
  if (.not. isnan(min(nan,nan,nan,nan,nan))) call abort
103 
  if (.not. isnan(max(nan,nan,nan,nan,nan))) call abort
104 
 
105 
  ! Large values, INF and NaNs
106 
  if (.not. isinf(max(large, inf))) call abort
107 
  if (isinf(min(large, inf))) call abort
108 
  if (.not. isinf(max(nan, large, inf))) call abort
109 
  if (isinf(min(nan, large, inf))) call abort
110 
  if (.not. isinf(max(large, nan, inf))) call abort
111 
  if (isinf(min(large, nan, inf))) call abort
112 
  if (.not. isinf(max(large, inf, nan))) call abort
113 
  if (isinf(min(large, inf, nan))) call abort
114 
 
115 
  if (.not. isinf(min(-large, -inf))) call abort
116 
  if (isinf(max(-large, -inf))) call abort
117 
  if (.not. isinf(min(nan, -large, -inf))) call abort
118 
  if (isinf(max(nan, -large, -inf))) call abort
119 
  if (.not. isinf(min(-large, nan, -inf))) call abort
120 
  if (isinf(max(-large, nan, -inf))) call abort
121 
  if (.not. isinf(min(-large, -inf, nan))) call abort
122 
  if (isinf(max(-large, -inf, nan))) call abort
123 
 
124 
end program test
125 
 
126 
! { dg-final { cleanup-modules "aux2" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.