coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add request primitive tests (17 passing) + test runner support

Browse Source 
Request primitives (now, state-get/set!/clear!, request-form/arg,
into, request-headers-all, etc.) added to test runner environment.
17 new tests covering all primitives with round-trip, default value,
and type assertion checks.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-01 00:57:57 +00:00
parent 461fae269b
commit 174260df93
2 changed files with 121 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
hosts/ocaml/bin/run_tests.ml
View File

@@ -627,6 +627,48 @@ let make_test_env () =
| [v; String expected] -> Sx_ref.value_matches_type_p v (String expected)
| _ -> raise (Eval_error "value-matches-type?: expected value and type string"));
(* Request primitives — stubs for test environment *)
let _test_state : (string, value) Hashtbl.t = Hashtbl.create 16 in
bind "now" (fun args ->
let fmt = match args with String f :: _ -> f | _ -> "%Y-%m-%d %H:%M:%S" in
let open Unix in let tm = localtime (gettimeofday ()) in
let r = if fmt = "%H:%M:%S" then Printf.sprintf "%02d:%02d:%02d" tm.tm_hour tm.tm_min tm.tm_sec
else Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" (tm.tm_year+1900) (tm.tm_mon+1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec in
String r);
bind "state-get" (fun args -> match args with
| String key :: rest -> let default = match rest with v :: _ -> v | [] -> Nil in
(match Hashtbl.find_opt _test_state key with Some v -> v | None -> default)
| _ -> Nil);
bind "state-set!" (fun args -> match args with
| String key :: value :: _ -> Hashtbl.replace _test_state key value; Nil | _ -> Nil);
bind "state-clear!" (fun args -> match args with
| [String key] -> Hashtbl.remove _test_state key; Nil | _ -> Nil);
bind "request-method" (fun _args -> String "GET");
bind "request-body" (fun _args -> String "");
bind "request-form" (fun args -> match args with
| String _ :: rest -> (match rest with v :: _ -> v | [] -> String "") | _ -> String "");
bind "request-arg" (fun args -> match args with
| String _ :: rest -> (match rest with v :: _ -> v | [] -> Nil) | _ -> Nil);
bind "request-form-all" (fun _args -> Dict (Hashtbl.create 0));
bind "request-args-all" (fun _args -> Dict (Hashtbl.create 0));
bind "request-form-list" (fun _args -> List []);
bind "request-json" (fun _args -> String "");
bind "request-header" (fun args -> match args with
| String _ :: rest -> (match rest with v :: _ -> v | [] -> String "") | _ -> String "");
bind "request-headers-all" (fun _args -> Dict (Hashtbl.create 0));
bind "request-content-type" (fun _args -> String "");
bind "request-file-name" (fun _args -> String "");
bind "into" (fun args -> match args with
| [String "list"; Dict d] ->
List (Hashtbl.fold (fun k v acc -> List [String k; v] :: acc) d [])
| [String "dict"; List pairs] | [String "dict"; ListRef { contents = pairs }] ->
let d = Hashtbl.create 8 in
List.iter (fun pair -> match pair with
| List [String k; v] | ListRef { contents = [String k; v] } -> Hashtbl.replace d k v
| _ -> ()) pairs;
Dict d
| _ -> Nil);
env
(* ====================================================================== *)