jon.recoil.org
this repo has no description
1(* Test incremental output *)
2open Js_top_worker
3open Impl
4
5let 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 (Buffer.add_string stdout_buff);
10
11 let x = f () in
12 let captured =
13 {
14 Impl.stdout = Buffer.contents stdout_buff;
15 stderr = Buffer.contents stderr_buff;
16 }
17 in
18 (captured, x)
19
20module S : Impl.S = struct
21 type findlib_t = Js_top_worker_web.Findlibish.t
22
23 let capture = capture
24
25 let sync_get f =
26 let f = Fpath.v ("_opam/" ^ f) in
27 Logs.info (fun m -> m "sync_get: %a" Fpath.pp f);
28 try Some (In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all)
29 with e ->
30 Logs.err (fun m ->
31 m "Error reading file %a: %s" Fpath.pp f (Printexc.to_string e));
32 None
33
34 let async_get f =
35 let f = Fpath.v ("_opam/" ^ f) in
36 Logs.info (fun m -> m "async_get: %a" Fpath.pp f);
37 try
38 let content =
39 In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all
40 in
41 Lwt.return (Ok content)
42 with e ->
43 Logs.err (fun m ->
44 m "Error reading file %a: %s" Fpath.pp f (Printexc.to_string e));
45 Lwt.return (Error (`Msg (Printexc.to_string e)))
46
47 let create_file = Js_of_ocaml.Sys_js.create_file
48
49 let import_scripts urls =
50 let open Js_of_ocaml.Js in
51 let import_scripts_fn = Unsafe.get Unsafe.global (string "importScripts") in
52 List.iter
53 (fun url ->
54 let (_ : 'a) =
55 Unsafe.fun_call import_scripts_fn [| Unsafe.inject (string url) |]
56 in
57 ())
58 urls
59
60 let init_function _ () = failwith "Not implemented"
61 let findlib_init = Js_top_worker_web.Findlibish.init async_get
62
63 let get_stdlib_dcs uri =
64 Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
65 |> Result.to_list
66
67 let find_stdlib_dcs v =
68 let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
69 | Some _ as r -> r
70 | None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
71 in
72 match pkg with
73 | Some url ->
74 Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
75 |> Result.to_list
76 | None -> []
77
78 let require b v = function
79 | [] -> []
80 | packages -> Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v packages
81
82 let path = "/static/cmis"
83end
84
85module U = Impl.Make (S)
86
87let _ =
88 Logs.set_reporter (Logs_fmt.reporter ());
89 Logs.set_level (Some Logs.Info);
90
91 let ( let* ) m f =
92 let open Lwt in
93 m >>= function
94 | Ok x -> f x
95 | Error e -> return (Error e)
96 in
97
98 let init_config =
99 { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true }
100 in
101
102 let x =
103 let* _ = U.init init_config in
104 let* _ = U.setup "" in
105 Logs.info (fun m -> m "Setup complete, testing incremental output...");
106
107 (* Test incremental output with multiple phrases *)
108 let phrase_outputs = ref [] in
109 let on_phrase_output (p : U.phrase_output) =
110 Logs.info (fun m -> m " OutputAt: loc=%d caml_ppf=%s"
111 p.loc
112 (Option.value ~default:"<none>" p.caml_ppf));
113 phrase_outputs := p :: !phrase_outputs
114 in
115
116 let code = "let x = 1;; let y = 2;; let z = x + y;;" in
117 Logs.info (fun m -> m "Evaluating: %s" code);
118
119 let* result = U.execute_incremental "" code ~on_phrase_output in
120
121 let num_callbacks = List.length !phrase_outputs in
122 Logs.info (fun m -> m "Number of OutputAt callbacks: %d (expected 3)" num_callbacks);
123
124 (* Verify we got 3 callbacks (one per phrase) *)
125 if num_callbacks <> 3 then
126 Logs.err (fun m -> m "FAIL: Expected 3 callbacks, got %d" num_callbacks)
127 else
128 Logs.info (fun m -> m "PASS: Got expected number of callbacks");
129
130 (* Verify the locations are increasing *)
131 let locs = List.rev_map (fun (p : U.phrase_output) -> p.loc) !phrase_outputs in
132 let sorted = List.sort compare locs in
133 if locs = sorted then
134 Logs.info (fun m -> m "PASS: Locations are in increasing order: %s"
135 (String.concat ", " (List.map string_of_int locs)))
136 else
137 Logs.err (fun m -> m "FAIL: Locations are not in order");
138
139 (* Verify final result has expected values *)
140 Logs.info (fun m -> m "Final result caml_ppf: %s"
141 (Option.value ~default:"<none>" result.caml_ppf));
142 Logs.info (fun m -> m "Final result stdout: %s"
143 (Option.value ~default:"<none>" result.stdout));
144
145 Lwt.return (Ok ())
146 in
147
148 let promise = x in
149 match Lwt.state promise with
150 | Lwt.Return (Ok ()) -> Logs.info (fun m -> m "Test completed successfully")
151 | Lwt.Return (Error (InternalError s)) -> Logs.err (fun m -> m "Error: %s" s)
152 | Lwt.Fail e ->
153 Logs.err (fun m -> m "Unexpected failure: %s" (Printexc.to_string e))
154 | Lwt.Sleep ->
155 Logs.err (fun m -> m "Error: Promise is still pending")