Eio HTTP server with static file serving and route handlers
respond: split runner, drop check_bool alias, shorten test names (E600/E320/E350)
- Inline Alcotest.(check bool) at the 31 call sites and drop the
check_bool alias whose signature (string -> bool -> bool -> unit)
tripped E350.
- Shorten three 5-underscore test identifiers
(test_catchall_not_greedy_past_pattern -> test_catchall_stops_at_pattern,
test_bindings_order_is_pattern_order -> test_bindings_pattern_order,
test_query_does_not_affect_match -> test_query_doesnt_affect_match).
- Move Alcotest.run from test_respond.ml into a new test.ml runner;
expose a flat [Test_respond.suite] (E600). Sub-suite names get
prefixed onto the case names so the alcotest output keeps the
RFC-section grouping.
+100
-51
+1
-1
test/dune
+1
-1
test/dune
+1
test/test.ml
+1
test/test.ml
···
1
+
let () = Alcotest.run "respond" [ Test_respond.suite ]
+96
-50
test/test_respond.ml
+96
-50
test/test_respond.ml
···
2
2
3
3
let check_string = Alcotest.(check string)
4
4
let check_int = Alcotest.(check int)
5
-
let check_bool = Alcotest.(check bool)
6
5
7
6
let check_pair =
8
7
let pp_pair ppf (a, b) = Fmt.pf ppf "(%S, %S)" a b in
···
77
76
let qs = String.make 1000 'x' in
78
77
let path, params = Respond.parse_url ("/f?" ^ qs) in
79
78
check_string "path" "/f" path;
80
-
check_bool "has param" true (List.length params = 1)
79
+
Alcotest.(check bool) "has param" true (List.length params = 1)
81
80
82
81
let test_url_special_chars () =
83
82
let _path, params =
···
219
218
let test_response_redirect () =
220
219
let r = Respond.Response.redirect "https://ssa.space/" in
221
220
check_int "status" 302 r.status;
222
-
check_bool "has location" true
221
+
Alcotest.(check bool)
222
+
"has location" true
223
223
(List.exists (fun (k, _) -> k = "Location") r.headers)
224
224
225
225
let test_response_raw () =
···
235
235
""
236
236
in
237
237
check_int "status" 204 r.status;
238
-
check_bool "custom header" true
238
+
Alcotest.(check bool)
239
+
"custom header" true
239
240
(List.exists (fun (k, _) -> k = "X-Custom") r.headers)
240
241
241
242
let response_tests =
···
256
257
257
258
let test_etag_format () =
258
259
let etag = Respond.generate_etag ~size:1024 in
259
-
check_bool "starts with W/" true
260
+
Alcotest.(check bool)
261
+
"starts with W/" true
260
262
(String.length etag >= 3 && String.sub etag 0 3 = "W/\"");
261
-
check_bool "ends with quote" true (etag.[String.length etag - 1] = '"')
263
+
Alcotest.(check bool)
264
+
"ends with quote" true
265
+
(etag.[String.length etag - 1] = '"')
262
266
263
267
let test_etag_different_sizes () =
264
-
check_bool "different" true
268
+
Alcotest.(check bool)
269
+
"different" true
265
270
(Respond.generate_etag ~size:100 <> Respond.generate_etag ~size:200)
266
271
267
272
let test_etag_same_size () =
···
312
317
313
318
let test_route_exact () =
314
319
let routes = [ Respond.get "/api/health" ok; Respond.get "/api/cdms" ok ] in
315
-
check_bool "found" true (Respond.match_route routes "/api/health" <> None);
316
-
check_bool "found 2" true (Respond.match_route routes "/api/cdms" <> None)
320
+
Alcotest.(check bool)
321
+
"found" true
322
+
(Respond.match_route routes "/api/health" <> None);
323
+
Alcotest.(check bool)
324
+
"found 2" true
325
+
(Respond.match_route routes "/api/cdms" <> None)
317
326
318
327
let test_route_no_match () =
319
328
let routes = [ Respond.get "/api/health" ok ] in
320
-
check_bool "not found" true (Respond.match_route routes "/api/unknown" = None)
329
+
Alcotest.(check bool)
330
+
"not found" true
331
+
(Respond.match_route routes "/api/unknown" = None)
321
332
322
333
let test_route_no_prefix () =
323
334
let routes = [ Respond.get "/api" ok ] in
324
-
check_bool "no prefix" true (Respond.match_route routes "/api/health" = None)
335
+
Alcotest.(check bool)
336
+
"no prefix" true
337
+
(Respond.match_route routes "/api/health" = None)
325
338
326
339
let test_route_param () =
327
340
let routes = [ Respond.get "/auth/:slug/callback" ok ] in
···
362
375
| _ -> Alcotest.fail "expected /blocks/:hash to win via ordering"
363
376
364
377
let test_route_catchall_misplaced () =
365
-
check_bool "raises on ** not last" true
378
+
Alcotest.(check bool)
379
+
"raises on ** not last" true
366
380
(try
367
381
let _ = Respond.get "/**/trailing" ok in
368
382
false
···
372
386
373
387
let test_root_pattern () =
374
388
let routes = [ Respond.get "/" ok ] in
375
-
check_bool "matches /" true (Respond.match_route routes "/" <> None);
376
-
check_bool "does not match /foo" true
389
+
Alcotest.(check bool) "matches /" true (Respond.match_route routes "/" <> None);
390
+
Alcotest.(check bool)
391
+
"does not match /foo" true
377
392
(Respond.match_route routes "/foo" = None)
378
393
379
394
let test_catchall_only () =
···
389
404
let test_trailing_slash_matches_bare () =
390
405
(* Request /foo/ and /foo both split to ["foo"]; both match /:name. *)
391
406
let routes = [ Respond.get "/:name" ok ] in
392
-
check_bool "matches /foo" true (Respond.match_route routes "/foo" <> None);
393
-
check_bool "matches /foo/" true (Respond.match_route routes "/foo/" <> None)
407
+
Alcotest.(check bool)
408
+
"matches /foo" true
409
+
(Respond.match_route routes "/foo" <> None);
410
+
Alcotest.(check bool)
411
+
"matches /foo/" true
412
+
(Respond.match_route routes "/foo/" <> None)
394
413
395
414
let test_consecutive_slashes () =
396
415
(* // is treated the same as / (empty segments filtered). Documents
397
416
behaviour; callers that care should reject weird paths upstream. *)
398
417
let routes = [ Respond.get "/a/b" ok ] in
399
-
check_bool "matches //a//b" true (Respond.match_route routes "//a//b" <> None)
418
+
Alcotest.(check bool)
419
+
"matches //a//b" true
420
+
(Respond.match_route routes "//a//b" <> None)
400
421
401
422
let test_too_few_segments () =
402
423
let routes = [ Respond.get "/users/:id/posts" ok ] in
403
-
check_bool "no match /users" true (Respond.match_route routes "/users" = None);
404
-
check_bool "no match /users/42" true
424
+
Alcotest.(check bool)
425
+
"no match /users" true
426
+
(Respond.match_route routes "/users" = None);
427
+
Alcotest.(check bool)
428
+
"no match /users/42" true
405
429
(Respond.match_route routes "/users/42" = None)
406
430
407
431
let test_too_many_segments () =
408
432
let routes = [ Respond.get "/users/:id" ok ] in
409
-
check_bool "no match extra segment" true
433
+
Alcotest.(check bool)
434
+
"no match extra segment" true
410
435
(Respond.match_route routes "/users/42/extra" = None)
411
436
412
437
let test_literal_wins_over_param () =
···
480
505
let test_pattern_compile_empty () =
481
506
(* Empty pattern "" compiles to no segments; matches only the empty path. *)
482
507
let routes = [ Respond.get "" ok ] in
483
-
check_bool "matches /" true (Respond.match_route routes "/" <> None);
484
-
check_bool "no match /a" true (Respond.match_route routes "/a" = None)
508
+
Alcotest.(check bool) "matches /" true (Respond.match_route routes "/" <> None);
509
+
Alcotest.(check bool)
510
+
"no match /a" true
511
+
(Respond.match_route routes "/a" = None)
485
512
486
513
let test_pattern_colon_in_literal () =
487
514
(* A colon NOT at position 0 of a segment must remain literal. *)
488
515
let routes = [ Respond.get "/api/v1:batch" ok ] in
489
-
check_bool "literal with colon matches" true
516
+
Alcotest.(check bool)
517
+
"literal with colon matches" true
490
518
(Respond.match_route routes "/api/v1:batch" <> None);
491
-
check_bool "plain name does not match" true
519
+
Alcotest.(check bool)
520
+
"plain name does not match" true
492
521
(Respond.match_route routes "/api/anything" = None)
493
522
494
523
let test_pattern_bare_colon () =
495
524
(* A bare ":" (len 1, leading colon but no name) must stay literal. *)
496
525
let routes = [ Respond.get "/a/:/b" ok ] in
497
-
check_bool "bare colon literal" true
526
+
Alcotest.(check bool)
527
+
"bare colon literal" true
498
528
(Respond.match_route routes "/a/:/b" <> None);
499
-
check_bool "does not behave as wildcard" true
529
+
Alcotest.(check bool)
530
+
"does not behave as wildcard" true
500
531
(Respond.match_route routes "/a/x/b" = None)
501
532
502
533
let test_empty_param_segment () =
···
512
543
let pattern = "/" ^ String.concat "/" (List.init 1000 (fun _ -> "x")) in
513
544
let path = pattern in
514
545
let routes = [ Respond.get pattern ok ] in
515
-
check_bool "matches 1000-seg path" true
546
+
Alcotest.(check bool)
547
+
"matches 1000-seg path" true
516
548
(Respond.match_route routes path <> None)
517
549
518
550
let test_deep_catchall_perf () =
···
526
558
527
559
let test_unrelated_path_against_param () =
528
560
let routes = [ Respond.get "/users/:id" ok ] in
529
-
check_bool "totally different path" true
561
+
Alcotest.(check bool)
562
+
"totally different path" true
530
563
(Respond.match_route routes "/orders/42" = None)
531
564
532
-
let test_catchall_not_greedy_past_pattern () =
565
+
let test_catchall_stops_at_pattern () =
533
566
(* A literal segment after a param must still match. *)
534
567
let routes = [ Respond.get "/auth/:slug/callback" ok ] in
535
-
check_bool "no match without /callback" true
568
+
Alcotest.(check bool)
569
+
"no match without /callback" true
536
570
(Respond.match_route routes "/auth/github" = None);
537
-
check_bool "no match with extra after callback" true
571
+
Alcotest.(check bool)
572
+
"no match with extra after callback" true
538
573
(Respond.match_route routes "/auth/github/callback/extra" = None);
539
574
match bindings_of "/auth/github/callback" routes with
540
575
| Some [ ("slug", "github") ] -> ()
541
576
| _ -> Alcotest.fail "expected slug=github"
542
577
543
-
let test_bindings_order_is_pattern_order () =
578
+
let test_bindings_pattern_order () =
544
579
(* path_params must come out in the order they appear in the pattern. *)
545
580
let routes = [ Respond.get "/:a/:b/:c" ok ] in
546
581
match bindings_of "/x/y/z" routes with
···
555
590
| Some [ ("v", "%Z1") ] -> ()
556
591
| _ -> Alcotest.fail "expected literal %Z1"
557
592
558
-
let test_query_does_not_affect_match () =
593
+
let test_query_doesnt_affect_match () =
559
594
(* Handled at the request layer (parse_url strips ?query before matching),
560
595
so this test drives the matcher with a path-only input. *)
561
596
let path, _ = Respond.parse_url "/users/42?sort=asc" in
···
565
600
| _ -> Alcotest.fail "expected id=42"
566
601
567
602
let test_multiple_catchall_misplaced () =
568
-
check_bool "double ** raises" true
603
+
Alcotest.(check bool)
604
+
"double ** raises" true
569
605
(try
570
606
let _ = Respond.get "/a/**/b/**" ok in
571
607
false
···
606
642
("deep path perf", `Quick, test_deep_path_perf);
607
643
("deep catchall perf", `Quick, test_deep_catchall_perf);
608
644
("unrelated path", `Quick, test_unrelated_path_against_param);
609
-
("exact chain with :param", `Quick, test_catchall_not_greedy_past_pattern);
610
-
("bindings preserve order", `Quick, test_bindings_order_is_pattern_order);
645
+
("exact chain with :param", `Quick, test_catchall_stops_at_pattern);
646
+
("bindings preserve order", `Quick, test_bindings_pattern_order);
611
647
("malformed pct-encoding", `Quick, test_malformed_pct);
612
-
("query stripped before match", `Quick, test_query_does_not_affect_match);
648
+
("query stripped before match", `Quick, test_query_doesnt_affect_match);
613
649
("multiple ** raises", `Quick, test_multiple_catchall_misplaced);
614
650
]
615
651
616
-
(* ── Runner ────────────────────────────────────────────────────────── *)
652
+
(* ── Suites ────────────────────────────────────────────────────────── *)
617
653
618
-
let () =
619
-
Alcotest.run "respond"
620
-
[
621
-
("url-parsing (RFC 7230 §5.3)", url_tests);
622
-
("path-normalization (RFC 3986 §5.2.4)", normalize_tests);
623
-
( "status-line (RFC 7231 §6)",
624
-
status_tests @ [ ("unknown code", `Quick, test_status_unknown) ] );
625
-
("response", response_tests);
626
-
("etag (RFC 7232 §2.3)", etag_tests);
627
-
("mime (RFC 7231 §3.1.1.5)", mime_tests);
628
-
("routing", route_tests);
629
-
]
654
+
let suites =
655
+
[
656
+
("url-parsing (RFC 7230 §5.3)", url_tests);
657
+
("path-normalization (RFC 3986 §5.2.4)", normalize_tests);
658
+
( "status-line (RFC 7231 §6)",
659
+
status_tests @ [ ("unknown code", `Quick, test_status_unknown) ] );
660
+
("response", response_tests);
661
+
("etag (RFC 7232 §2.3)", etag_tests);
662
+
("mime (RFC 7231 §3.1.1.5)", mime_tests);
663
+
("routing", route_tests);
664
+
]
665
+
666
+
let suite =
667
+
( "respond",
668
+
List.concat_map
669
+
(fun (group, cases) ->
670
+
List.map (fun (name, sp, f) -> (group ^ ": " ^ name, sp, f)) cases)
671
+
suites
672
+
|> List.map (fun (name, sp, f) ->
673
+
match sp with
674
+
| `Quick -> Alcotest.test_case name `Quick f
675
+
| `Slow -> Alcotest.test_case name `Slow f) )