OSDN Git Service

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