diff --git a/jscomp/index.html b/jscomp/index.html
index d10e3f4e76..240644392f 100644
--- a/jscomp/index.html
+++ b/jscomp/index.html
@@ -10,7 +10,7 @@
diff --git a/jscomp/runtime/caml_builtin_exceptions.js b/jscomp/runtime/caml_builtin_exceptions.js
index 09eaf58e51..10fe3322b1 100644
--- a/jscomp/runtime/caml_builtin_exceptions.js
+++ b/jscomp/runtime/caml_builtin_exceptions.js
@@ -5,7 +5,7 @@
var id = [0];
function caml_set_oo_id(b) {
- b[2] = id[0];
+ b[1] = id[0];
id[0] += 1;
return b;
}
diff --git a/jscomp/runtime/caml_builtin_exceptions.ml b/jscomp/runtime/caml_builtin_exceptions.ml
index e285bbd2e0..92799b88a9 100644
--- a/jscomp/runtime/caml_builtin_exceptions.ml
+++ b/jscomp/runtime/caml_builtin_exceptions.ml
@@ -42,9 +42,18 @@ let undefined_recursive_module = 248, "Undefined_recursive_module", -11
let id = ref 0n
+(* see #251
+ {[
+ CAMLprim value caml_set_oo_id (value obj) {
+ Field(obj, 1) = oo_last_id;
+ oo_last_id += 2;
+ return obj;
+ }
+
+ ]}*)
let caml_set_oo_id (b : exception_block) =
- Obj.set_field (Obj.repr b) 2 (Obj.repr !id);
- id := Nativeint.add !id 1n;
+ Obj.set_field (Obj.repr b) 1 (Obj.repr !id);
+ id := Nativeint.add !id 1n;
b
let get_id () =
diff --git a/jscomp/test/.depend b/jscomp/test/.depend
index 5d340b5567..bf6c2d36f4 100644
--- a/jscomp/test/.depend
+++ b/jscomp/test/.depend
@@ -66,6 +66,14 @@ class3_test.cmo : mt.cmi ../stdlib/list.cmi ../lib/js.cmo \
../stdlib/array.cmi
class3_test.cmx : mt.cmx ../stdlib/list.cmx ../lib/js.cmx \
../stdlib/array.cmx
+class4_test.cmo : mt.cmi
+class4_test.cmx : mt.cmx
+class5_test.cmo : mt.cmi ../stdlib/list.cmi
+class5_test.cmx : mt.cmx ../stdlib/list.cmx
+class6_test.cmo : mt.cmi
+class6_test.cmx : mt.cmx
+class7_test.cmo : ../stdlib/oo.cmi mt.cmi
+class7_test.cmx : ../stdlib/oo.cmx mt.cmx
class_test.cmo : mt.cmi
class_test.cmx : mt.cmx
class_type_ffi_test.cmo : ../lib/js.cmo
@@ -586,6 +594,14 @@ class3_test.cmo : mt.cmi ../stdlib/list.cmi ../lib/js.cmo \
../stdlib/array.cmi
class3_test.cmj : mt.cmj ../stdlib/list.cmj ../lib/js.cmj \
../stdlib/array.cmj
+class4_test.cmo : mt.cmi
+class4_test.cmj : mt.cmj
+class5_test.cmo : mt.cmi ../stdlib/list.cmi
+class5_test.cmj : mt.cmj ../stdlib/list.cmj
+class6_test.cmo : mt.cmi
+class6_test.cmj : mt.cmj
+class7_test.cmo : ../stdlib/oo.cmi mt.cmi
+class7_test.cmj : ../stdlib/oo.cmj mt.cmj
class_test.cmo : mt.cmi
class_test.cmj : mt.cmj
class_type_ffi_test.cmo : ../lib/js.cmo
diff --git a/jscomp/test/class4_test.js b/jscomp/test/class4_test.js
new file mode 100644
index 0000000000..09adb67442
--- /dev/null
+++ b/jscomp/test/class4_test.js
@@ -0,0 +1,237 @@
+// Generated CODE, PLEASE EDIT WITH CARE
+'use strict';
+
+var Caml_obj = require("../runtime/caml_obj");
+var Mt = require("./mt");
+var CamlinternalOO = require("../stdlib/camlinternalOO");
+var Caml_curry = require("../runtime/caml_curry");
+
+var shared = [
+ "move",
+ "get_x"
+];
+
+var shared$1 = ["x"];
+
+var shared$2 = [
+ "bump",
+ "get_x"
+];
+
+var suites = [/* [] */0];
+
+var test_id = [0];
+
+function eq(loc, x, y) {
+ test_id[0] = test_id[0] + 1 | 0;
+ suites[0] = /* :: */[
+ /* tuple */[
+ loc + (" id " + test_id[0]),
+ function () {
+ return /* Eq */{
+ 0: x,
+ 1: y,
+ length: 2,
+ tag: 0
+ };
+ }
+ ],
+ suites[0]
+ ];
+ return /* () */0;
+}
+
+function restricted_point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, [
+ "move",
+ "get_x",
+ "bump"
+ ], shared$1);
+ var move = ids[0];
+ var get_x = ids[1];
+ var bump = ids[2];
+ var x = ids[3];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get_x,
+ function (self$neg1) {
+ return self$neg1[x];
+ },
+ move,
+ function (self$neg1, d) {
+ self$neg1[x] = self$neg1[x] + d | 0;
+ return /* () */0;
+ },
+ bump,
+ function (self$neg1) {
+ return Caml_curry.app2(self$neg1[0][move], self$neg1, 1);
+ }
+ ]);
+ return function (_, self, x_init) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x] = x_init;
+ return self$1;
+ };
+}
+
+var restricted_point = CamlinternalOO.make_class(shared$2, restricted_point_init);
+
+function restricted_point$prime_init($$class) {
+ var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, restricted_point, 1);
+ var obj_init = inh[0];
+ return function (_, self, x) {
+ return Caml_curry.app2(obj_init, self, x);
+ };
+}
+
+var restricted_point$prime = CamlinternalOO.make_class(shared$2, restricted_point$prime_init);
+
+function restricted_point2$prime_init($$class) {
+ var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, restricted_point, 1);
+ var obj_init = inh[0];
+ return function (_, self, x) {
+ return Caml_curry.app2(obj_init, self, x);
+ };
+}
+
+var restricted_point2$prime = CamlinternalOO.make_class(shared$2, restricted_point2$prime_init);
+
+var restricted_point$prime$1 = restricted_point;
+
+var Point = /* module */[restricted_point$prime$1];
+
+var abstract_point = {
+
+};
+
+Caml_obj.caml_update_dummy(abstract_point, [
+ 0,
+ function ($$class) {
+ var x_init = CamlinternalOO.new_variable($$class, "");
+ var ids = CamlinternalOO.get_method_labels($$class, [
+ "move",
+ "get_x",
+ "get_offset"
+ ]);
+ var get_x = ids[1];
+ var get_offset = ids[2];
+ CamlinternalOO.set_method($$class, get_offset, function (self$neg5) {
+ return Caml_curry.app1(self$neg5[0][get_x], self$neg5) - self$neg5[x_init] | 0;
+ });
+ return function (_, self, x_init$1) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x_init] = x_init$1;
+ return self$1;
+ };
+ },
+ 0,
+ 0
+ ]);
+
+function point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, shared, shared$1);
+ var move = ids[0];
+ var get_x = ids[1];
+ var x = ids[2];
+ var inh = CamlinternalOO.inherits($$class, 0, shared, ["get_offset"], abstract_point, 1);
+ var obj_init = inh[0];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get_x,
+ function (self$neg6) {
+ return self$neg6[x];
+ },
+ move,
+ function (self$neg6, d) {
+ self$neg6[x] = self$neg6[x] + d | 0;
+ return /* () */0;
+ }
+ ]);
+ return function (_, self, x_init) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ Caml_curry.app2(obj_init, self$1, x_init);
+ self$1[x] = x_init;
+ return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
+ };
+}
+
+var point = CamlinternalOO.make_class([
+ "move",
+ "get_offset",
+ "get_x"
+ ], point_init);
+
+function colored_point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, ["color"], ["c"]);
+ var color = ids[0];
+ var c = ids[1];
+ var inh = CamlinternalOO.inherits($$class, shared$1, 0, [
+ "get_offset",
+ "get_x",
+ "move"
+ ], point, 1);
+ var obj_init = inh[0];
+ CamlinternalOO.set_method($$class, color, function (self$neg7) {
+ return self$neg7[c];
+ });
+ return function (_, self, x, c$1) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ Caml_curry.app2(obj_init, self$1, x);
+ self$1[c] = c$1;
+ return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
+ };
+}
+
+var colored_point = CamlinternalOO.make_class([
+ "move",
+ "color",
+ "get_offset",
+ "get_x"
+ ], colored_point_init);
+
+var p$prime = Caml_curry.app3(colored_point[0], 0, 5, "red");
+
+eq('File "class4_test.ml", line 67, characters 5-12', /* tuple */[
+ 5,
+ "red"
+ ], /* tuple */[
+ p$prime.tag === 248 ? Caml_curry.js1(291546447, 1, p$prime) : p$prime.get_x,
+ p$prime.tag === 248 ? Caml_curry.js1(-899911325, 2, p$prime) : p$prime.color
+ ]);
+
+function get_succ_x(p) {
+ return (
+ p.tag === 248 ? Caml_curry.js1(291546447, 3, p) : p.get_x
+ ) + 1 | 0;
+}
+
+eq('File "class4_test.ml", line 71, characters 12-19', 6, get_succ_x(p$prime));
+
+function set_x(p) {
+ if (p.tag === 248) {
+ return Caml_curry.js1(-97543333, 4, p);
+ }
+ else {
+ return p.set_x;
+ }
+}
+
+function incr(p) {
+ return Caml_curry.app1(set_x(p), get_succ_x(p));
+}
+
+Mt.from_pair_suites("class4_test.ml", suites[0]);
+
+exports.suites = suites;
+exports.test_id = test_id;
+exports.eq = eq;
+exports.restricted_point = restricted_point;
+exports.restricted_point$prime = restricted_point$prime;
+exports.restricted_point2$prime = restricted_point2$prime;
+exports.Point = Point;
+exports.abstract_point = abstract_point;
+exports.point = point;
+exports.colored_point = colored_point;
+exports.p$prime = p$prime;
+exports.get_succ_x = get_succ_x;
+exports.set_x = set_x;
+exports.incr = incr;
+/* restricted_point Not a pure module */
diff --git a/jscomp/test/class4_test.ml b/jscomp/test/class4_test.ml
new file mode 100644
index 0000000000..355c08b23c
--- /dev/null
+++ b/jscomp/test/class4_test.ml
@@ -0,0 +1,78 @@
+let suites : Mt.pair_suites ref = ref []
+let test_id = ref 0
+let eq loc x y =
+ incr test_id ;
+ suites :=
+ (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
+
+
+class restricted_point x_init =
+ object (self)
+ val mutable x = x_init
+ method get_x = x
+ method private move d = x <- x + d
+ method bump = self#move 1
+ end;;
+
+
+class type restricted_point_type =
+ object
+ method get_x : int
+ method bump : unit
+ end;;
+
+class restricted_point' x = (restricted_point x : restricted_point_type);;
+
+class restricted_point2' x = (restricted_point x : restricted_point_type);;
+
+module type POINT = sig
+ class restricted_point' : int ->
+ object
+ method get_x : int
+ method bump : unit
+ end
+ end;;
+
+module Point : POINT = struct
+ class restricted_point' = restricted_point
+end;;
+
+
+class virtual abstract_point x_init =
+ object (self)
+ method virtual get_x : int
+ method get_offset = self#get_x - x_init
+ method virtual move : int -> unit
+ end;;
+
+class point x_init =
+ object
+ inherit abstract_point x_init
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ end;;
+
+
+class colored_point x (c : string) =
+ object
+ inherit point x
+ val c = c
+ method color = c
+ end;;
+
+let p' = new colored_point 5 "red";;
+
+let () =
+ eq __LOC__ (5, "red") (p'#get_x, p'#color);;
+
+let get_succ_x p = p#get_x + 1;;
+
+let () = eq __LOC__ 6 (get_succ_x p');;
+
+let set_x p = p#set_x;;
+
+let incr p = set_x p (get_succ_x p)
+
+
+let () = Mt.from_pair_suites __FILE__ !suites
diff --git a/jscomp/test/class5_test.js b/jscomp/test/class5_test.js
new file mode 100644
index 0000000000..53b350bd0d
--- /dev/null
+++ b/jscomp/test/class5_test.js
@@ -0,0 +1,345 @@
+// Generated CODE, PLEASE EDIT WITH CARE
+'use strict';
+
+var Pervasives = require("../stdlib/pervasives");
+var Mt = require("./mt");
+var CamlinternalOO = require("../stdlib/camlinternalOO");
+var Caml_curry = require("../runtime/caml_curry");
+var List = require("../stdlib/list");
+
+var shared = [
+ "move",
+ "get_x"
+];
+
+var shared$1 = ["x"];
+
+var shared$2 = [
+ "fold",
+ "empty"
+];
+
+var suites = [/* [] */0];
+
+var test_id = [0];
+
+function eq(loc, x, y) {
+ test_id[0] = test_id[0] + 1 | 0;
+ suites[0] = /* :: */[
+ /* tuple */[
+ loc + (" id " + test_id[0]),
+ function () {
+ return /* Eq */{
+ 0: x,
+ 1: y,
+ length: 2,
+ tag: 0
+ };
+ }
+ ],
+ suites[0]
+ ];
+ return /* () */0;
+}
+
+function printable_point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, [
+ "print",
+ "move",
+ "get_x"
+ ], shared$1);
+ var print = ids[0];
+ var move = ids[1];
+ var get_x = ids[2];
+ var x = ids[3];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get_x,
+ function (self$neg1) {
+ return self$neg1[x];
+ },
+ move,
+ function (self$neg1, d) {
+ self$neg1[x] = self$neg1[x] + d | 0;
+ return /* () */0;
+ },
+ print,
+ function (self$neg1) {
+ return "" + Caml_curry.app1(self$neg1[0][get_x], self$neg1);
+ }
+ ]);
+ return function (_, self, x_init) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x] = x_init;
+ return self$1;
+ };
+}
+
+var printable_point = CamlinternalOO.make_class([
+ "move",
+ "print",
+ "get_x"
+ ], printable_point_init);
+
+function printable_colored_point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, [
+ "print",
+ "color"
+ ], ["c"]);
+ var print = ids[0];
+ var color = ids[1];
+ var c = ids[2];
+ CamlinternalOO.set_method($$class, color, function (self$neg2) {
+ return self$neg2[c];
+ });
+ var inh = CamlinternalOO.inherits($$class, shared$1, 0, [
+ "get_x",
+ "move",
+ "print"
+ ], printable_point, 1);
+ var obj_init = inh[0];
+ var print$1 = inh[4];
+ CamlinternalOO.set_method($$class, print, function (self$neg2) {
+ return "(" + (Caml_curry.app1(print$1, self$neg2) + (", " + (Caml_curry.app1(self$neg2[0][color], self$neg2) + ")")));
+ });
+ return function (_, self, y, c$1) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[c] = c$1;
+ Caml_curry.app2(obj_init, self$1, y);
+ return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
+ };
+}
+
+var printable_colored_point = CamlinternalOO.make_class([
+ "move",
+ "print",
+ "color",
+ "get_x"
+ ], printable_colored_point_init);
+
+var p = Caml_curry.app3(printable_colored_point[0], 0, 17, "red");
+
+eq('File "class5_test.ml", line 32, characters 12-19', p.tag === 248 ? Caml_curry.js1(-930392019, 1, p) : p.print, "(17, red)");
+
+function ref_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, [
+ "set",
+ "get"
+ ], shared$1);
+ var set = ids[0];
+ var get = ids[1];
+ var x = ids[2];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get,
+ function (self$neg3) {
+ return self$neg3[x];
+ },
+ set,
+ function (self$neg3, y) {
+ self$neg3[x] = y;
+ return /* () */0;
+ }
+ ]);
+ return function (_, self, x_init) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x] = x_init;
+ return self$1;
+ };
+}
+
+var ref = CamlinternalOO.make_class([
+ "get",
+ "set"
+ ], ref_init);
+
+var r = Caml_curry.app2(ref[0], 0, 1);
+
+if (r.tag === 248) {
+ Caml_curry.js2(5741474, 2, r, 2);
+}
+else {
+ Caml_curry.app1(r.set.bind(r), 2);
+}
+
+var v = r.tag === 248 ? Caml_curry.js1(5144726, 3, r) : r.get;
+
+eq('File "class5_test.ml", line 43, characters 12-19', v, 2);
+
+function intlist_init($$class) {
+ var l = CamlinternalOO.new_variable($$class, "");
+ var ids = CamlinternalOO.get_method_labels($$class, shared$2);
+ var fold = ids[0];
+ var empty = ids[1];
+ CamlinternalOO.set_methods($$class, /* array */[
+ empty,
+ function (self$neg4) {
+ return +(self$neg4[l] === /* [] */0);
+ },
+ fold,
+ function (self$neg4, f, accu) {
+ return List.fold_left(f, accu, self$neg4[l]);
+ }
+ ]);
+ return function (_, self, l$1) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[l] = l$1;
+ return self$1;
+ };
+}
+
+var intlist = CamlinternalOO.make_class(shared$2, intlist_init);
+
+var l = Caml_curry.app2(intlist[0], 0, /* :: */[
+ 1,
+ /* :: */[
+ 2,
+ /* :: */[
+ 3,
+ /* [] */0
+ ]
+ ]
+ ]);
+
+eq('File "class5_test.ml", line 54, characters 5-12', 6, l.tag === 248 ? Caml_curry.js3(-1010803711, 4, l, function (x, y) {
+ return x + y | 0;
+ }, 0) : Caml_curry.app2(l.fold.bind(l), function (x, y) {
+ return x + y | 0;
+ }, 0));
+
+function intlist2_init($$class) {
+ var l = CamlinternalOO.new_variable($$class, "");
+ var ids = CamlinternalOO.get_method_labels($$class, shared$2);
+ var fold = ids[0];
+ var empty = ids[1];
+ CamlinternalOO.set_methods($$class, /* array */[
+ empty,
+ function (self$neg5) {
+ return +(self$neg5[l] === /* [] */0);
+ },
+ fold,
+ function (self$neg5, f, accu) {
+ return List.fold_left(f, accu, self$neg5[l]);
+ }
+ ]);
+ return function (_, self, l$1) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[l] = l$1;
+ return self$1;
+ };
+}
+
+var intlist2 = CamlinternalOO.make_class(shared$2, intlist2_init);
+
+var l$1 = Caml_curry.app2(intlist2[0], 0, /* :: */[
+ 1,
+ /* :: */[
+ 2,
+ /* :: */[
+ 3,
+ /* [] */0
+ ]
+ ]
+ ]);
+
+eq('File "class5_test.ml", line 67, characters 5-12', /* tuple */[
+ 6,
+ "1 2 3 "
+ ], /* tuple */[
+ l$1.tag === 248 ? Caml_curry.js3(-1010803711, 5, l$1, function (x, y) {
+ return x + y | 0;
+ }, 0) : Caml_curry.app2(l$1.fold.bind(l$1), function (x, y) {
+ return x + y | 0;
+ }, 0),
+ l$1.tag === 248 ? Caml_curry.js3(-1010803711, 6, l$1, function (s, x) {
+ return s + (x + " ");
+ }, "") : Caml_curry.app2(l$1.fold.bind(l$1), function (s, x) {
+ return s + (x + " ");
+ }, "")
+ ]);
+
+function point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, shared, shared$1);
+ var move = ids[0];
+ var get_x = ids[1];
+ var x = ids[2];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get_x,
+ function (self$neg6) {
+ return self$neg6[x];
+ },
+ move,
+ function (self$neg6, d) {
+ self$neg6[x] = self$neg6[x] + d | 0;
+ return /* () */0;
+ }
+ ]);
+ return function (_, self, x_init) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x] = x_init;
+ return self$1;
+ };
+}
+
+var point = CamlinternalOO.make_class(shared, point_init);
+
+function distance_point_init($$class) {
+ var distance = CamlinternalOO.get_method_label($$class, "distance");
+ var inh = CamlinternalOO.inherits($$class, shared$1, 0, [
+ "get_x",
+ "move"
+ ], point, 1);
+ var obj_init = inh[0];
+ var x = inh[1];
+ CamlinternalOO.set_method($$class, distance, function (self$neg7, other) {
+ return Pervasives.abs((
+ other.tag === 248 ? Caml_curry.js1(291546447, 7, other) : other.get_x
+ ) - self$neg7[x] | 0);
+ });
+ return function (_, self, x) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ Caml_curry.app2(obj_init, self$1, x);
+ return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
+ };
+}
+
+var distance_point = CamlinternalOO.make_class([
+ "move",
+ "distance",
+ "get_x"
+ ], distance_point_init);
+
+var p$1 = Caml_curry.app2(distance_point[0], 0, 3);
+
+var match_000 = p$1.tag === 248 ? Caml_curry.js2(-335965387, 8, p$1, Caml_curry.app2(point[0], 0, 8)) : Caml_curry.app1(p$1.distance.bind(p$1), Caml_curry.app2(point[0], 0, 8));
+
+var match_001 = p$1.tag === 248 ? Caml_curry.js2(-335965387, 9, p$1, Caml_curry.app3(printable_colored_point[0], 0, 1, "blue")) : Caml_curry.app1(p$1.distance.bind(p$1), Caml_curry.app3(printable_colored_point[0], 0, 1, "blue"));
+
+var b = match_001;
+
+var a = match_000;
+
+eq('File "class5_test.ml", line 94, characters 5-12', /* tuple */[
+ 5,
+ 2
+ ], /* tuple */[
+ a,
+ b
+ ]);
+
+Mt.from_pair_suites("class5_test.ml", suites[0]);
+
+exports.suites = suites;
+exports.test_id = test_id;
+exports.eq = eq;
+exports.printable_point = printable_point;
+exports.printable_colored_point = printable_colored_point;
+exports.p = p;
+exports.ref = ref;
+exports.v = v;
+exports.intlist = intlist;
+exports.intlist2 = intlist2;
+exports.l = l$1;
+exports.point = point;
+exports.distance_point = distance_point;
+exports.a = a;
+exports.b = b;
+/* printable_point Not a pure module */
diff --git a/jscomp/test/class5_test.ml b/jscomp/test/class5_test.ml
new file mode 100644
index 0000000000..877e6fddd2
--- /dev/null
+++ b/jscomp/test/class5_test.ml
@@ -0,0 +1,97 @@
+let suites : Mt.pair_suites ref = ref []
+let test_id = ref 0
+let eq loc x y =
+ incr test_id ;
+ suites :=
+ (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
+
+
+class printable_point x_init =
+ object (s)
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ method print = (string_of_int s#get_x)
+ end;;
+
+class printable_colored_point y c =
+ object (self)
+ val c = c
+ method color = c
+ inherit printable_point y as super
+ method print =
+ "(" ^
+ super#print ^
+ ", " ^
+ (self#color) ^
+ ")"
+ end;;
+
+let p = new printable_colored_point 17 "red";;
+
+let () = eq __LOC__ p#print "(17, red)"
+
+class ['a] ref x_init =
+ object
+ val mutable x = (x_init : 'a)
+ method get = x
+ method set y = x <- y
+ end;;
+let v =
+ let r = new ref 1 in r#set 2; (r#get);;
+
+let () = eq __LOC__ v 2
+
+class ['a] intlist (l : int list) =
+ object
+ method empty = (l = [])
+ method fold f (accu : 'a) = List.fold_left f accu l
+ end;;
+
+let l = new intlist [1; 2; 3];;
+
+let () =
+ eq __LOC__ 6 (l#fold (fun x y -> x+y) 0);;
+
+
+class intlist2 (l : int list) =
+ object
+ method empty = (l = [])
+ method fold : 'a. ('a -> int -> 'a) -> 'a -> 'a =
+ fun f accu -> List.fold_left f accu l
+ end;;
+
+let l = new intlist2 [1; 2; 3];;
+
+let () =
+ eq __LOC__ (6,"1 2 3 ")
+ (l#fold (fun x y -> x+y) 0,
+ l#fold (fun s x -> s ^ string_of_int x ^ " ") "")
+
+class type point0 = object method get_x : int end;;
+
+class point x_init =
+ object
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ end;;
+
+class distance_point x =
+ object
+ inherit point x
+ method distance : 'a. (#point0 as 'a) -> int =
+ fun other -> abs (other#get_x - x)
+ end;;
+
+
+let a, b =
+ let p = new distance_point 3 in
+ (p#distance (new point 8),
+ p#distance (new printable_colored_point 1 "blue"));;
+
+let () =
+ eq __LOC__ (5,2) (a,b)
+
+
+let () = Mt.from_pair_suites __FILE__ !suites
diff --git a/jscomp/test/class6_test.js b/jscomp/test/class6_test.js
new file mode 100644
index 0000000000..b79e186231
--- /dev/null
+++ b/jscomp/test/class6_test.js
@@ -0,0 +1,301 @@
+// Generated CODE, PLEASE EDIT WITH CARE
+'use strict';
+
+var Caml_obj = require("../runtime/caml_obj");
+var Caml_builtin_exceptions = require("../runtime/caml_builtin_exceptions");
+var Mt = require("./mt");
+var CamlinternalOO = require("../stdlib/camlinternalOO");
+var Caml_curry = require("../runtime/caml_curry");
+
+var shared = [
+ "move",
+ "get_x"
+];
+
+var shared$1 = ["x"];
+
+var shared$2 = ["m"];
+
+var suites = [/* [] */0];
+
+var test_id = [0];
+
+function eq(loc, x, y) {
+ test_id[0] = test_id[0] + 1 | 0;
+ suites[0] = /* :: */[
+ /* tuple */[
+ loc + (" id " + test_id[0]),
+ function () {
+ return /* Eq */{
+ 0: x,
+ 1: y,
+ length: 2,
+ tag: 0
+ };
+ }
+ ],
+ suites[0]
+ ];
+ return /* () */0;
+}
+
+function point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, shared, shared$1);
+ var move = ids[0];
+ var get_x = ids[1];
+ var x = ids[2];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get_x,
+ function (self$neg1) {
+ return self$neg1[x];
+ },
+ move,
+ function (self$neg1, d) {
+ self$neg1[x] = self$neg1[x] + d | 0;
+ return /* () */0;
+ }
+ ]);
+ return function (_, self, x_init) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x] = x_init;
+ return self$1;
+ };
+}
+
+var point = CamlinternalOO.make_class(shared, point_init);
+
+function colored_point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, ["color"], ["c"]);
+ var color = ids[0];
+ var c = ids[1];
+ var inh = CamlinternalOO.inherits($$class, shared$1, 0, [
+ "get_x",
+ "move"
+ ], point, 1);
+ var obj_init = inh[0];
+ CamlinternalOO.set_method($$class, color, function (self$neg2) {
+ return self$neg2[c];
+ });
+ return function (_, self, x, c$1) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ Caml_curry.app2(obj_init, self$1, x);
+ self$1[c] = c$1;
+ return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
+ };
+}
+
+var colored_point = CamlinternalOO.make_class([
+ "move",
+ "color",
+ "get_x"
+ ], colored_point_init);
+
+function colored_point_to_point(cp) {
+ return cp;
+}
+
+var p = Caml_curry.app2(point[0], 0, 3);
+
+var q = Caml_curry.app3(colored_point[0], 0, 4, "blue");
+
+function lookup_obj(obj, _param) {
+ while(true) {
+ var param = _param;
+ if (param) {
+ var obj$prime = param[0];
+ if (Caml_obj.caml_equal(obj, obj$prime)) {
+ return obj$prime;
+ }
+ else {
+ _param = param[1];
+ continue ;
+
+ }
+ }
+ else {
+ throw Caml_builtin_exceptions.not_found;
+ }
+ };
+}
+
+function c_init($$class) {
+ var m = CamlinternalOO.get_method_label($$class, "m");
+ CamlinternalOO.set_method($$class, m, function () {
+ return 1;
+ });
+ return function (_, self) {
+ return CamlinternalOO.create_object_opt(self, $$class);
+ };
+}
+
+var c = CamlinternalOO.make_class(shared$2, c_init);
+
+function d_init($$class) {
+ var ids = CamlinternalOO.get_method_labels($$class, [
+ "n",
+ "as_c"
+ ]);
+ var n = ids[0];
+ var as_c = ids[1];
+ var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, c, 1);
+ var obj_init = inh[0];
+ CamlinternalOO.set_methods($$class, /* array */[
+ n,
+ function () {
+ return 2;
+ },
+ as_c,
+ function (self$neg4) {
+ return self$neg4;
+ }
+ ]);
+ return function (_, self) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ Caml_curry.app1(obj_init, self$1);
+ return CamlinternalOO.run_initializers_opt(self, self$1, $$class);
+ };
+}
+
+var table = CamlinternalOO.create_table([
+ "as_c",
+ "m",
+ "n"
+ ]);
+
+var env_init = d_init(table);
+
+CamlinternalOO.init_class(table);
+
+var d_000 = Caml_curry.app1(env_init, 0);
+
+var d = [
+ d_000,
+ d_init,
+ env_init,
+ 0
+];
+
+var c2$prime = {
+
+};
+
+Caml_obj.caml_update_dummy(c2$prime, [
+ 0,
+ function ($$class) {
+ CamlinternalOO.get_method_label($$class, "m");
+ return function (_, self) {
+ return CamlinternalOO.create_object_opt(self, $$class);
+ };
+ },
+ 0,
+ 0
+ ]);
+
+function functional_point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, shared, shared$1);
+ var move = ids[0];
+ var get_x = ids[1];
+ var x = ids[2];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get_x,
+ function (self$neg6) {
+ return self$neg6[x];
+ },
+ move,
+ function (self$neg6, d) {
+ var copy = Caml_builtin_exceptions.caml_set_oo_id(Caml_obj.caml_obj_dup(self$neg6));
+ copy[x] = self$neg6[x] + d | 0;
+ return copy;
+ }
+ ]);
+ return function (_, self, y) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x] = y;
+ return self$1;
+ };
+}
+
+var functional_point = CamlinternalOO.make_class(shared, functional_point_init);
+
+var p$1 = Caml_curry.app2(functional_point[0], 0, 7);
+
+var tmp = p$1.tag === 248 ? Caml_curry.js2(-933174511, 2, p$1, 3) : Caml_curry.app1(p$1.move.bind(p$1), 3);
+
+eq('File "class6_test.ml", line 60, characters 5-12', /* tuple */[
+ 7,
+ 10,
+ 7
+ ], /* tuple */[
+ p$1.tag === 248 ? Caml_curry.js1(291546447, 1, p$1) : p$1.get_x,
+ tmp.tag === 248 ? Caml_curry.js1(291546447, 3, tmp) : tmp.get_x,
+ p$1.tag === 248 ? Caml_curry.js1(291546447, 4, p$1) : p$1.get_x
+ ]);
+
+function bad_functional_point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, shared, shared$1);
+ var move = ids[0];
+ var get_x = ids[1];
+ var x = ids[2];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get_x,
+ function (self$neg7) {
+ return self$neg7[x];
+ },
+ move,
+ function (self$neg7, d) {
+ return Caml_curry.app2(bad_functional_point[0], 0, self$neg7[x] + d | 0);
+ }
+ ]);
+ return function (_, self, y) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x] = y;
+ return self$1;
+ };
+}
+
+var table$1 = CamlinternalOO.create_table(shared);
+
+var env_init$1 = bad_functional_point_init(table$1);
+
+CamlinternalOO.init_class(table$1);
+
+var bad_functional_point_000 = Caml_curry.app1(env_init$1, 0);
+
+var bad_functional_point = [
+ bad_functional_point_000,
+ bad_functional_point_init,
+ env_init$1,
+ 0
+];
+
+var p$2 = Caml_curry.app2(bad_functional_point_000, 0, 7);
+
+var tmp$1 = p$2.tag === 248 ? Caml_curry.js2(-933174511, 6, p$2, 3) : Caml_curry.app1(p$2.move.bind(p$2), 3);
+
+eq('File "class6_test.ml", line 74, characters 5-12', /* tuple */[
+ 7,
+ 10,
+ 7
+ ], /* tuple */[
+ p$2.tag === 248 ? Caml_curry.js1(291546447, 5, p$2) : p$2.get_x,
+ tmp$1.tag === 248 ? Caml_curry.js1(291546447, 7, tmp$1) : tmp$1.get_x,
+ p$2.tag === 248 ? Caml_curry.js1(291546447, 8, p$2) : p$2.get_x
+ ]);
+
+Mt.from_pair_suites("class6_test.ml", suites[0]);
+
+exports.suites = suites;
+exports.test_id = test_id;
+exports.eq = eq;
+exports.point = point;
+exports.colored_point = colored_point;
+exports.colored_point_to_point = colored_point_to_point;
+exports.p = p;
+exports.q = q;
+exports.lookup_obj = lookup_obj;
+exports.c = c;
+exports.d = d;
+exports.c2$prime = c2$prime;
+exports.functional_point = functional_point;
+exports.bad_functional_point = bad_functional_point;
+/* point Not a pure module */
diff --git a/jscomp/test/class6_test.ml b/jscomp/test/class6_test.ml
new file mode 100644
index 0000000000..e2b398dd9b
--- /dev/null
+++ b/jscomp/test/class6_test.ml
@@ -0,0 +1,78 @@
+let suites : Mt.pair_suites ref = ref []
+let test_id = ref 0
+let eq loc x y =
+ incr test_id ;
+ suites :=
+ (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
+
+
+
+class point = fun x_init ->
+ object
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ end
+class colored_point x (c : string) =
+ object
+ inherit point x
+ val c = c
+ method color = c
+ end;;
+
+let colored_point_to_point cp = (cp : colored_point :> point);;
+
+let p = new point 3 and q = new colored_point 4 "blue";;
+
+let rec lookup_obj obj =
+ function
+ | [] -> raise Not_found
+ | obj' :: l ->
+ if (obj :> < >) = (obj' :> < >) then obj' else lookup_obj obj l ;;
+
+
+
+
+class type c' = object method m : int end;;
+
+class c : c' = object method m = 1 end
+ and d = object (self)
+ inherit c
+ method n = 2
+ method as_c = (self :> c')
+ end;;
+
+class virtual c2' = object method virtual m : int end;;
+
+
+class functional_point y =
+ object
+ val x = y
+ method get_x = x
+ method move d = {< x = x + d >}
+ end;;
+
+
+
+
+let () =
+ let p = new functional_point 7 in
+ eq __LOC__
+ (7,10,7)
+ (p#get_x, (p#move 3)#get_x , p#get_x)
+
+
+class bad_functional_point y =
+ object
+ val x = y
+ method get_x = x
+ method move d = new bad_functional_point (x+d)
+ end;;
+
+let () =
+ let p = new bad_functional_point 7 in
+ eq __LOC__
+ (7,10,7)
+ (p#get_x, (p#move 3)#get_x , p#get_x)
+
+let () = Mt.from_pair_suites __FILE__ !suites
diff --git a/jscomp/test/class7_test.js b/jscomp/test/class7_test.js
new file mode 100644
index 0000000000..b57803500f
--- /dev/null
+++ b/jscomp/test/class7_test.js
@@ -0,0 +1,87 @@
+// Generated CODE, PLEASE EDIT WITH CARE
+'use strict';
+
+var Mt = require("./mt");
+var CamlinternalOO = require("../stdlib/camlinternalOO");
+var Caml_curry = require("../runtime/caml_curry");
+var Oo = require("../stdlib/oo");
+
+var shared = [
+ "move",
+ "get_x"
+];
+
+var suites = [/* [] */0];
+
+var test_id = [0];
+
+function eq(loc, x, y) {
+ test_id[0] = test_id[0] + 1 | 0;
+ suites[0] = /* :: */[
+ /* tuple */[
+ loc + (" id " + test_id[0]),
+ function () {
+ return /* Eq */{
+ 0: x,
+ 1: y,
+ length: 2,
+ tag: 0
+ };
+ }
+ ],
+ suites[0]
+ ];
+ return /* () */0;
+}
+
+function point_init($$class) {
+ var ids = CamlinternalOO.new_methods_variables($$class, shared, ["x"]);
+ var move = ids[0];
+ var get_x = ids[1];
+ var x = ids[2];
+ CamlinternalOO.set_methods($$class, /* array */[
+ get_x,
+ function (self$neg1) {
+ return self$neg1[x];
+ },
+ move,
+ function (self$neg1, d) {
+ self$neg1[x] = self$neg1[x] + d | 0;
+ return /* () */0;
+ }
+ ]);
+ return function (_, self, x_init) {
+ var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+ self$1[x] = x_init;
+ return self$1;
+ };
+}
+
+var point = CamlinternalOO.make_class(shared, point_init);
+
+var p = Caml_curry.app2(point[0], 0, 55);
+
+var q = Oo.copy(p);
+
+if (q.tag === 248) {
+ Caml_curry.js2(-933174511, 1, q, 7);
+}
+else {
+ Caml_curry.app1(q.move.bind(q), 7);
+}
+
+eq('File "class7_test.ml", line 22, characters 5-12', /* tuple */[
+ 55,
+ 62
+ ], /* tuple */[
+ p.tag === 248 ? Caml_curry.js1(291546447, 2, p) : p.get_x,
+ q.tag === 248 ? Caml_curry.js1(291546447, 3, q) : q.get_x
+ ]);
+
+Mt.from_pair_suites("class7_test.ml", suites[0]);
+
+exports.suites = suites;
+exports.test_id = test_id;
+exports.eq = eq;
+exports.point = point;
+/* point Not a pure module */
diff --git a/jscomp/test/class7_test.ml b/jscomp/test/class7_test.ml
new file mode 100644
index 0000000000..81dbe60d35
--- /dev/null
+++ b/jscomp/test/class7_test.ml
@@ -0,0 +1,24 @@
+let suites : Mt.pair_suites ref = ref []
+let test_id = ref 0
+let eq loc x y =
+ incr test_id ;
+ suites :=
+ (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
+
+class point = fun x_init ->
+ object
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ end
+
+let () =
+ let p = new point 55 in
+ (* TODO: see why [field 1] is missing
+ *)
+ (* let () = [%bs.debug] in *)
+ let q = Oo.copy p in
+ q # move 7;
+ eq __LOC__ (55, 62) (p#get_x, q # get_x )
+
+let () = Mt.from_pair_suites __FILE__ !suites
diff --git a/jscomp/test/test.mllib b/jscomp/test/test.mllib
index 03a741de00..8a8e0df3cb 100644
--- a/jscomp/test/test.mllib
+++ b/jscomp/test/test.mllib
@@ -233,4 +233,8 @@ const_test
class3_test
+class4_test
+class5_test
+class6_test
+class7_test