more class tests and bug fix for #251

Author: Hongbo Zhang

jscomp/index.html

@@ -10,7 +10,7 @@
     <!-- <script src="./async.js"></script> -->
     <script src="./require1k.js"></script>
     <script>
-     R('./test/class_test', function(err,v){
+     R('./test/class7_test', function(err,v){
          window.v = v
      })
     </script>

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;
 }

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 () = 

jscomp/test/.depend

@@ -72,6 +72,8 @@ 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
@@ -598,6 +600,8 @@ 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

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 */

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

jscomp/test/test.mllib

@@ -236,4 +236,5 @@ class3_test
 class4_test
 class5_test
 class6_test
+class7_test