Skip to content

Commit 88700ea

Browse files
authored
Merge pull request #3151 from BuckleScript/fix_3146
address #3146
2 parents 0520249 + 2c03a5c commit 88700ea

File tree

11 files changed

+1197
-1130
lines changed

11 files changed

+1197
-1130
lines changed

jscomp/syntax/ast_derive_js_mapper.ml

Lines changed: 22 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ let js_field (o : Parsetree.expression) m =
3333
(Exp.ident m)
3434

3535

36-
36+
3737

3838
let handle_config (config : Parsetree.expression option) =
3939
match config with
@@ -152,7 +152,7 @@ let assertExp e =
152152
let derivingName = "jsConverter"
153153

154154
(* let notApplicable loc =
155-
Location.prerr_warning
155+
Location.prerr_warning
156156
loc
157157
(Warnings.Bs_derive_warning ( derivingName ^ " not applicable to this type")) *)
158158

@@ -194,8 +194,7 @@ let init () =
194194
let coerceResultToNewType e =
195195
if createType then
196196
e +> newType
197-
else e
198-
in
197+
else e in
199198
match tdcl.ptype_kind with
200199
| Ptype_record label_declarations ->
201200
let exp =
@@ -254,7 +253,7 @@ let init () =
254253
| Some name ->
255254
name
256255
| None ->
257-
Ast_compatible.const_exp_string(Ast_compatible.label_of_name label)
256+
Ast_compatible.const_exp_string(Ast_compatible.label_of_name label)
258257
)
259258
| _ -> assert false (* checked by [is_enum_polyvar] *)
260259
) in
@@ -270,7 +269,7 @@ let init () =
270269
Exp.tuple
271270
[
272271
Ast_compatible.const_exp_int i;
273-
str
272+
str
274273
]
275274
) ));
276275
(
@@ -390,11 +389,11 @@ let init () =
390389
+>
391390
core_type
392391
else
393-
(Exp.ifthenelse
394-
( (exp_param <=~ range_upper) &&~ (range_low <=~ exp_param))
395-
(Exp.construct {loc; txt = Lident "Some"}
396-
( Some (exp_param -~ Ast_compatible.const_exp_int offset)))
397-
(Some (Exp.construct {loc; txt = Lident "None"} None)))
392+
Exp.ifthenelse
393+
( (exp_param <=~ range_upper) &&~ (range_low <=~ exp_param))
394+
(Exp.construct {loc; txt = Ast_literal.predef_some}
395+
( Some (exp_param -~ Ast_compatible.const_exp_int offset)))
396+
(Some (Exp.construct {loc; txt = Ast_literal.predef_none} None))
398397
+>
399398
Ast_core_type.lift_option_type core_type
400399
)
@@ -404,13 +403,13 @@ let init () =
404403
else
405404
begin
406405
U.notApplicable
407-
tdcl.Parsetree.ptype_loc
408-
derivingName;
406+
tdcl.Parsetree.ptype_loc
407+
derivingName;
409408
[]
410409
end
411410
| Ptype_open ->
412411
U.notApplicable tdcl.Parsetree.ptype_loc
413-
derivingName;
412+
derivingName;
414413
[] in
415414
Ext_list.flat_map tdcls handle_tdcl
416415
);
@@ -467,19 +466,18 @@ let init () =
467466

468467
| None ->
469468
U.notApplicable tdcl.Parsetree.ptype_loc
470-
derivingName;
469+
derivingName;
471470
[])
472471

473472
| Ptype_variant ctors
474473
->
475-
476474
if Ast_polyvar.is_enum_constructors ctors then
477475
let ty1 =
478476
if createType then newType
479477
else Ast_literal.type_int() in
480478
let ty2 =
481479
if createType then core_type
482-
else Ast_core_type.lift_option_type core_type (*-FIXME**) in
480+
else Ast_core_type.lift_option_type core_type in
483481
newTypeStr +?
484482
[
485483
toJsType ty1;
@@ -489,19 +487,19 @@ let init () =
489487
]
490488

491489
else
492-
begin
493-
U.notApplicable tdcl.Parsetree.ptype_loc
494-
derivingName;
495-
[]
496-
end
490+
begin
491+
U.notApplicable tdcl.Parsetree.ptype_loc
492+
derivingName;
493+
[]
494+
end
497495
| Ptype_open ->
498496
U.notApplicable tdcl.Parsetree.ptype_loc
499-
derivingName;
497+
derivingName;
500498
[] in
501499
Ext_list.flat_map tdcls handle_tdcl
502500

503501
);
504502
expression_gen = None
505503
}
506504
)
507-
;
505+
;

jscomp/test/.depend

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -554,7 +554,7 @@ test_incr_ref.cmj :
554554
test_index.cmj : ../runtime/js.cmj
555555
test_int_map_find.cmj :
556556
test_internalOO.cmj :
557-
test_is_js.cmj : test_is_js.cmi
557+
test_is_js.cmj : mt.cmj test_is_js.cmi
558558
test_js_ffi.cmj :
559559
test_let.cmj :
560560
test_list.cmj :

jscomp/test/gpr_3142_test.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ let v,u = tToJs, tFromJs
1515

1616

1717
(* not applicable to thiis type, and unused warning*)
18-
#if false then
18+
#if 0 then
1919
type t0 =
2020
[ `a of int [@bs.as "hi"] ]
2121
[@@bs.deriving jsConverter]

jscomp/test/test_is_js.js

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1 +1,21 @@
1-
/* This output is empty. Its source's type definitions, externals and/or unused code got optimized away. */
1+
'use strict';
2+
3+
var Mt = require("./mt.js");
4+
5+
var suites = /* record */[/* contents : [] */0];
6+
7+
var test_id = /* record */[/* contents */0];
8+
9+
function b(loc, x) {
10+
return Mt.bool_suites(test_id, suites, loc, x);
11+
}
12+
13+
b("File \"test_is_js.ml\", line 15, characters 2-9", true);
14+
15+
b("File \"test_is_js.ml\", line 23, characters 2-9", true);
16+
17+
b("File \"test_is_js.ml\", line 37, characters 2-9", true);
18+
19+
Mt.from_pair_suites("test_is_js.ml", suites[0]);
20+
21+
/* Not a pure module */

jscomp/test/test_is_js.ml

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,3 +4,38 @@ let v =
44
#else
55
false
66
#end
7+
8+
let suites : Mt.pair_suites ref = ref []
9+
let test_id = ref 0
10+
let eq loc x y = Mt.eq_suites ~test_id ~suites loc x y
11+
let b loc x = Mt.bool_suites ~test_id ~suites loc x;;
12+
13+
14+
#if 1 then
15+
b __LOC__ true;;
16+
#end
17+
18+
#if 0 then
19+
b __LOC__ false ;;
20+
#end
21+
22+
#if 1 > 0 then
23+
b __LOC__ true;;
24+
#end
25+
26+
27+
#if 1 < 0 then
28+
b __LOC__ false;;
29+
#end
30+
31+
#if 0 > 1 then
32+
b __LOC__ false;;
33+
#end
34+
35+
36+
#if 0 < 1 then
37+
b __LOC__ true;;
38+
#end
39+
40+
41+
let () = Mt.from_pair_suites __FILE__ !suites

0 commit comments

Comments
 (0)