Add node-based directive tests for OCaml toplevel · jon.recoil.org/js_top

+60 -1

test/node/dune

··· 32 32 +dynlink.js 33 33 +bigstringaf/runtime.js 34 34 +zarith_stubs_js/runtime.js 35 - +js_top_worker/stubs.js 35 + %{lib:js_top_worker:stubs.js} 36 36 %{dep:node_test.bc} 37 37 -o 38 38 %{targets}))) ··· 60 60 (deps _opam) 61 61 (action 62 62 (diff node_test.expected node_test.out))) 63 + 64 + ; Directive test executable 65 + (executable 66 + (name node_directive_test) 67 + (modes byte) 68 + (modules node_directive_test) 69 + (link_flags (-linkall)) 70 + (libraries 71 + str 72 + fpath 73 + js_of_ocaml 74 + js_top_worker-web 75 + js_of_ocaml-toplevel 76 + js_top_worker 77 + logs 78 + logs.fmt 79 + rpclib.core 80 + rpclib.json 81 + findlib.top 82 + js_of_ocaml-lwt 83 + zarith_stubs_js)) 84 + 85 + (rule 86 + (targets node_directive_test.js) 87 + (action 88 + (run 89 + %{bin:js_of_ocaml} 90 + --toplevel 91 + --pretty 92 + --no-cmis 93 + --effects=cps 94 + --debuginfo 95 + --target-env=nodejs 96 + +toplevel.js 97 + +dynlink.js 98 + +bigstringaf/runtime.js 99 + +zarith_stubs_js/runtime.js 100 + %{lib:js_top_worker:stubs.js} 101 + %{dep:node_directive_test.bc} 102 + -o 103 + %{targets}))) 104 + 105 + (rule 106 + (deps _opam) 107 + (action 108 + (with-outputs-to 109 + node_directive_test.out 110 + (run 111 + node 112 + --stack-size=2000 113 + -r 114 + ./%{dep:import_scripts.js} 115 + %{dep:node_directive_test.js})))) 116 + 117 + (rule 118 + (alias runtest) 119 + (deps _opam) 120 + (action 121 + (diff node_directive_test.expected node_directive_test.out)))

+207

test/node/node_directive_test.expected

