Class test continue and bug fix #251

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

@@ -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

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

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