Skip to content

Commit 2822554

Browse files
bobzhangbobzhang
committed
fix #1195 
1 parent fdb3bed commit 2822554

File tree

4 files changed

+385
-164
lines changed

4 files changed

+385
-164
lines changed

‎jscomp/runtime/caml_obj.ml

Lines changed: 66 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@
6565
6666
{[
6767
var u = caml_obj_dup (x)
68-
var new_record = u.slice ()
68+
var new_record = u.slice ()
6969
7070
]}
7171
*)
@@ -99,19 +99,19 @@ let caml_obj_truncate (x : Obj.t) (new_size : int) =
9999
let caml_lazy_make_forward x = lazy x
100100

101101
(**
102-
For the empty dummy object, whether it's
103-
`[]` or `{}` depends on how
104-
runtime encoding works, and will affect
105-
js polymorphic comparison(Js.(=)) (fine with caml polymoprhic comparison (Pervasives.equal))
106-
In most cases, rec value comes from record/modules,
107-
whose tag is 0, we optimize that case
108-
*)
102+
For the empty dummy object, whether it's
103+
`[]` or `{}` depends on how
104+
runtime encoding works, and will affect
105+
js polymorphic comparison(Js.(=)) (fine with caml polymoprhic comparison (Pervasives.equal))
106+
In most cases, rec value comes from record/modules,
107+
whose tag is 0, we optimize that case
108+
*)
109109
let caml_update_dummy x y =
110110
(* let len = Bs_obj.length y in
111-
for i = 0 to len - 1 do
112-
Array.unsafe_set x i (Obj.field y i)
113-
done;
114-
Obj.set_tag (Obj.magic x) (Obj.tag y)
111+
for i = 0 to len - 1 do
112+
Array.unsafe_set x i (Obj.field y i)
113+
done;
114+
Obj.set_tag (Obj.magic x) (Obj.tag y)
115115
*)
116116
let len = Bs_obj.length y in
117117
for i = 0 to len - 1 do
@@ -120,10 +120,10 @@ let caml_update_dummy x y =
120120
let y_tag = Obj.tag y in
121121
if y_tag <> 0 then
122122
Obj.set_tag x y_tag
123-
124-
(* Bs_obj.set_length x (Bs_obj.length y) *)
125-
(* [set_length] seems redundant here given that it is initialized as an array
126-
*)
123+
124+
(* Bs_obj.set_length x (Bs_obj.length y) *)
125+
(* [set_length] seems redundant here given that it is initialized as an array
126+
*)
127127
let caml_int_compare (x : int) (y: int) : int =
128128
if x < y then -1 else if x = y then 0 else 1
129129

