Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/nan_2.f90 @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! { dg-do run }
kono
parents:
diff changeset
2 ! { dg-options "-fno-range-check -pedantic" }
kono
parents:
diff changeset
3 ! { dg-add-options ieee }
kono
parents:
diff changeset
4 !
kono
parents:
diff changeset
5 ! PR fortran/34333
kono
parents:
diff changeset
6 !
kono
parents:
diff changeset
7 ! Check that (NaN /= NaN) == .TRUE.
kono
parents:
diff changeset
8 ! and some other NaN options.
kono
parents:
diff changeset
9 !
kono
parents:
diff changeset
10 ! Contrary to nan_1.f90, PARAMETERs are used and thus
kono
parents:
diff changeset
11 ! the front end resolves the min, max and binary operators at
kono
parents:
diff changeset
12 ! compile time.
kono
parents:
diff changeset
13 !
kono
parents:
diff changeset
14
kono
parents:
diff changeset
15 module aux2
kono
parents:
diff changeset
16 interface isinf
kono
parents:
diff changeset
17 module procedure isinf_r
kono
parents:
diff changeset
18 module procedure isinf_d
kono
parents:
diff changeset
19 end interface isinf
kono
parents:
diff changeset
20 contains
kono
parents:
diff changeset
21 pure function isinf_r(x) result (isinf)
kono
parents:
diff changeset
22 logical :: isinf
kono
parents:
diff changeset
23 real, intent(in) :: x
kono
parents:
diff changeset
24
kono
parents:
diff changeset
25 isinf = (x > huge(x)) .or. (x < -huge(x))
kono
parents:
diff changeset
26 end function isinf_r
kono
parents:
diff changeset
27
kono
parents:
diff changeset
28 pure function isinf_d(x) result (isinf)
kono
parents:
diff changeset
29 logical :: isinf
kono
parents:
diff changeset
30 double precision, intent(in) :: x
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 isinf = (x > huge(x)) .or. (x < -huge(x))
kono
parents:
diff changeset
33 end function isinf_d
kono
parents:
diff changeset
34 end module aux2
kono
parents:
diff changeset
35
kono
parents:
diff changeset
36 program test
kono
parents:
diff changeset
37 use aux2
kono
parents:
diff changeset
38 implicit none
kono
parents:
diff changeset
39 real, parameter :: nan = 0.0/0.0, large = huge(large), inf = 1.0/0.0
kono
parents:
diff changeset
40
kono
parents:
diff changeset
41 if (nan == nan .or. nan > nan .or. nan < nan .or. nan >= nan &
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
42 .or. nan <= nan) STOP 1
111
kono
parents:
diff changeset
43 if (isnan (2.d0) .or. (.not. isnan(nan)) .or. &
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
44 (.not. isnan(real(nan,kind=kind(2.d0))))) STOP 2
111
kono
parents:
diff changeset
45
kono
parents:
diff changeset
46 ! Create an INF and check it
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
47 if (isinf(nan) .or. isinf(large) .or. .not. isinf(inf)) STOP 3
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
48 if (isinf(-nan) .or. isinf(-large) .or. .not. isinf(-inf)) STOP 4
111
kono
parents:
diff changeset
49
kono
parents:
diff changeset
50 ! Check that MIN and MAX behave correctly
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
51 if (max(2.0, nan) /= 2.0) STOP 5
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
52 if (min(2.0, nan) /= 2.0) STOP 6
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
53 if (max(nan, 2.0) /= 2.0) STOP 7
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
54 if (min(nan, 2.0) /= 2.0) STOP 8
111
kono
parents:
diff changeset
55
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
56 if (max(2.d0, nan) /= 2.d0) STOP 9! { dg-warning "Extension: Different type kinds" }
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
57 if (min(2.d0, nan) /= 2.d0) STOP 10! { dg-warning "Extension: Different type kinds" }
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
58 if (max(nan, 2.d0) /= 2.d0) STOP 11! { dg-warning "Extension: Different type kinds" }
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
59 if (min(nan, 2.d0) /= 2.d0) STOP 12! { dg-warning "Extension: Different type kinds" }
111
kono
parents:
diff changeset
60
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
61 if (.not. isnan(min(nan,nan))) STOP 13
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
62 if (.not. isnan(max(nan,nan))) STOP 14
111
kono
parents:
diff changeset
63
kono
parents:
diff changeset
64 ! Same thing, with more arguments
kono
parents:
diff changeset
65
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
66 if (max(3.0, 2.0, nan) /= 3.0) STOP 15
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
67 if (min(3.0, 2.0, nan) /= 2.0) STOP 16
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
68 if (max(3.0, nan, 2.0) /= 3.0) STOP 17
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
69 if (min(3.0, nan, 2.0) /= 2.0) STOP 18
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
70 if (max(nan, 3.0, 2.0) /= 3.0) STOP 19
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
71 if (min(nan, 3.0, 2.0) /= 2.0) STOP 20
111
kono
parents:
diff changeset
72
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
73 if (max(3.d0, 2.d0, nan) /= 3.d0) STOP 21! { dg-warning "Extension: Different type kinds" }
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
74 if (min(3.d0, 2.d0, nan) /= 2.d0) STOP 22! { dg-warning "Extension: Different type kinds" }
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
75 if (max(3.d0, nan, 2.d0) /= 3.d0) STOP 23! { dg-warning "Extension: Different type kinds" }
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
76 if (min(3.d0, nan, 2.d0) /= 2.d0) STOP 24! { dg-warning "Extension: Different type kinds" }
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
77 if (max(nan, 3.d0, 2.d0) /= 3.d0) STOP 25! { dg-warning "Extension: Different type kinds" }
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
78 if (min(nan, 3.d0, 2.d0) /= 2.d0) STOP 26! { dg-warning "Extension: Different type kinds" }
111
kono
parents:
diff changeset
79
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
80 if (.not. isnan(min(nan,nan,nan))) STOP 27
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
81 if (.not. isnan(max(nan,nan,nan))) STOP 28
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
82 if (.not. isnan(min(nan,nan,nan,nan))) STOP 29
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
83 if (.not. isnan(max(nan,nan,nan,nan))) STOP 30
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
84 if (.not. isnan(min(nan,nan,nan,nan,nan))) STOP 31
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
85 if (.not. isnan(max(nan,nan,nan,nan,nan))) STOP 32
111
kono
parents:
diff changeset
86
kono
parents:
diff changeset
87 ! Large values, INF and NaNs
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
88 if (.not. isinf(max(large, inf))) STOP 33
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
89 if (isinf(min(large, inf))) STOP 34
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
90 if (.not. isinf(max(nan, large, inf))) STOP 35
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
91 if (isinf(min(nan, large, inf))) STOP 36
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
92 if (.not. isinf(max(large, nan, inf))) STOP 37
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
93 if (isinf(min(large, nan, inf))) STOP 38
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
94 if (.not. isinf(max(large, inf, nan))) STOP 39
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
95 if (isinf(min(large, inf, nan))) STOP 40
111
kono
parents:
diff changeset
96
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
97 if (.not. isinf(min(-large, -inf))) STOP 41
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
98 if (isinf(max(-large, -inf))) STOP 42
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
99 if (.not. isinf(min(nan, -large, -inf))) STOP 43
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
100 if (isinf(max(nan, -large, -inf))) STOP 44
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
101 if (.not. isinf(min(-large, nan, -inf))) STOP 45
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
102 if (isinf(max(-large, nan, -inf))) STOP 46
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
103 if (.not. isinf(min(-large, -inf, nan))) STOP 47
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
104 if (isinf(max(-large, -inf, nan))) STOP 48
111
kono
parents:
diff changeset
105
kono
parents:
diff changeset
106 end program test