Skip to content

Commit 7310fc5

Browse files
bobzhangbobzhang
committed
Class test continue and bug fix #251 (#252)
* more class tests * more class tests * more class tests and bug fix for #251
1 parent fab6a84 commit 7310fc5

13 files changed

+1280
-4
lines changed

‎jscomp/index.html

+1-1
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@
1010
<!-- <script src="./async.js"></script> -->
1111
<script src="./require1k.js"></script>
1212
<script>
13-
R('./test/class_test', function(err,v){
13+
R('./test/class7_test', function(err,v){
1414
window.v = v
1515
})
1616
</script>

‎jscomp/runtime/caml_builtin_exceptions.js

+1-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@
55
var id = [0];
66

77
function caml_set_oo_id(b) {
8-
b[2] = id[0];
8+
b[1] = id[0];
99
id[0] += 1;
1010
return b;
1111
}

‎jscomp/runtime/caml_builtin_exceptions.ml

+11-2
Original file line numberDiff line numberDiff line change
@@ -42,9 +42,18 @@ let undefined_recursive_module = 248, "Undefined_recursive_module", -11
4242
let id = ref 0n
4343

4444

45+
(* see #251
46+
{[
47+
CAMLprim value caml_set_oo_id (value obj) {
48+
Field(obj, 1) = oo_last_id;
49+
oo_last_id += 2;
50+
return obj;
51+
}
52+
53+
]}*)
4554
let caml_set_oo_id (b : exception_block) =
46-
Obj.set_field (Obj.repr b) 2 (Obj.repr !id);
47-
id := Nativeint.add !id 1n;
55+
Obj.set_field (Obj.repr b) 1 (Obj.repr !id);
56+
id := Nativeint.add !id 1n;
4857
b
4958

5059
let get_id () =

‎jscomp/test/.depend

+16
Original file line numberDiff line numberDiff line change
@@ -66,6 +66,14 @@ class3_test.cmo : mt.cmi ../stdlib/list.cmi ../lib/js.cmo \
6666
../stdlib/array.cmi
6767
class3_test.cmx : mt.cmx ../stdlib/list.cmx ../lib/js.cmx \
6868
../stdlib/array.cmx
69+
class4_test.cmo : mt.cmi
70+
class4_test.cmx : mt.cmx
71+
class5_test.cmo : mt.cmi ../stdlib/list.cmi
72+
class5_test.cmx : mt.cmx ../stdlib/list.cmx
73+
class6_test.cmo : mt.cmi
74+
class6_test.cmx : mt.cmx
75+
class7_test.cmo : ../stdlib/oo.cmi mt.cmi
76+
class7_test.cmx : ../stdlib/oo.cmx mt.cmx
6977
class_test.cmo : mt.cmi
7078
class_test.cmx : mt.cmx
7179
class_type_ffi_test.cmo : ../lib/js.cmo
@@ -586,6 +594,14 @@ class3_test.cmo : mt.cmi ../stdlib/list.cmi ../lib/js.cmo \
586594
../stdlib/array.cmi
587595
class3_test.cmj : mt.cmj ../stdlib/list.cmj ../lib/js.cmj \
588596
../stdlib/array.cmj
597+
class4_test.cmo : mt.cmi
598+
class4_test.cmj : mt.cmj
599+
class5_test.cmo : mt.cmi ../stdlib/list.cmi
600+
class5_test.cmj : mt.cmj ../stdlib/list.cmj
601+
class6_test.cmo : mt.cmi
602+
class6_test.cmj : mt.cmj
603+
class7_test.cmo : ../stdlib/oo.cmi mt.cmi
604+
class7_test.cmj : ../stdlib/oo.cmj mt.cmj
589605
class_test.cmo : mt.cmi
590606
class_test.cmj : mt.cmj
591607
class_type_ffi_test.cmo : ../lib/js.cmo

‎jscomp/test/class4_test.js

+237
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,237 @@
1+
// Generated CODE, PLEASE EDIT WITH CARE
2+
'use strict';
3+
4+
var Caml_obj = require("../runtime/caml_obj");
5+
var Mt = require("./mt");
6+
var CamlinternalOO = require("../stdlib/camlinternalOO");
7+
var Caml_curry = require("../runtime/caml_curry");
8+
9+
var shared = [
10+
"move",
11+
"get_x"
12+
];
13+
14+
var shared$1 = ["x"];
15+
16+
var shared$2 = [
17+
"bump",
18+
"get_x"
19+
];
20+
21+
var suites = [/* [] */0];
22+
23+
var test_id = [0];
24+
25+
function eq(loc, x, y) {
26+
test_id[0] = test_id[0] + 1 | 0;
27+
suites[0] = /* :: */[
28+
/* tuple */[
29+
loc + (" id " + test_id[0]),
30+
function () {
31+
return /* Eq */{
32+
0: x,
33+
1: y,
34+
length: 2,
35+
tag: 0
36+
};
37+
}
38+
],
39+
suites[0]
40+
];
41+
return /* () */0;
42+
}
43+
44+
function restricted_point_init($$class) {
45+
var ids = CamlinternalOO.new_methods_variables($$class, [
46+
"move",
47+
"get_x",
48+
"bump"
49+
], shared$1);
50+
var move = ids[0];
51+
var get_x = ids[1];
52+
var bump = ids[2];
53+
var x = ids[3];
54+
CamlinternalOO.set_methods($$class, /* array */[
55+
get_x,
56+
function (self$neg1) {
57+
return self$neg1[x];
58+
},
59+
move,
60+
function (self$neg1, d) {
61+
self$neg1[x] = self$neg1[x] + d | 0;
62+
return /* () */0;
63+
},
64+
bump,
65+
function (self$neg1) {
66+
return Caml_curry.app2(self$neg1[0][move], self$neg1, 1);
67+
}
68+
]);
69+
return function (_, self, x_init) {
70+
var self$1 = CamlinternalOO.create_object_opt(self, $$class);
71+
self$1[x] = x_init;
72+
return self$1;
73+
};
74+
}
75+
76+
var restricted_point = CamlinternalOO.make_class(shared$2, restricted_point_init);
77+
78+
function restricted_point$prime_init($$class) {
79+
var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, restricted_point, 1);
80+
var obj_init = inh[0];
81+
return function (_, self, x) {
82+
return Caml_curry.app2(obj_init, self, x);
83+
};
84+
}
85+
86+
var restricted_point$prime = CamlinternalOO.make_class(shared$2, restricted_point$prime_init);
87+
88+
function restricted_point2$prime_init($$class) {
89+
var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, restricted_point, 1);
90+
var obj_init = inh[0];
91+
return function (_, self, x) {
92+
return Caml_curry.app2(obj_init, self, x);
93+
};
94+
}
95+
96+
var restricted_point2$prime = CamlinternalOO.make_class(shared$2, restricted_point2$prime_init);
97+
98+
var restricted_point$prime$1 = restricted_point;
99+
100+
var Point = /* module */[restricted_point$prime$1];
101+
102+
var abstract_point = {
103+
104+
};
105+
106+
Caml_obj.caml_update_dummy(abstract_point, [
107+
0,
108+
function ($$class) {
109+
var x_init = CamlinternalOO.new_variable($$class, "");
110+
var ids = CamlinternalOO.get_method_labels($$class, [
111+
"move",
112+
"get_x",
113+
"get_offset"
114+
]);
115+
var get_x = ids[1];
116+
var get_offset = ids[2];
117+
CamlinternalOO.set_method($$class, get_offset, function (self$neg5) {
118+
return Caml_curry.app1(self$neg5[0][get_x], self$neg5) - self$neg5[x_init] | 0;
119+
});
120+
return function (_, self, x_init$1) {
121+
var self$1 = CamlinternalOO.create_object_opt(self, $$class);
122+
self$1[x_init] = x_init$1;
123+
return self$1;
124+
};
125+
},
126+
0,
127+
0
128+
]);
129+
130+
function point_init($$class) {
131+
var ids = CamlinternalOO.new_methods_variables($$class, shared, shared$1);
132+
var move = ids[0];
133+
var get_x = ids[1];
134+
var x = ids[2];
135+
var inh = CamlinternalOO.inherits($$class, 0, shared, ["get_offset"], abstract_point, 1);
136+
var obj_init = inh[0];
137+
CamlinternalOO.set_methods($$class, /* array */[
138+
get_x,
139+
function (self$neg6) {
140+
return self$neg6[x];
141+
},
142+
move,
143+
function (self$neg6, d) {
144+
self$neg6[x] = self$neg6[x] + d | 0;
145+
return /* () */0;
146+
}
147+
]);
148+
return function (_, self, x_init) {
149+
var self$1 = CamlinternalOO.create_object_opt(self, $$class);
150+
Caml_curry.app2(obj_init, self$1, x_init);
151+
self$1[x] = x_init;
152+
return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
153+
};
154+
}
155+
156+
var point = CamlinternalOO.make_class([
157+
"move",
158+
"get_offset",
159+
"get_x"
160+
], point_init);
161+
162+
function colored_point_init($$class) {
163+
var ids = CamlinternalOO.new_methods_variables($$class, ["color"], ["c"]);
164+
var color = ids[0];
165+
var c = ids[1];
166+
var inh = CamlinternalOO.inherits($$class, shared$1, 0, [
167+
"get_offset",
168+
"get_x",
169+
"move"
170+
], point, 1);
171+
var obj_init = inh[0];
172+
CamlinternalOO.set_method($$class, color, function (self$neg7) {
173+
return self$neg7[c];
174+
});
175+
return function (_, self, x, c$1) {
176+
var self$1 = CamlinternalOO.create_object_opt(self, $$class);
177+
Caml_curry.app2(obj_init, self$1, x);
178+
self$1[c] = c$1;
179+
return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
180+
};
181+
}
182+
183+
var colored_point = CamlinternalOO.make_class([
184+
"move",
185+
"color",
186+
"get_offset",
187+
"get_x"
188+
], colored_point_init);
189+
190+
var p$prime = Caml_curry.app3(colored_point[0], 0, 5, "red");
191+
192+
eq('File "class4_test.ml", line 67, characters 5-12', /* tuple */[
193+
5,
194+
"red"
195+
], /* tuple */[
196+
p$prime.tag === 248 ? Caml_curry.js1(291546447, 1, p$prime) : p$prime.get_x,
197+
p$prime.tag === 248 ? Caml_curry.js1(-899911325, 2, p$prime) : p$prime.color
198+
]);
199+
200+
function get_succ_x(p) {
201+
return (
202+
p.tag === 248 ? Caml_curry.js1(291546447, 3, p) : p.get_x
203+
) + 1 | 0;
204+
}
205+
206+
eq('File "class4_test.ml", line 71, characters 12-19', 6, get_succ_x(p$prime));
207+
208+
function set_x(p) {
209+
if (p.tag === 248) {
210+
return Caml_curry.js1(-97543333, 4, p);
211+
}
212+
else {
213+
return p.set_x;
214+
}
215+
}
216+
217+
function incr(p) {
218+
return Caml_curry.app1(set_x(p), get_succ_x(p));
219+
}
220+
221+
Mt.from_pair_suites("class4_test.ml", suites[0]);
222+
223+
exports.suites = suites;
224+
exports.test_id = test_id;
225+
exports.eq = eq;
226+
exports.restricted_point = restricted_point;
227+
exports.restricted_point$prime = restricted_point$prime;
228+
exports.restricted_point2$prime = restricted_point2$prime;
229+
exports.Point = Point;
230+
exports.abstract_point = abstract_point;
231+
exports.point = point;
232+
exports.colored_point = colored_point;
233+
exports.p$prime = p$prime;
234+
exports.get_succ_x = get_succ_x;
235+
exports.set_x = set_x;
236+
exports.incr = incr;
237+
/* restricted_point Not a pure module */