@@ -153,45 +153,54 @@ let unsafe_js_compare x y =
153153
*)
154154
let rec caml_compare (a : Obj.t) (b : Obj.t) : int =
155155
(*front and formoest, we do not compare function values*)
156-
if Js.typeof a = "string" then
156+
let a_type = Js.typeof a in
157+
let b_type = Js.typeof b in
158+
if a_type = "string" then
157159
caml_string_compare (Obj.magic a) (Obj.magic b )
158-
else if Js.typeof a = "number" then
159-
caml_int_compare (Obj.magic a) (Obj.magic b )
160-
else if Js.typeof a = "boolean"
161-
|| Js.typeof a = "null"
162-
|| Js.typeof a = "undefined"
163-
then
164-
unsafe_js_compare a b
165-
else if Js.typeof a = "function" || Js.typeof b = "function"
166-
then raise (Invalid_argument "compare: functional value")
167-
else
168-
(* if js_is_instance_array a then *)
169-
(* 0 *)
170-
(* else *)
171-
let tag_a = Bs_obj.tag a in
172-
let tag_b = Bs_obj.tag b in
173-
(* double_array_tag: 254
174-
forward_tag:250
175-
*)
176-
if tag_a = 250 then
177-
caml_compare (Obj.field a 0) b
178-
else if tag_b = 250 then
179-
caml_compare a (Obj.field b 0)
180-
else if tag_a = 248 (* object/exception *) then
181-
caml_int_compare (Obj.magic @@ Obj.field a 1) (Obj.magic @@ Obj.field b 1 )
182-
else if tag_a = 251 (* abstract_tag *) then
183-
raise (Invalid_argument "equal: abstract value")
184-
else if tag_a <> tag_b then
185-
if tag_a < tag_b then (-1) else 1
186-
else
187-
let len_a = Bs_obj.length a in
188-
let len_b = Bs_obj.length b in
189-
if len_a = len_b then
190-
aux_same_length a b 0 len_a
191-
else if len_a < len_b then
192-
aux_length_a_short a b 0 len_a
160+
else
161+
let is_a_number = a_type = "number" in
162+
let is_b_number = b_type = "number" in
163+
match is_a_number , is_b_number with
164+
| true, true ->
165+
caml_int_compare (Obj.magic a) (Obj.magic b )
166+
| true , false -> -1 (* Integer < Block in OCaml runtime GPR #1195 *)
167+
| false, true -> 1
168+
| false, false ->
169+
if a_type = "boolean"
170+
|| a_type = "null"
171+
|| a_type = "undefined"
172+
then
173+
unsafe_js_compare a b
174+
else if a_type = "function" || b_type = "function"
175+
then raise (Invalid_argument "compare: functional value")
193176
else
194-
aux_length_b_short a b 0 len_b
177+
(* if js_is_instance_array a then *)
178+
(* 0 *)
179+
(* else *)
180+
let tag_a = Bs_obj.tag a in
181+
let tag_b = Bs_obj.tag b in
182+
(* double_array_tag: 254
183+
forward_tag:250
184+
*)
185+
if tag_a = 250 then
186+
caml_compare (Obj.field a 0) b
187+
else if tag_b = 250 then
188+
caml_compare a (Obj.field b 0)
189+
else if tag_a = 248 (* object/exception *) then
190+
caml_int_compare (Obj.magic @@ Obj.field a 1) (Obj.magic @@ Obj.field b 1 )
191+
else if tag_a = 251 (* abstract_tag *) then
192+
raise (Invalid_argument "equal: abstract value")
193+
else if tag_a <> tag_b then
194+
if tag_a < tag_b then (-1) else 1
195+
else
196+
let len_a = Bs_obj.length a in
197+
let len_b = Bs_obj.length b in
198+
if len_a = len_b then
199+
aux_same_length a b 0 len_a
200+
else if len_a < len_b then
201+
aux_length_a_short a b 0 len_a
202+
else
203+
aux_length_b_short a b 0 len_b
195204
and aux_same_length (a : Obj.t) (b : Obj.t) i same_length =
196205
if i = same_length then
197206
0
@@ -218,10 +227,10 @@ let rec caml_equal (a : Obj.t) (b : Obj.t) : bool =
218227
(*front and formoest, we do not compare function values*)
219228
if a == b then true
220229
else if Js.typeof a = "string"
221-
|| Js.typeof a = "number"
222-
|| Js.typeof a = "boolean"
223-
|| Js.typeof a = "undefined"
224-
|| Js.typeof a = "null"
230+
|| Js.typeof a = "number"
231+
|| Js.typeof a = "boolean"
232+
|| Js.typeof a = "undefined"
233+
|| Js.typeof a = "null"
225234
then false
226235
else if Js.typeof a = "function" || Js.typeof b = "function"
227236
then raise (Invalid_argument "equal: functional value")

‎jscomp/test/caml_compare_test.js

Lines changed: 176 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -165,7 +165,182 @@ var suites_001 = /* :: */[
165165
]);
166166
}
167167
],
168-
/* [] */0
168+
/* :: */[
169+
/* tuple */[
170+
'File "caml_compare_test.ml", line 17, characters 4-11',
171+
function () {
172+
return /* Eq */Block.__(0, [
173+
/* true */1,
174+
Caml_obj.caml_lessthan(/* None */0, /* Some */[1])
175+
]);
176+
}
177+
],
178+
/* :: */[
179+
/* tuple */[
180+
'File "caml_compare_test.ml", line 28, characters 4-11',
181+
function () {
182+
return /* Eq */Block.__(0, [
183+
/* true */1,
184+
Caml_obj.caml_lessthan(/* None */0, /* Some */[/* int array */[
185+
1,
186+
30
187+
]])
188+
]);
189+
}
190+
],
191+
/* :: */[
192+
/* tuple */[
193+
'File "caml_compare_test.ml", line 31, characters 4-11',
194+
function () {
195+
return /* Eq */Block.__(0, [
196+
/* true */1,
197+
Caml_obj.caml_greaterthan(/* Some */[/* int array */[
198+
1,
199+
30
200+
]], /* None */0)
201+
]);
202+
}
203+
],
204+
/* :: */[
205+
/* tuple */[
206+
'File "caml_compare_test.ml", line 34, characters 4-11',
207+
function () {
208+
return /* Eq */Block.__(0, [
209+
/* true */1,
210+
Caml_obj.caml_lessthan(/* :: */[
211+
2,
212+
/* :: */[
213+
6,
214+
/* :: */[
215+
1,
216+
/* :: */[
217+
1,
218+
/* :: */[
219+
2,
220+
/* :: */[
221+
1,
222+
/* :: */[
223+
4,
224+
/* :: */[
225+
2,
226+
/* :: */[
227+
1,
228+
/* [] */0
229+
]
230+
]
231+
]
232+
]
233+
]
234+
]
235+
]
236+
]
237+
], /* :: */[
238+
2,
239+
/* :: */[
240+
6,
241+
/* :: */[
242+
1,
243+
/* :: */[
244+
1,
245+
/* :: */[
246+
2,
247+
/* :: */[
248+
1,
249+
/* :: */[
250+
4,
251+
/* :: */[
252+
2,
253+
/* :: */[
254+
1,
255+
/* :: */[
256+
409,
257+
/* [] */0
258+
]
259+
]
260+
]
261+
]
262+
]
263+
]
264+
]
265+
]
266+
]
267+
])
268+
]);
269+
}
270+
],
271+
/* :: */[
272+
/* tuple */[
273+
'File "caml_compare_test.ml", line 37, characters 4-11',
274+
function () {
275+
return /* Eq */Block.__(0, [
276+
/* true */1,
277+
Caml_obj.caml_greaterthan(/* :: */[
278+
2,
279+
/* :: */[
280+
6,
281+
/* :: */[
282+
1,
283+
/* :: */[
284+
1,
285+
/* :: */[
286+
2,
287+
/* :: */[
288+
1,
289+
/* :: */[
290+
4,
291+
/* :: */[
292+
2,
293+
/* :: */[
294+
1,
295+
/* :: */[
296+
409,
297+
/* [] */0
298+
]
299+
]
300+
]
301+
]
302+
]
303+
]
304+
]
305+
]
306+
]
307+
], /* :: */[
308+
2,
309+
/* :: */[
310+
6,
311+
/* :: */[
312+
1,
313+
/* :: */[
314+
1,
315+
/* :: */[
316+
2,
317+
/* :: */[
318+
1,
319+
/* :: */[
320+
4,
321+
/* :: */[
322+
2,
323+
/* :: */[
324+
1,
325+
/* [] */0
326+
]
327+
]
328+
]
329+
]
330+
]
331+
]
332+
]
333+
]
334+
])
335+
]);
336+
}
337+
],
338+
/* [] */0
339+
]
340+
]
341+
]
342+
]
343+
]
169344
]
170345
]
171346
]

