Merge pull request #1070 from bloomberg/fix_gpr_977

bobzhang · web-flow · commit 9f205095b013 · 2017-01-10T15:34:59.000-05:00
fix #977, add unit tests
diff --git a/jscomp/Makefile b/jscomp/Makefile
@@ -10,7 +10,7 @@ BYTE=ocamlc.opt$(EXE)
 OCAMLLEX=ocamllex.opt$(EXE)
 CAMLP4OF=camlp4of
 CAMLDEP=ocamldep.opt$(EXE)
-COMPFLAGS= -g -w +6-40-30-23 -warn-error +a-40-30-23
+COMPFLAGS=  -g -w +6-40-30-23 -warn-error +a-40-30-23
 
 
 .SUFFIXES: .mli .ml .cmi .cmx .mll .c .o .cmo
diff --git a/jscomp/bin/all_ounit_tests.ml b/jscomp/bin/all_ounit_tests.ml
@@ -1342,7 +1342,7 @@ end = struct
 
 
 let reverse_range a i len =
-  if len=0 then ()
+  if len = 0 then ()
   else
     for k = 0 to (len-1)/2 do
       let t = Array.unsafe_get a (i+k) in
@@ -1549,7 +1549,7 @@ external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
 let escaped s =
-  let n = ref 0 in
+  let n = Pervasives.ref 0 in
   for i = 0 to Bytes.length s - 1 do
     n := !n +
       (match Bytes.unsafe_get s i with
diff --git a/jscomp/bin/bsb.ml b/jscomp/bin/bsb.ml
@@ -335,7 +335,7 @@ external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
 let escaped s =
-  let n = ref 0 in
+  let n = Pervasives.ref 0 in
   for i = 0 to Bytes.length s - 1 do
     n := !n +
       (match Bytes.unsafe_get s i with
@@ -2813,7 +2813,7 @@ end = struct
 
 
 let reverse_range a i len =
-  if len=0 then ()
+  if len = 0 then ()
   else
     for k = 0 to (len-1)/2 do
       let t = Array.unsafe_get a (i+k) in
@@ -4573,7 +4573,7 @@ module Ext_file_pp : sig
 type action = 
   [
     `skip
-  | `print of (out_channel -> int -> unit)
+  | `print of (Pervasives.out_channel -> int -> unit)
   ]
 
 
diff --git a/jscomp/bin/bsb_helper.ml b/jscomp/bin/bsb_helper.ml
@@ -301,7 +301,7 @@ external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
 let escaped s =
-  let n = ref 0 in
+  let n = Pervasives.ref 0 in
   for i = 0 to Bytes.length s - 1 do
     n := !n +
       (match Bytes.unsafe_get s i with
diff --git a/jscomp/bin/bsdep.ml b/jscomp/bin/bsdep.ml
@@ -23127,7 +23127,7 @@ external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
 let escaped s =
-  let n = ref 0 in
+  let n = Pervasives.ref 0 in
   for i = 0 to Bytes.length s - 1 do
     n := !n +
       (match Bytes.unsafe_get s i with
diff --git a/jscomp/bin/bsppx.ml b/jscomp/bin/bsppx.ml
@@ -4974,7 +4974,7 @@ external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
 let escaped s =
-  let n = ref 0 in
+  let n = Pervasives.ref 0 in
   for i = 0 to Bytes.length s - 1 do
     n := !n +
       (match Bytes.unsafe_get s i with
diff --git a/jscomp/bin/whole_compiler.ml b/jscomp/bin/whole_compiler.ml
@@ -20942,7 +20942,7 @@ external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
 let escaped s =
-  let n = ref 0 in
+  let n = Pervasives.ref 0 in
   for i = 0 to Bytes.length s - 1 do
     n := !n +
       (match Bytes.unsafe_get s i with
@@ -57204,7 +57204,7 @@ end = struct
 
 
 let reverse_range a i len =
-  if len=0 then ()
+  if len = 0 then ()
   else
     for k = 0 to (len-1)/2 do
       let t = Array.unsafe_get a (i+k) in
@@ -91657,6 +91657,13 @@ let translate  loc
     | [ e ] -> E.int32_minus (E.zero_int_literal)  e 
     | _ -> assert false
     end
+  | Pnegint
+    -> 
+    begin match args with (* #977 *)
+    | [ e ] -> E.int32_minus (E.zero_int_literal)  e 
+    | _ -> assert false
+    end
+    
   | Pnegbint Pnativeint
     -> 
     begin match args with
@@ -91667,13 +91674,7 @@ let translate  loc
     -> 
     Js_long.neg args 
 
-  | Pnegint
-    -> 
-    begin match args with
-    | [ e ] -> E.unchecked_int32_minus (E.zero_int_literal)  e 
-    | _ -> assert false
-    end
-
+  
   | Pnegfloat 
     -> 
     begin match args with 
diff --git a/jscomp/core/lam_compile_group.ml b/jscomp/core/lam_compile_group.ml
@@ -367,7 +367,7 @@ let lambda_as_module
   begin 
     Js_config.set_current_file filename ;  
 #if BS_DEBUG then    
-    Js_config.set_debug_file "rec_value_test.ml";
+    Js_config.set_debug_file "gpr_977_test.ml";
 #end    
     let lambda_output = compile ~filename output_prefix env sigs lam in
     let (//) = Filename.concat in 
diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml
@@ -85,6 +85,13 @@ let translate  loc
     | [ e ] -> E.int32_minus (E.zero_int_literal)  e 
     | _ -> assert false
     end
+  | Pnegint
+    -> 
+    begin match args with (* #977 *)
+    | [ e ] -> E.int32_minus (E.zero_int_literal)  e 
+    | _ -> assert false
+    end
+    
   | Pnegbint Pnativeint
     -> 
     begin match args with
@@ -95,13 +102,7 @@ let translate  loc
     -> 
     Js_long.neg args 
 
-  | Pnegint
-    -> 
-    begin match args with
-    | [ e ] -> E.unchecked_int32_minus (E.zero_int_literal)  e 
-    | _ -> assert false
-    end
-
+  
   | Pnegfloat 
     -> 
     begin match args with 
diff --git a/jscomp/ext/ext_array.ml b/jscomp/ext/ext_array.ml
@@ -27,7 +27,7 @@
 
 
 let reverse_range a i len =
-  if len=0 then ()
+  if len = 0 then ()
   else
     for k = 0 to (len-1)/2 do
       let t = Array.unsafe_get a (i+k) in
diff --git a/jscomp/ext/ext_bytes.ml b/jscomp/ext/ext_bytes.ml
@@ -33,7 +33,7 @@ external char_code: char -> int = "%identity"
 external char_chr: int -> char = "%identity"
 
 let escaped s =
-  let n = ref 0 in
+  let n = Pervasives.ref 0 in
   for i = 0 to Bytes.length s - 1 do
     n := !n +
       (match Bytes.unsafe_get s i with
diff --git a/jscomp/ext/ext_file_pp.mli b/jscomp/ext/ext_file_pp.mli
@@ -25,7 +25,7 @@
 type action = 
   [
     `skip
-  | `print of (out_channel -> int -> unit)
+  | `print of (Pervasives.out_channel -> int -> unit)
   ]
 
 
diff --git a/jscomp/runtime/Readme.adoc b/jscomp/runtime/Readme.adoc
@@ -0,0 +1,3 @@
+# Runtime support 
+
+The build deps are manually maintained.
diff --git a/jscomp/test/.depend b/jscomp/test/.depend
@@ -128,7 +128,7 @@ event_ffi.cmj : ../stdlib/list.cmj ../runtime/js_unsafe.cmj \
 exception_raise_test.cmj : mt.cmj
 exception_value_test.cmj :
 ext_array.cmj : ../stdlib/list.cmj ../stdlib/array.cmj
-ext_bytes.cmj : ../stdlib/bytes.cmj
+ext_bytes.cmj : ../stdlib/pervasives.cmj ../stdlib/bytes.cmj
 ext_filename.cmj : ../stdlib/sys.cmj ../stdlib/string.cmj literals.cmj \
     ../stdlib/list.cmj ../stdlib/lazy.cmj ../stdlib/filename.cmj \
     ext_string.cmj ext_pervasives.cmj
@@ -188,6 +188,8 @@ gpr_858_test.cmj : ../stdlib/list.cmj
 gpr_858_unit2_test.cmj :
 gpr_904_test.cmj : mt.cmj
 gpr_974_test.cmj : ../runtime/js.cmj
+gpr_977_test.cmj : ../stdlib/nativeint.cmj mt.cmj ../runtime/js.cmj \
+    ../stdlib/int32.cmj
 gray_code_test.cmj : ../stdlib/bytes.cmj
 guide_for_ext.cmj :
 hamming_test.cmj : ../stdlib/printf.cmj mt.cmj ../stdlib/lazy.cmj \
diff --git a/jscomp/test/Makefile b/jscomp/test/Makefile
@@ -77,7 +77,8 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
 	gray_code_test alias_test\
 	flattern_order_test\
 	minimal_test\
-	gpr_1063_test
+	gpr_1063_test\
+	gpr_977_test
 
 
 
diff --git a/jscomp/test/gpr_977_test.js b/jscomp/test/gpr_977_test.js
@@ -0,0 +1,69 @@
+'use strict';
+
+var Mt    = require("./mt");
+var Block = require("../../lib/js/block");
+var Int32 = require("../../lib/js/int32");
+
+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;
+}
+
+function f(x) {
+  for(var i = 0; i <= 100; ++i){
+    console.log(".");
+  }
+  return -x | 0;
+}
+
+function int32_f(x) {
+  for(var i = 0; i <= 100; ++i){
+    console.log(".");
+  }
+  return -x | 0;
+}
+
+function nint32_f(x) {
+  for(var i = 0; i <= 100; ++i){
+    console.log(".");
+  }
+  return -x;
+}
+
+var u = f(-2147483648);
+
+eq('File "gpr_977_test.ml", line 32, characters 5-12', -2147483648, u);
+
+eq('File "gpr_977_test.ml", line 33, characters 5-12', Int32.min_int, int32_f(Int32.min_int));
+
+eq('File "gpr_977_test.ml", line 34, characters 5-12', nint32_f(-2147483648), 2147483648);
+
+Mt.from_pair_suites("gpr_977_test.ml", suites[0]);
+
+var min_32_int = -2147483648;
+
+exports.suites     = suites;
+exports.test_id    = test_id;
+exports.eq         = eq;
+exports.f          = f;
+exports.int32_f    = int32_f;
+exports.nint32_f   = nint32_f;
+exports.min_32_int = min_32_int;
+exports.u          = u;
+/* u Not a pure module */
diff --git a/jscomp/test/gpr_977_test.ml b/jscomp/test/gpr_977_test.ml
@@ -0,0 +1,35 @@
+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
+
+
+let f x =  
+  for i = 0 to 100 do 
+    Js.log "." ; (* prevent optimization*)
+  done;    
+  - x
+
+
+let int32_f x =
+  for i = 0 to 100 do 
+    Js.log "." ; (* prevent optimization*)
+  done;    
+  Int32.neg x 
+
+let nint32_f x =
+  for i = 0 to 100 do 
+    Js.log "." ; (* prevent optimization*)
+  done;    
+  Nativeint.neg x 
+
+let min_32_int = (-2147483648)
+let u = f min_32_int
+
+let () = 
+  eq __LOC__  min_32_int u ;
+  eq __LOC__ (Int32.min_int) (int32_f Int32.min_int);
+  eq __LOC__ (nint32_f (-2147483648n)) (2147483648n)
+let () = Mt.from_pair_suites __FILE__ !suites
diff --git a/jscomp/test/qcc.js b/jscomp/test/qcc.js
@@ -1530,7 +1530,7 @@ function top(_param) {
                   }
                   var stk$prime_000 = /* tuple */[
                     match[0],
-                    (-n << 3)
+                    ((-n | 0) << 3)
                   ];
                   var stk$prime = /* :: */[
                     stk$prime_000,
diff --git a/jscomp/test/test_per.js b/jscomp/test/test_per.js
@@ -48,7 +48,7 @@ function abs(x) {
     return x;
   }
   else {
-    return -x;
+    return -x | 0;
   }
 }
 
@@ -409,7 +409,7 @@ function input_line(chan) {
         }
       }
       else {
-        var beg = Caml_string.caml_create_string(-n);
+        var beg = Caml_string.caml_create_string(-n | 0);
         (function () {
               throw "caml_ml_input not implemented by bucklescript yet\n";
             }());
diff --git a/lib/js/bytes.js b/lib/js/bytes.js
@@ -62,7 +62,7 @@ function extend(s, left, right) {
   var len = (s.length + left | 0) + right | 0;
   var r = Caml_string.caml_create_string(len);
   var match = left < 0 ? /* tuple */[
-      -left,
+      -left | 0,
       0
     ] : /* tuple */[
       0,
diff --git a/lib/js/caml_int64.js b/lib/js/caml_int64.js
@@ -113,7 +113,7 @@ function lsr_(x, numBits) {
       }
       else {
         var hi$1 = (hi >>> numBits);
-        var lo$1 = (hi << -offset) | (x[/* lo */1] >>> numBits);
+        var lo$1 = (hi << (-offset | 0)) | (x[/* lo */1] >>> numBits);
         return /* record */[
                 /* hi */hi$1,
                 /* lo */(lo$1 >>> 0)
diff --git a/lib/js/camlinternalFormat.js b/lib/js/camlinternalFormat.js
@@ -5293,7 +5293,7 @@ function fmt_ebb_of_string(legacy_behavior, str) {
         var match$1 = parse_positive(str_ind + 1 | 0, end_ind, 0);
         return /* tuple */[
                 match$1[0],
-                -match$1[1]
+                -match$1[1] | 0
               ];
       }
     }
diff --git a/lib/js/curry.js b/lib/js/curry.js
@@ -13,7 +13,7 @@ function app(_f, _args) {
     var d = arity$1 - len | 0;
     if (d) {
       if (d < 0) {
-        _args = Caml_array.caml_array_sub(args, arity$1, -d);
+        _args = Caml_array.caml_array_sub(args, arity$1, -d | 0);
         _f = f.apply(null, Caml_array.caml_array_sub(args, 0, arity$1));
         continue ;
         
diff --git a/lib/js/format.js b/lib/js/format.js
diff --git a/lib/js/pervasives.js b/lib/js/pervasives.js
