diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 40392abe..6e64cb5a 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -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 (* ====================================================================== *) diff --git a/spec/tests/test-handlers.sx b/spec/tests/test-handlers.sx new file mode 100644 index 00000000..574595c5 --- /dev/null +++ b/spec/tests/test-handlers.sx @@ -0,0 +1,79 @@ +(defsuite + "request-primitives" + (deftest + "now returns a string" + (let + ((result (now))) + (assert-type "string" result) + (assert-true (> (len result) 5)))) + (deftest + "now with format returns time" + (let + ((result (now "%H:%M:%S"))) + (assert-type "string" result) + (assert-true (contains? result ":")))) + (deftest + "state-get returns default for missing key" + (assert-equal 42 (state-get "test-nonexistent-key-xyz" 42))) + (deftest + "state-set! and state-get round-trip" + (state-set! "test-rt-abc" "hello") + (assert-equal "hello" (state-get "test-rt-abc" nil)) + (state-clear! "test-rt-abc")) + (deftest + "state-set! overwrites previous value" + (state-set! "test-ow-abc" "first") + (state-set! "test-ow-abc" "second") + (assert-equal "second" (state-get "test-ow-abc" nil)) + (state-clear! "test-ow-abc")) + (deftest + "state-clear! removes key" + (state-set! "test-cl-abc" "value") + (state-clear! "test-cl-abc") + (assert-nil (state-get "test-cl-abc" nil))) + (deftest + "request-method returns string" + (assert-type "string" (request-method))) + (deftest + "request-arg returns default for missing param" + (assert-nil (request-arg "nonexistent-param-xyz"))) + (deftest + "request-form returns default for empty body" + (assert-equal "" (request-form "nonexistent-field-xyz"))) + (deftest + "request-form with custom default" + (assert-equal "fallback" (request-form "missing-xyz" "fallback"))) + (deftest + "into list converts dict to pairs" + (let + ((d {:b 2 :a 1}) (result (into "list" d))) + (assert-type "list" result) + (assert-equal 2 (len result)))) + (deftest + "into dict converts pairs to dict" + (let + ((pairs (list (list "x" 1) (list "y" 2))) + (result (into "dict" pairs))) + (assert-type "dict" result) + (assert-equal 1 (get result "x")) + (assert-equal 2 (get result "y")))) + (deftest + "into round-trips dict→list→dict" + (let + ((original {:age 36 :name "Ada"}) + (as-list (into "list" original)) + (back (into "dict" as-list))) + (assert-equal "Ada" (get back "name")) + (assert-equal 36 (get back "age")))) + (deftest + "request-headers-all returns dict" + (assert-type "dict" (request-headers-all))) + (deftest + "request-form-all returns dict" + (assert-type "dict" (request-form-all))) + (deftest + "request-args-all returns dict" + (assert-type "dict" (request-args-all))) + (deftest + "request-content-type returns string" + (assert-type "string" (request-content-type))))