fix #1762

Changes.md

@@ -1,7 +1,9 @@
-
-# Next
+# 1.8.1
 Fixes:
+- #1762
 
+# 1.8.0
+Fixes:
 - #1573, don't include `-bs` flags in `.merlin`
 - #1716, fix wrong optimization of recursive values
 - #1728, bad inlining

jscomp/bin/bsb_watcher.js

@@ -1,4 +1,4 @@
-//@ts-check
+
 
 var fs = require('fs')
 var child_process = require('child_process')

jscomp/bin/whole_compiler.ml

@@ -96815,7 +96815,8 @@ and
                 begin
                   match Js_exp_make.extract_non_pure out1 ,
                         Js_exp_make.extract_non_pure out2 with
-                  | None, None -> Js_output.make b
+                  | None, None -> Js_output.make (b @ [ S.exp e]) 
+                    (* FIX #1762 *)
                   | Some out1, Some out2 -> 
                     Js_output.make b  ~value:(E.econd e  out1 out2)
                   | Some out1, None -> 

jscomp/core/lam_compile.ml

@@ -1019,7 +1019,8 @@ and
                 begin
                   match Js_exp_make.extract_non_pure out1 ,
                         Js_exp_make.extract_non_pure out2 with
-                  | None, None -> Js_output.make b
+                  | None, None -> Js_output.make (b @ [ S.exp e]) 
+                    (* FIX #1762 *)
                   | Some out1, Some out2 -> 
                     Js_output.make b  ~value:(E.econd e  out1 out2)
                   | Some out1, None -> 

jscomp/test/.depend

@@ -235,6 +235,9 @@ gpr_1716_test.cmj : mt.cmj
 gpr_1717_test.cmj :
 gpr_1728_test.cmj : mt.cmj
 gpr_1749_test.cmj : mt.cmj
+gpr_1759_test.cmj :
+gpr_1760_test.cmj :
+gpr_1762_test.cmj : mt.cmj
 gpr_405_test.cmj : ../stdlib/hashtbl.cmj gpr_405_test.cmi
 gpr_441.cmj :
 gpr_459_test.cmj : mt.cmj

jscomp/test/Makefile

@@ -169,7 +169,11 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
 	gpr_1409_test\
 	rec_fun_test\
 	gpr_1749_test\
-	ocaml_re_test
+	ocaml_re_test\
+	gpr_1762_test\
+	gpr_1760_test\
+	gpr_1759_test
+
 # bs_uncurry_test
 # needs Lam to get rid of Uncurry arity first
 

jscomp/test/gpr_1759_test.js

@@ -0,0 +1,5 @@
+'use strict';
+
+
+
+/* No side effect */

jscomp/test/gpr_1759_test.ml

@@ -0,0 +1,8 @@
+
+
+(*;; let i:int =
+    (compare (print_string "") ())
+  in print_int i
+
+;; print_string 
+(if (<>) () (print_string "") then "true" else "false")  *)

jscomp/test/gpr_1760_test.js

@@ -0,0 +1,5 @@
+'use strict';
+
+
+
+/* No side effect */

jscomp/test/gpr_1760_test.ml

@@ -0,0 +1,4 @@
+
+(*;; print_int (let _c = (/) 0 0 in 0)
+
+;; print_int (let _h = ((mod) 0 0) in 0)*)

jscomp/test/gpr_1762_test.js

@@ -0,0 +1,45 @@
+'use strict';
+
+var Mt    = require("./mt.js");
+var Block = require("../../lib/js/block.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 v = [3];
+
+function update() {
+  v[0] = v[0] + 1 | 0;
+  return /* true */1;
+}
+
+v[0] = v[0] + 1 | 0;
+
+eq("File \"gpr_1762_test.ml\", line 22, characters 6-13", v[0], 4);
+
+Mt.from_pair_suites("gpr_1762_test.ml", suites[0]);
+
+exports.suites  = suites;
+exports.test_id = test_id;
+exports.eq      = eq;
+exports.v       = v;
+exports.update  = update;
+/*  Not a pure module */

jscomp/test/gpr_1762_test.ml

@@ -0,0 +1,25 @@
+
+
+
+(*;; if bool_of_string "x" then "" else "" *)
+
+
+
+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 v = ref 3
+
+let update () = incr v ; true 
+
+;; if update () then "" else ""
+
+;; eq __LOC__ !v 4 
+
+
+;; Mt.from_pair_suites __FILE__ !suites