this repo has no description
Add node test, not currently working
+173
+22
test/node/dune
+22
test/node/dune
···
1
+
(executable
2
+
(name node_test)
3
+
(modes byte)
4
+
(modules node_test)
5
+
(link_flags (-linkall))
6
+
(libraries js_of_ocaml js_of_ocaml-toplevel js_top_worker logs logs.fmt rpclib.core rpclib.json findlib.top))
7
+
8
+
(rule
9
+
(targets node_test.js)
10
+
(action
11
+
(run
12
+
%{bin:js_of_ocaml}
13
+
--toplevel
14
+
; --pretty
15
+
--no-cmis
16
+
--effects=cps
17
+
+toplevel.js
18
+
+dynlink.js
19
+
+bigstringaf/runtime.js
20
+
%{dep:node_test.bc}
21
+
-o
22
+
%{targets})))
+151
test/node/node_test.ml
+151
test/node/node_test.ml
···
1
+
(* Unix worker *)
2
+
open Js_top_worker
3
+
open Impl
4
+
5
+
let capture : (unit -> 'a) -> unit -> Impl.captured * 'a =
6
+
fun f () ->
7
+
let stdout_buff = Buffer.create 1024 in
8
+
let stderr_buff = Buffer.create 1024 in
9
+
Js_of_ocaml.Sys_js.set_channel_flusher stdout
10
+
(Buffer.add_string stdout_buff);
11
+
Js_of_ocaml.Sys_js.set_channel_flusher stderr
12
+
(Buffer.add_string stderr_buff);
13
+
let x = f () in
14
+
let captured =
15
+
{
16
+
Impl.stdout = Buffer.contents stdout_buff;
17
+
stderr = Buffer.contents stderr_buff;
18
+
}
19
+
in
20
+
(captured, x)
21
+
22
+
let handle_findlib_error = function
23
+
| Failure msg -> Printf.fprintf stderr "%s" msg
24
+
| Fl_package_base.No_such_package (pkg, reason) ->
25
+
Printf.fprintf stderr "No such package: %s%s\n" pkg
26
+
(if reason <> "" then " - " ^ reason else "")
27
+
| Fl_package_base.Package_loop pkg ->
28
+
Printf.fprintf stderr "Package requires itself: %s\n" pkg
29
+
| exn -> raise exn
30
+
31
+
module Server = Js_top_worker_rpc.Toplevel_api_gen.Make (Impl.IdlM.GenServer ())
32
+
33
+
module S : Impl.S = struct
34
+
type findlib_t = unit
35
+
36
+
let capture = capture
37
+
let sync_get _ = None
38
+
let create_file = Js_of_ocaml.Sys_js.create_file
39
+
40
+
let import_scripts urls =
41
+
if List.length urls > 0 then failwith "Not implemented" else ()
42
+
43
+
let init_function _ () = failwith "Not implemented"
44
+
let findlib_init _ = ()
45
+
let get_stdlib_dcs _uri = []
46
+
47
+
let require () packages =
48
+
try
49
+
let eff_packages =
50
+
Findlib.package_deep_ancestors !Topfind.predicates packages
51
+
in
52
+
Topfind.load eff_packages;
53
+
[]
54
+
with exn ->
55
+
handle_findlib_error exn;
56
+
[]
57
+
end
58
+
59
+
module U = Impl.Make (S)
60
+
61
+
(* let test () =
62
+
let _x = Compmisc.initial_env in
63
+
let oc = open_out "/tmp/unix_worker.ml" in
64
+
Printf.fprintf oc "let x=1;;\n";
65
+
close_out oc;
66
+
let unit_info = Unit_info.make ~source_file:"/tmp/unix_worker.ml" "/tmp/unix_worker" in
67
+
try
68
+
let _ast = Pparse.parse_implementation ~tool_name:"worker" "/tmp/unix_worker.ml" in
69
+
let _ = Typemod.type_implementation unit_info (Compmisc.initial_env ()) _ast in
70
+
()
71
+
with exn ->
72
+
Printf.eprintf "error: %s\n%!" (Printexc.to_string exn);
73
+
let ppf = Format.err_formatter in
74
+
let _ = Location.report_exception ppf exn in
75
+
() *)
76
+
77
+
let start_server () =
78
+
let open U in
79
+
Logs.set_reporter (Logs_fmt.reporter ());
80
+
Logs.set_level (Some Logs.Info);
81
+
(* let pid = Unix.getpid () in *)
82
+
Server.exec execute;
83
+
Server.setup setup;
84
+
Server.init init;
85
+
Server.typecheck typecheck_phrase;
86
+
Server.complete_prefix complete_prefix;
87
+
Server.query_errors query_errors;
88
+
Server.type_enclosing type_enclosing;
89
+
Server.compile_js compile_js;
90
+
Server.exec_toplevel exec_toplevel;
91
+
IdlM.server Server.implementation
92
+
93
+
module Client = Js_top_worker_rpc.Toplevel_api_gen.Make (Impl.IdlM.GenClient ())
94
+
95
+
let _ =
96
+
let rpc = start_server () in
97
+
Printf.printf "Starting worker...\n%!";
98
+
let ( let* ) = IdlM.ErrM.bind in
99
+
let dcs =
100
+
Js_top_worker_rpc.Toplevel_api_gen.
101
+
{
102
+
dcs_url = "cmis/";
103
+
dcs_toplevel_modules =
104
+
[
105
+
"CamlinternalOO";
106
+
"Stdlib";
107
+
"CamlinternalFormat";
108
+
"Std_exit";
109
+
"CamlinternalMod";
110
+
"CamlinternalFormatBasics";
111
+
"CamlinternalLazy";
112
+
];
113
+
dcs_file_prefixes = [ "stdlib__" ];
114
+
}
115
+
in
116
+
let init =
117
+
Js_top_worker_rpc.Toplevel_api_gen.
118
+
{
119
+
path = "/tmp/static/cmis";
120
+
cmas = [];
121
+
cmis = { dynamic_cmis = [ dcs ]; static_cmis = [] };
122
+
stdlib_dcs = "/lib/ocaml/dynamic_cmis.json";
123
+
findlib_index = "/lib/findlib_index";
124
+
findlib_requires = [];
125
+
}
126
+
in
127
+
let x =
128
+
let* _ = Client.init rpc init in
129
+
let* o = Client.setup rpc () in
130
+
Printf.printf "setup output: %s\n%!" (Option.value ~default:"" o.stdout);
131
+
let* _ =
132
+
Client.query_errors rpc (Some "c1") [] false "typ xxxx = int;;\n"
133
+
in
134
+
let* o1 =
135
+
Client.query_errors rpc (Some "c2") ["c1"] false "type yyy = xxx;;\n"
136
+
in
137
+
Printf.printf "Number of errors: %d\n%!" (List.length o1);
138
+
let* _ =
139
+
Client.query_errors rpc (Some "c1") [] false "type xxx = int;;\n"
140
+
in
141
+
let* o2 =
142
+
Client.query_errors rpc (Some "c2") ["c1"] false
143
+
"type yyy = xxx;;\n"
144
+
in
145
+
Printf.printf "Number of errors1: %d\n%!" (List.length o1);
146
+
Printf.printf "Number of errors2: %d\n%!" (List.length o2);
147
+
IdlM.ErrM.return ()
148
+
in
149
+
match x |> IdlM.T.get |> M.run with
150
+
| Ok () -> Printf.printf "Success\n%!"
151
+
| Error (InternalError s) -> Printf.printf "Error: %s\n%!" s