ocaml bindings for chibi-scheme VM
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

align test runner with upstream chibi behavior

+107 -16
+24 -1
lib/chibi.ml
··· 204 204 let check_alive t = 205 205 if t.destroyed then raise Context_destroyed 206 206 207 + let scheme_string_literal s = 208 + let buf = Buffer.create (String.length s + 8) in 209 + Buffer.add_char buf '"'; 210 + String.iter (function 211 + | '"' -> Buffer.add_string buf "\\\"" 212 + | '\\' -> Buffer.add_string buf "\\\\" 213 + | '\n' -> Buffer.add_string buf "\\n" 214 + | '\r' -> Buffer.add_string buf "\\r" 215 + | '\t' -> Buffer.add_string buf "\\t" 216 + | c -> Buffer.add_char buf c 217 + ) s; 218 + Buffer.add_char buf '"'; 219 + Buffer.contents buf 220 + 221 + let initialize_command_line raw = 222 + let argv0 = 223 + if Array.length Sys.argv > 0 then Sys.argv.(0) 224 + else Sys.executable_name 225 + in 226 + let expr = Printf.sprintf "(command-line '(%s))" (scheme_string_literal argv0) in 227 + ignore (Chibi_ffi.eval_string raw expr) 228 + 207 229 (** Override a list of bindings with void in the current environment. 208 230 Silently ignores bindings that don't exist. *) 209 231 let nullify_bindings ctx names = ··· 351 373 if Sandbox.has_capability config.sandbox Sandbox.Module_import then begin 352 374 Chibi_ffi.load_standard_env raw; 353 375 if Sandbox.has_capability config.sandbox Sandbox.Standard_io then 354 - Chibi_ffi.load_standard_ports raw 376 + Chibi_ffi.load_standard_ports raw; 377 + initialize_command_line raw 355 378 end; 356 379 (* Apply sandbox restrictions *) 357 380 apply_sandbox t;
+1
lib/chibi_ffi.ml
··· 116 116 external set_context_env : context -> sexp -> unit = "caml_chibi_set_context_env" 117 117 external eval_in_env : context -> string -> sexp -> sexp = "caml_chibi_eval_in_env" 118 118 external load_standard_env_into : context -> sexp -> unit = "caml_chibi_load_standard_env_into" 119 + external set_language : context -> string -> unit = "caml_chibi_set_language" 119 120 120 121 (* ---- Equality ---- *) 121 122 external sexp_equal : sexp -> sexp -> bool = "caml_chibi_sexp_equal"
+42
lib/chibi_stubs.c
··· 140 140 return w; 141 141 } 142 142 143 + static void chibi_add_import_binding(sexp ctx, sexp env) { 144 + sexp_gc_var2(sym, tmp); 145 + sexp_gc_preserve2(ctx, sym, tmp); 146 + sym = sexp_intern(ctx, "repl-import", -1); 147 + tmp = sexp_env_ref(ctx, sexp_global(ctx, SEXP_G_META_ENV), sym, SEXP_VOID); 148 + sym = sexp_intern(ctx, "import", -1); 149 + sexp_env_define(ctx, env, sym, tmp); 150 + sexp_gc_release2(ctx); 151 + } 152 + 143 153 /* ---------- Error handling ---------- */ 144 154 145 155 static void raise_chibi_error(sexp ctx, sexp err) { ··· 1106 1116 sexp res = sexp_load_standard_env(ctx, env, SEXP_SEVEN); 1107 1117 if (sexp_exceptionp(res)) 1108 1118 raise_chibi_error(ctx, res); 1119 + CAMLreturn(Val_unit); 1120 + } 1121 + 1122 + CAMLprim value caml_chibi_set_language(value v_ctx, value v_lang) { 1123 + CAMLparam2(v_ctx, v_lang); 1124 + sexp ctx = get_ctx(v_ctx); 1125 + sexp meta_env = sexp_global(ctx, SEXP_G_META_ENV); 1126 + size_t lang_len = caml_string_length(v_lang); 1127 + size_t expr_len = strlen("(mutable-environment '())") + lang_len + 1; 1128 + char *expr = caml_stat_alloc(expr_len); 1129 + sexp env, ports; 1130 + 1131 + if (!sexp_envp(meta_env)) 1132 + caml_failwith("Chibi: meta environment is not initialized"); 1133 + 1134 + snprintf(expr, expr_len, "(mutable-environment '(%s))", String_val(v_lang)); 1135 + env = sexp_eval_string(ctx, expr, -1, meta_env); 1136 + caml_stat_free(expr); 1137 + 1138 + if (sexp_exceptionp(env)) 1139 + raise_chibi_error(ctx, env); 1140 + 1141 + sexp_set_parameter(ctx, meta_env, 1142 + sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), 1143 + env); 1144 + sexp_context_env(ctx) = env; 1145 + chibi_add_import_binding(ctx, env); 1146 + 1147 + ports = sexp_load_standard_ports(ctx, env, stdin, stdout, stderr, 1); 1148 + if (sexp_exceptionp(ports)) 1149 + raise_chibi_error(ctx, ports); 1150 + 1109 1151 CAMLreturn(Val_unit); 1110 1152 } 1111 1153
+1 -1
test_runner/dune
··· 1 1 (executables 2 2 (names run_chibi_tests diagnose) 3 - (libraries chibi_ocaml)) 3 + (libraries chibi_ocaml unix))
+39 -14
test_runner/run_chibi_tests.ml
··· 5 5 can correctly execute all the standard tests. *) 6 6 7 7 open Chibi_ocaml.Chibi 8 + module Ffi = Chibi_ocaml.Chibi_ffi 8 9 9 10 (* ---------- Helpers ---------- *) 10 11 11 - let vendor_dir = 12 - (* Find the vendor directory relative to this executable *) 12 + let expand_home path = 13 + if String.length path > 0 && path.[0] = '~' then 14 + match Sys.getenv_opt "HOME" with 15 + | Some home when String.length path = 1 -> home 16 + | Some home when path.[1] = '/' -> home ^ String.sub path 1 (String.length path - 1) 17 + | _ -> path 18 + else 19 + path 20 + 21 + let test_root = 22 + (* Prefer an external checkout when available, then fall back to the vendored copy. *) 13 23 let exe = Sys.executable_name in 14 24 let dir = Filename.dirname exe in 15 - let candidates = [ 16 - Filename.concat dir "../../../vendor/chibi-scheme"; 17 - Filename.concat dir "../../vendor/chibi-scheme"; 18 - Filename.concat dir "../vendor/chibi-scheme"; 19 - "vendor/chibi-scheme"; 20 - ] in 25 + let candidates = 26 + (match Sys.getenv_opt "CHIBI_TEST_ROOT" with 27 + | Some path -> [expand_home path] 28 + | None -> []) 29 + @ [ 30 + expand_home "~/data/src/chibi-scheme"; 31 + Filename.concat dir "../../../vendor/chibi-scheme"; 32 + Filename.concat dir "../../vendor/chibi-scheme"; 33 + Filename.concat dir "../vendor/chibi-scheme"; 34 + "vendor/chibi-scheme"; 35 + ] 36 + in 21 37 match List.find_opt (fun d -> 22 38 Sys.file_exists (Filename.concat d "lib/init-7.scm")) candidates 23 39 with 24 40 | Some d -> d 25 - | None -> failwith "Cannot find vendor/chibi-scheme directory" 41 + | None -> failwith "Cannot find chibi-scheme test root" 26 42 27 - let tests_dir = Filename.concat vendor_dir "tests" 28 - let lib_dir = Filename.concat vendor_dir "lib" 43 + let tests_dir = Filename.concat test_root "tests" 44 + let lib_dir = Filename.concat test_root "lib" 29 45 30 46 (** Create a context suitable for running tests. 31 47 Full access, with module path pointing at vendored lib. *) 32 48 let make_test_context ?(max_heap = 64 * 1024 * 1024) () = 49 + Unix.putenv "CHIBI_MODULE_PATH" lib_dir; 33 50 let config = Context.{ 34 51 default_config with 35 52 max_heap_size = max_heap; ··· 153 170 let ctx = make_test_context () in 154 171 Fun.protect ~finally:(fun () -> Context.destroy ctx) (fun () -> 155 172 let expected = String.trim (read_file res_file) in 156 - let (_result, stdout, stderr) = load_capturing_output ctx scm_file in 173 + let raw = Context.raw ctx in 174 + let original_env = Ffi.context_env raw in 175 + let (_result, stdout, stderr) = 176 + Fun.protect 177 + ~finally:(fun () -> Ffi.set_context_env raw original_env) 178 + (fun () -> 179 + Ffi.set_language raw "chibi"; 180 + load_capturing_output ctx scm_file) 181 + in 157 182 let _ = stderr in 158 183 let actual = String.trim stdout in 159 184 if actual = expected then begin ··· 332 357 if Sys.file_exists file then begin 333 358 (* chdir to the vendor dir so relative paths like "tests/re-tests.txt" work *) 334 359 let original_dir = Sys.getcwd () in 335 - Sys.chdir vendor_dir; 360 + Sys.chdir test_root; 336 361 Fun.protect ~finally:(fun () -> Sys.chdir original_dir) (fun () -> 337 362 run_chibi_test_suite "lib-tests (all SRFIs + chibi libs)" file) 338 363 end else begin ··· 384 409 let () = 385 410 Printf.printf "chibi-scheme test runner (via chibi-ocaml)\n"; 386 411 Printf.printf "==========================================\n"; 387 - Printf.printf "vendor dir: %s\n" vendor_dir; 412 + Printf.printf "test root: %s\n" test_root; 388 413 Printf.printf "tests dir: %s\n" tests_dir; 389 414 Printf.printf "lib dir: %s\n%!" lib_dir; 390 415