jon.recoil.org
this repo has no description
Add multiple isolated execution environments
This commit adds support for multiple isolated OCaml execution environments,
each with its own type environment and failed cell tracking.
Key changes:
- New Environment module (lib/environment.ml) provides:
- Isolated execution contexts using Toploop.toplevel_env
- Per-environment state (is_setup, failed_cells)
- Create/destroy/list operations
- with_env for safe context switching
- Updated API to include env_id parameter on all environment-scoped operations
- Changed env_id from string option to string (empty = default) for cmdliner compatibility
- Updated all clients, workers, tests, and examples
Environment IDs are strings. Empty string maps to "default" environment.
All existing single-environment usage continues to work unchanged.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+2
-2
example/example.ml
+2
-2
example/example.ml
···
40
40
let _ =
41
41
let ( let* ) = Lwt_result.bind in
42
42
let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in
43
-
let* o = W.setup rpc () in
43
+
let* o = W.setup rpc "" in
44
44
log_output o;
45
-
let* o = W.exec rpc "Stringext.of_list ['a';'b';'c'];;" in
45
+
let* o = W.exec rpc "" "Stringext.of_list ['a';'b';'c'];;" in
46
46
log_output o;
47
47
Lwt.return (Ok ())
+2
-2
example/example2.ml
+2
-2
example/example2.ml
···
36
36
let _ =
37
37
let ( let* ) = Lwt_result.bind in
38
38
let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in
39
-
let* o = W.setup rpc () in
39
+
let* o = W.setup rpc "" in
40
40
log_output o;
41
-
let* o = W.exec rpc "2*2;;" in
41
+
let* o = W.exec rpc "" "2*2;;" in
42
42
log_output o;
43
43
Lwt.return (Ok ())
+3
-3
example/example3.ml
+3
-3
example/example3.ml
···
36
36
let _ =
37
37
let ( let* ) = Lwt_result.bind in
38
38
let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in
39
-
let* o = W.setup rpc () in
39
+
let* o = W.setup rpc "" in
40
40
log_output o;
41
-
let* _o = W.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in
41
+
let* _o = W.query_errors rpc "" (Some "c1") [] false "type xxx = int;;\n" in
42
42
let* _o2 =
43
-
W.query_errors rpc (Some "c2") [ "c1" ] true
43
+
W.query_errors rpc "" (Some "c2") [ "c1" ] true
44
44
"# type yyy = xxx;;\n type yyy = xxx\n"
45
45
in
46
46
Lwt.return (Ok ())
+5
-5
example/example4.ml
+5
-5
example/example4.ml
···
36
36
let _ =
37
37
let ( let* ) = Lwt_result.bind in
38
38
let* rpc = initialise "_opam/worker.js" (fun _ -> log "Timeout") in
39
-
let* o = W.setup rpc () in
39
+
let* o = W.setup rpc "" in
40
40
log_output o;
41
-
let* _o = W.query_errors rpc (Some "c1") [] false "type xxxx = int;;\n" in
41
+
let* _o = W.query_errors rpc "" (Some "c1") [] false "type xxxx = int;;\n" in
42
42
let* _o2 =
43
-
W.query_errors rpc (Some "c2") [ "c1" ] true
43
+
W.query_errors rpc "" (Some "c2") [ "c1" ] true
44
44
"# type yyy = xxx;;\n type yyy = xxx\n"
45
45
in
46
-
let* _o = W.query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in
46
+
let* _o = W.query_errors rpc "" (Some "c1") [] false "type xxx = int;;\n" in
47
47
let* _o2 =
48
-
W.query_errors rpc (Some "c2") [ "c1" ] true
48
+
W.query_errors rpc "" (Some "c2") [ "c1" ] true
49
49
"# type yyy = xxx (* With a comment *);;\n type yyy = xxx\n"
50
50
in
51
51
+5
-2
example/unix_worker.ml
+5
-2
example/unix_worker.ml
···
165
165
Logs.set_reporter (Logs_fmt.reporter ());
166
166
Logs.set_level (Some Logs.Info);
167
167
(* let pid = Unix.getpid () in *)
168
-
Server.exec execute;
168
+
Server.init (IdlM.T.lift init);
169
+
Server.create_env (IdlM.T.lift create_env);
170
+
Server.destroy_env (IdlM.T.lift destroy_env);
171
+
Server.list_envs (IdlM.T.lift list_envs);
169
172
Server.setup (IdlM.T.lift setup);
170
-
Server.init (IdlM.T.lift init);
173
+
Server.exec execute;
171
174
Server.typecheck typecheck_phrase;
172
175
Server.complete_prefix complete_prefix;
173
176
Server.query_errors query_errors;
+33
-6
idl/js_top_worker_client.ml
+33
-6
idl/js_top_worker_client.ml
···
80
80
Toplevel_api_gen.init_config ->
81
81
(unit, Toplevel_api_gen.err) result Lwt.t
82
82
83
+
val create_env :
84
+
rpc ->
85
+
string ->
86
+
(unit, Toplevel_api_gen.err) result Lwt.t
87
+
88
+
val destroy_env :
89
+
rpc ->
90
+
string ->
91
+
(unit, Toplevel_api_gen.err) result Lwt.t
92
+
93
+
val list_envs :
94
+
rpc ->
95
+
(string list, Toplevel_api_gen.err) result Lwt.t
96
+
83
97
val setup :
84
98
rpc ->
85
-
unit ->
99
+
string ->
86
100
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
87
101
88
102
val typecheck :
89
103
rpc ->
104
+
string ->
90
105
string ->
91
106
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
92
107
93
108
val exec :
94
109
rpc ->
110
+
string ->
95
111
string ->
96
112
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t
97
113
114
+
val exec_toplevel :
115
+
rpc ->
116
+
string ->
117
+
string ->
118
+
(Toplevel_api_gen.exec_toplevel_result, Toplevel_api_gen.err) result Lwt.t
119
+
98
120
val query_errors :
99
121
rpc ->
122
+
string ->
100
123
string option ->
101
124
string list ->
102
125
bool ->
···
108
131
type exec_result = Toplevel_api_gen.exec_result
109
132
110
133
let init rpc a = Wraw.init rpc a |> Rpc_lwt.T.get
111
-
let setup rpc a = Wraw.setup rpc a |> Rpc_lwt.T.get
112
-
let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_lwt.T.get
113
-
let exec rpc a = Wraw.exec rpc a |> Rpc_lwt.T.get
134
+
let create_env rpc env_id = Wraw.create_env rpc env_id |> Rpc_lwt.T.get
135
+
let destroy_env rpc env_id = Wraw.destroy_env rpc env_id |> Rpc_lwt.T.get
136
+
let list_envs rpc = Wraw.list_envs rpc () |> Rpc_lwt.T.get
137
+
let setup rpc env_id = Wraw.setup rpc env_id |> Rpc_lwt.T.get
138
+
let typecheck rpc env_id phrase = Wraw.typecheck rpc env_id phrase |> Rpc_lwt.T.get
139
+
let exec rpc env_id phrase = Wraw.exec rpc env_id phrase |> Rpc_lwt.T.get
140
+
let exec_toplevel rpc env_id script = Wraw.exec_toplevel rpc env_id script |> Rpc_lwt.T.get
114
141
115
-
let query_errors rpc id deps is_toplevel doc =
116
-
Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_lwt.T.get
142
+
let query_errors rpc env_id id deps is_toplevel doc =
143
+
Wraw.query_errors rpc env_id id deps is_toplevel doc |> Rpc_lwt.T.get
117
144
end
+29
-12
idl/js_top_worker_client.mli
+29
-12
idl/js_top_worker_client.mli
···
38
38
val init : rpc -> init_config -> (unit, err) result Lwt.t
39
39
(** Initialise the toplevel. This must be called before any other API. *)
40
40
41
-
val setup : rpc -> unit -> (exec_result, err) result Lwt.t
42
-
(** Start the toplevel. Return value is the initial blurb printed when
43
-
starting a toplevel. Note that the toplevel must be initialised first. *)
41
+
val create_env : rpc -> string -> (unit, err) result Lwt.t
42
+
(** Create a new isolated execution environment with the given ID. *)
43
+
44
+
val destroy_env : rpc -> string -> (unit, err) result Lwt.t
45
+
(** Destroy an execution environment. *)
46
+
47
+
val list_envs : rpc -> (string list, err) result Lwt.t
48
+
(** List all existing environment IDs. *)
49
+
50
+
val setup : rpc -> string -> (exec_result, err) result Lwt.t
51
+
(** Start the toplevel for the given environment. If [env_id] is empty string,
52
+
uses the default environment. Return value is the initial blurb printed
53
+
when starting a toplevel. Note that the toplevel must be initialised first. *)
44
54
45
-
val typecheck : rpc -> string -> (exec_result, err) result Lwt.t
46
-
(** Typecheck a phrase using the toplevel. The toplevel must have been
47
-
initialised first. *)
55
+
val typecheck : rpc -> string -> string -> (exec_result, err) result Lwt.t
56
+
(** Typecheck a phrase using the toplevel. If [env_id] is empty string, uses the
57
+
default environment. The toplevel must have been initialised first. *)
58
+
59
+
val exec : rpc -> string -> string -> (exec_result, err) result Lwt.t
60
+
(** Execute a phrase using the toplevel. If [env_id] is empty string, uses the
61
+
default environment. The toplevel must have been initialised first. *)
48
62
49
-
val exec : rpc -> string -> (exec_result, err) result Lwt.t
50
-
(** Execute a phrase using the toplevel. The toplevel must have been
51
-
initialised first. *)
63
+
val exec_toplevel :
64
+
rpc ->
65
+
string ->
66
+
string ->
67
+
(Toplevel_api_gen.exec_toplevel_result, err) result Lwt.t
68
+
(** Execute a toplevel script. If [env_id] is empty string, uses the default
69
+
environment. The toplevel must have been initialised first. *)
52
70
53
71
val query_errors :
54
72
rpc ->
73
+
string ->
55
74
string option ->
56
75
string list ->
57
76
bool ->
58
77
string ->
59
78
(Toplevel_api_gen.error list, err) result Lwt.t
60
-
(** Query the toplevel for errors. The first argument is the phrase to check
61
-
for errors. If it is [None], the toplevel will return all errors. If it is
62
-
[Some s], the toplevel will return only errors related to [s]. *)
79
+
(** Query the toplevel for errors. [env_id] specifies the environment. *)
63
80
end
+13
-10
idl/js_top_worker_client_fut.ml
+13
-10
idl/js_top_worker_client_fut.ml
···
78
78
type exec_result = Toplevel_api_gen.exec_result
79
79
80
80
let init rpc a = Wraw.init rpc a |> Rpc_fut.T.get
81
-
let setup rpc a = Wraw.setup rpc a |> Rpc_fut.T.get
82
-
let typecheck rpc a = Wraw.typecheck rpc a |> Rpc_fut.T.get
83
-
let exec rpc a = Wraw.exec rpc a |> Rpc_fut.T.get
81
+
let create_env rpc env_id = Wraw.create_env rpc env_id |> Rpc_fut.T.get
82
+
let destroy_env rpc env_id = Wraw.destroy_env rpc env_id |> Rpc_fut.T.get
83
+
let list_envs rpc = Wraw.list_envs rpc () |> Rpc_fut.T.get
84
+
let setup rpc env_id = Wraw.setup rpc env_id |> Rpc_fut.T.get
85
+
let typecheck rpc env_id phrase = Wraw.typecheck rpc env_id phrase |> Rpc_fut.T.get
86
+
let exec rpc env_id phrase = Wraw.exec rpc env_id phrase |> Rpc_fut.T.get
84
87
85
-
let query_errors rpc id deps is_toplevel doc =
86
-
Wraw.query_errors rpc id deps is_toplevel doc |> Rpc_fut.T.get
88
+
let query_errors rpc env_id id deps is_toplevel doc =
89
+
Wraw.query_errors rpc env_id id deps is_toplevel doc |> Rpc_fut.T.get
87
90
88
-
let exec_toplevel rpc doc = Wraw.exec_toplevel rpc doc |> Rpc_fut.T.get
91
+
let exec_toplevel rpc env_id doc = Wraw.exec_toplevel rpc env_id doc |> Rpc_fut.T.get
89
92
90
-
let complete_prefix rpc id deps is_toplevel doc pos =
91
-
Wraw.complete_prefix rpc id deps is_toplevel doc pos |> Rpc_fut.T.get
93
+
let complete_prefix rpc env_id id deps is_toplevel doc pos =
94
+
Wraw.complete_prefix rpc env_id id deps is_toplevel doc pos |> Rpc_fut.T.get
92
95
93
-
let type_enclosing rpc id deps is_toplevel doc pos =
94
-
Wraw.type_enclosing rpc id deps is_toplevel doc pos |> Rpc_fut.T.get
96
+
let type_enclosing rpc env_id id deps is_toplevel doc pos =
97
+
Wraw.type_enclosing rpc env_id id deps is_toplevel doc pos |> Rpc_fut.T.get
95
98
end
+57
-18
idl/toplevel_api.ml
+57
-18
idl/toplevel_api.ml
···
192
192
193
193
type opt_id = string option [@@deriving rpcty]
194
194
195
+
type env_id = string [@@deriving rpcty]
196
+
(** Environment identifier. If empty string, uses the default environment. *)
197
+
198
+
type env_id_list = string list [@@deriving rpcty]
199
+
(** List of environment identifiers *)
200
+
195
201
type dependencies = string list [@@deriving rpcty]
196
202
(** The ids of the cells that are dependencies *)
197
203
···
221
227
let unit_p = Param.mk Types.unit
222
228
let phrase_p = Param.mk Types.string
223
229
let id_p = Param.mk opt_id
230
+
let env_id_p = Param.mk ~name:"env_id" ~description:["Environment ID (empty string for default)"] env_id
231
+
let env_id_list_p = Param.mk env_id_list
224
232
let dependencies_p = Param.mk dependencies
225
233
let typecheck_result_p = Param.mk exec_result
226
234
let exec_result_p = Param.mk exec_result
···
254
262
[ "Initialise the toplevel. This must be called before any other API." ]
255
263
(init_libs @-> returning unit_p err)
256
264
265
+
(** {2 Environment Management} *)
266
+
267
+
let create_env =
268
+
declare "create_env"
269
+
[
270
+
"Create a new isolated execution environment with the given ID.";
271
+
"Returns unit on success. The environment must be set up with";
272
+
"setup_env before use.";
273
+
]
274
+
(env_id_p @-> returning unit_p err)
275
+
276
+
let destroy_env =
277
+
declare "destroy_env"
278
+
[
279
+
"Destroy an execution environment, freeing its resources.";
280
+
"The environment ID must exist.";
281
+
]
282
+
(env_id_p @-> returning unit_p err)
283
+
284
+
let list_envs =
285
+
declare "list_envs"
286
+
[ "List all existing environment IDs." ]
287
+
(unit_p @-> returning env_id_list_p err)
288
+
257
289
let setup =
258
290
declare "setup"
259
291
[
260
-
"Start the toplevel. Return value is the initial blurb ";
261
-
"printed when starting a toplevel. Note that the toplevel";
262
-
"must be initialised first.";
292
+
"Start the toplevel for the given environment. Return value is the";
293
+
"initial blurb printed when starting a toplevel. Note that the";
294
+
"toplevel must be initialised first. If env_id is None, uses the";
295
+
"default environment.";
263
296
]
264
-
(unit_p @-> returning exec_result_p err)
297
+
(env_id_p @-> returning exec_result_p err)
265
298
266
299
let typecheck =
267
300
declare "typecheck"
268
-
[ "Typecheck a phrase without actually executing it." ]
269
-
(phrase_p @-> returning typecheck_result_p err)
301
+
[
302
+
"Typecheck a phrase without actually executing it.";
303
+
"If env_id is None, uses the default environment.";
304
+
]
305
+
(env_id_p @-> phrase_p @-> returning typecheck_result_p err)
270
306
271
307
let exec =
272
308
declare "exec"
273
309
[
274
310
"Execute a phrase using the toplevel. The toplevel must have been";
275
-
"Initialised first.";
311
+
"initialised first. If env_id is None, uses the default environment.";
276
312
]
277
-
(phrase_p @-> returning exec_result_p err)
313
+
(env_id_p @-> phrase_p @-> returning exec_result_p err)
278
314
279
315
let exec_toplevel =
280
316
declare "exec_toplevel"
281
317
[
282
318
"Execute a toplevel script. The toplevel must have been";
283
-
"Initialised first. Returns the updated toplevel script.";
319
+
"initialised first. Returns the updated toplevel script.";
320
+
"If env_id is None, uses the default environment.";
284
321
]
285
-
(toplevel_script_p @-> returning exec_toplevel_result_p err)
322
+
(env_id_p @-> toplevel_script_p @-> returning exec_toplevel_result_p err)
286
323
287
324
let complete_prefix =
288
325
declare "complete_prefix"
289
-
[
290
-
"Complete a prefix"
326
+
[
327
+
"Complete a prefix. If env_id is None, uses the default environment.";
291
328
]
292
-
(id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> position_p @-> returning completions_p err)
293
-
329
+
(env_id_p @-> id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> position_p @-> returning completions_p err)
330
+
294
331
let query_errors =
295
332
declare "query_errors"
296
333
[
297
-
"Query the errors in the given source"
334
+
"Query the errors in the given source.";
335
+
"If env_id is None, uses the default environment.";
298
336
]
299
-
(id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> returning error_list_p err)
337
+
(env_id_p @-> id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> returning error_list_p err)
300
338
301
339
let type_enclosing =
302
340
declare "type_enclosing"
303
341
[
304
-
"Get the type of the enclosing expression"
342
+
"Get the type of the enclosing expression.";
343
+
"If env_id is None, uses the default environment.";
305
344
]
306
-
(id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> position_p @-> returning typed_enclosings_p err)
345
+
(env_id_p @-> id_p @-> dependencies_p @-> is_toplevel_p @-> source_p @-> position_p @-> returning typed_enclosings_p err)
307
346
end
+88
-24
idl/toplevel_api_gen.ml
+88
-24
idl/toplevel_api_gen.ml
···
2118
2118
let _ = typ_of_opt_id
2119
2119
and _ = opt_id
2120
2120
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2121
+
type env_id = string[@@deriving rpcty][@@ocaml.doc
2122
+
" Environment identifier. If empty string, uses the default environment. "]
2123
+
include
2124
+
struct
2125
+
let _ = fun (_ : env_id) -> ()
2126
+
let rec typ_of_env_id = let open Rpc.Types in Basic String
2127
+
and env_id =
2128
+
{
2129
+
Rpc.Types.name = "env_id";
2130
+
Rpc.Types.description =
2131
+
["Environment identifier. If empty string, uses the default environment."];
2132
+
Rpc.Types.ty = typ_of_env_id
2133
+
}
2134
+
let _ = typ_of_env_id
2135
+
and _ = env_id
2136
+
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2137
+
type env_id_list = string list[@@deriving rpcty][@@ocaml.doc
2138
+
" List of environment identifiers "]
2139
+
include
2140
+
struct
2141
+
let _ = fun (_ : env_id_list) -> ()
2142
+
let rec typ_of_env_id_list =
2143
+
Rpc.Types.List (let open Rpc.Types in Basic String)
2144
+
and env_id_list =
2145
+
{
2146
+
Rpc.Types.name = "env_id_list";
2147
+
Rpc.Types.description = ["List of environment identifiers"];
2148
+
Rpc.Types.ty = typ_of_env_id_list
2149
+
}
2150
+
let _ = typ_of_env_id_list
2151
+
and _ = env_id_list
2152
+
end[@@ocaml.doc "@inline"][@@merlin.hide ]
2121
2153
type dependencies = string list[@@deriving rpcty][@@ocaml.doc
2122
2154
" The ids of the cells that are dependencies "]
2123
2155
include
···
2159
2191
let unit_p = Param.mk Types.unit
2160
2192
let phrase_p = Param.mk Types.string
2161
2193
let id_p = Param.mk opt_id
2194
+
let env_id_p =
2195
+
Param.mk ~name:"env_id"
2196
+
~description:["Environment ID (empty string for default)"] env_id
2197
+
let env_id_list_p = Param.mk env_id_list
2162
2198
let dependencies_p = Param.mk dependencies
2163
2199
let typecheck_result_p = Param.mk exec_result
2164
2200
let exec_result_p = Param.mk exec_result
···
2182
2218
declare "init"
2183
2219
["Initialise the toplevel. This must be called before any other API."]
2184
2220
(init_libs @-> (returning unit_p err))
2221
+
[@@@ocaml.text " {2 Environment Management} "]
2222
+
let create_env =
2223
+
declare "create_env"
2224
+
["Create a new isolated execution environment with the given ID.";
2225
+
"Returns unit on success. The environment must be set up with";
2226
+
"setup_env before use."] (env_id_p @-> (returning unit_p err))
2227
+
let destroy_env =
2228
+
declare "destroy_env"
2229
+
["Destroy an execution environment, freeing its resources.";
2230
+
"The environment ID must exist."]
2231
+
(env_id_p @-> (returning unit_p err))
2232
+
let list_envs =
2233
+
declare "list_envs" ["List all existing environment IDs."]
2234
+
(unit_p @-> (returning env_id_list_p err))
2185
2235
let setup =
2186
2236
declare "setup"
2187
-
["Start the toplevel. Return value is the initial blurb ";
2188
-
"printed when starting a toplevel. Note that the toplevel";
2189
-
"must be initialised first."]
2190
-
(unit_p @-> (returning exec_result_p err))
2237
+
["Start the toplevel for the given environment. Return value is the";
2238
+
"initial blurb printed when starting a toplevel. Note that the";
2239
+
"toplevel must be initialised first. If env_id is None, uses the";
2240
+
"default environment."] (env_id_p @-> (returning exec_result_p err))
2191
2241
let typecheck =
2192
2242
declare "typecheck"
2193
-
["Typecheck a phrase without actually executing it."]
2194
-
(phrase_p @-> (returning typecheck_result_p err))
2243
+
["Typecheck a phrase without actually executing it.";
2244
+
"If env_id is None, uses the default environment."]
2245
+
(env_id_p @-> (phrase_p @-> (returning typecheck_result_p err)))
2195
2246
let exec =
2196
2247
declare "exec"
2197
2248
["Execute a phrase using the toplevel. The toplevel must have been";
2198
-
"Initialised first."] (phrase_p @-> (returning exec_result_p err))
2249
+
"initialised first. If env_id is None, uses the default environment."]
2250
+
(env_id_p @-> (phrase_p @-> (returning exec_result_p err)))
2199
2251
let exec_toplevel =
2200
2252
declare "exec_toplevel"
2201
2253
["Execute a toplevel script. The toplevel must have been";
2202
-
"Initialised first. Returns the updated toplevel script."]
2203
-
(toplevel_script_p @-> (returning exec_toplevel_result_p err))
2254
+
"initialised first. Returns the updated toplevel script.";
2255
+
"If env_id is None, uses the default environment."]
2256
+
(env_id_p @->
2257
+
(toplevel_script_p @-> (returning exec_toplevel_result_p err)))
2204
2258
let complete_prefix =
2205
-
declare "complete_prefix" ["Complete a prefix"]
2206
-
(id_p @->
2207
-
(dependencies_p @->
2208
-
(is_toplevel_p @->
2209
-
(source_p @-> (position_p @-> (returning completions_p err))))))
2259
+
declare "complete_prefix"
2260
+
["Complete a prefix. If env_id is None, uses the default environment."]
2261
+
(env_id_p @->
2262
+
(id_p @->
2263
+
(dependencies_p @->
2264
+
(is_toplevel_p @->
2265
+
(source_p @->
2266
+
(position_p @-> (returning completions_p err)))))))
2210
2267
let query_errors =
2211
-
declare "query_errors" ["Query the errors in the given source"]
2212
-
(id_p @->
2213
-
(dependencies_p @->
2214
-
(is_toplevel_p @-> (source_p @-> (returning error_list_p err)))))
2268
+
declare "query_errors"
2269
+
["Query the errors in the given source.";
2270
+
"If env_id is None, uses the default environment."]
2271
+
(env_id_p @->
2272
+
(id_p @->
2273
+
(dependencies_p @->
2274
+
(is_toplevel_p @->
2275
+
(source_p @-> (returning error_list_p err))))))
2215
2276
let type_enclosing =
2216
-
declare "type_enclosing" ["Get the type of the enclosing expression"]
2217
-
(id_p @->
2218
-
(dependencies_p @->
2219
-
(is_toplevel_p @->
2220
-
(source_p @->
2221
-
(position_p @-> (returning typed_enclosings_p err))))))
2277
+
declare "type_enclosing"
2278
+
["Get the type of the enclosing expression.";
2279
+
"If env_id is None, uses the default environment."]
2280
+
(env_id_p @->
2281
+
(id_p @->
2282
+
(dependencies_p @->
2283
+
(is_toplevel_p @->
2284
+
(source_p @->
2285
+
(position_p @-> (returning typed_enclosings_p err)))))))
2222
2286
end
+1
-1
lib/dune
+1
-1
lib/dune
+77
lib/environment.ml
+77
lib/environment.ml
···
1
+
(** Multiple isolated execution environments. *)
2
+
3
+
module StringSet = Set.Make (String)
4
+
5
+
type id = string
6
+
7
+
type t = {
8
+
id : id;
9
+
mutable toplevel_env : Env.t option;
10
+
mutable is_setup : bool;
11
+
failed_cells : StringSet.t ref;
12
+
}
13
+
14
+
let default_id = "default"
15
+
16
+
(* Global table of environments *)
17
+
let environments : (id, t) Hashtbl.t = Hashtbl.create 16
18
+
19
+
let create id =
20
+
let env = {
21
+
id;
22
+
toplevel_env = None;
23
+
is_setup = false;
24
+
failed_cells = ref StringSet.empty;
25
+
} in
26
+
Hashtbl.replace environments id env;
27
+
env
28
+
29
+
let get id = Hashtbl.find_opt environments id
30
+
31
+
let get_or_create id =
32
+
match get id with
33
+
| Some env -> env
34
+
| None -> create id
35
+
36
+
let destroy id = Hashtbl.remove environments id
37
+
38
+
let list () = Hashtbl.fold (fun id _ acc -> id :: acc) environments []
39
+
40
+
let id env = env.id
41
+
42
+
let with_env env f =
43
+
(* Save current toplevel environment *)
44
+
let saved = !Toploop.toplevel_env in
45
+
(* Restore this environment's state if we have one *)
46
+
(match env.toplevel_env with
47
+
| Some e -> Toploop.toplevel_env := e
48
+
| None -> ());
49
+
(* Run the function *)
50
+
let result =
51
+
try f ()
52
+
with exn ->
53
+
(* Save the environment state before re-raising *)
54
+
env.toplevel_env <- Some !Toploop.toplevel_env;
55
+
Toploop.toplevel_env := saved;
56
+
raise exn
57
+
in
58
+
(* Save the updated environment state *)
59
+
env.toplevel_env <- Some !Toploop.toplevel_env;
60
+
(* Restore the previous environment *)
61
+
Toploop.toplevel_env := saved;
62
+
result
63
+
64
+
let is_setup env = env.is_setup
65
+
66
+
let mark_setup env = env.is_setup <- true
67
+
68
+
let get_failed_cells env = !(env.failed_cells)
69
+
70
+
let add_failed_cell env cell_id =
71
+
env.failed_cells := StringSet.add cell_id !(env.failed_cells)
72
+
73
+
let remove_failed_cell env cell_id =
74
+
env.failed_cells := StringSet.remove cell_id !(env.failed_cells)
75
+
76
+
let is_cell_failed env cell_id =
77
+
StringSet.mem cell_id !(env.failed_cells)
+72
lib/environment.mli
+72
lib/environment.mli
···
1
+
(** Multiple isolated execution environments.
2
+
3
+
This module provides support for running multiple isolated OCaml
4
+
evaluation contexts within a single worker. Each environment has
5
+
its own type environment, allowing independent code execution
6
+
without interference.
7
+
8
+
Libraries are shared across all environments to save memory - once
9
+
a library is loaded, it's available to all environments. *)
10
+
11
+
(** {1 Types} *)
12
+
13
+
type t
14
+
(** An isolated execution environment. *)
15
+
16
+
type id = string
17
+
(** Environment identifier. *)
18
+
19
+
(** {1 Environment Management} *)
20
+
21
+
val create : id -> t
22
+
(** [create id] creates a new environment with the given identifier.
23
+
The environment starts uninitialized; call [setup] after creation. *)
24
+
25
+
val get : id -> t option
26
+
(** [get id] returns the environment with the given identifier, if it exists. *)
27
+
28
+
val get_or_create : id -> t
29
+
(** [get_or_create id] returns the existing environment or creates a new one. *)
30
+
31
+
val destroy : id -> unit
32
+
(** [destroy id] removes the environment with the given identifier. *)
33
+
34
+
val list : unit -> id list
35
+
(** [list ()] returns all environment identifiers. *)
36
+
37
+
val default_id : id
38
+
(** The default environment identifier used when none is specified. *)
39
+
40
+
val id : t -> id
41
+
(** [id env] returns the identifier of the environment. *)
42
+
43
+
(** {1 Environment Switching} *)
44
+
45
+
val with_env : t -> (unit -> 'a) -> 'a
46
+
(** [with_env env f] runs [f ()] in the context of environment [env].
47
+
The toplevel environment is saved before and restored after,
48
+
allowing isolated execution. *)
49
+
50
+
(** {1 Environment State} *)
51
+
52
+
val is_setup : t -> bool
53
+
(** [is_setup env] returns whether [setup] has been called for this environment. *)
54
+
55
+
val mark_setup : t -> unit
56
+
(** [mark_setup env] marks the environment as having completed setup. *)
57
+
58
+
(** {1 Failed Cells Tracking} *)
59
+
60
+
module StringSet : Set.S with type elt = string
61
+
62
+
val get_failed_cells : t -> StringSet.t
63
+
(** [get_failed_cells env] returns the set of cell IDs that failed to compile. *)
64
+
65
+
val add_failed_cell : t -> string -> unit
66
+
(** [add_failed_cell env cell_id] marks a cell as failed. *)
67
+
68
+
val remove_failed_cell : t -> string -> unit
69
+
(** [remove_failed_cell env cell_id] marks a cell as no longer failed. *)
70
+
71
+
val is_cell_failed : t -> string -> bool
72
+
(** [is_cell_failed env cell_id] checks if a cell is marked as failed. *)
+148
-88
lib/impl.ml
+148
-88
lib/impl.ml
···
167
167
The toplevel implementation, parameterized by backend operations. *)
168
168
169
169
module Make (S : S) = struct
170
-
(** {3 State} *)
170
+
(** {3 Global State}
171
+
172
+
These are shared across all environments. *)
171
173
172
174
let functions : (unit -> unit) list option ref = ref None
173
175
let requires : string list ref = ref []
174
176
let path : string option ref = ref None
175
177
let findlib_v : S.findlib_t Lwt.t option ref = ref None
176
178
let execution_allowed = ref true
179
+
180
+
(** {3 Environment Management}
181
+
182
+
Helper to resolve env_id string to an Environment.t.
183
+
Empty string means the default environment. *)
184
+
185
+
let resolve_env env_id =
186
+
let id = if env_id = "" then Environment.default_id else env_id in
187
+
Environment.get_or_create id
177
188
178
189
(** {3 Lexer Helpers} *)
179
190
···
290
301
with End_of_file -> ());
291
302
flush_all ()
292
303
293
-
let execute : string -> Toplevel_api_gen.exec_result =
304
+
let execute_in_env env phrase =
294
305
let code_buff = Buffer.create 100 in
295
306
let res_buff = Buffer.create 100 in
296
307
let pp_code = Format.formatter_of_buffer code_buff in
···
301
312
let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in
302
313
highlighted := Some Toplevel_api_gen.{ line1; col1; line2; col2 }
303
314
in
304
-
fun phrase ->
305
-
Buffer.clear code_buff;
306
-
Buffer.clear res_buff;
307
-
Buffer.clear stderr_buff;
308
-
Buffer.clear stdout_buff;
309
-
let o, () =
315
+
Buffer.clear code_buff;
316
+
Buffer.clear res_buff;
317
+
Buffer.clear stderr_buff;
318
+
Buffer.clear stdout_buff;
319
+
let o, () =
320
+
Environment.with_env env (fun () ->
310
321
S.capture
311
322
(fun () -> execute true ~pp_code ~highlight_location pp_result phrase)
312
-
()
313
-
in
314
-
let mime_vals = Mime_printer.get () in
315
-
Format.pp_print_flush pp_code ();
316
-
Format.pp_print_flush pp_result ();
317
-
Toplevel_api_gen.
318
-
{
319
-
stdout = string_opt o.stdout;
320
-
stderr = string_opt o.stderr;
321
-
sharp_ppf = buff_opt code_buff;
322
-
caml_ppf = buff_opt res_buff;
323
-
highlight = !highlighted;
324
-
mime_vals;
325
-
}
323
+
())
324
+
in
325
+
let mime_vals = Mime_printer.get () in
326
+
Format.pp_print_flush pp_code ();
327
+
Format.pp_print_flush pp_result ();
328
+
Toplevel_api_gen.
329
+
{
330
+
stdout = string_opt o.stdout;
331
+
stderr = string_opt o.stderr;
332
+
sharp_ppf = buff_opt code_buff;
333
+
caml_ppf = buff_opt res_buff;
334
+
highlight = !highlighted;
335
+
mime_vals;
336
+
}
326
337
327
338
(** {3 Dynamic CMI Loading}
328
339
···
465
476
Lwt.return
466
477
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
467
478
468
-
let setup () =
479
+
let setup env_id =
469
480
Lwt.catch
470
481
(fun () ->
471
-
Logs.info (fun m -> m "setup() ...");
482
+
let env = resolve_env env_id in
483
+
Logs.info (fun m -> m "setup() for env %s..." (Environment.id env));
472
484
473
-
let o =
474
-
try
475
-
match !functions with
476
-
| Some l -> setup l ()
477
-
| None -> failwith "Error: toplevel has not been initialised"
478
-
with
479
-
| Persistent_env.Error e ->
480
-
Persistent_env.report_error Format.err_formatter e;
481
-
let err = Format.asprintf "%a" Persistent_env.report_error e in
482
-
failwith ("Error: " ^ err)
483
-
| Env.Error _ as exn ->
484
-
Location.report_exception Format.err_formatter exn;
485
-
let err = Format.asprintf "%a" Location.report_exception exn in
486
-
failwith ("Error: " ^ err)
487
-
in
485
+
if Environment.is_setup env then (
486
+
Logs.info (fun m -> m "setup() already done for env %s" (Environment.id env));
487
+
Lwt.return
488
+
(Ok
489
+
Toplevel_api_gen.
490
+
{
491
+
stdout = None;
492
+
stderr = Some "Environment already set up";
493
+
sharp_ppf = None;
494
+
caml_ppf = None;
495
+
highlight = None;
496
+
mime_vals = [];
497
+
}))
498
+
else
499
+
let o =
500
+
Environment.with_env env (fun () ->
501
+
try
502
+
match !functions with
503
+
| Some l -> setup l ()
504
+
| None -> failwith "Error: toplevel has not been initialised"
505
+
with
506
+
| Persistent_env.Error e ->
507
+
Persistent_env.report_error Format.err_formatter e;
508
+
let err = Format.asprintf "%a" Persistent_env.report_error e in
509
+
failwith ("Error: " ^ err)
510
+
| Env.Error _ as exn ->
511
+
Location.report_exception Format.err_formatter exn;
512
+
let err = Format.asprintf "%a" Location.report_exception exn in
513
+
failwith ("Error: " ^ err))
514
+
in
488
515
489
-
let* dcs =
490
-
match !findlib_v with
491
-
| Some v ->
492
-
let* v = v in
493
-
Lwt.return (S.require (not !execution_allowed) v !requires)
494
-
| None -> Lwt.return []
495
-
in
516
+
let* dcs =
517
+
match !findlib_v with
518
+
| Some v ->
519
+
let* v = v in
520
+
Lwt.return (S.require (not !execution_allowed) v !requires)
521
+
| None -> Lwt.return []
522
+
in
496
523
497
-
let* () = Lwt_list.iter_p add_dynamic_cmis dcs in
524
+
let* () = Lwt_list.iter_p add_dynamic_cmis dcs in
498
525
499
-
Logs.info (fun m -> m "setup() finished");
526
+
Environment.mark_setup env;
527
+
Logs.info (fun m -> m "setup() finished for env %s" (Environment.id env));
500
528
501
-
Lwt.return
502
-
(Ok
503
-
Toplevel_api_gen.
504
-
{
505
-
stdout = string_opt o.stdout;
506
-
stderr = string_opt o.stderr;
507
-
sharp_ppf = None;
508
-
caml_ppf = None;
509
-
highlight = None;
510
-
mime_vals = [];
511
-
}))
529
+
Lwt.return
530
+
(Ok
531
+
Toplevel_api_gen.
532
+
{
533
+
stdout = string_opt o.stdout;
534
+
stderr = string_opt o.stderr;
535
+
sharp_ppf = None;
536
+
caml_ppf = None;
537
+
highlight = None;
538
+
mime_vals = [];
539
+
}))
512
540
(fun e ->
513
541
Lwt.return
514
542
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
515
543
516
-
let typecheck_phrase :
517
-
string ->
518
-
(Toplevel_api_gen.exec_result, Toplevel_api_gen.err) IdlM.T.resultb =
544
+
let typecheck_phrase env_id phr =
545
+
let env = resolve_env env_id in
519
546
let res_buff = Buffer.create 100 in
520
547
let pp_result = Format.formatter_of_buffer res_buff in
521
548
let highlighted = ref None in
···
524
551
let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in
525
552
highlighted := Some Toplevel_api_gen.{ line1; col1; line2; col2 }
526
553
in
527
-
fun phr ->
528
-
Buffer.clear res_buff;
529
-
Buffer.clear stderr_buff;
530
-
Buffer.clear stdout_buff;
554
+
Buffer.clear res_buff;
555
+
Buffer.clear stderr_buff;
556
+
Buffer.clear stdout_buff;
557
+
Environment.with_env env (fun () ->
531
558
try
532
559
let lb = Lexing.from_function (refill_lexbuf phr (ref 0) None) in
533
560
let phr = !Toploop.parse_toplevel_phrase lb in
···
569
596
caml_ppf = buff_opt res_buff;
570
597
highlight = !highlighted;
571
598
mime_vals = [];
572
-
}
599
+
})
573
600
574
-
let handle_toplevel stripped =
601
+
let handle_toplevel env stripped =
575
602
if String.length stripped < 2 || stripped.[0] <> '#' || stripped.[1] <> ' '
576
603
then (
577
604
Printf.eprintf
···
585
612
let mime_vals =
586
613
List.fold_left
587
614
(fun acc (phr, _junk, _output) ->
588
-
let new_output = execute phr in
615
+
let new_output = execute_in_env env phr in
589
616
Printf.bprintf buf "# %s\n" phr;
590
617
let r =
591
618
Option.to_list new_output.stdout
···
609
636
in
610
637
IdlM.ErrM.return result
611
638
612
-
let exec_toplevel (phrase : string) =
613
-
try handle_toplevel phrase
639
+
let exec_toplevel env_id (phrase : string) =
640
+
let env = resolve_env env_id in
641
+
try handle_toplevel env phrase
614
642
with e ->
615
643
Logs.info (fun m -> m "Error: %s" (Printexc.to_string e));
616
644
IdlM.ErrM.return_err
617
645
(Toplevel_api_gen.InternalError (Printexc.to_string e))
618
646
619
-
let execute (phrase : string) =
620
-
let result = execute phrase in
647
+
let execute env_id (phrase : string) =
648
+
let env = resolve_env env_id in
649
+
let result = execute_in_env env phrase in
621
650
IdlM.ErrM.return result
622
651
623
652
(** {3 Merlin Integration}
···
736
765
Some (from, to_, wdispatch source query)
737
766
end
738
767
739
-
module StringSet = Set.Make (String)
740
-
741
-
let failed_cells = ref StringSet.empty
742
-
743
-
let complete_prefix id deps is_toplevel source position =
768
+
let complete_prefix env_id id deps is_toplevel source position =
769
+
let _env = resolve_env env_id in (* Reserved for future use *)
744
770
try
745
771
Logs.info (fun m -> m "completing for id: %s" (match id with Some x -> x | None -> "(none)"));
746
772
···
807
833
IdlM.ErrM.return_err
808
834
(Toplevel_api_gen.InternalError (Printexc.to_string e))
809
835
810
-
let add_cmi id deps source =
836
+
let add_cmi execution_env id deps source =
811
837
Logs.info (fun m -> m "add_cmi");
812
838
let dep_modules = List.map modname_of_id deps in
813
839
let loc = Location.none in
···
836
862
Logs.info (fun m -> m "About to type_implementation");
837
863
let _ = Typemod.type_implementation unit_info env ast in
838
864
let b = Sys.file_exists (prefix ^ ".cmi") in
839
-
failed_cells := StringSet.remove id !failed_cells;
865
+
Environment.remove_failed_cell execution_env id;
840
866
Logs.info (fun m -> m "file_exists: %s = %b" (prefix ^ ".cmi") b));
841
867
Ocaml_typing.Cmi_cache.clear ()
842
868
with
843
869
| Env.Error _ as exn ->
844
870
Logs.err (fun m -> m "Env.Error: %a" Location.report_exception exn);
845
-
failed_cells := StringSet.add id !failed_cells;
871
+
Environment.add_failed_cell execution_env id;
846
872
()
847
873
| exn ->
848
874
let s = Printexc.to_string exn in
···
850
876
Logs.err (fun m -> m "Backtrace: %s" (Printexc.get_backtrace ()));
851
877
let ppf = Format.err_formatter in
852
878
let _ = Location.report_exception ppf exn in
853
-
failed_cells := StringSet.add id !failed_cells;
879
+
Environment.add_failed_cell execution_env id;
854
880
()
855
881
856
882
let map_pos line1 pos =
···
869
895
Ocaml_utils.Warnings.loc_end = map_pos line1 loc.loc_end;
870
896
}
871
897
872
-
let query_errors id deps is_toplevel orig_source =
898
+
let query_errors env_id id deps is_toplevel orig_source =
899
+
let execution_env = resolve_env env_id in
873
900
try
874
901
let deps =
875
-
List.filter (fun dep -> not (StringSet.mem dep !failed_cells)) deps
902
+
List.filter (fun dep -> not (Environment.is_cell_failed execution_env dep)) deps
876
903
in
877
904
(* Logs.info (fun m -> m "About to mangle toplevel"); *)
878
905
let line1, src = mangle_toplevel is_toplevel orig_source deps in
···
912
939
source;
913
940
})
914
941
in
915
-
if List.length errors = 0 then add_cmi id deps src
916
-
else failed_cells := StringSet.add id !failed_cells;
942
+
if List.length errors = 0 then add_cmi execution_env id deps src
943
+
else Environment.add_failed_cell execution_env id;
917
944
918
945
(* Logs.info (fun m -> m "Got to end"); *)
919
946
IdlM.ErrM.return errors
···
922
949
IdlM.ErrM.return_err
923
950
(Toplevel_api_gen.InternalError (Printexc.to_string e))
924
951
925
-
let type_enclosing _id deps is_toplevel orig_source position =
952
+
let type_enclosing env_id _id deps is_toplevel orig_source position =
953
+
let execution_env = resolve_env env_id in
926
954
try
927
955
let deps =
928
-
List.filter (fun dep -> not (StringSet.mem dep !failed_cells)) deps
956
+
List.filter (fun dep -> not (Environment.is_cell_failed execution_env dep)) deps
929
957
in
930
958
let line1, src = mangle_toplevel is_toplevel orig_source deps in
931
959
let src = line1 ^ src in
···
959
987
Logs.info (fun m -> m "Error: %s" (Printexc.to_string e));
960
988
IdlM.ErrM.return_err
961
989
(Toplevel_api_gen.InternalError (Printexc.to_string e))
990
+
991
+
(** {3 Environment Management RPCs} *)
992
+
993
+
let create_env env_id =
994
+
Lwt.catch
995
+
(fun () ->
996
+
Logs.info (fun m -> m "create_env(%s)" env_id);
997
+
let _env = Environment.create env_id in
998
+
Lwt.return (Ok ()))
999
+
(fun e ->
1000
+
Lwt.return
1001
+
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
1002
+
1003
+
let destroy_env env_id =
1004
+
Lwt.catch
1005
+
(fun () ->
1006
+
Logs.info (fun m -> m "destroy_env(%s)" env_id);
1007
+
Environment.destroy env_id;
1008
+
Lwt.return (Ok ()))
1009
+
(fun e ->
1010
+
Lwt.return
1011
+
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
1012
+
1013
+
let list_envs () =
1014
+
Lwt.catch
1015
+
(fun () ->
1016
+
let envs = Environment.list () in
1017
+
Logs.info (fun m -> m "list_envs() -> [%s]" (String.concat ", " envs));
1018
+
Lwt.return (Ok envs))
1019
+
(fun e ->
1020
+
Lwt.return
1021
+
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
962
1022
end
+5
-2
lib/worker.ml
+5
-2
lib/worker.ml
···
90
90
let _ = test () in
91
91
Logs.set_reporter (Logs_browser.console_reporter ());
92
92
Logs.set_level (Some Logs.Debug);
93
-
Server.exec execute;
93
+
Server.init (Impl.IdlM.T.lift init);
94
+
Server.create_env (Impl.IdlM.T.lift create_env);
95
+
Server.destroy_env (Impl.IdlM.T.lift destroy_env);
96
+
Server.list_envs (Impl.IdlM.T.lift list_envs);
94
97
Server.setup (Impl.IdlM.T.lift setup);
95
-
Server.init (Impl.IdlM.T.lift init);
98
+
Server.exec execute;
96
99
Server.typecheck typecheck_phrase;
97
100
Server.complete_prefix complete_prefix;
98
101
Server.query_errors query_errors;
+1
test/browser/.gitignore
+1
test/browser/.gitignore
···
1
+
node_modules/
+124
test/browser/client_test.ml
+124
test/browser/client_test.ml
···
1
+
(** Browser test for js_top_worker_client library.
2
+
3
+
This test runs in a browser via Playwright and exercises:
4
+
- Worker spawning
5
+
- RPC communication via postMessage
6
+
- Timeout handling
7
+
- All W module functions *)
8
+
9
+
open Js_of_ocaml
10
+
open Js_top_worker_rpc
11
+
module W = Js_top_worker_client.W
12
+
13
+
(* Test result tracking *)
14
+
type test_result = { name : string; passed : bool; message : string }
15
+
16
+
let results : test_result list ref = ref []
17
+
18
+
let log s = Console.console##log (Js.string s)
19
+
20
+
let add_result name passed message =
21
+
results := { name; passed; message } :: !results;
22
+
let status = if passed then "PASS" else "FAIL" in
23
+
log (Printf.sprintf "[%s] %s: %s" status name message)
24
+
25
+
let report_results () =
26
+
let total = List.length !results in
27
+
let passed = List.filter (fun r -> r.passed) !results |> List.length in
28
+
let failed = total - passed in
29
+
log (Printf.sprintf "\n=== Test Results: %d passed, %d failed ===" passed failed);
30
+
List.iter (fun r ->
31
+
let status = if r.passed then "OK" else "FAILED" in
32
+
log (Printf.sprintf " %s: %s - %s" status r.name r.message)
33
+
) (List.rev !results);
34
+
(* Set a global variable for Playwright to check *)
35
+
Js.Unsafe.set Js.Unsafe.global (Js.string "testResults")
36
+
(object%js
37
+
val total = total
38
+
val passed = passed
39
+
val failed = failed
40
+
val done_ = Js._true
41
+
end)
42
+
43
+
let test_init_and_setup rpc =
44
+
let ( let* ) = Lwt_result.bind in
45
+
let* () =
46
+
W.init rpc
47
+
Toplevel_api_gen.
48
+
{ stdlib_dcs = None; findlib_requires = []; execute = true }
49
+
in
50
+
add_result "init" true "Initialized successfully";
51
+
let* _o = W.setup rpc "" in
52
+
add_result "setup" true "Setup completed";
53
+
Lwt.return (Ok ())
54
+
55
+
let test_exec rpc =
56
+
let ( let* ) = Lwt_result.bind in
57
+
let* o = W.exec rpc "" "let x = 1 + 2;;" in
58
+
let has_output =
59
+
match o.caml_ppf with Some s -> String.length s > 0 | None -> false
60
+
in
61
+
add_result "exec" has_output
62
+
(Printf.sprintf "caml_ppf=%s"
63
+
(Option.value ~default:"(none)" o.caml_ppf));
64
+
Lwt.return (Ok ())
65
+
66
+
let test_exec_with_output rpc =
67
+
let ( let* ) = Lwt_result.bind in
68
+
let* o = W.exec rpc "" "print_endline \"hello from test\";;" in
69
+
let has_stdout =
70
+
match o.stdout with
71
+
| Some s -> Astring.String.is_prefix ~affix:"hello" s
72
+
| None -> false
73
+
in
74
+
add_result "exec_stdout" has_stdout
75
+
(Printf.sprintf "stdout=%s" (Option.value ~default:"(none)" o.stdout));
76
+
Lwt.return (Ok ())
77
+
78
+
let test_typecheck rpc =
79
+
let ( let* ) = Lwt_result.bind in
80
+
(* Valid code should typecheck *)
81
+
let* o1 = W.typecheck rpc "" "let f x = x + 1;;" in
82
+
let valid_ok = Option.is_none o1.stderr in
83
+
add_result "typecheck_valid" valid_ok "Valid code typechecks";
84
+
(* Invalid code should produce error *)
85
+
let* o2 = W.typecheck rpc "" "let f x = x + \"string\";;" in
86
+
let invalid_has_error = Option.is_some o2.stderr || Option.is_some o2.highlight in
87
+
add_result "typecheck_invalid" invalid_has_error "Invalid code produces error";
88
+
Lwt.return (Ok ())
89
+
90
+
let test_query_errors rpc =
91
+
let ( let* ) = Lwt_result.bind in
92
+
(* Test that query_errors RPC call works - result depends on context *)
93
+
let* _errors = W.query_errors rpc "" (Some "test1") [] false "let x : int = \"foo\";;" in
94
+
(* Success = the RPC call completed without error *)
95
+
add_result "query_errors" true "query_errors RPC call succeeded";
96
+
Lwt.return (Ok ())
97
+
98
+
let run_tests worker_url =
99
+
let ( let* ) = Lwt.bind in
100
+
log (Printf.sprintf "Starting tests with worker: %s" worker_url);
101
+
let rpc =
102
+
Js_top_worker_client.start worker_url 30000 (fun () ->
103
+
add_result "timeout" false "Unexpected timeout")
104
+
in
105
+
let test_sequence =
106
+
let ( let* ) = Lwt_result.bind in
107
+
let* () = test_init_and_setup rpc in
108
+
let* () = test_exec rpc in
109
+
let* () = test_exec_with_output rpc in
110
+
let* () = test_typecheck rpc in
111
+
let* () = test_query_errors rpc in
112
+
Lwt.return (Ok ())
113
+
in
114
+
let* result = test_sequence in
115
+
(match result with
116
+
| Ok () -> add_result "all_tests" true "All tests completed"
117
+
| Error (Toplevel_api_gen.InternalError msg) ->
118
+
add_result "all_tests" false (Printf.sprintf "Error: %s" msg));
119
+
report_results ();
120
+
Lwt.return ()
121
+
122
+
let () =
123
+
(* Use test_worker.bc.js by default *)
124
+
ignore (run_tests "test_worker.bc.js")
+23
test/browser/dune
+23
test/browser/dune
···
1
+
; Test worker - minimal worker for browser tests
2
+
(executable
3
+
(name test_worker)
4
+
(modes js)
5
+
(modules test_worker)
6
+
(link_flags (-linkall))
7
+
(preprocess (pps js_of_ocaml-ppx))
8
+
(js_of_ocaml
9
+
(flags (:standard --toplevel))
10
+
(javascript_files ../../lib/stubs.js))
11
+
(libraries js_top_worker-web zarith_stubs_js))
12
+
13
+
; Test client - exercises js_top_worker_client
14
+
(executable
15
+
(name client_test)
16
+
(modes js)
17
+
(modules client_test)
18
+
(preprocess (pps js_of_ocaml-ppx))
19
+
(libraries js_top_worker_client js_of_ocaml lwt astring))
20
+
21
+
(alias
22
+
(name default)
23
+
(deps client_test.bc.js test_worker.bc.js test.html))
+62
test/browser/package-lock.json
+62
test/browser/package-lock.json
···
1
+
{
2
+
"name": "js_top_worker_browser_tests",
3
+
"version": "1.0.0",
4
+
"lockfileVersion": 3,
5
+
"requires": true,
6
+
"packages": {
7
+
"": {
8
+
"name": "js_top_worker_browser_tests",
9
+
"version": "1.0.0",
10
+
"devDependencies": {
11
+
"playwright": "^1.40.0"
12
+
}
13
+
},
14
+
"node_modules/fsevents": {
15
+
"version": "2.3.2",
16
+
"resolved": "https://registry.npmjs.org/fsevents/-/fsevents-2.3.2.tgz",
17
+
"integrity": "sha512-xiqMQR4xAeHTuB9uWm+fFRcIOgKBMiOBP+eXiyT7jsgVCq1bkVygt00oASowB7EdtpOHaaPgKt812P9ab+DDKA==",
18
+
"dev": true,
19
+
"hasInstallScript": true,
20
+
"license": "MIT",
21
+
"optional": true,
22
+
"os": [
23
+
"darwin"
24
+
],
25
+
"engines": {
26
+
"node": "^8.16.0 || ^10.6.0 || >=11.0.0"
27
+
}
28
+
},
29
+
"node_modules/playwright": {
30
+
"version": "1.57.0",
31
+
"resolved": "https://registry.npmjs.org/playwright/-/playwright-1.57.0.tgz",
32
+
"integrity": "sha512-ilYQj1s8sr2ppEJ2YVadYBN0Mb3mdo9J0wQ+UuDhzYqURwSoW4n1Xs5vs7ORwgDGmyEh33tRMeS8KhdkMoLXQw==",
33
+
"dev": true,
34
+
"license": "Apache-2.0",
35
+
"dependencies": {
36
+
"playwright-core": "1.57.0"
37
+
},
38
+
"bin": {
39
+
"playwright": "cli.js"
40
+
},
41
+
"engines": {
42
+
"node": ">=18"
43
+
},
44
+
"optionalDependencies": {
45
+
"fsevents": "2.3.2"
46
+
}
47
+
},
48
+
"node_modules/playwright-core": {
49
+
"version": "1.57.0",
50
+
"resolved": "https://registry.npmjs.org/playwright-core/-/playwright-core-1.57.0.tgz",
51
+
"integrity": "sha512-agTcKlMw/mjBWOnD6kFZttAAGHgi/Nw0CZ2o6JqWSbMlI219lAFLZZCyqByTsvVAJq5XA5H8cA6PrvBRpBWEuQ==",
52
+
"dev": true,
53
+
"license": "Apache-2.0",
54
+
"bin": {
55
+
"playwright-core": "cli.js"
56
+
},
57
+
"engines": {
58
+
"node": ">=18"
59
+
}
60
+
}
61
+
}
62
+
}
+13
test/browser/package.json
+13
test/browser/package.json
···
1
+
{
2
+
"name": "js_top_worker_browser_tests",
3
+
"version": "1.0.0",
4
+
"description": "Browser tests for js_top_worker_client",
5
+
"private": true,
6
+
"scripts": {
7
+
"test": "node run_tests.js",
8
+
"test:headed": "node run_tests.js --headed"
9
+
},
10
+
"devDependencies": {
11
+
"playwright": "^1.40.0"
12
+
}
13
+
}
+133
test/browser/run_tests.js
+133
test/browser/run_tests.js
···
1
+
#!/usr/bin/env node
2
+
/**
3
+
* Playwright test runner for js_top_worker_client browser tests.
4
+
*
5
+
* Usage:
6
+
* node run_tests.js [--headed]
7
+
*
8
+
* Starts an HTTP server, runs tests in a browser, reports results.
9
+
*/
10
+
11
+
const { chromium } = require('playwright');
12
+
const http = require('http');
13
+
const fs = require('fs');
14
+
const path = require('path');
15
+
16
+
const PORT = 8765;
17
+
const TIMEOUT = 60000; // 60 seconds max test time
18
+
19
+
// Determine the directory where test files are located
20
+
const testDir = path.dirname(fs.realpathSync(__filename));
21
+
const buildDir = path.resolve(testDir, '../../_build/default/test/browser');
22
+
23
+
// MIME types for serving files
24
+
const mimeTypes = {
25
+
'.html': 'text/html',
26
+
'.js': 'application/javascript',
27
+
'.css': 'text/css',
28
+
};
29
+
30
+
function startServer() {
31
+
return new Promise((resolve, reject) => {
32
+
const server = http.createServer((req, res) => {
33
+
let filePath = req.url === '/' ? '/test.html' : req.url;
34
+
35
+
// Try build directory first, then test source directory
36
+
let fullPath = path.join(buildDir, filePath);
37
+
if (!fs.existsSync(fullPath)) {
38
+
fullPath = path.join(testDir, filePath);
39
+
}
40
+
41
+
if (!fs.existsSync(fullPath)) {
42
+
res.writeHead(404);
43
+
res.end('Not found: ' + filePath);
44
+
return;
45
+
}
46
+
47
+
const ext = path.extname(fullPath);
48
+
const contentType = mimeTypes[ext] || 'application/octet-stream';
49
+
50
+
fs.readFile(fullPath, (err, content) => {
51
+
if (err) {
52
+
res.writeHead(500);
53
+
res.end('Error reading file');
54
+
return;
55
+
}
56
+
res.writeHead(200, { 'Content-Type': contentType });
57
+
res.end(content);
58
+
});
59
+
});
60
+
61
+
server.listen(PORT, () => {
62
+
console.log(`Test server running at http://localhost:${PORT}/`);
63
+
resolve(server);
64
+
});
65
+
66
+
server.on('error', reject);
67
+
});
68
+
}
69
+
70
+
async function runTests(headed = false) {
71
+
let server;
72
+
let browser;
73
+
let exitCode = 0;
74
+
75
+
try {
76
+
// Start the HTTP server
77
+
server = await startServer();
78
+
79
+
// Launch browser
80
+
browser = await chromium.launch({ headless: !headed });
81
+
const page = await browser.newPage();
82
+
83
+
// Collect console messages
84
+
const logs = [];
85
+
page.on('console', msg => {
86
+
const text = msg.text();
87
+
logs.push(text);
88
+
console.log(`[browser] ${text}`);
89
+
});
90
+
91
+
// Navigate to test page
92
+
console.log('Loading test page...');
93
+
await page.goto(`http://localhost:${PORT}/`);
94
+
95
+
// Wait for tests to complete
96
+
console.log('Waiting for tests to complete...');
97
+
const results = await page.waitForFunction(
98
+
() => window.testResults && window.testResults.done,
99
+
{ timeout: TIMEOUT }
100
+
);
101
+
102
+
// Get final results
103
+
const testResults = await page.evaluate(() => ({
104
+
total: window.testResults.total,
105
+
passed: window.testResults.passed,
106
+
failed: window.testResults.failed,
107
+
}));
108
+
109
+
console.log('\n========================================');
110
+
console.log(`Test Results: ${testResults.passed}/${testResults.total} passed`);
111
+
console.log('========================================\n');
112
+
113
+
if (testResults.failed > 0) {
114
+
console.log('FAILED: Some tests did not pass');
115
+
exitCode = 1;
116
+
} else {
117
+
console.log('SUCCESS: All tests passed');
118
+
}
119
+
120
+
} catch (err) {
121
+
console.error('Error running tests:', err.message);
122
+
exitCode = 1;
123
+
} finally {
124
+
if (browser) await browser.close();
125
+
if (server) server.close();
126
+
}
127
+
128
+
process.exit(exitCode);
129
+
}
130
+
131
+
// Parse command line args
132
+
const headed = process.argv.includes('--headed');
133
+
runTests(headed);
+41
test/browser/test.html
+41
test/browser/test.html
···
1
+
<!DOCTYPE html>
2
+
<html>
3
+
<head>
4
+
<title>js_top_worker_client Browser Test</title>
5
+
<style>
6
+
body { font-family: monospace; padding: 20px; }
7
+
#status { margin-bottom: 20px; }
8
+
.pass { color: green; }
9
+
.fail { color: red; }
10
+
</style>
11
+
</head>
12
+
<body>
13
+
<h1>js_top_worker_client Browser Test</h1>
14
+
<div id="status">Running tests...</div>
15
+
<pre id="log"></pre>
16
+
17
+
<script>
18
+
// Capture console.log for display
19
+
const logEl = document.getElementById('log');
20
+
const originalLog = console.log;
21
+
console.log = function(...args) {
22
+
originalLog.apply(console, args);
23
+
const text = args.map(a => typeof a === 'string' ? a : JSON.stringify(a)).join(' ');
24
+
logEl.textContent += text + '\n';
25
+
26
+
// Update status when done
27
+
if (window.testResults && window.testResults.done) {
28
+
const status = document.getElementById('status');
29
+
const passed = window.testResults.passed;
30
+
const failed = window.testResults.failed;
31
+
if (failed === 0) {
32
+
status.innerHTML = '<span class="pass">All ' + passed + ' tests passed!</span>';
33
+
} else {
34
+
status.innerHTML = '<span class="fail">' + failed + ' tests failed</span> (' + passed + ' passed)';
35
+
}
36
+
}
37
+
};
38
+
</script>
39
+
<script src="client_test.bc.js"></script>
40
+
</body>
41
+
</html>
+61
test/browser/test_worker.ml
+61
test/browser/test_worker.ml
···
1
+
(** Minimal test worker for browser client tests.
2
+
3
+
This is a simplified worker that doesn't require dynamic package loading,
4
+
making it suitable for isolated browser testing. *)
5
+
6
+
open Js_top_worker_rpc
7
+
open Js_top_worker
8
+
module Server = Toplevel_api_gen.Make (Impl.IdlM.GenServer ())
9
+
10
+
let server process e =
11
+
let _, id, call = Jsonrpc.version_id_and_call_of_string e in
12
+
Lwt.bind (process call) (fun response ->
13
+
let rtxt = Jsonrpc.string_of_response ~id response in
14
+
Js_of_ocaml.Worker.post_message (Js_of_ocaml.Js.string rtxt);
15
+
Lwt.return ())
16
+
17
+
module S : Impl.S = struct
18
+
type findlib_t = unit
19
+
20
+
let capture : (unit -> 'a) -> unit -> Impl.captured * 'a =
21
+
fun f () ->
22
+
let stdout_buff = Buffer.create 1024 in
23
+
let stderr_buff = Buffer.create 1024 in
24
+
Js_of_ocaml.Sys_js.set_channel_flusher stdout (Buffer.add_string stdout_buff);
25
+
Js_of_ocaml.Sys_js.set_channel_flusher stderr (Buffer.add_string stderr_buff);
26
+
let x = f () in
27
+
({ Impl.stdout = Buffer.contents stdout_buff;
28
+
stderr = Buffer.contents stderr_buff }, x)
29
+
30
+
let sync_get _ = None
31
+
let async_get _ = Lwt.return (Error (`Msg "Not implemented"))
32
+
let create_file = Js_of_ocaml.Sys_js.create_file
33
+
let get_stdlib_dcs _ = []
34
+
let import_scripts _ = ()
35
+
let findlib_init _ = Lwt.return ()
36
+
let require _ () _ = []
37
+
let init_function _ () = ()
38
+
let path = "/static/cmis"
39
+
end
40
+
41
+
module M = Impl.Make (S)
42
+
43
+
let run () =
44
+
let open Js_of_ocaml in
45
+
let open M in
46
+
Console.console##log (Js.string "Test worker starting...");
47
+
Server.exec execute;
48
+
Server.setup (Impl.IdlM.T.lift setup);
49
+
Server.init (Impl.IdlM.T.lift init);
50
+
Server.typecheck typecheck_phrase;
51
+
Server.complete_prefix complete_prefix;
52
+
Server.query_errors query_errors;
53
+
Server.type_enclosing type_enclosing;
54
+
Server.exec_toplevel exec_toplevel;
55
+
let rpc_fn = Impl.IdlM.server Server.implementation in
56
+
Worker.set_onmessage (fun x ->
57
+
let s = Js.to_string x in
58
+
ignore (server rpc_fn s));
59
+
Console.console##log (Js.string "Test worker ready")
60
+
61
+
let () = run ()
+68
-68
test/cram/directives.t/run.t
+68
-68
test/cram/directives.t/run.t
···
9
9
$ unix_worker &
10
10
unix_worker: [INFO] init()
11
11
unix_worker: [INFO] init() finished
12
-
unix_worker: [INFO] setup() ...
12
+
unix_worker: [INFO] setup() for env default...
13
13
unix_worker: [INFO] Setup complete
14
-
unix_worker: [INFO] setup() finished
14
+
unix_worker: [INFO] setup() finished for env default
15
15
$ sleep 2
16
16
$ unix_client init '{ findlib_requires:[], execute: true }'
17
17
N
18
-
$ unix_client setup
18
+
$ unix_client setup ''
19
19
{mime_vals:[];stderr:S(error while evaluating #enable "pretty";;
20
20
error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.4.0
21
21
Unknown directive enable.
···
25
25
SECTION 1: Basic Code Execution (Baseline)
26
26
==============================================
27
27
28
-
$ unix_client exec_toplevel '# 1 + 2;;'
28
+
$ unix_client exec_toplevel '' '# 1 + 2;;'
29
29
{mime_vals:[];parts:[];script:S(# 1 + 2;;
30
30
- : int = 3)}
31
31
32
-
$ unix_client exec_toplevel '# let x = 42;;'
32
+
$ unix_client exec_toplevel '' '# let x = 42;;'
33
33
{mime_vals:[];parts:[];script:S(# let x = 42;;
34
34
val x : int = 42)}
35
35
···
39
39
40
40
Define some types and values to query:
41
41
42
-
$ unix_client exec_toplevel '# type point = { x: float; y: float };;'
42
+
$ unix_client exec_toplevel '' '# type point = { x: float; y: float };;'
43
43
{mime_vals:[];parts:[];script:S(# type point = { x: float; y: float };;
44
44
type point = { x : float; y : float; })}
45
45
46
-
$ unix_client exec_toplevel '# let origin = { x = 0.0; y = 0.0 };;'
46
+
$ unix_client exec_toplevel '' '# let origin = { x = 0.0; y = 0.0 };;'
47
47
{mime_vals:[];parts:[];script:S(# let origin = { x = 0.0; y = 0.0 };;
48
48
val origin : point = {x = 0.; y = 0.})}
49
49
50
-
$ unix_client exec_toplevel '# module MyMod = struct type t = int let zero = 0 end;;'
50
+
$ unix_client exec_toplevel '' '# module MyMod = struct type t = int let zero = 0 end;;'
51
51
{mime_vals:[];parts:[];script:S(# module MyMod = struct type t = int let zero = 0 end;;
52
52
module MyMod : sig type t = int val zero : int end)}
53
53
54
-
$ unix_client exec_toplevel '# exception My_error of string;;'
54
+
$ unix_client exec_toplevel '' '# exception My_error of string;;'
55
55
{mime_vals:[];parts:[];script:S(# exception My_error of string;;
56
56
exception My_error of string)}
57
57
58
58
Test #show directive:
59
59
60
-
$ unix_client exec_toplevel '# #show point;;'
60
+
$ unix_client exec_toplevel '' '# #show point;;'
61
61
{mime_vals:[];parts:[];script:S(# #show point;;
62
62
type point = { x : float; y : float; })}
63
63
64
-
$ unix_client exec_toplevel '# #show origin;;'
64
+
$ unix_client exec_toplevel '' '# #show origin;;'
65
65
{mime_vals:[];parts:[];script:S(# #show origin;;
66
66
val origin : point)}
67
67
68
-
$ unix_client exec_toplevel '# #show MyMod;;'
68
+
$ unix_client exec_toplevel '' '# #show MyMod;;'
69
69
{mime_vals:[];parts:[];script:S(# #show MyMod;;
70
70
module MyMod : sig type t = int val zero : int end)}
71
71
72
-
$ unix_client exec_toplevel '# #show My_error;;'
72
+
$ unix_client exec_toplevel '' '# #show My_error;;'
73
73
{mime_vals:[];parts:[];script:S(# #show My_error;;
74
74
exception My_error of string)}
75
75
76
76
Test #show_type directive:
77
77
78
-
$ unix_client exec_toplevel '# #show_type point;;'
78
+
$ unix_client exec_toplevel '' '# #show_type point;;'
79
79
{mime_vals:[];parts:[];script:S(# #show_type point;;
80
80
type point = { x : float; y : float; })}
81
81
82
-
$ unix_client exec_toplevel '# #show_type list;;'
82
+
$ unix_client exec_toplevel '' '# #show_type list;;'
83
83
{mime_vals:[];parts:[];script:S(# #show_type list;;
84
84
type 'a list = [] | (::) of 'a * 'a list)}
85
85
86
86
Test #show_val directive:
87
87
88
-
$ unix_client exec_toplevel '# #show_val origin;;'
88
+
$ unix_client exec_toplevel '' '# #show_val origin;;'
89
89
{mime_vals:[];parts:[];script:S(# #show_val origin;;
90
90
val origin : point)}
91
91
92
-
$ unix_client exec_toplevel '# #show_val List.map;;'
92
+
$ unix_client exec_toplevel '' '# #show_val List.map;;'
93
93
{mime_vals:[];parts:[];script:S(# #show_val List.map;;
94
94
val map : ('a -> 'b) -> 'a list -> 'b list)}
95
95
96
96
Test #show_module directive:
97
97
98
-
$ unix_client exec_toplevel '# #show_module List;;'
98
+
$ unix_client exec_toplevel '' '# #show_module List;;'
99
99
{mime_vals:[];parts:[];script:S(# #show_module List;;
100
100
module List :
101
101
sig
···
178
178
179
179
Test #show_exception directive:
180
180
181
-
$ unix_client exec_toplevel '# #show_exception Not_found;;'
181
+
$ unix_client exec_toplevel '' '# #show_exception Not_found;;'
182
182
{mime_vals:[];parts:[];script:S(# #show_exception Not_found;;
183
183
exception Not_found)}
184
184
185
-
$ unix_client exec_toplevel '# #show_exception Invalid_argument;;'
185
+
$ unix_client exec_toplevel '' '# #show_exception Invalid_argument;;'
186
186
{mime_vals:[];parts:[];script:S(# #show_exception Invalid_argument;;
187
187
exception Invalid_argument of string)}
188
188
···
190
190
SECTION 3: #print_depth and #print_length
191
191
==============================================
192
192
193
-
$ unix_client exec_toplevel '# let nested = [[[[1;2;3]]]];;'
193
+
$ unix_client exec_toplevel '' '# let nested = [[[[1;2;3]]]];;'
194
194
{mime_vals:[];parts:[];script:S(# let nested = [[[[1;2;3]]]];;
195
195
val nested : int list list list list = [[[[1; 2; 3]]]])}
196
196
197
197
Test #print_depth:
198
198
199
-
$ unix_client exec_toplevel '# #print_depth 2;;'
199
+
$ unix_client exec_toplevel '' '# #print_depth 2;;'
200
200
{mime_vals:[];parts:[];script:S(# #print_depth 2;;)}
201
201
202
-
$ unix_client exec_toplevel '# nested;;'
202
+
$ unix_client exec_toplevel '' '# nested;;'
203
203
{mime_vals:[];parts:[];script:S(# nested;;
204
204
- : int list list list list = [[[...]]])}
205
205
206
-
$ unix_client exec_toplevel '# #print_depth 100;;'
206
+
$ unix_client exec_toplevel '' '# #print_depth 100;;'
207
207
{mime_vals:[];parts:[];script:S(# #print_depth 100;;)}
208
208
209
-
$ unix_client exec_toplevel '# nested;;'
209
+
$ unix_client exec_toplevel '' '# nested;;'
210
210
{mime_vals:[];parts:[];script:S(# nested;;
211
211
- : int list list list list = [[[[1; 2; 3]]]])}
212
212
213
213
Test #print_length:
214
214
215
-
$ unix_client exec_toplevel '# let long_list = [1;2;3;4;5;6;7;8;9;10];;'
215
+
$ unix_client exec_toplevel '' '# let long_list = [1;2;3;4;5;6;7;8;9;10];;'
216
216
{mime_vals:[];parts:[];script:S(# let long_list = [1;2;3;4;5;6;7;8;9;10];;
217
217
val long_list : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10])}
218
218
219
-
$ unix_client exec_toplevel '# #print_length 3;;'
219
+
$ unix_client exec_toplevel '' '# #print_length 3;;'
220
220
{mime_vals:[];parts:[];script:S(# #print_length 3;;)}
221
221
222
-
$ unix_client exec_toplevel '# long_list;;'
222
+
$ unix_client exec_toplevel '' '# long_list;;'
223
223
{mime_vals:[];parts:[];script:S(# long_list;;
224
224
- : int list = [1; 2; ...])}
225
225
226
-
$ unix_client exec_toplevel '# #print_length 100;;'
226
+
$ unix_client exec_toplevel '' '# #print_length 100;;'
227
227
{mime_vals:[];parts:[];script:S(# #print_length 100;;)}
228
228
229
229
==============================================
230
230
SECTION 4: #install_printer and #remove_printer
231
231
==============================================
232
232
233
-
$ unix_client exec_toplevel '# type color = Red | Green | Blue;;'
233
+
$ unix_client exec_toplevel '' '# type color = Red | Green | Blue;;'
234
234
{mime_vals:[];parts:[];script:S(# type color = Red | Green | Blue;;
235
235
type color = Red | Green | Blue)}
236
236
237
-
$ unix_client exec_toplevel '# let pp_color fmt c = Format.fprintf fmt "<color:%s>" (match c with Red -> "red" | Green -> "green" | Blue -> "blue");;'
237
+
$ unix_client exec_toplevel '' '# let pp_color fmt c = Format.fprintf fmt "<color:%s>" (match c with Red -> "red" | Green -> "green" | Blue -> "blue");;'
238
238
{mime_vals:[];parts:[];script:S(# let pp_color fmt c = Format.fprintf fmt "<color:%s>" (match c with Red -> "red" | Green -> "green" | Blue -> "blue");;
239
239
val pp_color : Format.formatter -> color -> unit = <fun>)}
240
240
241
241
Test #install_printer:
242
242
243
-
$ unix_client exec_toplevel '# #install_printer pp_color;;'
243
+
$ unix_client exec_toplevel '' '# #install_printer pp_color;;'
244
244
{mime_vals:[];parts:[];script:S(# #install_printer pp_color;;)}
245
245
246
-
$ unix_client exec_toplevel '# Red;;'
246
+
$ unix_client exec_toplevel '' '# Red;;'
247
247
{mime_vals:[];parts:[];script:S(# Red;;
248
248
- : color = <color:red>)}
249
249
250
-
$ unix_client exec_toplevel '# [Red; Green; Blue];;'
250
+
$ unix_client exec_toplevel '' '# [Red; Green; Blue];;'
251
251
{mime_vals:[];parts:[];script:S(# [Red; Green; Blue];;
252
252
- : color list = [<color:red>; <color:green>; <color:blue>])}
253
253
254
254
Test #remove_printer:
255
255
256
-
$ unix_client exec_toplevel '# #remove_printer pp_color;;'
256
+
$ unix_client exec_toplevel '' '# #remove_printer pp_color;;'
257
257
{mime_vals:[];parts:[];script:S(# #remove_printer pp_color;;)}
258
258
259
-
$ unix_client exec_toplevel '# Red;;'
259
+
$ unix_client exec_toplevel '' '# Red;;'
260
260
{mime_vals:[];parts:[];script:S(# Red;;
261
261
- : color = Red)}
262
262
···
264
264
SECTION 5: #warnings and #warn_error
265
265
==============================================
266
266
267
-
$ unix_client exec_toplevel '# #warnings "-26";;'
267
+
$ unix_client exec_toplevel '' '# #warnings "-26";;'
268
268
{mime_vals:[];parts:[];script:S(# #warnings "-26";;)}
269
269
270
270
Code with unused variable should not warn:
271
271
272
-
$ unix_client exec_toplevel '# let _ = let unused = 1 in 2;;'
272
+
$ unix_client exec_toplevel '' '# let _ = let unused = 1 in 2;;'
273
273
{mime_vals:[];parts:[];script:S(# let _ = let unused = 1 in 2;;
274
274
- : int = 2)}
275
275
276
276
Re-enable warning:
277
277
278
-
$ unix_client exec_toplevel '# #warnings "+26";;'
278
+
$ unix_client exec_toplevel '' '# #warnings "+26";;'
279
279
{mime_vals:[];parts:[];script:S(# #warnings "+26";;)}
280
280
281
281
Now should warn:
282
282
283
-
$ unix_client exec_toplevel '# let _ = let unused2 = 1 in 2;;'
283
+
$ unix_client exec_toplevel '' '# let _ = let unused2 = 1 in 2;;'
284
284
{mime_vals:[];parts:[];script:S(# let _ = let unused2 = 1 in 2;;
285
285
Line 1, characters 12-19:
286
286
Warning 26 [unused-var]: unused variable unused2.
···
288
288
289
289
Test #warn_error:
290
290
291
-
$ unix_client exec_toplevel '# #warn_error "+26";;'
291
+
$ unix_client exec_toplevel '' '# #warn_error "+26";;'
292
292
{mime_vals:[];parts:[];script:S(# #warn_error "+26";;)}
293
293
294
-
$ unix_client exec_toplevel '# let _ = let unused3 = 1 in 2;;'
294
+
$ unix_client exec_toplevel '' '# let _ = let unused3 = 1 in 2;;'
295
295
{mime_vals:[];parts:[];script:S(# let _ = let unused3 = 1 in 2;;
296
296
Line 1, characters 12-19:
297
297
Error (warning 26 [unused-var]): unused variable unused3.)}
298
298
299
299
Reset:
300
300
301
-
$ unix_client exec_toplevel '# #warn_error "-a";;'
301
+
$ unix_client exec_toplevel '' '# #warn_error "-a";;'
302
302
{mime_vals:[];parts:[];script:S(# #warn_error "-a";;)}
303
303
304
304
==============================================
···
307
307
308
308
Without rectypes, recursive type should fail:
309
309
310
-
$ unix_client exec_toplevel "# type 'a t = 'a t -> int;;"
310
+
$ unix_client exec_toplevel '' "# type 'a t = 'a t -> int;;"
311
311
{mime_vals:[];parts:[];script:S(# type 'a t = 'a t -> int;;
312
312
Line 1, characters 0-23:
313
313
Error: The type abbreviation t is cyclic:
···
316
316
317
317
Enable rectypes:
318
318
319
-
$ unix_client exec_toplevel '# #rectypes;;'
319
+
$ unix_client exec_toplevel '' '# #rectypes;;'
320
320
{mime_vals:[];parts:[];script:S(# #rectypes;;)}
321
321
322
322
Now recursive type should work:
323
323
324
-
$ unix_client exec_toplevel "# type 'a u = 'a u -> int;;"
324
+
$ unix_client exec_toplevel '' "# type 'a u = 'a u -> int;;"
325
325
{mime_vals:[];parts:[];script:S(# type 'a u = 'a u -> int;;
326
326
type 'a u = 'a u -> int)}
327
327
···
329
329
SECTION 7: #directory
330
330
==============================================
331
331
332
-
$ unix_client exec_toplevel '# #directory "/tmp";;'
332
+
$ unix_client exec_toplevel '' '# #directory "/tmp";;'
333
333
{mime_vals:[];parts:[];script:S(# #directory "/tmp";;)}
334
334
335
-
$ unix_client exec_toplevel '# #remove_directory "/tmp";;'
335
+
$ unix_client exec_toplevel '' '# #remove_directory "/tmp";;'
336
336
{mime_vals:[];parts:[];script:S(# #remove_directory "/tmp";;)}
337
337
338
338
==============================================
339
339
SECTION 8: #help
340
340
==============================================
341
341
342
-
$ unix_client exec_toplevel '# #help;;'
342
+
$ unix_client exec_toplevel '' '# #help;;'
343
343
{mime_vals:[];parts:[];script:S(# #help;;
344
344
General
345
345
#help
···
443
443
> let add x y = x + y
444
444
> EOF
445
445
446
-
$ unix_client exec_toplevel '# #use "/tmp/test_use.ml";;'
446
+
$ unix_client exec_toplevel '' '# #use "/tmp/test_use.ml";;'
447
447
{mime_vals:[];parts:[];script:S(# #use "/tmp/test_use.ml";;
448
448
val from_file : string = "loaded via #use"
449
449
450
450
val add : int -> int -> int = <fun>)}
451
451
452
-
$ unix_client exec_toplevel '# from_file;;'
452
+
$ unix_client exec_toplevel '' '# from_file;;'
453
453
{mime_vals:[];parts:[];script:S(# from_file;;
454
454
- : string = "loaded via #use")}
455
455
456
-
$ unix_client exec_toplevel '# add 1 2;;'
456
+
$ unix_client exec_toplevel '' '# add 1 2;;'
457
457
{mime_vals:[];parts:[];script:S(# add 1 2;;
458
458
- : int = 3)}
459
459
···
468
468
> type t = A | B
469
469
> EOF
470
470
471
-
$ unix_client exec_toplevel '# #mod_use "/tmp/test_mod.ml";;'
471
+
$ unix_client exec_toplevel '' '# #mod_use "/tmp/test_mod.ml";;'
472
472
{mime_vals:[];parts:[];script:S(# #mod_use "/tmp/test_mod.ml";;
473
473
module Test_mod : sig val value : int type t = A | B end)}
474
474
475
-
$ unix_client exec_toplevel '# Test_mod.value;;'
475
+
$ unix_client exec_toplevel '' '# Test_mod.value;;'
476
476
{mime_vals:[];parts:[];script:S(# Test_mod.value;;
477
477
- : int = 42)}
478
478
···
480
480
SECTION 11: Findlib #require
481
481
==============================================
482
482
483
-
$ unix_client exec_toplevel '# #require "str";;'
483
+
$ unix_client exec_toplevel '' '# #require "str";;'
484
484
{mime_vals:[];parts:[];script:S(# #require "str";;
485
485
/home/node/.opam/default/lib/ocaml/str: added to search path)}
486
486
487
-
$ unix_client exec_toplevel '# Str.regexp "test";;'
487
+
$ unix_client exec_toplevel '' '# Str.regexp "test";;'
488
488
{mime_vals:[];parts:[];script:S(# Str.regexp "test";;
489
489
- : Str.regexp = <abstr>)}
490
490
···
492
492
SECTION 12: Findlib #list
493
493
==============================================
494
494
495
-
$ unix_client exec_toplevel '# #list;;'
495
+
$ unix_client exec_toplevel '' '# #list;;'
496
496
{mime_vals:[];parts:[];script:S(# #list;;
497
497
afl-persistent (version: n/a)
498
498
alcotest (version: 1.9.1)
···
913
913
SECTION 13: #labels and #principal
914
914
==============================================
915
915
916
-
$ unix_client exec_toplevel '# #labels true;;'
916
+
$ unix_client exec_toplevel '' '# #labels true;;'
917
917
{mime_vals:[];parts:[];script:S(# #labels true;;)}
918
918
919
-
$ unix_client exec_toplevel '# #labels false;;'
919
+
$ unix_client exec_toplevel '' '# #labels false;;'
920
920
{mime_vals:[];parts:[];script:S(# #labels false;;)}
921
921
922
-
$ unix_client exec_toplevel '# #principal true;;'
922
+
$ unix_client exec_toplevel '' '# #principal true;;'
923
923
{mime_vals:[];parts:[];script:S(# #principal true;;)}
924
924
925
-
$ unix_client exec_toplevel '# #principal false;;'
925
+
$ unix_client exec_toplevel '' '# #principal false;;'
926
926
{mime_vals:[];parts:[];script:S(# #principal false;;)}
927
927
928
928
==============================================
···
931
931
932
932
Unknown directive:
933
933
934
-
$ unix_client exec_toplevel '# #unknown_directive;;'
934
+
$ unix_client exec_toplevel '' '# #unknown_directive;;'
935
935
{mime_vals:[];parts:[];script:S(# #unknown_directive;;
936
936
Unknown directive unknown_directive.)}
937
937
938
938
#show with non-existent identifier:
939
939
940
-
$ unix_client exec_toplevel '# #show nonexistent_value;;'
940
+
$ unix_client exec_toplevel '' '# #show nonexistent_value;;'
941
941
{mime_vals:[];parts:[];script:S(# #show nonexistent_value;;
942
942
Unknown element.)}
943
943
944
944
#require non-existent package:
945
945
946
-
$ unix_client exec_toplevel '# #require "nonexistent_package_12345";;'
946
+
$ unix_client exec_toplevel '' '# #require "nonexistent_package_12345";;'
947
947
{mime_vals:[];parts:[];script:S(# #require "nonexistent_package_12345";;
948
948
No such package: nonexistent_package_12345)}
949
949
950
950
#use non-existent file:
951
951
952
-
$ unix_client exec_toplevel '# #use "/nonexistent/file.ml";;'
952
+
$ unix_client exec_toplevel '' '# #use "/nonexistent/file.ml";;'
953
953
{mime_vals:[];parts:[];script:S(# #use "/nonexistent/file.ml";;
954
954
Cannot find file /nonexistent/file.ml.)}
955
955
···
959
959
960
960
Note: #load may not work in js_of_ocaml context
961
961
962
-
$ unix_client exec_toplevel '# #load "str.cma";;'
962
+
$ unix_client exec_toplevel '' '# #load "str.cma";;'
963
963
{mime_vals:[];parts:[];script:S(# #load "str.cma";;)}
964
964
965
965
==============================================
966
966
SECTION 16: Classes (#show_class)
967
967
==============================================
968
968
969
-
$ unix_client exec_toplevel '# class counter = object val mutable n = 0 method incr = n <- n + 1 method get = n end;;'
969
+
$ unix_client exec_toplevel '' '# class counter = object val mutable n = 0 method incr = n <- n + 1 method get = n end;;'
970
970
{mime_vals:[];parts:[];script:S(# class counter = object val mutable n = 0 method incr = n <- n + 1 method get = n end;;
971
971
class counter :
972
972
object val mutable n : int method get : int method incr : unit end)}
973
973
974
-
$ unix_client exec_toplevel '# #show_class counter;;'
974
+
$ unix_client exec_toplevel '' '# #show_class counter;;'
975
975
{mime_vals:[];parts:[];script:S(# #show_class counter;;
976
976
class counter :
977
977
object val mutable n : int method get : int method incr : unit end)}
+2
-2
test/cram/simple.t/run.t
+2
-2
test/cram/simple.t/run.t
···
2
2
unix_worker: [INFO] init()
3
3
unix_worker: [INFO] init() finished
4
4
N
5
-
unix_worker: [INFO] setup() ...
5
+
unix_worker: [INFO] setup() for env default...
6
6
unix_worker: [INFO] Setup complete
7
-
unix_worker: [INFO] setup() finished
7
+
unix_worker: [INFO] setup() finished for env default
8
8
{mime_vals:[];stderr:S(error while evaluating #enable "pretty";;
9
9
error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.4.0
10
10
Unknown directive enable.
+4
-4
test/cram/simple.t/script.sh
+4
-4
test/cram/simple.t/script.sh
···
9
9
sleep 2
10
10
11
11
unix_client init '{ findlib_requires:[], execute: true }'
12
-
unix_client setup
13
-
unix_client exec_toplevel '# Printf.printf "Hello, world\n";;'
14
-
unix_client exec_toplevel "$(cat s1)"
15
-
unix_client exec_toplevel "$(cat s2)"
12
+
unix_client setup ''
13
+
unix_client exec_toplevel '' '# Printf.printf "Hello, world\n";;'
14
+
unix_client exec_toplevel '' "$(cat s1)"
15
+
unix_client exec_toplevel '' "$(cat s2)"
16
16
17
17
kill $pid
18
18
+2
-2
test/node/node_directive_test.expected
+2
-2
test/node/node_directive_test.expected
···
26
26
node_directive_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/ocaml/
27
27
node_directive_test.js: [INFO] toplevel modules: CamlinternalFormat, CamlinternalLazy, CamlinternalFormatBasics, CamlinternalMod, Std_exit, Stdlib, CamlinternalOO
28
28
node_directive_test.js: [INFO] init() finished
29
-
node_directive_test.js: [INFO] setup() ...
29
+
node_directive_test.js: [INFO] setup() for env default...
30
30
node_directive_test.js: [INFO] Fetching stdlib__Format.cmi
31
31
32
32
node_directive_test.js: [INFO] Fetching stdlib__Sys.cmi
···
34
34
error while evaluating #enable "pretty";;
35
35
error while evaluating #disable "shortvar";;
36
36
node_directive_test.js: [INFO] Setup complete
37
-
node_directive_test.js: [INFO] setup() finished
37
+
node_directive_test.js: [INFO] setup() finished for env default
38
38
--- Section 1: Basic Execution ---
39
39
[PASS] basic_eval: # 1 + 2;;
40
40
- : int = 3
+7
-4
test/node/node_directive_test.ml
+7
-4
test/node/node_directive_test.ml
···
106
106
let open U in
107
107
Logs.set_reporter (Logs_fmt.reporter ());
108
108
Logs.set_level (Some Logs.Info);
109
-
Server.exec execute;
109
+
Server.init (IdlM.T.lift init);
110
+
Server.create_env (IdlM.T.lift create_env);
111
+
Server.destroy_env (IdlM.T.lift destroy_env);
112
+
Server.list_envs (IdlM.T.lift list_envs);
110
113
Server.setup (IdlM.T.lift setup);
111
-
Server.init (IdlM.T.lift init);
114
+
Server.exec execute;
112
115
Server.typecheck typecheck_phrase;
113
116
Server.complete_prefix complete_prefix;
114
117
Server.query_errors query_errors;
···
137
140
138
141
let run_directive rpc code =
139
142
let ( let* ) = IdlM.ErrM.bind in
140
-
let* result = Client.exec_toplevel rpc ("# " ^ code) in
143
+
let* result = Client.exec_toplevel rpc "" ("# " ^ code) in
141
144
IdlM.ErrM.return result.script
142
145
143
146
let _ =
···
153
156
let test_sequence =
154
157
(* Initialize *)
155
158
let* _ = Client.init rpc init_config in
156
-
let* _ = Client.setup rpc () in
159
+
let* _ = Client.setup rpc "" in
157
160
158
161
Printf.printf "--- Section 1: Basic Execution ---\n%!";
159
162
+2
-2
test/node/node_ppx_test.expected
+2
-2
test/node/node_ppx_test.expected
···
39
39
node_ppx_test.js: [INFO] async_get: _opam/lib/ocaml/stdlib.cmi
40
40
node_ppx_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalOO.cmi
41
41
node_ppx_test.js: [INFO] init() finished
42
-
node_ppx_test.js: [INFO] setup() ...
42
+
node_ppx_test.js: [INFO] setup() for env default...
43
43
node_ppx_test.js: [INFO] Fetching stdlib__Format.cmi
44
44
45
45
node_ppx_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__Format.cmi
···
49
49
error while evaluating #enable "pretty";;
50
50
error while evaluating #disable "shortvar";;
51
51
node_ppx_test.js: [INFO] Setup complete
52
-
node_ppx_test.js: [INFO] setup() finished
52
+
node_ppx_test.js: [INFO] setup() finished for env default
53
53
--- Section 1: Basic PPX Preprocessing ---
54
54
[PASS] basic_no_ppx: # let x = 1 + 2;;
55
55
val x : int = 3
+7
-4
test/node/node_ppx_test.ml
+7
-4
test/node/node_ppx_test.ml
···
99
99
let open U in
100
100
Logs.set_reporter (Logs_fmt.reporter ());
101
101
Logs.set_level (Some Logs.Info);
102
-
Server.exec execute;
102
+
Server.init (IdlM.T.lift init);
103
+
Server.create_env (IdlM.T.lift create_env);
104
+
Server.destroy_env (IdlM.T.lift destroy_env);
105
+
Server.list_envs (IdlM.T.lift list_envs);
103
106
Server.setup (IdlM.T.lift setup);
104
-
Server.init (IdlM.T.lift init);
107
+
Server.exec execute;
105
108
Server.typecheck typecheck_phrase;
106
109
Server.complete_prefix complete_prefix;
107
110
Server.query_errors query_errors;
···
128
131
129
132
let run_toplevel rpc code =
130
133
let ( let* ) = IdlM.ErrM.bind in
131
-
let* result = Client.exec_toplevel rpc ("# " ^ code) in
134
+
let* result = Client.exec_toplevel rpc "" ("# " ^ code) in
132
135
IdlM.ErrM.return result.script
133
136
134
137
let _ =
···
144
147
let test_sequence =
145
148
(* Initialize *)
146
149
let* _ = Client.init rpc init_config in
147
-
let* _ = Client.setup rpc () in
150
+
let* _ = Client.setup rpc "" in
148
151
149
152
Printf.printf "--- Section 1: Basic PPX Preprocessing ---\n%!";
150
153
+2
-2
test/node/node_test.expected
+2
-2
test/node/node_test.expected
···
37
37
node_test.js: [INFO] async_get: _opam/lib/ocaml/stdlib.cmi
38
38
node_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalOO.cmi
39
39
node_test.js: [INFO] init() finished
40
-
node_test.js: [INFO] setup() ...
40
+
node_test.js: [INFO] setup() for env default...
41
41
node_test.js: [INFO] Fetching stdlib__Format.cmi
42
42
43
43
node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__Format.cmi
···
92
92
node_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/base/base_internalhash_types/
93
93
node_test.js: [INFO] toplevel modules: Base_internalhash_types
94
94
node_test.js: [INFO] async_get: _opam/lib/base/base_internalhash_types/base_internalhash_types.cmi
95
-
node_test.js: [INFO] setup() finished
95
+
node_test.js: [INFO] setup() finished for env default
96
96
node_test.js: [INFO] setup output: OCaml version 5.4.0
97
97
Unknown directive enable.
98
98
Unknown directive disable.
+18
-15
test/node/node_test.ml
+18
-15
test/node/node_test.ml
···
82
82
Logs.set_reporter (Logs_fmt.reporter ());
83
83
Logs.set_level (Some Logs.Info);
84
84
(* let pid = Unix.getpid () in *)
85
-
Server.exec execute;
85
+
Server.init (IdlM.T.lift init);
86
+
Server.create_env (IdlM.T.lift create_env);
87
+
Server.destroy_env (IdlM.T.lift destroy_env);
88
+
Server.list_envs (IdlM.T.lift list_envs);
86
89
Server.setup (IdlM.T.lift setup);
87
-
Server.init (IdlM.T.lift init);
90
+
Server.exec execute;
88
91
Server.typecheck typecheck_phrase;
89
92
Server.complete_prefix complete_prefix;
90
93
Server.query_errors query_errors;
···
105
108
let x =
106
109
let open Client in
107
110
let* _ = init rpc init_config in
108
-
let* o = setup rpc () in
111
+
let* o = setup rpc "" in
109
112
Logs.info (fun m ->
110
113
m "setup output: %s" (Option.value ~default:"" o.stdout));
111
-
let* _ = query_errors rpc (Some "c1") [] false "type xxxx = int;;\n" in
114
+
let* _ = query_errors rpc "" (Some "c1") [] false "type xxxx = int;;\n" in
112
115
let* o1 =
113
-
query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
116
+
query_errors rpc "" (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
114
117
in
115
118
Logs.info (fun m -> m "Number of errors: %d (should be 1)" (List.length o1));
116
-
let* _ = query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in
119
+
let* _ = query_errors rpc "" (Some "c1") [] false "type xxx = int;;\n" in
117
120
let* o2 =
118
-
query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
121
+
query_errors rpc "" (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
119
122
in
120
123
Logs.info (fun m ->
121
124
m "Number of errors1: %d (should be 1)" (List.length o1));
···
125
128
(* Test completion for List.leng *)
126
129
let* completions1 =
127
130
let text = "let _ = List.leng" in
128
-
Client.complete_prefix rpc (Some "c_comp1") [] false text
131
+
Client.complete_prefix rpc "" (Some "c_comp1") [] false text
129
132
(Offset (String.length text))
130
133
in
131
134
Logs.info (fun m ->
···
151
154
(* Test completion for List. (should show all List module functions) *)
152
155
let* completions2 =
153
156
let text = "# let _ = List." in
154
-
Client.complete_prefix rpc (Some "c_comp2") [] true text
157
+
Client.complete_prefix rpc "" (Some "c_comp2") [] true text
155
158
(Offset (String.length text))
156
159
in
157
160
Logs.info (fun m ->
···
177
180
(* Test completion for partial identifier *)
178
181
let* completions3 =
179
182
let text = "# let _ = ma" in
180
-
Client.complete_prefix rpc (Some "c_comp3") [] true text
183
+
Client.complete_prefix rpc "" (Some "c_comp3") [] true text
181
184
(Offset (String.length text))
182
185
in
183
186
Logs.info (fun m ->
···
202
205
(* Test completion in non-toplevel context *)
203
206
let* completions4 =
204
207
let text = "let _ = List.leng" in
205
-
Client.complete_prefix rpc (Some "c_comp4") [] false text
208
+
Client.complete_prefix rpc "" (Some "c_comp4") [] false text
206
209
(Offset (String.length text))
207
210
in
208
211
Logs.info (fun m ->
···
228
231
(* Test completion using Logical position constructor *)
229
232
let* completions5 =
230
233
let text = "# let _ = List.leng\n let foo=1.0;;" in
231
-
Client.complete_prefix rpc (Some "c_comp5") [] true text
234
+
Client.complete_prefix rpc "" (Some "c_comp5") [] true text
232
235
(Logical (1, 16))
233
236
in
234
237
Logs.info (fun m ->
···
254
257
(* Test toplevel completion with variable binding *)
255
258
let* completions6 =
256
259
let s = "# let my_var = 42;;\n# let x = 1 + my_v" in
257
-
Client.complete_prefix rpc (Some "c_comp6") [] true
260
+
Client.complete_prefix rpc "" (Some "c_comp6") [] true
258
261
s
259
262
(Offset (String.length s))
260
263
in
···
280
283
281
284
(* Test toplevel completion with function definition *)
282
285
let* completions7 =
283
-
Client.complete_prefix rpc (Some "c_comp7") [] true
286
+
Client.complete_prefix rpc "" (Some "c_comp7") [] true
284
287
"# let rec factorial n = if n <= 1 then 1 else n * facto"
285
288
(Offset 55)
286
289
in
···
306
309
307
310
(* Test toplevel completion with module paths *)
308
311
let* completions8 =
309
-
Client.complete_prefix rpc (Some "c_comp8") [] true
312
+
Client.complete_prefix rpc "" (Some "c_comp8") [] true
310
313
"# String.lengt"
311
314
(Offset 14)
312
315
in
+7
-4
test/unix/unix_test.ml
+7
-4
test/unix/unix_test.ml
···
98
98
Logs.set_reporter (Logs_fmt.reporter ());
99
99
Logs.set_level (Some Logs.Info);
100
100
(* let pid = Unix.getpid () in *)
101
-
Server.exec execute;
101
+
Server.init (IdlM.T.lift init);
102
+
Server.create_env (IdlM.T.lift create_env);
103
+
Server.destroy_env (IdlM.T.lift destroy_env);
104
+
Server.list_envs (IdlM.T.lift list_envs);
102
105
Server.setup (IdlM.T.lift setup);
103
-
Server.init (IdlM.T.lift init);
106
+
Server.exec execute;
104
107
Server.typecheck typecheck_phrase;
105
108
Server.complete_prefix complete_prefix;
106
109
Server.query_errors query_errors;
···
132
135
let rec run notebook =
133
136
match notebook with
134
137
| (id, deps, cell) :: cells ->
135
-
let* errs = Client.query_errors rpc (Some id) deps false cell in
138
+
let* errs = Client.query_errors rpc "" (Some id) deps false cell in
136
139
Printf.printf "Cell %s: %d errors\n%!" id (List.length errs);
137
140
run cells
138
141
| [] -> IdlM.ErrM.return ()
139
142
in
140
143
let* _ = Client.init rpc init in
141
-
let* _ = Client.setup rpc () in
144
+
let* _ = Client.setup rpc "" in
142
145
let* _ = run notebook in
143
146
IdlM.ErrM.return ()
144
147
in