more tests

Author: bobzhang

jscomp/runtime/caml_builtin_exceptions.ml

@@ -58,7 +58,15 @@ let () =
     Obj.set_tag (Obj.repr sys_blocked_io) object_tag;
     Obj.set_tag (Obj.repr assert_failure) object_tag;
     Obj.set_tag (Obj.repr undefined_recursive_module) object_tag
-(* TODO: 
-   1. is it necessary to tag [248] here
-   2. is it okay to remove the negative value
+
+(**: 
+   1. Is it necessary to tag [248] here
+   For compatibility reasons: tag [248] will make 
+   `Printexc.to_string` happy see #1501
+   2. Is it okay to remove the negative value
+   For marshalling? 
+   3. Global exception is encoded the same as user defined exception 
+   (for nullary and non-nullary), except
+   - time stamp
+   - its name is not qualified
 *)

jscomp/test/.depend

@@ -143,6 +143,7 @@ event_ffi.cmj : ../stdlib/list.cmj ../runtime/js_unsafe.cmj \
 exception_alias.cmj : ../stdlib/list.cmj
 exception_raise_test.cmj : mt.cmj
 exception_rebound_err.cmj : ../runtime/js.cmj
+exception_repr_test.cmj : ../stdlib/printexc.cmj mt.cmj ../stdlib/format.cmj
 exception_value_test.cmj : ../runtime/js.cmj
 export_keyword.cmj :
 ext_array.cmj : ../stdlib/list.cmj ../stdlib/array.cmj

jscomp/test/Makefile

@@ -137,7 +137,8 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
 	exception_rebound_err\
 	js_exception_catch_test\
 	gpr_1503_test\
-	gpr_1501_test
+	gpr_1501_test\
+	exception_repr_test
 
 # bs_uncurry_test
 # needs Lam to get rid of Uncurry arity first

jscomp/test/exception_repr_test.js

@@ -0,0 +1,78 @@
+'use strict';
+
+var Mt              = require("./mt.js");
+var Block           = require("../../lib/js/block.js");
+var Curry           = require("../../lib/js/curry.js");
+var Format          = require("../../lib/js/format.js");
+var Printexc        = require("../../lib/js/printexc.js");
+var Caml_exceptions = require("../../lib/js/caml_exceptions.js");
+
+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 */Block.__(0, [
+                  x,
+                  y
+                ]);
+      }
+    ],
+    suites[0]
+  ];
+  return /* () */0;
+}
+
+var Hi = Caml_exceptions.create("Exception_repr_test.Hi");
+
+var Hello = Caml_exceptions.create("Exception_repr_test.Hello");
+
+var A = Caml_exceptions.create("Exception_repr_test.A");
+
+Printexc.register_printer(function (param) {
+      if (param === Hi) {
+        return /* Some */["hey"];
+      } else if (param[0] === A) {
+        return /* Some */[Curry._1(Format.asprintf(/* Format */[
+                          /* String_literal */Block.__(11, [
+                              "A(",
+                              /* Int */Block.__(4, [
+                                  /* Int_d */0,
+                                  /* No_padding */0,
+                                  /* No_precision */0,
+                                  /* Char_literal */Block.__(12, [
+                                      /* ")" */41,
+                                      /* End_of_format */0
+                                    ])
+                                ])
+                            ]),
+                          "A(%d)"
+                        ]), param[1])];
+      } else {
+        return /* None */0;
+      }
+    });
+
+eq("File \"exception_repr_test.ml\", line 22, characters 7-14", "hey", Printexc.to_string(Hi));
+
+eq("File \"exception_repr_test.ml\", line 23, characters 7-14", "A(1)", Printexc.to_string([
+          A,
+          1
+        ]));
+
+eq("File \"exception_repr_test.ml\", line 24, characters 7-14", "Exception_repr_test.Hello", Printexc.to_string(Hello));
+
+Mt.from_pair_suites("exception_repr_test.ml", suites[0]);
+
+exports.suites  = suites;
+exports.test_id = test_id;
+exports.eq      = eq;
+exports.Hi      = Hi;
+exports.Hello   = Hello;
+exports.A       = A;
+/*  Not a pure module */

jscomp/test/exception_repr_test.ml

@@ -0,0 +1,28 @@
+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
+
+
+
+exception Hi 
+exception Hello
+exception A of int 
+;; Printexc.register_printer (function 
+    | Hi  -> Some "hey"
+    | A s -> Some (Format.asprintf "A(%d)" s )
+    | _ -> None
+)
+
+
+
+let () = 
+    eq __LOC__ "hey" (Printexc.to_string Hi);
+    eq __LOC__ "A(1)" (Printexc.to_string (A 1));
+    eq __LOC__ "Exception_repr_test.Hello" (Printexc.to_string Hello)
+
+;; Mt.from_pair_suites __FILE__ !suites
+
+