··· 1 + === Node.js Directive Tests === 2 + 3 + node_directive_test.js: [INFO] init() 4 + Initializing findlib 5 + Parsed uri: lib/sexplib0/META 6 + Reading library: sexplib0 7 + Number of children: 0 8 + Parsed uri: lib/ocaml_intrinsics_kernel/META 9 + Reading library: ocaml_intrinsics_kernel 10 + Number of children: 0 11 + Parsed uri: lib/ocaml/stdlib/META 12 + Reading library: stdlib 13 + Number of children: 0 14 + Parsed uri: lib/base/META 15 + Reading library: base 16 + Number of children: 3 17 + Found child: base_internalhash_types 18 + Reading library: base.base_internalhash_types 19 + Number of children: 0 20 + Found child: md5 21 + Reading library: base.md5 22 + Number of children: 0 23 + Found child: shadow_stdlib 24 + Reading library: base.shadow_stdlib 25 + Number of children: 0 26 + node_directive_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/ocaml/ 27 + node_directive_test.js: [INFO] toplevel modules: CamlinternalFormat, CamlinternalLazy, CamlinternalFormatBasics, CamlinternalMod, Std_exit, Stdlib, CamlinternalOO 28 + node_directive_test.js: [INFO] init() finished 29 + node_directive_test.js: [INFO] setup() ... 30 + node_directive_test.js: [INFO] Fetching stdlib__Format.cmi 31 + 32 + node_directive_test.js: [INFO] Fetching stdlib__Sys.cmi 33 + 34 + error while evaluating #enable "pretty";; 35 + error while evaluating #disable "shortvar";; 36 + node_directive_test.js: [INFO] Setup complete 37 + node_directive_test.js: [INFO] setup() finished 38 + --- Section 1: Basic Execution --- 39 + [PASS] basic_eval: # 1 + 2;; 40 + - : int = 3 41 + [PASS] let_binding: # let x = 42;; 42 + val x : int = 42 43 + 44 + --- Section 2: #show Directives --- 45 + [PASS] show_type_point: # #show point;; 46 + type point = { x : float; y : float; } 47 + [PASS] show_val_origin: # #show origin;; 48 + val origin : point 49 + [PASS] show_module: # #show MyMod;; 50 + module MyMod : sig type t = int val zero : int end 51 + [PASS] show_exception: # #show My_error;; 52 + exception My_error of string 53 + [PASS] show_type_list: # #show_type list;; 54 + type 'a list = [] | (::) of 'a * 'a list 55 + node_directive_test.js: [INFO] Fetching stdlib__List.cmi 56 + 57 + [PASS] show_val_list_map: # #show_val List.map;; 58 + val map : ('a -> 'b) -> 'a list -> 'b list 59 + [PASS] show_module_list: # #show_module List;; 60 + module List : 61 + sig 62 + type 'a t = 'a list = [] | (::) of 'a * 'a list 63 + val length : 'a list -> int 64 + val compare_lengths : 'a list -> 'b list -> int 65 + val compare_length_with : 'a list -> int -> int 66 + val is_empty : 'a list -> bool 67 + val cons : 'a -> 'a list -> 'a list 68 + val singleton : 'a -> 'a list 69 + val hd : 'a list -> 'a 70 + val tl : 'a list -> 'a list 71 + val nth : 'a list -> int -> 'a 72 + val nth_opt : 'a list -> int -> 'a option 73 + val rev : 'a list -> 'a list 74 + val init : int -> (int -> 'a) -> 'a list 75 + val append : 'a list -> 'a list -> 'a list 76 + val rev_append : 'a list -> 'a list -> 'a list 77 + val concat : 'a list list -> 'a list 78 + val flatten : 'a list list -> 'a list 79 + val equal : ('a -> 'a -> bool) -> 'a list -> 'a list -> bool 80 + val compare : ('a -> 'a -> int) -> 'a list -> 'a list -> int 81 + val iter : ('a -> unit) -> 'a list -> unit 82 + val iteri : (int -> 'a -> unit) -> 'a list -> unit 83 + val map : ('a -> 'b) -> 'a list -> 'b list 84 + val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list 85 + val rev_map : ('a -> 'b) -> 'a list -> 'b list 86 + val filter_map : ('a -> 'b option) -> 'a list -> 'b list 87 + val concat_map : ('a -> 'b list) -> 'a list -> 'b list 88 + val fold_left_map : 89 + ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list 90 + val fold_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc 91 + val fold_right : ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc 92 + val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit 93 + val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list 94 + val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list 95 + val fold_left2 : 96 + ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a list -> 'b list -> 'acc 97 + val fold_right2 : 98 + ('a -> 'b -> 'acc -> 'acc) -> 'a list -> 'b list -> 'acc -> 'acc 99 + val for_all : ('a -> bool) -> 'a list -> bool 100 + val exists : ('a -> bool) -> 'a list -> bool 101 + val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool 102 + val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool 103 + val mem : 'a -> 'a list -> bool 104 + val memq : 'a -> 'a list -> bool 105 + val find : ('a -> bool) -> 'a list -> 'a 106 + val find_opt : ('a -> bool) -> 'a list -> 'a option 107 + val find_index : ('a -> bool) -> 'a list -> int option 108 + val find_map : ('a -> 'b option) -> 'a list -> 'b option 109 + val find_mapi : (int -> 'a -> 'b option) -> 'a list -> 'b option 110 + val filter : ('a -> bool) -> 'a list -> 'a list 111 + val find_all : ('a -> bool) -> 'a list -> 'a list 112 + val filteri : (int -> 'a -> bool) -> 'a list -> 'a list 113 + val take : int -> 'a list -> 'a list 114 + val drop : int -> 'a list -> 'a list 115 + val take_while : ('a -> bool) -> 'a list -> 'a list 116 + val drop_while : ('a -> bool) -> 'a list -> 'a list 117 + val partition : ('a -> bool) -> 'a list -> 'a list * 'a list 118 + val partition_map : 119 + ('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list 120 + val assoc : 'a -> ('a * 'b) list -> 'b 121 + val assoc_opt : 'a -> ('a * 'b) list -> 'b option 122 + val assq : 'a -> ('a * 'b) list -> 'b 123 + val assq_opt : 'a -> ('a * 'b) list -> 'b option 124 + val mem_assoc : 'a -> ('a * 'b) list -> bool 125 + val mem_assq : 'a -> ('a * 'b) list -> bool 126 + val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list 127 + val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list 128 + val split : ('a * 'b) list -> 'a list * 'b list 129 + val combine : 'a list -> 'b list -> ('a * 'b) list 130 + val sort : ('a -> 'a -> int) -> 'a list -> 'a list 131 + val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list 132 + val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list 133 + val sort_uniq : ('a -> 'a -> int) -> 'a list -> 'a list 134 + val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list 135 + val to_seq : 'a list -> 'a Seq.t 136 + val of_seq : 'a Seq.t -> 'a list 137 + end 138 + [PASS] show_exception_not_found: # #show_exception Not_found;; 139 + exception Not_found 140 + 141 + --- Section 3: #print_depth and #print_length --- 142 + [PASS] print_depth_truncated: # nested;; 143 + - : int list list list list = [[[...]]] 144 + [PASS] print_depth_full: # nested;; 145 + - : int list list list list = [[[[1; 2; 3]]]] 146 + [PASS] print_length_truncated: # long_list;; 147 + - : int list = [1; 2; ...] 148 + [PASS] print_length_full: # long_list;; 149 + - : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10] 150 + 151 + --- Section 4: #install_printer / #remove_printer --- 152 + [PASS] install_printer: # Red;; 153 + - : color = <color:red> 154 + [PASS] remove_printer: # Red;; 155 + - : color = Red 156 + 157 + --- Section 5: #warnings / #warn_error --- 158 + [PASS] warnings_disabled: # let _ = let unused = 1 in 2;; 159 + - : int = 2 160 + Line 1, characters 12-19: 161 + Warning 26 [unused-var]: unused variable unused2. 162 + [PASS] warnings_enabled: # let _ = let unused2 = 1 in 2;; 163 + - : int = 2 164 + 165 + Line 1, characters 12-19: 166 + Error (warning 26 [unused-var]): unused variable unused3. 167 + [FAIL] warn_error: # let _ = let unused3 = 1 in 2;; 168 + 169 + --- Section 6: #rectypes --- 170 + 171 + Line 1, characters 0-23: 172 + Error: The type abbreviation t is cyclic: 173 + 'a t = 'a t -> int, 174 + 'a t -> int contains 'a t 175 + [FAIL] rectypes_before: # type 'a t = 'a t -> int;; 176 + [PASS] rectypes_after: # type 'a u = 'a u -> int;; 177 + type 'a u = 'a u -> int 178 + 179 + --- Section 7: #directory --- 180 + [PASS] directory_add: (no error) 181 + [PASS] directory_remove: (no error) 182 + 183 + --- Section 8: #help --- 184 + [PASS] help: # #help;; 185 + General 186 + #help 187 + Prints a list of all available directives, with corresponding argume... 188 + 189 + --- Section 9: #labels / #principal --- 190 + [PASS] labels_true: (no error) 191 + [PASS] labels_false: (no error) 192 + [PASS] principal_true: (no error) 193 + [PASS] principal_false: (no error) 194 + 195 + --- Section 10: Error Cases --- 196 + [PASS] unknown_directive: # #unknown_directive;; 197 + Unknown directive unknown_directive. 198 + [PASS] show_nonexistent: # #show nonexistent_value;; 199 + Unknown element. 200 + 201 + --- Section 11: Classes --- 202 + [PASS] show_class: # #show_class counter;; 203 + class counter : 204 + object val mutable n : int method get : int method incr : unit end 205 + 206 + === Results: 29/31 tests passed === 207 + FAILURE: Some tests failed.

