OSDN Git Service

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