Fix toplevel generation

CHANGES.md

@@ -1,7 +1,10 @@
 # ?? (??) - ??
 
 ## Features/Changes
-* Lib: add hidden, onfullscreenchange and onwebkitfullscreenchange to to Dom_html.document
+* Lib: add hidden, onfullscreenchange and onwebkitfullscreenchange to document
+
+## Bug fixes
+* Compiler: fix toplevel generation (#1129, #1130, #1131)
 
 # 3.10.0 (2021-08-30) - Lille
 ## Features/Changes

compiler/lib/parse_bytecode.ml

@@ -2211,7 +2211,8 @@ end
 
 let read_primitives toc ic =
   let prim = Toc.read_prim toc ic in
-  String.split_char ~sep:'\000' prim
+  assert (Char.equal (String.get prim (String.length prim - 1)) '\000');
+  String.split_char ~sep:'\000' (String.sub prim ~pos:0 ~len:(String.length prim - 1))
 
 let from_exe
     ?(includes = [])
@@ -2311,7 +2312,7 @@ let from_exe
       let toc =
         [ "SYMB", Obj.repr symbols
         ; "CRCS", Obj.repr crcs
-        ; "PRIM", Obj.repr (String.concat ~sep:"\000" primitives)
+        ; "PRIM", Obj.repr (String.concat ~sep:"\000" primitives ^ "\000")
         ]
       in
       let gdata = Var.fresh () in

compiler/lib/stdlib.ml

@@ -486,16 +486,7 @@ module String = struct
     done;
     !res
 
-  let split_char ~sep p =
-    let len = String.length p in
-    let rec split beg cur =
-      if cur >= len
-      then if cur - beg > 0 then [ String.sub p beg (cur - beg) ] else []
-      else if Char.equal p.[cur] sep
-      then String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
-      else split beg (cur + 1)
-    in
-    split 0 0
+  let split_char ~sep p = String.split_on_char sep p
 
   (* copied from https://github.com/ocaml/ocaml/pull/10 *)
   let split ~sep s =

toplevel/bin/jsoo_common.ml

@@ -75,16 +75,18 @@ let cmis_of_package pkg : string list =
       with exc -> if String.equal pkg "stdlib" then "stdlib.cma" else raise exc
     in
     let l = String.split_char ~sep:' ' archive in
-    List.iter l ~f:(fun x ->
-        if Filename.check_suffix x ".cmo"
-        then
-          let u = Filename.chop_suffix x ".cmo" in
-          add (read_cmi ~dir (u ^ ".cmi"))
-        else if Filename.check_suffix x ".cma"
-        then List.iter (cmis_of_cma ~dir x) ~f:add
-        else if Filename.check_suffix x ".cmi"
-        then add (read_cmi ~dir (Filename.chop_suffix x ".cmi"))
-        else Format.eprintf "Wrong extension for archive %s@." x);
+    List.iter l ~f:(function
+        | "" -> ()
+        | x ->
+            if Filename.check_suffix x ".cmo"
+            then
+              let u = Filename.chop_suffix x ".cmo" in
+              add (read_cmi ~dir (u ^ ".cmi"))
+            else if Filename.check_suffix x ".cma"
+            then List.iter (cmis_of_cma ~dir x) ~f:add
+            else if Filename.check_suffix x ".cmi"
+            then add (read_cmi ~dir (Filename.chop_suffix x ".cmi"))
+            else Format.eprintf "Wrong extension for archive %s@." x);
     !fs
   with exn ->
     Format.eprintf "Error for package %s@." pkg;

toplevel/test/dune

@@ -0,0 +1,40 @@
+(executables
+ (names test_toplevel)
+ (libraries js_of_ocaml_toplevel)
+ (flags (:standard -linkall))
+ (modes byte))
+
+(rule
+ (targets export.txt)
+ (deps
+   (package js_of_ocaml-toplevel)
+ )
+ (action (run
+    jsoo_listunits -o %{targets}
+      stdlib
+      js_of_ocaml-toplevel
+      )))
+
+(rule
+ (targets test_toplevel.js)
+ (action
+    (run %{bin:js_of_ocaml}
+         -I .
+         --export %{dep:export.txt}
+         --toplevel
+         --disable shortvar
+         +toplevel.js +dynlink.js
+         %{dep:test_toplevel.bc}
+         -o %{targets}
+    )))
+
+
+(rule
+  (target test_toplevel.referencejs)
+  (deps test_toplevel.js)
+  (action (with-outputs-to %{target} (run node ./test_toplevel.js))))
+
+(rule
+  (alias runtest)
+  (deps test_toplevel.reference test_toplevel.referencejs)
+  (action (diff test_toplevel.reference test_toplevel.referencejs)))

toplevel/test/test_toplevel.ml

@@ -0,0 +1,13 @@
+open Js_of_ocaml_toplevel
+
+let () = JsooTop.initialize ()
+
+let fmt = Format.std_formatter
+
+let () =
+  JsooTop.execute
+    true
+    ~pp_code:fmt
+    ~highlight_location:(fun _ -> ())
+    fmt
+    {|let () = print_endline "hello";;|}

toplevel/test/test_toplevel.reference

@@ -0,0 +1,2 @@
+let () = print_endline "hello";;
+hello