1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
(* TEST *)
let test n check res =
print_string "Test "; print_int n;
if check res then print_string " passed.\n" else print_string " FAILED.\n";
flush stderr
let eq0 = function 0 -> true | _ -> false
let eqm1 = function -1 -> true | _ -> false
let eq1 = function 1 -> true | _ -> false
let eqtrue (b:bool) = b
let eqftffff =
function (false,true,false,false,false,false) -> true | _ -> false
let eqfun delayed_check =
match delayed_check () with
| exception Invalid_argument _ -> true
| _ -> false
let x = [1;2;3]
let f x = 1 :: 2 :: 3 :: x
let mklist len =
let l = ref [] in
for i = 1 to len do l := i :: !l done;
!l
type tree = Dummy | Leaf | Node of tree * tree
let rec mktree depth =
if depth <= 0 then Leaf else Node(mktree(depth - 1), mktree(depth - 1))
type 'a leftlist = Nil | Cons of 'a leftlist * 'a
let mkleftlist len =
let l = ref Nil in
for i = 1 to len do l := Cons(!l, i) done;
!l
(* use an existential to check equality with different tags *)
type any = Any : 'a -> any
let _ =
test 1 eq0 (compare 0 0);
test 2 eqm1 (compare 0 1);
test 3 eq1 (compare 1 0);
test 4 eq0 (compare max_int max_int);
test 5 eqm1 (compare min_int max_int);
test 6 eq1 (compare max_int min_int);
test 7 eq0 (compare "foo" "foo");
test 8 eqm1 (compare "foo" "zorglub");
test 9 eqm1 (compare "abcdef" "foo");
test 10 eqm1 (compare "abcdefghij" "abcdefghijkl");
test 11 eq1 (compare "abcdefghij" "abcdefghi");
test 12 eq0 (compare (0,1) (0,1));
test 13 eqm1 (compare (0,1) (0,2));
test 14 eqm1 (compare (0,1) (1,0));
test 15 eq1 (compare (0,1) (0,0));
test 16 eq1 (compare (1,0) (0,1));
test 17 eq0 (compare 0.0 0.0);
test 18 eqm1 (compare 0.0 1.0);
test 19 eqm1 (compare (-1.0) 0.0);
test 20 eq0 (compare [| 0.0; 1.0; 2.0 |] [| 0.0; 1.0; 2.0 |]);
test 21 eqm1 (compare [| 0.0; 1.0; 2.0 |] [| 0.0; 1.0; 3.0 |]);
test 22 eq1 (compare [| 0.0; 5.0; 2.0 |] [| 0.0; 1.0; 2.0 |]);
test 23 eq0 (compare [1;2;3;4] [1;2;3;4]);
test 24 eqm1 (compare [1;2;3;4] [1;2;5;6]);
test 25 eqm1 (compare [1;2;3;4] [1;2;3;4;5]);
test 26 eq1 (compare [1;2;3;4] [1;2;3]);
test 27 eq1 (compare [1;2;3;4] [1;2;0;4]);
test 28 eq0 (compare (mklist 1000) (mklist 1000));
test 29 eq0 (compare (mkleftlist 1000) (mkleftlist 1000));
test 30 eq0 (compare (mktree 12) (mktree 12));
test 31 eqtrue (x = f []);
test 32 eqtrue (stdout <> stderr);
test 33 eqm1 (compare nan 0.0);
test 34 eqm1 (compare nan neg_infinity);
test 35 eq0 (compare nan nan);
test 36 eqm1 (compare (0.0, nan) (0.0, 0.0));
test 37 eqm1 (compare (0.0, nan) (0.0, neg_infinity));
test 38 eq0 (compare (nan, 0.0) (nan, 0.0));
let cmpgen x y = (x=y, x<>y, x<y, x<=y, x>y, x>=y) in
let cmpfloat (x:float) (y:float) = (x=y, x<>y, x<y, x<=y, x>y, x>=y) in
test 39 eqftffff (cmpgen nan nan);
test 40 eqftffff (cmpgen nan 0.0);
test 41 eqftffff (cmpfloat nan nan);
test 42 eqftffff (cmpfloat nan 0.0);
test 43 eqtrue ([||] = [||]);
(* Convoluted forms to test both the "positive" and "negative" cases
of float tests *)
let cmpfloatpos (x:float) (y:float) =
((let r = ref false in (if x = y then r := true); !r),
(let r = ref false in (if x <> y then r := true); !r),
(let r = ref false in (if x < y then r := true); !r),
(let r = ref false in (if x <= y then r := true); !r),
(let r = ref false in (if x > y then r := true); !r),
(let r = ref false in (if x >= y then r := true); !r))
and cmpfloatneg (x:float) (y:float) =
((let r = ref true in (if not (x = y) then r := false); !r),
(let r = ref true in (if not (x <> y) then r := false); !r),
(let r = ref true in (if not (x < y) then r := false); !r),
(let r = ref true in (if not (x <= y) then r := false); !r),
(let r = ref true in (if not (x > y) then r := false); !r),
(let r = ref true in (if not (x >= y) then r := false); !r)) in
let testcmpfloat x y =
cmpfloatpos x y = cmpgen x y &&
cmpfloatneg x y = cmpgen x y in
test 50 eqtrue (testcmpfloat nan nan);
test 51 eqtrue (testcmpfloat nan 0.0);
test 52 eqtrue (testcmpfloat 0.0 nan);
test 53 eqtrue (testcmpfloat 0.0 0.0);
test 54 eqtrue (testcmpfloat 1.0 0.0);
test 55 eqtrue (testcmpfloat 0.0 1.0);
test 56 eqfun (fun () -> compare (fun x -> x) (fun x -> x));
test 57 eqfun (fun () ->
(* #9521 *)
let rec f x = g x and g x = f x in compare f g);
(* this is the current behavior of comparison
with values of incoherent types (packed below
an existential), but it may not be the only specification. *)
test 58 eqm1
(compare (Any 0) (Any 2));
begin
(* comparing two function fails *)
test 59 eqfun (fun () ->
compare (Any (fun x -> x)) (Any (fun x -> x + 1)));
(* comparing a function and a non-function succeeds *)
test 60 (Fun.negate eq0)
(compare (Any (fun x -> x)) (Any 0));
test 61 (Fun.negate eq0)
(compare (Any 0) (Any (fun x -> x)));
end;
()
|
