From 0603f5d75a01a8b83fc23a15443fe8131f6644c9 Mon Sep 17 00:00:00 2001 From: Kabir Samsi Date: Sat, 26 Oct 2024 00:05:02 -0400 Subject: [PATCH] Broadened test suite and added generation capabilities --- semantics/lib/program.ml | 3 +- semantics/lib/queue.ml | 2 + semantics/lib/queue.mli | 3 + semantics/lib/semantics.ml | 3 +- semantics/test/test_semantics.ml | 248 ++++++++++++++++++++++++------- 5 files changed, 205 insertions(+), 54 deletions(-) diff --git a/semantics/lib/program.ml b/semantics/lib/program.ml index 78c4e58..a87065e 100644 --- a/semantics/lib/program.ml +++ b/semantics/lib/program.ml @@ -13,5 +13,6 @@ module Program = struct | Strict of stream list | WeightedFair of stream list * int list - type prog = stream (* Exportable type *) + (* Exportable type *) + type prog = stream end diff --git a/semantics/lib/queue.ml b/semantics/lib/queue.ml index 2a8b696..de5099f 100644 --- a/semantics/lib/queue.ml +++ b/semantics/lib/queue.ml @@ -10,6 +10,7 @@ module type Queue = sig val remove : elt option -> t -> t val update : t -> t -> t list -> t list val flush : t -> elt list + val from_list : elt list -> t end (* An implementation for queues (see MLI) *) @@ -41,4 +42,5 @@ module QueueImpl (Pkt : Packet) : Queue with type elt = Pkt.t = struct | h :: t -> if h = e then t else h :: remove elem t) let flush q = q + let from_list elems = List.fold_right (fun x acc -> push (x, acc)) elems empty end diff --git a/semantics/lib/queue.mli b/semantics/lib/queue.mli index 8c2409f..34b7e3e 100644 --- a/semantics/lib/queue.mli +++ b/semantics/lib/queue.mli @@ -23,4 +23,7 @@ module type Queue = sig (* flush q returns all elements enqeued in q. *) val flush : t -> elt list + + (* from_list elems returns a queue containing all elements enqueued in priority order *) + val from_list : elt list -> t end diff --git a/semantics/lib/semantics.ml b/semantics/lib/semantics.ml index 2bb1396..6557b5c 100644 --- a/semantics/lib/semantics.ml +++ b/semantics/lib/semantics.ml @@ -21,8 +21,7 @@ module type SemanticsSig = sig end (** An implementation for Rio's operational semantics. *) -module Semantics (Pkt : Packet) (Q : Queue with type elt = Pkt.t) : - SemanticsSig = struct +module Semantics (Pkt : Packet) (Q : Queue with type elt = Pkt.t) = struct type set = Program.set type prog = Program.prog type pkt = Pkt.t diff --git a/semantics/test/test_semantics.ml b/semantics/test/test_semantics.ml index b5777c6..58ab6b5 100644 --- a/semantics/test/test_semantics.ml +++ b/semantics/test/test_semantics.ml @@ -2,80 +2,226 @@ open RioSemantics open OUnit2 module SemanticsTester - (Pkt : RioSemantics.Packet.Packet) + (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) + exception QueryFormatException + + (* Parse query string to format *) + let parse_to_query = function + | [ cmd; p1; p2; p3; idx ] -> + ( int_of_string cmd, + float_of_string p1, + float_of_string p2, + float_of_string p3, + int_of_string idx ) + | _ -> raise QueryFormatException + + (* Load data from file into query format *) + let load_queries filename = + let ic = open_in filename in + let rec read_lines acc = + try + let line = input_line ic in + read_lines (line :: acc) + with End_of_file -> + close_in ic; + List.rev acc + in + read_lines [] + |> List.map (String.split_on_char ' ') + |> List.map parse_to_query + (* Generate a list of packets by pushing and popping a given state tuple *) - let rec simulate state = function - | [] -> [] - | (cmd, pkt, q) :: t -> - (* Command = true => push with packet and queue *) - if cmd then simulate (S.push (pkt, q, state)) t - else - (* Command = false => pop *) - let popped, new_state = S.pop state in - popped :: simulate new_state t + let simulate (p, qs) input_file = + let rec aux (p, qs) = function + | [] -> [] + | (cmd, p1, p2, p3, i) :: t -> + if cmd = 1 then + (* Command = 1 => push with packet and qs[i] *) + aux (S.push ((p1, p2, p3), List.nth qs i, (p, qs))) t + else if cmd = 0 then + (* Command = 0 => pop *) + let popped, new_state = S.pop (p, qs) in + popped :: aux new_state t + else (* No other commands are valid *) + raise QueryFormatException + in + aux (p, qs) (load_queries input_file) + + (* 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) + + (* 3 Underlying Classes *) + let three_classes = + [ + Fifo (union [ "A"; "B"; "C" ]); + EarliestDeadline (union [ "X"; "Y"; "Z" ]); + ShortestJobNext (union [ "D"; "E"; "F" ]); + ] + + (* 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 ] ); + ] - let programs = + (* 5 Underlying Classes *) + let five_classes = [ - (* 1. Simple FIFO with a Single Class *) - Fifo (Class "A"); - (* 2. Union of Multiple Classes *) - Fifo (Union [ Class "A"; Class "B"; Class "C" ]); - (* 3. Earliest Deadline on a Union *) - EarliestDeadline (Union [ Class "X"; Class "Y" ]); - (* 4. Shortest Job Next with a Single Class *) - ShortestJobNext (Class "Z"); - (* 5. Strict Combination of Two Streams *) + WeightedFair + ( [ + Strict [ Fifo (Class "A"); ShortestJobNext (Class "B") ]; + RoundRobin [ Fifo (Class "C"); EarliestDeadline (Class "D") ]; + ], + [ 3; 2 ] ); Strict - [ Fifo (Class "A"); ShortestJobNext (Union [ Class "B"; Class "C" ]) ]; - (* 6. RoundRobin with Three Streams *) + [ + RoundRobin [ Fifo (Class "E"); EarliestDeadline (Class "F") ]; + Fifo (union [ "G"; "H"; "I" ]); + ]; + EarliestDeadline (union [ "J"; "K"; "L"; "M"; "N" ]); + ] + + (* 6 Underlying Classes *) + let six_classes = + [ RoundRobin [ - Fifo (Class "A"); - EarliestDeadline (Class "B"); - ShortestJobNext (Union [ Class "C"; Class "D" ]); + Fifo (union [ "A"; "B" ]); + WeightedFair ([ ShortestJobNext (Class "C") ], [ 1 ]); + Fifo (union [ "D"; "E"; "F" ]); ]; - (* 7. WeightedFair with Two Streams and Weights *) - WeightedFair ([ Fifo (Class "A"); EarliestDeadline (Class "B") ], [ 3; 5 ]); - (* 8. Complex Strict with a Nested RoundRobin *) Strict [ - RoundRobin - [ - Fifo (Class "A"); ShortestJobNext (Union [ Class "B"; Class "C" ]); - ]; - EarliestDeadline (Class "D"); + EarliestDeadline (union [ "X"; "Y"; "Z" ]); + RoundRobin [ Fifo (Class "P") ]; + ShortestJobNext (union [ "Q"; "R"; "S" ]); ]; - (* 9. WeightedFair with Nested Streams *) WeightedFair ( [ - Strict [ Fifo (Class "A"); EarliestDeadline (Class "B") ]; - ShortestJobNext (Union [ Class "C"; Class "D" ]); + Fifo (union [ "A"; "B"; "C" ]); + EarliestDeadline (union [ "D"; "E"; "F" ]); ], - [ 1; 2 ] ); - (* 10. Deeply Nested Stream with Multiple Layers *) + [ 2; 3 ] ); + ] + + (* 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" ]); + ], + [ 3; 4 ] ); + Strict + [ + RoundRobin [ Fifo (union [ "N"; "O" ]); EarliestDeadline (Class "P") ]; + Fifo (Class "Q"); + ]; + ] + + (* 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" ]) ]; + ], + [ 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" ]); + ]; + ] + + (* 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" ]); + ]; + ], + [ 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" ]); + ]; + ] + + (* 10 Underlying Classes *) + let ten_classes = + [ + WeightedFair + ( [ + Strict + [ + RoundRobin + [ + Fifo (union [ "A"; "B"; "C" ]); EarliestDeadline (Class "D"); + ]; + ShortestJobNext (union [ "E"; "F"; "G"; "H" ]); + ]; + Fifo (union [ "I"; "J" ]); + ], + [ 2; 2 ] ); RoundRobin [ Strict [ - EarliestDeadline (Union [ Class "X"; Class "Y" ]); - RoundRobin - [ - ShortestJobNext (Class "Z"); - WeightedFair - ( [ - Fifo (Class "A"); - Strict - [ EarliestDeadline (Class "B"); Fifo (Class "C") ]; - ], - [ 4; 2 ] ); - ]; + Fifo (union [ "K"; "L"; "M" ]); + EarliestDeadline (union [ "N"; "O" ]); ]; - Fifo (Union [ Class "D"; Class "E" ]); + ShortestJobNext (union [ "P"; "Q"; "R"; "S" ]); + ]; + Strict + [ + WeightedFair + ( [ Fifo (union [ "T"; "U"; "V" ]); ShortestJobNext (Class "W") ], + [ 3; 4 ] ); + EarliestDeadline (union [ "X"; "Y"; "Z" ]); ]; ] end