toggle between 4.02 and 4.06 automtically

jscomp/cleanlib.js

@@ -1,11 +1,15 @@
 #!/usr/bin/env node
 var cp = require('child_process')
 var fs = require('fs')
+exports.run = function () {
+    cp.execSync(`make clean`)
+    if (fs.existsSync(`stdlib-406`)) {
+        cp.execSync(`git clean -dfx stdlib-406`)
+    }
 
-cp.execSync(`make clean`)
-if(fs.existsSync(`stdlib-406`)){
-    cp.execSync(`git clean -dfx stdlib-406`)
+    cp.execSync(`git clean -dfx stdlib-402 test others runtime`)
 }
 
-cp.execSync(`git clean -dfx stdlib-402 test others runtime`)
-
+if(require.main === module){
+    run()
+}

jscomp/stdlib-406/gc.ml

@@ -97,8 +97,12 @@ let allocated_bytes () =
 
 
 external finalise : ('a -> unit) -> 'a -> unit = "caml_final_register"
+#if BS then 
+let finalise_last = fun _ _ : unit -> ()
+#else
 external finalise_last : (unit -> unit) -> 'a -> unit =
   "caml_final_register_called_without_value"
+#end  
 external finalise_release : unit -> unit = "caml_final_release"
 
 

jscomp/stdlib-406/hashtbl.ml

@@ -56,10 +56,13 @@ let flip_ongoing_traversal h =
 (* To pick random seeds if requested *)
 
 let randomized_default =
-  let params =
+#if BS then false  
+#else
+  let params =    
     try Sys.getenv "OCAMLRUNPARAM" with Not_found ->
     try Sys.getenv "CAMLRUNPARAM" with Not_found -> "" in
   String.contains params 'R'
+#end
 
 let randomized = ref randomized_default
 

jscomp/stdlib-406/obj.ml

@@ -28,9 +28,15 @@ external size : t -> int = "%obj_size"
 external reachable_words : t -> int = "caml_obj_reachable_words"
 external field : t -> int -> t = "%obj_field"
 external set_field : t -> int -> t -> unit = "%obj_set_field"
+#if BS then
+external floatarray_get : floatarray -> int -> float = "%array_safe_get"
+external floatarray_set :
+    floatarray -> int -> float -> unit = "%array_safe_set"
+#else
 external floatarray_get : floatarray -> int -> float = "caml_floatarray_get"
 external floatarray_set :
     floatarray -> int -> float -> unit = "caml_floatarray_set"
+#end    
 let [@inline always] double_field x i = floatarray_get (obj x : floatarray) i
 let [@inline always] set_double_field x i v =
   floatarray_set (obj x : floatarray) i v
@@ -93,7 +99,7 @@ module Ephemeron = struct
 
   external create: int -> t = "caml_ephe_create"
 
-  let length x = size(repr x) - 2
+  let length x = size(repr x) - 2 (*-FIXME*)
 
   external get_key: t -> int -> obj_t option = "caml_ephe_get_key"
   external get_key_copy: t -> int -> obj_t option = "caml_ephe_get_key_copy"

jscomp/stdlib-406/spacetime.ml

@@ -11,12 +11,15 @@
 (*   special exception on linking described in the file LICENSE.          *)
 (*                                                                        *)
 (**************************************************************************)
-
+#if BS then
+let spacetime_enabled : unit -> bool = fun _ -> false
+let enabled = false
+#else
 external spacetime_enabled : unit -> bool
   = "caml_spacetime_enabled" [@@noalloc]
 
 let enabled = spacetime_enabled ()
-
+#end
 let if_spacetime_enabled f =
   if enabled then f () else ()
 

jscomp/stdlib-406/string.ml

@@ -36,7 +36,7 @@ module B = Bytes
 
 let bts = B.unsafe_to_string
 let bos = B.unsafe_of_string
-
+(*-FIXME: replaced by Belt.String.repeat *)
 let make n c =
   B.make n c |> bts
 let init n f =

jscomp/stdlib-406/sys.ml

@@ -129,12 +129,15 @@ let catch_break on =
   else
     set_signal sigint Signal_default
 
-
+#if BS then
+let enable_runtime_warnings : bool -> unit = fun _ -> () 
+let runtime_warnings_enabled : unit -> bool = fun _ -> false
+#else
 external enable_runtime_warnings: bool -> unit =
   "caml_ml_enable_runtime_warnings"
 external runtime_warnings_enabled: unit -> bool =
   "caml_ml_runtime_warnings_enabled"
-
+#end
 (* The version string is found in file ../VERSION *)
 
 let ocaml_version = "4.06.2+BS"

jscomp/switch.js

@@ -0,0 +1,42 @@
+#!/usr/bin/env node
+var fs = require('fs')
+var path = require('path')
+
+
+var clean = require('./cleanlib.js')
+function toggleMakefile() {
+    var filename = path.join(__dirname,'Makefile.shared')
+    var line = fs.readFileSync(filename,'utf8')
+    var toggled = (line.split('\n').map(x => {
+        if (x.startsWith('STDLIB')) {
+            return '# ' + x
+        } else if (x.startsWith('# STDLIB')) {
+            return x.substring(2)
+        }
+        return x
+    }).join('\n'))
+
+    fs.writeFileSync(filename, toggled, 'utf8')
+}
+function toggleSharedMakefile(){
+    var filename = path.join(__dirname, 'test','Makefile')
+    var line = fs.readFileSync(filename,'utf8')
+    var toggled = (line.split('\n').map(x => {
+        if(x.startsWith('	# ocaml_typedtree_test')){
+            return '	ocaml_typedtree_test'
+        } else {
+            if (x.startsWith('	ocaml_typedtree_test')){
+                return '	# ocaml_typedtree_test'
+            }
+        }
+        return x 
+    })).join('\n')
+    fs.writeFileSync(filename,toggled,'utf8')
+}
+
+
+toggleMakefile()
+toggleSharedMakefile()
+clean.run()
+
+

jscomp/test/adt_optimize_test.ml

@@ -105,7 +105,43 @@ let f8 = function
   | T65 _ -> 2
   | _ -> 3 
 
-
+(*
+ocaml402
+{[
+  (function param/1098
+          (catch
+            (catch
+              (catch
+                (switch param/1098
+                 case int 0: (exit 11)
+                 case int 1: (exit 11)
+                 case int 2: (exit 11)
+                 case tag 0: (exit 12)
+                 case tag 1: (exit 12)
+                 default: (exit 13))
+               with (13) 3)
+             with (11) 1)
+           with (12) 2))
+]}
+
+ocaml406
+{[
+   (function param/1069
+         (catch
+           (catch
+             (switch param/1069
+              case int 3: (exit 10)
+              case tag 0: (exit 9)
+              case tag 1: (exit 9)
+              case tag 2: (exit 10)
+              case tag 3: (exit 10)
+              default: 1)
+            with (10) 3)
+          with (9) 2))
+]}
+
+
+*)
 let f9 = function 
   | T60
   | T61

jscomp/test/local_exception_test.ml

@@ -9,7 +9,7 @@ let u = B
 exception D of int 
 
 let d = D  3
-#if OCAML_VERSION =~ "<4.03.0" then (* Not allowed *)
+#if 0  then (* Not allowed *)
 exception A of int 
 (* intentionally overridden , 
    so that we can not tell the differrence, only by [id]*)

jscomp/test/recursive_module.ml

@@ -1,3 +1,8 @@
+let suites :  Mt.pair_suites ref  = ref []
+let test_id = ref 0
+let eq loc x y = Mt.eq_suites ~test_id ~suites loc x y 
+
+
 module  rec Int32 : sig
   type t
   type buffer
@@ -14,3 +19,12 @@ module  rec Int3 : sig
 end = Int3
 
 
+
+(* expect raise Undefined_recursive_module *)
+;; eq __LOC__ 4
+ (try ignore (Int3.u 3); 3
+  with Undefined_recursive_module _ -> 4)
+
+
+let () = 
+  Mt.from_pair_suites __FILE__ !suites