From a95b5d0f0e0cc668d38b554b234c5e10d6605074 Mon Sep 17 00:00:00 2001 From: Kabir Samsi Date: Sat, 26 Oct 2024 12:30:47 -0400 Subject: [PATCH] More test development --- semantics/data/test1.data | 0 semantics/test/dune | 3 +- semantics/test/input_progs/test1.data | 30 +++ semantics/test/test_semantics.ml | 339 ++++++++++++++++---------- 4 files changed, 241 insertions(+), 131 deletions(-) create mode 100644 semantics/data/test1.data create mode 100644 semantics/test/input_progs/test1.data diff --git a/semantics/data/test1.data b/semantics/data/test1.data new file mode 100644 index 0000000..e69de29 diff --git a/semantics/test/dune b/semantics/test/dune index ac6be37..72f9f15 100644 --- a/semantics/test/dune +++ b/semantics/test/dune @@ -1,3 +1,4 @@ (tests (names test_semantics) - (libraries rioSemantics ounit2)) + (libraries rioSemantics ounit2) + (deps (glob_files_rec ../data/*))) \ No newline at end of file diff --git a/semantics/test/input_progs/test1.data b/semantics/test/input_progs/test1.data new file mode 100644 index 0000000..b05a7e1 --- /dev/null +++ b/semantics/test/input_progs/test1.data @@ -0,0 +1,30 @@ +0 33.8 38.37 27.62 0 +0 30.81 7.13 9.28 2 +1 0. 0. 0. 0 +1 0. 0. 0. 0 +0 9.16 22.35 17.31 0 +0 4.39 15.83 13.27 1 +0 14.25 40.46 8.18 0 +0 13.77 35.91 5.65 3 +0 18.7 48.73 14.78 3 +0 42.92 41.07 9.67 3 +0 38.71 20.96 18.78 3 +1 0. 0. 0. 0 +1 0. 0. 0. 0 +0 16.11 47.61 12.34 1 +0 20.7 2.5 25.12 3 +0 12.63 11.95 36.88 0 +0 42.14 0.58 23.62 3 +0 38.17 16.61 44.04 3 +0 24.85 7.02 44.14 1 +1 0. 0. 0. 0 +0 15.08 20.53 22.03 3 +0 33.57 13.45 14.48 0 +1 0. 0. 0. 0 +1 0. 0. 0. 0 +1 0. 0. 0. 0 +0 49.94 36.77 9.13 1 +1 0. 0. 0. 0 +1 0. 0. 0. 0 +0 15.05 34.67 31.2 0 +1 0. 0. 0. 0 \ No newline at end of file diff --git a/semantics/test/test_semantics.ml b/semantics/test/test_semantics.ml index 58ab6b5..91f3ce6 100644 --- a/semantics/test/test_semantics.ml +++ b/semantics/test/test_semantics.ml @@ -1,15 +1,37 @@ open RioSemantics open OUnit2 +open Random -module SemanticsTester - (Pkt : RioSemantics.Packet.Packet with type t = float * float * float) - (Q : RioSemantics.Queue.Queue with type elt = Pkt.t) = -struct - include RioSemantics.Program.Program - module S = RioSemantics.Semantics.Semantics (Pkt) (Q) - +(** A module for creating tests *) +module TestGenerator = struct exception QueryFormatException + let trunc f = Float.trunc (f *. 100.) /. 100. + + (* Create a testing file *) + let gen_tests queue_count filename num_cmds = + let rec create_string num_cmds = + if num_cmds = 0 then "" + else + let cmd = if Random.int 100 > 66 then 1 else 0 in + let rank, weight, time = + if cmd = 1 then (0., 0., 0.) + else + ( trunc (Random.float 50.), + trunc (Random.float 50.), + trunc (Random.float 50.) ) + in + let idx = if cmd = 1 then 0 else Random.int queue_count in + string_of_int cmd ^ " " ^ string_of_float rank ^ " " + ^ string_of_float time ^ " " ^ string_of_float weight ^ " " + ^ string_of_int idx ^ "\n" + ^ create_string (num_cmds - 1) + in + + let oc = open_out filename in + Printf.fprintf oc "%s\n" (create_string num_cmds); + close_out oc + (* Parse query string to format *) let parse_to_query = function | [ cmd; p1; p2; p3; idx ] -> @@ -34,9 +56,42 @@ struct read_lines [] |> List.map (String.split_on_char ' ') |> List.map parse_to_query +end + +(** A functor for testing semantics with packet and queue modules *) +module SemanticsTester + (Pkt : RioSemantics.Packet.Packet + with type t = float * float * float + and type ord = float) + (Q : RioSemantics.Queue.Queue with type elt = Pkt.t) = +struct + include RioSemantics.Program.Program + module S = RioSemantics.Semantics.Semantics (Pkt) (Q) + + exception QueryFormatException + + let rec queuegen n = if n = 0 then [] else Q.empty :: queuegen (n - 1) + + (* Write packets to file *) + let write_results filename results = + let oc = open_out filename in + Printf.fprintf oc "%s\n" + (List.fold_right + (fun pkt acc -> + match pkt with + | None -> "No packet\n" ^ acc + | Some p -> + string_of_float (Pkt.rank p) + ^ " " + ^ string_of_float (Pkt.time p) + ^ " " + ^ string_of_float (Pkt.weight p) + ^ "\n") + results ""); + close_out oc (* Generate a list of packets by pushing and popping a given state tuple *) - let simulate (p, qs) input_file = + let simulate (p, qs) lst = let rec aux (p, qs) = function | [] -> [] | (cmd, p1, p2, p3, i) :: t -> @@ -50,7 +105,7 @@ struct else (* No other commands are valid *) raise QueryFormatException in - aux (p, qs) (load_queries input_file) + aux (p, qs) lst (* union clss generates a union of classes such that each class i has name clss[i] *) let union classes = Union (List.map (fun c -> Class c) classes) @@ -58,170 +113,194 @@ struct (* 3 Underlying Classes *) let three_classes = [ - Fifo (union [ "A"; "B"; "C" ]); - EarliestDeadline (union [ "X"; "Y"; "Z" ]); - ShortestJobNext (union [ "D"; "E"; "F" ]); + (Fifo (union [ "A"; "B"; "C" ]), queuegen 3); + (EarliestDeadline (union [ "X"; "Y"; "Z" ]), queuegen 3); + (ShortestJobNext (union [ "D"; "E"; "F" ]), queuegen 3); ] (* 4 Underlying Classes *) let four_classes = [ - RoundRobin - [ Fifo (union [ "A"; "B" ]); EarliestDeadline (union [ "C"; "D" ]) ]; - Strict - [ - ShortestJobNext (union [ "X"; "Y" ]); - Fifo (Class "Z"); - EarliestDeadline (Class "W"); - ]; - WeightedFair - ( [ Fifo (Class "A"); EarliestDeadline (union [ "B"; "C"; "D" ]) ], - [ 1; 2 ] ); + ( RoundRobin + [ Fifo (union [ "A"; "B" ]); EarliestDeadline (union [ "C"; "D" ]) ], + queuegen 4 ); + ( Strict + [ + ShortestJobNext (union [ "X"; "Y" ]); + Fifo (Class "Z"); + EarliestDeadline (Class "W"); + ], + queuegen 4 ); + ( WeightedFair + ( [ Fifo (Class "A"); EarliestDeadline (union [ "B"; "C"; "D" ]) ], + [ 1; 2 ] ), + queuegen 4 ); ] (* 5 Underlying Classes *) let five_classes = [ - WeightedFair - ( [ - Strict [ Fifo (Class "A"); ShortestJobNext (Class "B") ]; - RoundRobin [ Fifo (Class "C"); EarliestDeadline (Class "D") ]; + ( WeightedFair + ( [ + Strict [ Fifo (Class "A"); ShortestJobNext (Class "B") ]; + RoundRobin [ Fifo (Class "C"); EarliestDeadline (Class "D") ]; + ], + [ 3; 2 ] ), + queuegen 5 ); + ( Strict + [ + RoundRobin [ Fifo (Class "E"); EarliestDeadline (Class "F") ]; + Fifo (union [ "G"; "H"; "I" ]); ], - [ 3; 2 ] ); - Strict - [ - RoundRobin [ Fifo (Class "E"); EarliestDeadline (Class "F") ]; - Fifo (union [ "G"; "H"; "I" ]); - ]; - EarliestDeadline (union [ "J"; "K"; "L"; "M"; "N" ]); + queuegen 5 ); + (EarliestDeadline (union [ "J"; "K"; "L"; "M"; "N" ]), queuegen 5); ] (* 6 Underlying Classes *) let six_classes = [ - RoundRobin - [ - Fifo (union [ "A"; "B" ]); - WeightedFair ([ ShortestJobNext (Class "C") ], [ 1 ]); - Fifo (union [ "D"; "E"; "F" ]); - ]; - Strict - [ - EarliestDeadline (union [ "X"; "Y"; "Z" ]); - RoundRobin [ Fifo (Class "P") ]; - ShortestJobNext (union [ "Q"; "R"; "S" ]); - ]; - WeightedFair - ( [ - Fifo (union [ "A"; "B"; "C" ]); - EarliestDeadline (union [ "D"; "E"; "F" ]); + ( RoundRobin + [ + Fifo (union [ "A"; "B" ]); + WeightedFair ([ ShortestJobNext (Class "C") ], [ 1 ]); + Fifo (union [ "D"; "E"; "F" ]); + ], + queuegen 6 ); + ( Strict + [ + EarliestDeadline (union [ "X"; "Y"; "Z" ]); + RoundRobin [ Fifo (Class "P") ]; + ShortestJobNext (union [ "Q"; "R"; "S" ]); ], - [ 2; 3 ] ); + queuegen 6 ); + ( WeightedFair + ( [ + Fifo (union [ "A"; "B"; "C" ]); + EarliestDeadline (union [ "D"; "E"; "F" ]); + ], + [ 2; 3 ] ), + queuegen 6 ); ] (* 7 Underlying Classes *) let seven_classes = [ - RoundRobin - [ - Fifo (union [ "A"; "B"; "C" ]); - ShortestJobNext (union [ "D"; "E" ]); - EarliestDeadline (union [ "F"; "G" ]); - ]; - WeightedFair - ( [ - Strict [ Fifo (Class "H"); EarliestDeadline (Class "I") ]; - ShortestJobNext (union [ "J"; "K"; "L"; "M" ]); + ( RoundRobin + [ + Fifo (union [ "A"; "B"; "C" ]); + ShortestJobNext (union [ "D"; "E" ]); + EarliestDeadline (union [ "F"; "G" ]); + ], + queuegen 7 ); + ( WeightedFair + ( [ + Strict [ Fifo (Class "H"); EarliestDeadline (Class "I") ]; + ShortestJobNext (union [ "J"; "K"; "L"; "M" ]); + ], + [ 3; 4 ] ), + queuegen 7 ); + ( Strict + [ + RoundRobin + [ Fifo (union [ "N"; "O" ]); EarliestDeadline (Class "P") ]; + Fifo (Class "Q"); ], - [ 3; 4 ] ); - Strict - [ - RoundRobin [ Fifo (union [ "N"; "O" ]); EarliestDeadline (Class "P") ]; - Fifo (Class "Q"); - ]; + queuegen 7 ); ] (* 8 Underlying Classes *) let eight_classes = [ - WeightedFair - ( [ - RoundRobin - [ Fifo (union [ "A"; "B"; "C" ]); ShortestJobNext (Class "D") ]; - Strict - [ Fifo (Class "E"); EarliestDeadline (union [ "F"; "G"; "H" ]) ]; + ( WeightedFair + ( [ + RoundRobin + [ Fifo (union [ "A"; "B"; "C" ]); ShortestJobNext (Class "D") ]; + Strict + [ Fifo (Class "E"); EarliestDeadline (union [ "F"; "G"; "H" ]) ]; + ], + [ 1; 1 ] ), + queuegen 8 ); + ( RoundRobin + [ + EarliestDeadline (union [ "I"; "J"; "K"; "L" ]); + ShortestJobNext (union [ "M"; "N"; "O"; "P" ]); + ], + queuegen 8 ); + ( Strict + [ + WeightedFair ([ Fifo (Class "Q") ], [ 2 ]); + ShortestJobNext (union [ "R"; "S"; "T"; "U" ]); ], - [ 1; 1 ] ); - RoundRobin - [ - EarliestDeadline (union [ "I"; "J"; "K"; "L" ]); - ShortestJobNext (union [ "M"; "N"; "O"; "P" ]); - ]; - Strict - [ - WeightedFair ([ Fifo (Class "Q") ], [ 2 ]); - ShortestJobNext (union [ "R"; "S"; "T"; "U" ]); - ]; + queuegen 8 ); ] (* 9 Underlying Classes *) let nine_classes = [ - WeightedFair - ( [ - RoundRobin - [ Fifo (union [ "A"; "B" ]); EarliestDeadline (Class "C") ]; - Strict - [ - Fifo (union [ "D"; "E" ]); - ShortestJobNext (union [ "F"; "G"; "H" ]); - ]; + ( WeightedFair + ( [ + RoundRobin + [ Fifo (union [ "A"; "B" ]); EarliestDeadline (Class "C") ]; + Strict + [ + Fifo (union [ "D"; "E" ]); + ShortestJobNext (union [ "F"; "G"; "H" ]); + ]; + ], + [ 1; 3 ] ), + queuegen 9 ); + ( Strict + [ + WeightedFair + ([ Fifo (Class "I"); EarliestDeadline (Class "J") ], [ 2 ]); + Fifo (union [ "K"; "L"; "M" ]); + ], + queuegen 9 ); + ( RoundRobin + [ + EarliestDeadline (union [ "N"; "O"; "P" ]); + ShortestJobNext (union [ "Q"; "R"; "S" ]); ], - [ 1; 3 ] ); - Strict - [ - WeightedFair - ([ Fifo (Class "I"); EarliestDeadline (Class "J") ], [ 2 ]); - Fifo (union [ "K"; "L"; "M" ]); - ]; - RoundRobin - [ - EarliestDeadline (union [ "N"; "O"; "P" ]); - ShortestJobNext (union [ "Q"; "R"; "S" ]); - ]; + queuegen 9 ); ] (* 10 Underlying Classes *) let ten_classes = [ - WeightedFair - ( [ + ( WeightedFair + ( [ + Strict + [ + RoundRobin + [ + Fifo (union [ "A"; "B"; "C" ]); + EarliestDeadline (Class "D"); + ]; + ShortestJobNext (union [ "E"; "F"; "G"; "H" ]); + ]; + Fifo (union [ "I"; "J" ]); + ], + [ 2; 2 ] ), + queuegen 10 ); + ( RoundRobin + [ Strict [ - RoundRobin - [ - Fifo (union [ "A"; "B"; "C" ]); EarliestDeadline (Class "D"); - ]; - ShortestJobNext (union [ "E"; "F"; "G"; "H" ]); + Fifo (union [ "K"; "L"; "M" ]); + EarliestDeadline (union [ "N"; "O" ]); ]; - Fifo (union [ "I"; "J" ]); + ShortestJobNext (union [ "P"; "Q"; "R"; "S" ]); ], - [ 2; 2 ] ); - RoundRobin - [ - Strict - [ - Fifo (union [ "K"; "L"; "M" ]); - EarliestDeadline (union [ "N"; "O" ]); - ]; - ShortestJobNext (union [ "P"; "Q"; "R"; "S" ]); - ]; - Strict - [ - WeightedFair - ( [ Fifo (union [ "T"; "U"; "V" ]); ShortestJobNext (Class "W") ], - [ 3; 4 ] ); - EarliestDeadline (union [ "X"; "Y"; "Z" ]); - ]; + queuegen 10 ); + ( Strict + [ + WeightedFair + ( [ Fifo (union [ "T"; "U"; "V" ]); ShortestJobNext (Class "W") ], + [ 3; 4 ] ); + EarliestDeadline (union [ "X"; "Y"; "Z" ]); + ], + queuegen 10 ); ] end + +let () = TestGenerator.gen_tests 5 "test1.data" 40