mte/unikernel/duniverse/ocaml-h2/lib_test/test_priority.ml
2025-11-11 02:07:51 +01:00

352 lines
11 KiB
OCaml

open H2__
open Test_common
module Scheduler = Server_connection.Scheduler
let pp_priority fmt { Priority.weight; stream_dependency; exclusive } =
Format.fprintf
fmt
"Weight: %d; Parent: %ld; Exclusive: %B"
weight
stream_dependency
exclusive
let priority = Alcotest.of_pp pp_priority
let node =
(module struct
open Scheduler.PriorityTreeNode
type t = parent
let pp formatter (Parent t) =
Format.pp_print_text formatter (Scheduler.stream_id t |> Int32.to_string)
let equal (Parent h1) (Parent h2) =
Stream_identifier.(Scheduler.(stream_id h1) === Scheduler.(stream_id h2))
end : Alcotest.TESTABLE
with type t = Scheduler.PriorityTreeNode.parent)
let default_error_handler ?request:_ _err _handle = ()
let new_p w = { Priority.exclusive = false; stream_dependency = 0l; weight = w }
let test_reqd stream_id =
Stream.create
~max_frame_size:Config.default.read_buffer_size
stream_id
Serialize.Writer.(create 0x400)
default_error_handler
(fun ~active:_ _ -> ())
let repeat (Scheduler.PriorityTreeNode.Connection root) queue num =
let rec loop q n acc =
if n = 0
then acc
else
match Scheduler.PriorityQueue.pop q with
| None -> failwith "invalid queue"
| Some ((k, (Scheduler.Stream p as p_node)), q') ->
(* simulate writing 100 bytes *)
root.t_last <- p.t;
Scheduler.update_t p_node 100;
loop (Scheduler.PriorityQueue.add k p_node q') (n - 1) (k :: acc)
in
loop queue num []
let add_stream root ?(priority = Priority.default_priority) reqd =
ignore
@@ Scheduler.add
root
~priority
~initial_recv_window_size:Settings.WindowSize.default_initial_window_size
~initial_send_window_size:Settings.WindowSize.default_initial_window_size
reqd
let test_priority_queue () =
let root = Scheduler.make_root ~capacity:1000 () in
add_stream root ~priority:(new_p 201) (test_reqd 1l);
add_stream root ~priority:(new_p 101) (test_reqd 3l);
add_stream root ~priority:(new_p 1) (test_reqd 5l);
let q = Scheduler.children root in
Alcotest.(check bool)
"Check if empty"
false
(Scheduler.PriorityQueue.is_empty q);
let t = repeat root q 1000 in
let count_1 = List.filter (fun x -> x = 1l) t |> List.length in
let count_3 = List.filter (fun x -> x = 3l) t |> List.length in
let count_5 = List.filter (fun x -> x = 5l) t |> List.length in
(* After multiple repetitions, the frequency of 1, 3 and 5 is proportional to
* their weight, e.g. 101 * 1000 / 303 *)
Alcotest.(check int) "Number of items with weight 201" 663 count_1;
Alcotest.(check int) "Number of items with weight 101" 333 count_3;
Alcotest.(check int) "Number of items with weight 1" 4 count_5
let test_reprioritize () =
let open Scheduler in
let root = Scheduler.make_root ~capacity:5 () in
add_stream root (test_reqd 1l);
add_stream root (test_reqd 3l);
add_stream root (test_reqd 5l);
(* change the weight of stream 1 *)
let new_priority = { Priority.default_priority with weight = 100 } in
let (Stream stream1 as stream1_node) =
Scheduler.get_node root 1l |> opt_exn
in
Scheduler.reprioritize_stream root ~priority:new_priority stream1_node;
Alcotest.check
priority
"Stream 1 changed weight"
new_priority
stream1.priority;
let (Stream stream3) = Scheduler.get_node root 3l |> opt_exn in
Alcotest.check
priority
"Stream 3 still has default weight"
Priority.default_priority
stream3.priority;
(* Add stream 7 that depends on 1 *)
let stream7 = test_reqd 7l in
let stream7_priority =
{ Priority.default_priority with stream_dependency = 1l }
in
add_stream root ~priority:stream7_priority stream7;
let (Stream stream7) = Scheduler.get_node root 7l |> opt_exn in
Alcotest.check
priority
"Stream 7 depends on stream 1"
stream7_priority
stream7.priority;
Alcotest.check
node
"Stream 7 depends on stream 1"
(Parent stream1_node)
stream7.parent;
let _, Stream stream1_first_child =
stream1.children |> PriorityQueue.to_list |> List.hd
in
Alcotest.(check bool)
"Stream 1 has stream 7 in its children"
false
(PriorityQueue.is_empty stream1.children);
Alcotest.(check int32)
"Stream 1 has stream 7 in its children"
7l
stream1_first_child.descriptor.id;
Alcotest.(check int)
"Root still has 3 children"
3
(PriorityQueue.size (Scheduler.children root))
let test_reprioritize_exclusive () =
let open Scheduler in
let root = Scheduler.make_root ~capacity:5 () in
add_stream root (test_reqd 1l);
add_stream root (test_reqd 3l);
add_stream root (test_reqd 5l);
(* Add stream 7 that exclusively depends on 0 *)
let stream7 = test_reqd 7l in
let stream7_priority =
{ Priority.default_priority with stream_dependency = 0l; exclusive = true }
in
add_stream root ~priority:stream7_priority stream7;
let (Stream stream7 as stream7_node) =
Scheduler.get_node root 7l |> opt_exn
in
Alcotest.check
priority
"Stream 7 depends on stream 0"
stream7_priority
stream7.priority;
Alcotest.check
node
"Stream 7 depends on stream 0"
(Parent root)
stream7.parent;
let root_children = Scheduler.children root |> PriorityQueue.to_list in
let _, Stream root_first_child = List.hd root_children in
Alcotest.(check int32)
"Stream 0 has a single child, stream 7"
7l
root_first_child.descriptor.id;
Alcotest.(check int)
"Stream 0 has a single child, stream 7"
1
(List.length root_children);
let (Stream stream1) = Scheduler.get_node root 1l |> opt_exn in
Alcotest.check
node
"Stream 1's parent is now stream 7"
(Parent stream7_node)
stream1.parent;
Alcotest.(check int)
"Stream 7 has 3 children"
3
(PriorityQueue.size stream7.children)
let depend_on stream_id =
{ Priority.default_priority with stream_dependency = stream_id }
let set_up_dep_tree root =
add_stream root (test_reqd 1l);
add_stream root ~priority:(depend_on 1l) (test_reqd 3l);
add_stream root ~priority:(depend_on 1l) (test_reqd 5l);
add_stream root ~priority:(depend_on 5l) (test_reqd 7l);
add_stream root ~priority:(depend_on 5l) (test_reqd 9l);
add_stream root ~priority:(depend_on 7l) (test_reqd 11l)
(*
* This is the tree from: https://tools.ietf.org/html/rfc7540#section-5.3.3
*
* 1 --> 7
* 0 0
* | |
* 1 7
* / \ / \
* 3 5 ==> 11 1
* / \ / \
* 7 9 3 5
* | |
* 11 9
*
* (non-exclusive)
*)
let test_reprioritize_to_dependency () =
let open Scheduler in
let root = Scheduler.make_root ~capacity:6 () in
set_up_dep_tree root;
let (Stream stream1 as stream1_node) =
Scheduler.get_node root 1l |> opt_exn
in
let stream5_node = Scheduler.get_node root 5l |> opt_exn in
let (Stream stream7 as stream7_node) =
Scheduler.get_node root 7l |> opt_exn
in
Alcotest.check
node
"Stream 7 depends on stream 5"
(Parent stream5_node)
stream7.parent;
let root_children = Scheduler.children root |> PriorityQueue.to_list in
let _, Stream root_first_child = List.hd root_children in
Alcotest.(check int32)
"Stream 0 has a single child, stream 1"
1l
root_first_child.descriptor.id;
Alcotest.(check int)
"Stream 0 has a single child, stream 7"
1
(List.length root_children);
(* reprioritize stream 1 to have 7 as the new parent *)
reprioritize_stream root ~priority:(depend_on 7l) stream1_node;
Alcotest.check
node
"Stream 1's parent is now stream 7"
(Parent stream7_node)
stream1.parent;
Alcotest.check
node
"Stream 7's parent is now stream 0"
(Parent root)
stream7.parent;
Alcotest.(check int)
"Stream 7 has 2 children"
2
(PriorityQueue.size stream7.children);
Alcotest.(check (list int32))
"Stream 7 has 2 children, 11 and 1"
[ 1l; 11l ]
(stream7.children |> PriorityQueue.to_list |> List.map fst)
(*
* This is the tree from: https://tools.ietf.org/html/rfc7540#section-5.3.3
*
* 1 --> 7
* 0 0
* | |
* 1 7
* / \ |
* 3 5 ==> 1
* / \ /|\
* 7 9 3 5 11
* | |
* 11 9
*
* (exclusive)
*)
let test_reprioritize_to_dependency_exclusive () =
let open Scheduler in
let root = Scheduler.make_root ~capacity:6 () in
set_up_dep_tree root;
let stream5_node = Scheduler.get_node root 5l |> opt_exn in
let (Stream stream7 as stream7_node) =
Scheduler.get_node root 7l |> opt_exn
in
Alcotest.check
node
"Stream 7 depends on stream 5"
(Parent stream5_node)
stream7.parent;
let root_children = Scheduler.children root |> PriorityQueue.to_list in
let _, Stream root_first_child = List.hd root_children in
Alcotest.(check int32)
"Stream 0 has a single child, stream 1"
1l
root_first_child.descriptor.id;
Alcotest.(check int)
"Stream 0 has a single child, stream 7"
1
(List.length root_children);
(* reprioritize stream 1 to have 7 as the new parent with exclusive
priority *)
let (Stream stream1 as stream1_node) =
Scheduler.get_node root 1l |> opt_exn
in
reprioritize_stream
root
~priority:
{ Priority.default_priority with
stream_dependency = 7l
; exclusive = true
}
stream1_node;
Alcotest.check
node
"Stream 1's parent is now stream 7"
(Parent stream7_node)
stream1.parent;
Alcotest.check
node
"Stream 7's parent is now stream 0"
(Parent root)
stream7.parent;
Alcotest.(check int)
"Stream 7 has a single child"
1
(PriorityQueue.size stream7.children);
Alcotest.(check (list int32))
"Stream 7 has a single child 1"
[ 1l ]
(stream7.children |> PriorityQueue.to_list |> List.map fst);
Alcotest.(check (list int32))
"Stream 11 is now a child of stream 1"
[ 3l; 5l; 11l ]
(stream1.children |> PriorityQueue.to_list |> List.map fst)
let priority_queue_tests =
[ "Priority queue tests", `Quick, test_priority_queue ]
let reprioritization_tests =
[ "Reprioritize simple", `Quick, test_reprioritize
; "Reprioritize simple exclusive", `Quick, test_reprioritize_exclusive
; "Reprioritize to dependency", `Quick, test_reprioritize_to_dependency
; ( "Reprioritize to dependency exclusive"
, `Quick
, test_reprioritize_to_dependency_exclusive )
]
let () =
Alcotest.run
"h2 unit tests"
[ "Reprioritization tests", reprioritization_tests
; "Priority_Queue_Tests", priority_queue_tests
]