+326

test/node/node_directive_test.ml

··· 1 + (** Node.js test for OCaml toplevel directives. 2 + 3 + This tests the js_of_ocaml implementation of the toplevel, 4 + running in Node.js to verify directives work in the JS context. 5 + 6 + Directives tested: 7 + - Environment query: #show, #show_type, #show_val, #show_module, #show_exception 8 + - Pretty-printing: #print_depth, #print_length 9 + - Custom printers: #install_printer, #remove_printer 10 + - Warnings: #warnings, #warn_error 11 + - Type system: #rectypes 12 + - Directory: #directory, #remove_directory 13 + - Help: #help 14 + - Compiler options: #labels, #principal 15 + - Error handling: unknown directives, missing identifiers 16 + 17 + NOT tested (require file system or special setup): 18 + - #use, #mod_use (file loading) 19 + - #load (bytecode loading) 20 + - #require, #list (findlib - tested separately) 21 + - #trace (excluded per user request) 22 + *) 23 + 24 + open Js_top_worker 25 + open Js_top_worker_rpc.Toplevel_api_gen 26 + open Impl 27 + 28 + (* Flusher that writes to process.stdout in Node.js *) 29 + let console_flusher (s : string) : unit = 30 + let open Js_of_ocaml in 31 + let process = Js.Unsafe.get Js.Unsafe.global (Js.string "process") in 32 + let stdout = Js.Unsafe.get process (Js.string "stdout") in 33 + let write = Js.Unsafe.get stdout (Js.string "write") in 34 + ignore (Js.Unsafe.call write stdout [| Js.Unsafe.inject (Js.string s) |]) 35 + 36 + let capture : (unit -> 'a) -> unit -> Impl.captured * 'a = 37 + fun f () -> 38 + let stdout_buff = Buffer.create 1024 in 39 + let stderr_buff = Buffer.create 1024 in 40 + Js_of_ocaml.Sys_js.set_channel_flusher stdout (Buffer.add_string stdout_buff); 41 + (* Note: Do NOT set stderr flusher - it causes hangs in js_of_ocaml *) 42 + let x = f () in 43 + let captured = 44 + { 45 + Impl.stdout = Buffer.contents stdout_buff; 46 + stderr = Buffer.contents stderr_buff; 47 + } 48 + in 49 + (* Restore flusher that writes to console so Printf.printf works for test output *) 50 + Js_of_ocaml.Sys_js.set_channel_flusher stdout console_flusher; 51 + (captured, x) 52 + 53 + module Server = Js_top_worker_rpc.Toplevel_api_gen.Make (Impl.IdlM.GenServer ()) 54 + 55 + module S : Impl.S = struct 56 + type findlib_t = Js_top_worker_web.Findlibish.t 57 + 58 + let capture = capture 59 + 60 + let sync_get f = 61 + let f = Fpath.v ("_opam/" ^ f) in 62 + try Some (In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all) 63 + with _ -> None 64 + 65 + let async_get f = 66 + let f = Fpath.v ("_opam/" ^ f) in 67 + try 68 + let content = 69 + In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all 70 + in 71 + Lwt.return (Ok content) 72 + with e -> Lwt.return (Error (`Msg (Printexc.to_string e))) 73 + 74 + let create_file = Js_of_ocaml.Sys_js.create_file 75 + 76 + let import_scripts urls = 77 + let open Js_of_ocaml.Js in 78 + let import_scripts_fn = Unsafe.get Unsafe.global (string "importScripts") in 79 + List.iter 80 + (fun url -> 81 + let (_ : 'a) = 82 + Unsafe.fun_call import_scripts_fn [| Unsafe.inject (string url) |] 83 + in 84 + ()) 85 + urls 86 + 87 + let init_function _ () = failwith "Not implemented" 88 + let findlib_init = Js_top_worker_web.Findlibish.init async_get 89 + 90 + let get_stdlib_dcs uri = 91 + Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri 92 + |> Result.to_list 93 + 94 + let require b v = function 95 + | [] -> [] 96 + | packages -> 97 + Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v 98 + packages 99 + 100 + let path = "/static/cmis" 101 + end 102 + 103 + module U = Impl.Make (S) 104 + 105 + let start_server () = 106 + let open U in 107 + Logs.set_reporter (Logs_fmt.reporter ()); 108 + Logs.set_level (Some Logs.Info); 109 + Server.exec execute; 110 + Server.setup (IdlM.T.lift setup); 111 + Server.init (IdlM.T.lift init); 112 + Server.typecheck typecheck_phrase; 113 + Server.complete_prefix complete_prefix; 114 + Server.query_errors query_errors; 115 + Server.type_enclosing type_enclosing; 116 + Server.exec_toplevel exec_toplevel; 117 + IdlM.server Server.implementation 118 + 119 + module Client = Js_top_worker_rpc.Toplevel_api_gen.Make (Impl.IdlM.GenClient ()) 120 + 121 + (* Test result tracking *) 122 + let total_tests = ref 0 123 + let passed_tests = ref 0 124 + 125 + let test name check message = 126 + incr total_tests; 127 + let passed = check in 128 + if passed then incr passed_tests; 129 + let status = if passed then "PASS" else "FAIL" in 130 + Printf.printf "[%s] %s: %s\n%!" status name message 131 + 132 + let contains s substr = 133 + try 134 + let _ = Str.search_forward (Str.regexp_string substr) s 0 in 135 + true 136 + with Not_found -> false 137 + 138 + let run_directive rpc code = 139 + let ( let* ) = IdlM.ErrM.bind in 140 + let* result = Client.exec_toplevel rpc ("# " ^ code) in 141 + IdlM.ErrM.return result.script 142 + 143 + let _ = 144 + Printf.printf "=== Node.js Directive Tests ===\n\n%!"; 145 + 146 + let rpc = start_server () in 147 + let ( let* ) = IdlM.ErrM.bind in 148 + 149 + let init_config = 150 + { stdlib_dcs = None; findlib_requires = []; execute = true } 151 + in 152 + 153 + let test_sequence = 154 + (* Initialize *) 155 + let* _ = Client.init rpc init_config in 156 + let* _ = Client.setup rpc () in 157 + 158 + Printf.printf "--- Section 1: Basic Execution ---\n%!"; 159 + 160 + let* r = run_directive rpc "1 + 2;;" in 161 + test "basic_eval" (contains r "- : int = 3") r; 162 + 163 + let* r = run_directive rpc "let x = 42;;" in 164 + test "let_binding" (contains r "val x : int = 42") r; 165 + 166 + Printf.printf "\n--- Section 2: #show Directives ---\n%!"; 167 + 168 + (* Define types/values to query *) 169 + let* _ = run_directive rpc "type point = { x: float; y: float };;" in 170 + let* _ = run_directive rpc "let origin = { x = 0.0; y = 0.0 };;" in 171 + let* _ = 172 + run_directive rpc 173 + "module MyMod = struct type t = int let zero = 0 end;;" 174 + in 175 + let* _ = run_directive rpc "exception My_error of string;;" in 176 + 177 + let* r = run_directive rpc "#show point;;" in 178 + test "show_type_point" (contains r "type point") r; 179 + 180 + let* r = run_directive rpc "#show origin;;" in 181 + test "show_val_origin" (contains r "val origin") r; 182 + 183 + let* r = run_directive rpc "#show MyMod;;" in 184 + test "show_module" (contains r "module MyMod") r; 185 + 186 + let* r = run_directive rpc "#show My_error;;" in 187 + test "show_exception" (contains r "exception My_error") r; 188 + 189 + let* r = run_directive rpc "#show_type list;;" in 190 + test "show_type_list" (contains r "type 'a list") r; 191 + 192 + let* r = run_directive rpc "#show_val List.map;;" in 193 + test "show_val_list_map" (contains r "val map") r; 194 + 195 + let* r = run_directive rpc "#show_module List;;" in 196 + test "show_module_list" (contains r "module List") r; 197 + 198 + let* r = run_directive rpc "#show_exception Not_found;;" in 199 + test "show_exception_not_found" (contains r "exception Not_found") r; 200 + 201 + Printf.printf "\n--- Section 3: #print_depth and #print_length ---\n%!"; 202 + 203 + let* _ = run_directive rpc "let nested = [[[[1;2;3]]]];;" in 204 + let* _ = run_directive rpc "#print_depth 2;;" in 205 + let* r = run_directive rpc "nested;;" in 206 + test "print_depth_truncated" (contains r "...") r; 207 + 208 + let* _ = run_directive rpc "#print_depth 100;;" in 209 + let* r = run_directive rpc "nested;;" in 210 + test "print_depth_full" (contains r "1; 2; 3") r; 211 + 212 + let* _ = run_directive rpc "let long_list = [1;2;3;4;5;6;7;8;9;10];;" in 213 + let* _ = run_directive rpc "#print_length 3;;" in 214 + let* r = run_directive rpc "long_list;;" in 215 + test "print_length_truncated" (contains r "...") r; 216 + 217 + let* _ = run_directive rpc "#print_length 100;;" in 218 + let* r = run_directive rpc "long_list;;" in 219 + test "print_length_full" (contains r "10") r; 220 + 221 + Printf.printf "\n--- Section 4: #install_printer / #remove_printer ---\n%!"; 222 + 223 + let* _ = run_directive rpc "type color = Red | Green | Blue;;" in 224 + let* _ = 225 + run_directive rpc 226 + {|let pp_color fmt c = Format.fprintf fmt "<color:%s>" (match c with Red -> "red" | Green -> "green" | Blue -> "blue");;|} 227 + in 228 + let* _ = run_directive rpc "#install_printer pp_color;;" in 229 + let* r = run_directive rpc "Red;;" in 230 + test "install_printer" (contains r "<color:red>") r; 231 + 232 + let* _ = run_directive rpc "#remove_printer pp_color;;" in 233 + let* r = run_directive rpc "Red;;" in 234 + test "remove_printer" (contains r "Red" && not (contains r "<color:red>")) r; 235 + 236 + Printf.printf "\n--- Section 5: #warnings / #warn_error ---\n%!"; 237 + 238 + let* _ = run_directive rpc "#warnings \"-26\";;" in 239 + let* r = run_directive rpc "let _ = let unused = 1 in 2;;" in 240 + test "warnings_disabled" 241 + (not (contains r "Warning") || contains r "- : int = 2") 242 + r; 243 + 244 + let* _ = run_directive rpc "#warnings \"+26\";;" in 245 + let* r = run_directive rpc "let _ = let unused2 = 1 in 2;;" in 246 + test "warnings_enabled" (contains r "Warning" || contains r "unused2") r; 247 + 248 + let* _ = run_directive rpc "#warn_error \"+26\";;" in 249 + let* r = run_directive rpc "let _ = let unused3 = 1 in 2;;" in 250 + test "warn_error" (contains r "Error") r; 251 + 252 + let* _ = run_directive rpc "#warn_error \"-a\";;" in 253 + 254 + Printf.printf "\n--- Section 6: #rectypes ---\n%!"; 255 + 256 + let* r = run_directive rpc "type 'a t = 'a t -> int;;" in 257 + test "rectypes_before" (contains r "Error" || contains r "cyclic") r; 258 + 259 + let* _ = run_directive rpc "#rectypes;;" in 260 + let* r = run_directive rpc "type 'a u = 'a u -> int;;" in 261 + test "rectypes_after" (contains r "type 'a u") r; 262 + 263 + Printf.printf "\n--- Section 7: #directory ---\n%!"; 264 + 265 + let* r = run_directive rpc "#directory \"/tmp\";;" in 266 + test "directory_add" (String.length r >= 0) "(no error)"; 267 + 268 + let* r = run_directive rpc "#remove_directory \"/tmp\";;" in 269 + test "directory_remove" (String.length r >= 0) "(no error)"; 270 + 271 + Printf.printf "\n--- Section 8: #help ---\n%!"; 272 + 273 + let* r = run_directive rpc "#help;;" in 274 + test "help" 275 + (contains r "directive" || contains r "Directive" || contains r "#") 276 + (String.sub r 0 (min 100 (String.length r)) ^ "..."); 277 + 278 + Printf.printf "\n--- Section 9: #labels / #principal ---\n%!"; 279 + 280 + let* r = run_directive rpc "#labels true;;" in 281 + test "labels_true" (String.length r >= 0) "(no error)"; 282 + 283 + let* r = run_directive rpc "#labels false;;" in 284 + test "labels_false" (String.length r >= 0) "(no error)"; 285 + 286 + let* r = run_directive rpc "#principal true;;" in 287 + test "principal_true" (String.length r >= 0) "(no error)"; 288 + 289 + let* r = run_directive rpc "#principal false;;" in 290 + test "principal_false" (String.length r >= 0) "(no error)"; 291 + 292 + Printf.printf "\n--- Section 10: Error Cases ---\n%!"; 293 + 294 + let* r = run_directive rpc "#unknown_directive;;" in 295 + test "unknown_directive" (contains r "Unknown") r; 296 + 297 + let* r = run_directive rpc "#show nonexistent_value;;" in 298 + test "show_nonexistent" (contains r "Unknown" || contains r "not found") r; 299 + 300 + Printf.printf "\n--- Section 11: Classes ---\n%!"; 301 + 302 + let* _ = 303 + run_directive rpc 304 + "class counter = object val mutable n = 0 method incr = n <- n + 1 \ 305 + method get = n end;;" 306 + in 307 + let* r = run_directive rpc "#show_class counter;;" in 308 + test "show_class" (contains r "class counter") r; 309 + 310 + IdlM.ErrM.return () 311 + in 312 + 313 + let promise = test_sequence |> IdlM.T.get in 314 + (match Lwt.state promise with 315 + | Lwt.Return (Ok ()) -> () 316 + | Lwt.Return (Error (InternalError s)) -> 317 + Printf.printf "\n[ERROR] Test failed with: %s\n%!" s 318 + | Lwt.Fail e -> 319 + Printf.printf "\n[ERROR] Exception: %s\n%!" (Printexc.to_string e) 320 + | Lwt.Sleep -> Printf.printf "\n[ERROR] Promise still pending\n%!"); 321 + 322 + Printf.printf "\n=== Results: %d/%d tests passed ===\n%!" !passed_tests 323 + !total_tests; 324 + if !passed_tests = !total_tests then 325 + Printf.printf "SUCCESS: All directive tests passed!\n%!" 326 + else Printf.printf "FAILURE: Some tests failed.\n%!"