jon.recoil.org
A fork of mtelver's day10 project
1(** Node.js test for multiple environment support.
2
3 This tests that multiple isolated execution environments work correctly,
4 including:
5 - Creating and destroying environments
6 - Isolation between environments (values defined in one don't leak to another)
7 - Using the default environment
8 - Listing environments
9*)
10
11open Js_top_worker
12open Impl
13
14(* Flusher that writes to process.stdout in Node.js *)
15let console_flusher (s : string) : unit =
16 let open Js_of_ocaml in
17 let process = Js.Unsafe.get Js.Unsafe.global (Js.string "process") in
18 let stdout = Js.Unsafe.get process (Js.string "stdout") in
19 let write = Js.Unsafe.get stdout (Js.string "write") in
20 ignore (Js.Unsafe.call write stdout [| Js.Unsafe.inject (Js.string s) |])
21
22let capture : (unit -> 'a) -> unit -> Impl.captured * 'a =
23 fun f () ->
24 let stdout_buff = Buffer.create 1024 in
25 let stderr_buff = Buffer.create 1024 in
26 Js_of_ocaml.Sys_js.set_channel_flusher stdout (Buffer.add_string stdout_buff);
27 let x = f () in
28 let captured =
29 {
30 Impl.stdout = Buffer.contents stdout_buff;
31 stderr = Buffer.contents stderr_buff;
32 }
33 in
34 Js_of_ocaml.Sys_js.set_channel_flusher stdout console_flusher;
35 (captured, x)
36
37module S : Impl.S = struct
38 type findlib_t = Js_top_worker_web.Findlibish.t
39
40 let capture = capture
41
42 let sync_get f =
43 let f = Fpath.v ("_opam/" ^ f) in
44 try Some (In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all)
45 with _ -> None
46
47 let async_get f =
48 let f = Fpath.v ("_opam/" ^ f) in
49 try
50 let content =
51 In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all
52 in
53 Lwt.return (Ok content)
54 with e -> Lwt.return (Error (`Msg (Printexc.to_string e)))
55
56 let create_file = Js_of_ocaml.Sys_js.create_file
57
58 let import_scripts urls =
59 let open Js_of_ocaml.Js in
60 let import_scripts_fn = Unsafe.get Unsafe.global (string "importScripts") in
61 List.iter
62 (fun url ->
63 let (_ : 'a) =
64 Unsafe.fun_call import_scripts_fn [| Unsafe.inject (string url) |]
65 in
66 ())
67 urls
68
69 let init_function _ () = failwith "Not implemented"
70 let findlib_init = Js_top_worker_web.Findlibish.init async_get
71
72 let get_stdlib_dcs uri =
73 Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
74 |> Result.to_list
75
76 let find_stdlib_dcs v =
77 let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
78 | Some _ as r -> r
79 | None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
80 in
81 match pkg with
82 | Some url ->
83 Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
84 |> Result.to_list
85 | None -> []
86
87 let require b v = function
88 | [] -> []
89 | packages ->
90 Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v
91 packages
92
93 let path = "/static/cmis"
94end
95
96module U = Impl.Make (S)
97
98(* Test result tracking *)
99let total_tests = ref 0
100let passed_tests = ref 0
101
102let test name check message =
103 incr total_tests;
104 let passed = check in
105 if passed then incr passed_tests;
106 let status = if passed then "PASS" else "FAIL" in
107 Printf.printf "[%s] %s: %s\n%!" status name message
108
109let contains s substr =
110 try
111 let _ = Str.search_forward (Str.regexp_string substr) s 0 in
112 true
113 with Not_found -> false
114
115let run_toplevel env_id code =
116 let ( let* ) m f =
117 let open Lwt in
118 m >>= function
119 | Ok x -> f x
120 | Error e -> return (Error e)
121 in
122 let* result = U.exec_toplevel env_id ("# " ^ code) in
123 Lwt.return (Ok result.script)
124
125let _ =
126 Printf.printf "=== Node.js Environment Tests ===\n\n%!";
127
128 Logs.set_reporter (Logs_fmt.reporter ());
129 Logs.set_level (Some Logs.Info);
130
131 let ( let* ) m f =
132 let open Lwt in
133 m >>= function
134 | Ok x -> f x
135 | Error e -> return (Error e)
136 in
137
138 let init_config =
139 { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true }
140 in
141
142 let test_sequence =
143 (* Initialize *)
144 let* _ = U.init init_config in
145
146 Printf.printf "--- Section 1: Default Environment ---\n%!";
147
148 (* Setup default environment *)
149 let* _ = U.setup "" in
150 test "default_setup" true "Default environment setup";
151
152 (* Define a value in default environment *)
153 let* r = run_toplevel "" "let default_val = 42;;" in
154 test "default_define" (contains r "val default_val : int = 42") r;
155
156 Printf.printf "\n--- Section 2: Creating New Environments ---\n%!";
157
158 (* Create a new environment "env1" *)
159 let* _ = U.create_env "env1" in
160 test "create_env1" true "Created environment env1";
161
162 (* Setup env1 *)
163 let* _ = U.setup "env1" in
164 test "setup_env1" true "Setup environment env1";
165
166 (* Define a different value in env1 *)
167 let* r = run_toplevel "env1" "let env1_val = 100;;" in
168 test "env1_define" (contains r "val env1_val : int = 100") r;
169
170 Printf.printf "\n--- Section 3: Environment Isolation ---\n%!";
171
172 (* Check that default_val is NOT visible in env1 - the script output
173 should NOT contain "val default_val" if there was an error *)
174 let* r = run_toplevel "env1" "default_val;;" in
175 test "isolation_default_from_env1" (not (contains r "val default_val"))
176 ("No leakage: " ^ String.sub r 0 (min 40 (String.length r)));
177
178 (* Check that env1_val is NOT visible in default env *)
179 let* r = run_toplevel "" "env1_val;;" in
180 test "isolation_env1_from_default" (not (contains r "val env1_val"))
181 ("No leakage: " ^ String.sub r 0 (min 40 (String.length r)));
182
183 (* Check that default_val IS still visible in default env *)
184 let* r = run_toplevel "" "default_val;;" in
185 test "default_still_works" (contains r "- : int = 42") r;
186
187 Printf.printf "\n--- Section 4: Multiple Environments ---\n%!";
188
189 (* Create a second environment *)
190 let* _ = U.create_env "env2" in
191 let* _ = U.setup "env2" in
192 test "create_and_setup_env2" true "Created and setup env2";
193
194 (* Define value in env2 *)
195 let* r = run_toplevel "env2" "let env2_val = 200;;" in
196 test "env2_define" (contains r "val env2_val : int = 200") r;
197
198 (* Verify isolation between all three environments *)
199 let* r = run_toplevel "env2" "env1_val;;" in
200 test "isolation_env1_from_env2" (not (contains r "val env1_val"))
201 ("No leakage: " ^ String.sub r 0 (min 40 (String.length r)));
202
203 let* r = run_toplevel "env1" "env2_val;;" in
204 test "isolation_env2_from_env1" (not (contains r "val env2_val"))
205 ("No leakage: " ^ String.sub r 0 (min 40 (String.length r)));
206
207 Printf.printf "\n--- Section 5: List Environments ---\n%!";
208
209 (* List all environments *)
210 let* envs = U.list_envs () in
211 test "list_envs_count" (List.length envs >= 3)
212 (Printf.sprintf "Found %d environments" (List.length envs));
213 test "list_envs_has_default" (List.mem "default" envs)
214 (String.concat ", " envs);
215 test "list_envs_has_env1" (List.mem "env1" envs)
216 (String.concat ", " envs);
217 test "list_envs_has_env2" (List.mem "env2" envs)
218 (String.concat ", " envs);
219
220 Printf.printf "\n--- Section 6: Destroy Environment ---\n%!";
221
222 (* Destroy env2 *)
223 let* _ = U.destroy_env "env2" in
224 test "destroy_env2" true "Destroyed env2";
225
226 (* Verify env2 is gone from list *)
227 let* envs = U.list_envs () in
228 test "env2_destroyed" (not (List.mem "env2" envs))
229 (String.concat ", " envs);
230
231 (* env1 should still exist *)
232 test "env1_still_exists" (List.mem "env1" envs)
233 (String.concat ", " envs);
234
235 Printf.printf "\n--- Section 7: Reuse Environment Name ---\n%!";
236
237 (* Re-create env2 *)
238 let* _ = U.create_env "env2" in
239 let* _ = U.setup "env2" in
240
241 (* Old values should not exist - checking that it doesn't find the old value *)
242 let* r = run_toplevel "env2" "env2_val;;" in
243 test "new_env2_clean" (not (contains r "- : int = 200"))
244 ("Old value gone: " ^ String.sub r 0 (min 40 (String.length r)));
245
246 (* Define new value *)
247 let* r = run_toplevel "env2" "let new_env2_val = 999;;" in
248 test "new_env2_define" (contains r "val new_env2_val : int = 999") r;
249
250 Lwt.return (Ok ())
251 in
252
253 let promise = test_sequence in
254 (match Lwt.state promise with
255 | Lwt.Return (Ok ()) -> ()
256 | Lwt.Return (Error (InternalError s)) ->
257 Printf.printf "\n[ERROR] Test failed with: %s\n%!" s
258 | Lwt.Fail e ->
259 Printf.printf "\n[ERROR] Exception: %s\n%!" (Printexc.to_string e)
260 | Lwt.Sleep -> Printf.printf "\n[ERROR] Promise still pending\n%!");
261
262 Printf.printf "\n=== Results: %d/%d tests passed ===\n%!" !passed_tests
263 !total_tests;
264 if !passed_tests = !total_tests then
265 Printf.printf "SUCCESS: All environment tests passed!\n%!"
266 else Printf.printf "FAILURE: Some tests failed.\n%!"