jon.recoil.org
A fork of mtelver's day10 project
1(** Node.js test for MIME output infrastructure.
2
3 This tests that the MIME output infrastructure is wired up correctly:
4 - exec_result.mime_vals field is returned
5 - Field is empty when no MIME output occurs
6 - API types are correctly defined
7
8 Note: The mime_printer library is used internally by the worker to
9 capture MIME output. User code can call Mime_printer.push to produce
10 MIME values when the mime_printer package is loaded in the toplevel.
11*)
12
13open Js_top_worker
14open Impl
15
16(* Flusher that writes to process.stdout in Node.js *)
17let console_flusher (s : string) : unit =
18 let open Js_of_ocaml in
19 let process = Js.Unsafe.get Js.Unsafe.global (Js.string "process") in
20 let stdout = Js.Unsafe.get process (Js.string "stdout") in
21 let write = Js.Unsafe.get stdout (Js.string "write") in
22 ignore (Js.Unsafe.call write stdout [| Js.Unsafe.inject (Js.string s) |])
23
24let capture : (unit -> 'a) -> unit -> Impl.captured * 'a =
25 fun f () ->
26 let stdout_buff = Buffer.create 1024 in
27 let stderr_buff = Buffer.create 1024 in
28 Js_of_ocaml.Sys_js.set_channel_flusher stdout (Buffer.add_string stdout_buff);
29 let x = f () in
30 let captured =
31 {
32 Impl.stdout = Buffer.contents stdout_buff;
33 stderr = Buffer.contents stderr_buff;
34 }
35 in
36 Js_of_ocaml.Sys_js.set_channel_flusher stdout console_flusher;
37 (captured, x)
38
39module S : Impl.S = struct
40 type findlib_t = Js_top_worker_web.Findlibish.t
41
42 let capture = capture
43
44 let sync_get f =
45 let f = Fpath.v ("_opam/" ^ f) in
46 try Some (In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all)
47 with _ -> None
48
49 let async_get f =
50 let f = Fpath.v ("_opam/" ^ f) in
51 try
52 let content =
53 In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all
54 in
55 Lwt.return (Ok content)
56 with e -> Lwt.return (Error (`Msg (Printexc.to_string e)))
57
58 let create_file = Js_of_ocaml.Sys_js.create_file
59
60 let import_scripts urls =
61 let open Js_of_ocaml.Js in
62 let import_scripts_fn = Unsafe.get Unsafe.global (string "importScripts") in
63 List.iter
64 (fun url ->
65 let (_ : 'a) =
66 Unsafe.fun_call import_scripts_fn [| Unsafe.inject (string url) |]
67 in
68 ())
69 urls
70
71 let init_function _ () = failwith "Not implemented"
72 let findlib_init = Js_top_worker_web.Findlibish.init async_get
73
74 let get_stdlib_dcs uri =
75 Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
76 |> Result.to_list
77
78 let find_stdlib_dcs v =
79 let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
80 | Some _ as r -> r
81 | None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
82 in
83 match pkg with
84 | Some url ->
85 Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
86 |> Result.to_list
87 | None -> []
88
89 let require b v = function
90 | [] -> []
91 | packages ->
92 Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v
93 packages
94
95 let path = "/static/cmis"
96end
97
98module U = Impl.Make (S)
99
100(* Test result tracking *)
101let total_tests = ref 0
102let passed_tests = ref 0
103
104let test name check message =
105 incr total_tests;
106 let passed = check in
107 if passed then incr passed_tests;
108 let status = if passed then "PASS" else "FAIL" in
109 Printf.printf "[%s] %s: %s\n%!" status name message
110
111let _ =
112 Printf.printf "=== Node.js MIME Infrastructure Tests ===\n\n%!";
113
114 Logs.set_reporter (Logs_fmt.reporter ());
115 Logs.set_level (Some Logs.Info);
116
117 let ( let* ) m f =
118 let open Lwt in
119 m >>= function
120 | Ok x -> f x
121 | Error e -> return (Error e)
122 in
123
124 let run_exec code = U.execute "" code in
125
126 let init_config =
127 { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true }
128 in
129
130 let test_sequence =
131 (* Initialize *)
132 let* _ = U.init init_config in
133 let* _ = U.setup "" in
134
135 Printf.printf "--- Section 1: exec_result Has mime_vals Field ---\n%!";
136
137 (* Basic execution returns a result with mime_vals *)
138 let* r = run_exec {|let x = 1 + 2;;|} in
139 test "has_mime_vals_field" true "exec_result has mime_vals field";
140 test "mime_vals_is_list" (List.length r.mime_vals >= 0)
141 (Printf.sprintf "mime_vals is a list (length=%d)" (List.length r.mime_vals));
142 test "mime_vals_empty_no_output" (List.length r.mime_vals = 0)
143 "mime_vals is empty when no MIME output";
144
145 Printf.printf "\n--- Section 2: MIME Type Definitions ---\n%!";
146
147 (* Verify API types are accessible *)
148 let mime_val_example : mime_val = {
149 mime_type = "text/html";
150 encoding = Mime_printer.Noencoding;
151 data = "<b>test</b>";
152 } in
153 test "mime_type_field" (mime_val_example.mime_type = "text/html")
154 "mime_val has mime_type field";
155 test "encoding_noencoding" (mime_val_example.encoding = Mime_printer.Noencoding)
156 "Noencoding variant works";
157 test "data_field" (mime_val_example.data = "<b>test</b>")
158 "mime_val has data field";
159
160 let mime_val_base64 : mime_val = {
161 mime_type = "image/png";
162 encoding = Mime_printer.Base64;
163 data = "iVBORw0KGgo=";
164 } in
165 test "encoding_base64" (mime_val_base64.encoding = Mime_printer.Base64)
166 "Base64 variant works";
167
168 Printf.printf "\n--- Section 3: Multiple Executions ---\n%!";
169
170 (* Verify mime_vals is fresh for each execution *)
171 let* r1 = run_exec {|let a = 1;;|} in
172 let* r2 = run_exec {|let b = 2;;|} in
173 let* r3 = run_exec {|let c = 3;;|} in
174 test "r1_mime_empty" (List.length r1.mime_vals = 0) "First exec: mime_vals empty";
175 test "r2_mime_empty" (List.length r2.mime_vals = 0) "Second exec: mime_vals empty";
176 test "r3_mime_empty" (List.length r3.mime_vals = 0) "Third exec: mime_vals empty";
177
178 Printf.printf "\n--- Section 4: exec_toplevel Has mime_vals ---\n%!";
179
180 (* exec_toplevel also returns mime_vals *)
181 let* tr = U.exec_toplevel "" "# let z = 42;;" in
182 test "toplevel_has_mime_vals" true "exec_toplevel_result has mime_vals field";
183 test "toplevel_mime_vals_list" (List.length tr.mime_vals >= 0)
184 (Printf.sprintf "toplevel mime_vals is a list (length=%d)" (List.length tr.mime_vals));
185
186 Lwt.return (Ok ())
187 in
188
189 let promise = test_sequence in
190 (match Lwt.state promise with
191 | Lwt.Return (Ok ()) -> ()
192 | Lwt.Return (Error (InternalError s)) ->
193 Printf.printf "\n[ERROR] Test failed with: %s\n%!" s
194 | Lwt.Fail e ->
195 Printf.printf "\n[ERROR] Exception: %s\n%!" (Printexc.to_string e)
196 | Lwt.Sleep -> Printf.printf "\n[ERROR] Promise still pending\n%!");
197
198 Printf.printf "\n=== Results: %d/%d tests passed ===\n%!" !passed_tests
199 !total_tests;
200 if !passed_tests = !total_tests then
201 Printf.printf "SUCCESS: All MIME infrastructure tests passed!\n%!"
202 else Printf.printf "FAILURE: Some tests failed.\n%!"