‎jscomp/test/caml_compare_test.ml

Lines changed: 24 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,30 @@ let suites = Mt.[
1313
"listneq", (fun _ -> Eq(true, [1;2;3] > [1;2;2]));
1414
"custom_u", (fun _ -> Eq(true, ( A 3 , B (2,false) , C 1) > ( A 3, B (2,false) , C 0 )));
1515
"custom_u2", (fun _ -> Eq(true, ( A 3 , B (2,false) , C 1) = ( A 3, B (2,false) , C 1 )));
16-
"function", (fun _ -> Eq(true, function_equal_test))
16+
"function", (fun _ -> Eq(true, function_equal_test));
17+
__LOC__ , begin fun _ ->
18+
Eq(true, None < Some 1)
19+
end;
20+
(*JS WAT
21+
{[
22+
0 < [1]
23+
true
24+
0 < [1,30]
25+
false
26+
]}
27+
*)
28+
__LOC__, begin fun _ ->
29+
Eq(true, None < Some [|1;30|] )
30+
end;
31+
__LOC__, begin fun _ ->
32+
Eq(true, Some [|1;30|] > None )
33+
end;
34+
__LOC__ , begin fun _ ->
35+
Eq(true, [2;6;1;1;2;1;4;2;1] < [2;6;1;1;2;1;4;2;1;409])
36+
end;
37+
__LOC__ , begin fun _ ->
38+
Eq(true, [2;6;1;1;2;1;4;2;1;409] > [2;6;1;1;2;1;4;2;1])
39+
end
1740
]
1841
;;
1942

0 commit comments

Comments
 (0)