‎jscomp/test/class4_test.ml

+78
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
let suites : Mt.pair_suites ref = ref []
2+
let test_id = ref 0
3+
let eq loc x y =
4+
incr test_id ;
5+
suites :=
6+
(loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
7+
8+
9+
class restricted_point x_init =
10+
object (self)
11+
val mutable x = x_init
12+
method get_x = x
13+
method private move d = x <- x + d
14+
method bump = self#move 1
15+
end;;
16+
17+
18+
class type restricted_point_type =
19+
object
20+
method get_x : int
21+
method bump : unit
22+
end;;
23+
24+
class restricted_point' x = (restricted_point x : restricted_point_type);;
25+
26+
class restricted_point2' x = (restricted_point x : restricted_point_type);;
27+
28+
module type POINT = sig
29+
class restricted_point' : int ->
30+
object
31+
method get_x : int
32+
method bump : unit
33+
end
34+
end;;
35+
36+
module Point : POINT = struct
37+
class restricted_point' = restricted_point
38+
end;;
39+
40+
41+
class virtual abstract_point x_init =
42+
object (self)
43+
method virtual get_x : int
44+
method get_offset = self#get_x - x_init
45+
method virtual move : int -> unit
46+
end;;
47+
48+
class point x_init =
49+
object
50+
inherit abstract_point x_init
51+
val mutable x = x_init
52+
method get_x = x
53+
method move d = x <- x + d
54+
end;;
55+
56+
57+
class colored_point x (c : string) =
58+
object
59+
inherit point x
60+
val c = c
61+
method color = c
62+
end;;
63+
64+
let p' = new colored_point 5 "red";;
65+
66+
let () =
67+
eq __LOC__ (5, "red") (p'#get_x, p'#color);;
68+
69+
let get_succ_x p = p#get_x + 1;;
70+
71+
let () = eq __LOC__ 6 (get_succ_x p');;
72+
73+
let set_x p = p#set_x;;
74+
75+
let incr p = set_x p (get_succ_x p)
76+
77+
78+
let () = Mt.from_pair_suites __FILE__ !suites

0 commit comments

Comments
 (0)